用delphi7编写windows服务程序
- 格式:doc
- 大小:101.50 KB
- 文档页数:19
⽤delphi7编写windows服务程序⽤delphi7编写windows服务程序总结⼀、服务程序的创建delphi编写服务程序⾮常简单,点击菜单File->New->Other->New属性页->Service Application,系统⾃动会创建基本的代码。
这⾥需要说明的是,在“New属性页”中还有⼀个Service,这个Service和Service Application还是有区别的,应该说Service Application的范围⼤,它可以包含⼏个Service。
⼀个Service Application可以创建⼏个Service,service继承⾃TService,界⾯表现和TDataModel类似,做过数据库的朋友肯定都不陌⽣,区别是TDataModel是⽤来放数据库连接及操作组件的容器,⽽TService则是可以存放很多没有界⾯的组件,如indy的IDtcpclient等。
⼆、重要属性及事件说明属性:DisplayName 显⽰名称Name 名称,当你⽤命令提⽰符来启动、停⽌服务时,就需要⽤到Interactive 与界⾯交互的选项事件:OnCreate:类似于Tform的OnCreateOnDestroy:类似于Tform的OnDestroyOnExecute:⾮常重要,⼀般写成下⾯while not Terminated dobeginSleep(10);ServiceThread.ProcessRequests(False);end;OnPause:服务暂停OnShutdown:不太清楚OnStart:服务启动,重要OnStop:服务停⽌,重要三、服务的依赖关系因为我的服务是要连接数据库的,所以必须要等sql server的服务起来之后,我才能起来,这样才能连接数据库,因此这⾥⾯有个依赖关系的问题。
可以在属性Dependencies 中增加⼀项,选择MSSQLSERVER。
实验一Delphi程序设计初识实验目的●了解Delphi 7.0的集成开发环境(IDE)●初步掌握在Delphi IDE中开发应用程序的一般步骤●初步掌握窗体设计器、对象观察器、代码编辑器的使用方法实验示例1设计如下图所示的Windows应用程序。
程序运行后,窗口空白显示,鼠标点击窗口,则显示如图文字,同时“退出”按钮激活;单击“退出”按钮,则关闭窗口,结束运行。
实现步骤:1.新建Application项目启动Delphi 7.0后,IDE已自动创建并初始化了一个Application项目Project1。
第1步可省略。
否则,通过执行菜单【File】→【New】→【Application】项创建,或单击工具栏上的New items快捷钮打开的对话框来创建Application。
IDE自动初始化一个Windows应用程序项目。
2.在窗体上布置组件1)用鼠标拖动的方法,适当调整窗体的大小;2)在standard组件板上用鼠标点击(Button组件),然后在窗体适当位置单击,将自动创建按钮Button1;3)在standard组件板上用鼠标点击(Label组件),然后在窗体适当位置单击,将自动创建标签Label1。
3.设置窗体和组件属性1)通过单击窗体空白处,或在对象观察器(Object Inspector)窗口的对象列表框中选中Form1,然后在属性页(Properties)中点击选中Caption属性,在其后输入“My first form”属性值;2)同样方法选中Label1组件对象,将其Caption属性值设为“我的第一个Windows应用程序”,Font(字体)属性设为“宋体”、五号、深蓝色,Visible(可视的)属性设为False;3)选中Button1组件对象,设置其Caption属性为“退出”,Enabled(激活的)属性设为False。
4.编写程序代码1)选中Form1,在对象观察器窗口的事件(Events)页中选中OnClick(鼠标点击)事件,鼠标双击其后的编辑处,IDE则自动初始化了一个TForm1的OnClick事件处理过程(见代码编辑器窗口),转到代码编辑器窗口,在对应事件处理过程中编写如下代码:procedure TForm1.FormClick(Sender: TObject);beginlabel1.Visible:=true;button1.Enabled:=true;end;2)选中Button1,同样方法,编写其OnClick事件处理程序代码如下:procedure TForm1.Button1Click(Sender: TObject);beginform1.Close;end;5.保存项目和程序单元执行菜单【File】→【S ave Project As…】项,在打开的保存项目文件对话框中,选择项目保存位置,编辑项目文件名,确认保存项目(扩展名dpr);然后执行菜单【File】→【Save As…】项,在打开的对话框中保存单元文件(扩展名pas)。
使用Delphi 7创建Intraweb应用程序赵海平haipin@一、使用Intraweb创建Web服务程序Intraweb是一套开发Web应用程序的简单工具,你可以像开发传统的可视化和窗口程序一样,开发Web应用程序。
你可以通过Delphi语言写出各种商用软件,当需要的时候Intraweb可以转成脚本或者Html语言。
你可以通过下面的各种方式使用IntraWeb:✧单独式IntraWeb使用其独立的应用对象类型处理程序。
程序开发不需商业服务器,而以Intraweb自己的应用程序服务器来进行应用程序开发.✧应用程序模式IntraWeb支持应用程序对象。
应用程序依靠商业服务器。
✧页面模式应用程序被Web Broker or WebSnap所支持。
二、IntraWeb应用程序可以创建如下三种类型:✧ISAPI/NSAPI✧Apache 版本1 和2✧CGI (仅用于页面模式)✧Windows服务三、使用Intraweb控件IntraWeb与大多数的浏览器兼容,IntraWeb应用程序自己探测用户的浏览器,以达到最好的浏览效果。
IntraWeb支持Internet Explorer从版本4-6, Netscape 4和6,以及Mozilla.。
一个重要的优势是IntraWeb象开发Vcl和CLX程序一样,使用同一套工具和技术。
你可以拖动控件到窗口上开发你的程序界面。
下面列出VCL/CLX控件与IntraWeb控件的对照表:VCL/CLX控件对应的IntraWeb IntraWeb控件面板位置Button IWButton IWStandardCheckBox IWCheckBox IW StandardComboBox IWComboBox IW Standard DBCheckBox IWDBCheckBox IW DataDBComboBox IWDBComboBox IW DataDBEdit IWDBEdit IW DataDBGrid IWDBGrid IW DataDBImage IWDBImage IW DataDBLabel IWDBLabel IW DataDBListBox IWDBListBox IW Data DBLookupComboBox IWDBLookupComboBox IW Data DBLookupListBox IWDBLookupListBox IW DataDBMemo IWDBMemo IW DataDBNavigator IWDBNavigator IW DataDBText IWDBText IW DataEdit IWEdit IW StandardImage IWImage or IWImageFile IW StandardLabel IWLabel IW StandardListBox IWListBox IW StandardMemo IWMemo IW Standard RadioGroup IWRadioGroup IW StandardTimer IWTimer IW StandardTreeView IWTreeView IW Standard四、开始创建IntraWeb应用程序假如你以前使用过Delphi开发过可视化应用程序,那么,恭喜你,你已经有了基本的开发IntraWeb的基础。
利用Delphi编写Windows 控制面板组件及实例张建军(中国人民解放军合肥炮兵学院研究生系97级)韩莹(中保财险安徽省铜陵市分公司计财部)关键词:在windows95/Nt/98操作系统中,控制面板(controlpanel)提供了定制windows的操作方法,通过它可以完成设置打印机、显示、网络、添加新硬件等功能。
通常控制面板包含20多个组件(*.cpL),分别负责系统某一方面的设置。
鼠标双击任一组件图标,控制面板调用相应程序,弹出对话框,允许设置系统参数。
确认修改后系统参数保存在windows注册表或某一配置文件(*.INI)中。
一、控制面板组件基础知识控制面板是一个windows应用程序c:\wINDowS\coNtRoL.ExE,其配置文件是c:\wINDowS\coNtRoL.INI.控制面板组件是一些动态链接库,其扩展名不是DLL,而是cpL.通常,控制面板组件保存在c:\wINDowS\SyStEm\目录下。
在coNtRoL.INI中有一个[mmcpL]节,该节可指定由coNtRoL.ExE调用的动态链接库,其格式一般为:…[mmcpL]uniqueName=D:\pRoJEct1.DLL(这里假设pRoJEct1为用户编写的控制面板组板文件名,其访问路径可由读者自行确定)…采用此方法,pRoJEct1.DLL不必存放在c:\wINDowS\SyStEm\目录下,扩展名不必改为cpL.coNtRoL.ExE运行后按以下顺序调用这些动态链接库:在c:\wINDowS\SyStEm\目录下调用mAIN.INI.已加载并输出cplApplet()函数的可安装驱动程序。
在coNtRoL.INI[mmcpL]节中指定的DLL.在c:\wINDowS\SyStEm\目录下调用cpL.因此,编写控制面板组件近似于编写普通DLL.通常一个cpL支持控制面板中的一个组件(即一个图标),也可支持多个组件。
Delphi中的Windows API编程初步使用RAD类型工具的人越来越多了,虽然我对于RAD类的工具向来不多作评议,但我还是常常使用的。
所以我深深的知道这类工具虽然给我们带来了便利,使我们能不用将更多的精力放在界面上,但同时也将初学者紧紧的圈在了他所提供的控件和组件中。
所以很多人并不能真正的了解windows的消息驱动原理以及windows的运作过程。
本文中我们就一起来学习一下windows的运作过程,使我们对delphi这样一个优秀的编程工具有一个新的认识,并对windows下的程序编写有更深刻、透辟的了解和认识。
一、消息的定义我们先从使用的角度看看windows的运作过程。
我们都知道windows是一个多任务的平台,使用这个平台,我们可以一边工作,一边听歌曲,等等。
所以对于这个操作平台可以想象到它除了一般操作系统所提供的对文件系统,内存系统等的管理之外,更重要的就是我们所熟知的消息驱动了,也就是说,要通过一定的方法和结构可以给每一个运行中的程序实例以及其中的每一个窗口传递其中所触发的事件。
Windows中究竟是怎样做到的呢?让我们打开安装delphi的目录,在其中的source\rtl\Win\Windows.pas文件(或者在一个工程文件,找到uses,在其中找到Windows,然后按下Ctrl键,用鼠标点击单词),在其中的第18919行,我们可以看到这样一个结构的定义:{ Message structure }PMsg = ^TMsg ;tagMSG = packed recordhwnd : HWND ;message : UINT ;wParam : WPARAM ;lParam : LPARAM ;time : DWORD ;pt : TPoint ;end ;{ $ EXTERNALSYM tagMSG }TMsg = tagMSG ;MSG = tagMSG ;{ $ EXTERNALSYM MSG }其中hwnd字段表示触发了消息的窗口的ID,由此可以保证消息正确的发送到每一个窗口去。
DELPHI编写服务程序一、服务程序和桌面程序的区别Windows 2000/XP/2003等支持一种叫做“系统服务程序”的进程,系统服务和桌面程序的区别是:系统服务不用登陆系统即可运行;系统服务是运行在System Idle Process/System/smss/winlogon/services下的,而桌面程序是运行在Explorer下的;系统服务拥有更高的权限,系统服务拥有Sytem的权限,而桌面程序只有Administrator权限;在Delphi中系统服务是对桌面程序进行了再一次的封装,既系统服务继承于桌面程序。
因而拥有桌面程序所拥有的特性;系统服务对桌面程序的DoHandleException做了改进,会自动把异常信息写到NT服务日志中;普通应用程序启动只有一个线程,而服务启动至少含有三个线程。
(服务含有三个线程:TServiceStartThread服务启动线程;TServiceThread服务运行线程;Application主线程,负责消息循环);摘录代码:procedure TServiceApplication.Run;begin...StartThread := TServiceStartThread.Create(ServiceStartT able);trywhile not Forms.Application.Terminated doForms.Application.HandleMessage;Forms.Application.Terminate;if StartThread.ReturnValue <> 0 thenFEventLogger.LogMessage(SysErrorMessage(StartThread.Re turnValue));finallyStartThread.Free;end;...end;procedure TService.DoStart;begintryStatus := csStartPending;tryFServiceThread := TServiceThread.Create(Self);FServiceThread.Resume;FServiceThread.WaitFor;FreeAndNil(FServiceThread);finallyStatus := csStopped;end;excepton E: Exception doLogMessage(Format(SServiceFailed,[SExecute, E.Message]));end;end;在系统服务中也可以使用TTimer这些需要消息的定时器,因为系统服务在后台使用TApplication在分发消息;二、如何编写一个系统服务打开Delphi编辑器,选择菜单中的File|New|Other...,在New Item中选择Service Application项,Delphi便自动为你建立一个基于TServiceApplication的新工程,TserviceApplication是一个封装NT服务程序的类,它包含一个TService1对象以及服务程序的装卸、注册、取消方法。
附录:案例使用说明1.关于操作系统的使用说明本书的案例适合于在Microsft Windows 98操作系统和Microsft Windows XP操作系统中开发制作,如果你在Microsft Windows 98操作系统中安装Delphi 7.x,则请先参考后面的Delphi的安装与使用,但是如果你指定要在Microsft Windows XP操作系统中使用本书并进行案例制作,由于Microsft Windows XP操作系统对于一些非微软的应用程序需要进行驱动程序签名,否则Delphi一些程序将不可运行,因此你需要首先作如下一些操作:在Microsft Windows XP操作系统中进行驱动程序签名的设置,其过程按如下顺序进行:控制面板――>系统属性――>驱动程序签名选项――>忽略-安装。
在进行了驱动程序签名设置之后,就可以象在Microsft Windows 98操作系统中安装和使用Delphi 7.x了。
2.本书中的Delphi 7.x代指Delphi 7.0以及Delphi 7.0以上的其他的测试版直到Delphi8.0。
3.Delphi 7.0的注册安装与使用注册本书中,由于Delphi 7.x泛指Delphi 7.0以上的一切升级版(包括Delphi 7.0),因此我们特以Delphi 7.0的安装为例来说明Delphi 在操作系统中的安装方法,请严格按此说明进行安装,因为光盘中的程序是未建立安装文件的程序,它们可能依赖于原开发环境,因此原开发平台的安装将影响到光盘中案例的正常的运行和演示。
安装Delphi 7.0的方法如下:第一步:启动Delphi 7.0,系统提示将Delphi 7.0的安装文件解压缩到硬盘的一个指定的驱动器之中,这样在硬盘中安装最为快捷而且不会由于光盘的质量问题而中断安装。
第二步:对Delphi 7.0进行安装注册。
在Delphi 7.0光盘中有一个序列号生成器(Keygen 程序),启动该程序生成安装Delphi 7.0的序列号和著作权号,请记下这两个号码,因为在安装Delphi 7.0后需要对Delphi 7.0进行使用注册,使用注册时即需要用到这两个号码。
一、Windows服务简介服务程序(Service Application)是一种运行于WinNT的后台程序,每个服务程序(Service Application)中可能包含若干个服务(Service),每个服务就是其中的一个线程(该服务也可以创建多个子线程)。
采用服务,应用程序可以获得特殊的权限,而且不会被用户通过Win2000的任务管理器直接结束程序,所以服务常常用来实现一些特殊的目标。
通过Win2000控制面板中的服务管理工具,我们可以设置/查看服务的特性:(1)服务名称;(2)显示名称;(3)描述;(4)启动类型;(5)依赖关系;其中,服务名称是标识给服务的。
以Win2000的C:\WINNT\System32\程序为例子,该Exe文件对应一个Service Application,是该服务程序的可见实体;该exe中包含多个服务(Service),例如Alerter,Dhcp(DHCP Client),Messenger等。
当我们结束一个服务的时候,该服务所在的Service Application 中的其他服务并没有被终止。
在Delphi中,Borland的工程师为我们提供了TServiceApplication,TService,TServiceThread等类,封装了大量细节,简化了服务程序的。
二、TServiceApplication在Delphi中,类TServiceApplication就对应上述的ServiceApplication。
利用Delphi的开发环境,我们新建一个Service Application Project,同时就创建了一个继承自TService的类。
项目文件中的Application对象就是一个TServiceApplication实例。
每个TServiceApplication包含若干个TService对象,正好对应上述的服务程序和服务之间的数量关系。
使用Delphi 7创建Intraweb应用程序赵海平haipin@一、使用Intraweb创建Web服务程序Intraweb是一套开发Web应用程序的简单工具,你可以像开发传统的可视化和窗口程序一样,开发Web应用程序。
你可以通过Delphi语言写出各种商用软件,当需要的时候Intraweb可以转成脚本或者Html语言。
你可以通过下面的各种方式使用IntraWeb:✧单独式IntraWeb使用其独立的应用对象类型处理程序。
程序开发不需商业服务器,而以Intraweb自己的应用程序服务器来进行应用程序开发.✧应用程序模式IntraWeb支持应用程序对象。
应用程序依靠商业服务器。
✧页面模式应用程序被Web Broker or WebSnap所支持。
二、IntraWeb应用程序可以创建如下三种类型:✧ISAPI/NSAPI✧Apache 版本1 和2✧CGI (仅用于页面模式)✧Windows服务三、使用Intraweb控件IntraWeb与大多数的浏览器兼容,IntraWeb应用程序自己探测用户的浏览器,以达到最好的浏览效果。
IntraWeb支持Internet Explorer从版本4-6, Netscape 4和6,以及Mozilla.。
一个重要的优势是IntraWeb象开发Vcl和CLX程序一样,使用同一套工具和技术。
你可以拖动控件到窗口上开发你的程序界面。
下面列出VCL/CLX控件与IntraWeb控件的对照表:VCL/CLX控件对应的IntraWeb IntraWeb控件面板位置Button IWButton IWStandardCheckBox IWCheckBox IW StandardComboBox IWComboBox IW Standard DBCheckBox IWDBCheckBox IW DataDBComboBox IWDBComboBox IW DataDBEdit IWDBEdit IW DataDBGrid IWDBGrid IW DataDBImage IWDBImage IW DataDBLabel IWDBLabel IW DataDBListBox IWDBListBox IW Data DBLookupComboBox IWDBLookupComboBox IW Data DBLookupListBox IWDBLookupListBox IW DataDBMemo IWDBMemo IW DataDBNavigator IWDBNavigator IW DataDBText IWDBText IW DataEdit IWEdit IW StandardImage IWImage or IWImageFile IW StandardLabel IWLabel IW StandardListBox IWListBox IW StandardMemo IWMemo IW Standard RadioGroup IWRadioGroup IW StandardTimer IWTimer IW StandardTreeView IWTreeView IW Standard四、开始创建IntraWeb应用程序假如你以前使用过Delphi开发过可视化应用程序,那么,恭喜你,你已经有了基本的开发IntraWeb的基础。
用Delphi编写Windows服务程序Delphi是一种基于Object Pascal语言的集成开发环境(IDE),主要用于Windows平台的软件开发。
它提供了丰富的库和组件,使得开发者可以轻松地创建各种类型的应用程序,包括Windows服务程序。
Windows服务程序是在后台运行的应用程序,它们可以在Windows系统启动时自动启动,并在系统运行期间持续运行。
这些服务通常用于执行一些重要的任务,如数据备份、定时任务、网络通信等。
编写Windows服务程序需要以下步骤:1. 创建新的Delphi项目:打开Delphi IDE,选择"File"菜单,点击"New",然后选择"Other",在弹出的对话框中选择"Service Application",点击"OK"按钮。
这将创建一个新的Windows服务程序项目。
2. 设计服务:在Delphi IDE的主界面中,可以看到Service1单元。
在该单元中,可以定义服务的属性和事件。
可以使用TService组件来添加自定义的属性和事件。
例如,可以添加一个Timer组件来定时执行某个任务。
3. 编写服务逻辑:在Service1单元中,可以编写服务的逻辑代码。
例如,可以在服务的OnStart事件中编写启动逻辑,在OnStop事件中编写停止逻辑。
可以使用Delphi提供的各种库和组件来实现所需的功能。
4. 安装服务:在Delphi IDE的主界面中,选择"Project"菜单,点击"Options",然后选择"Application"选项卡。
在"Title"字段中输入服务的名称,在"Description"字段中输入服务的描述。
然后点击"Install"按钮,将服务安装到系统中。
用Delphi创建服务程序Windows 2000/XP和2003等支持一种叫做"服务程序"的东西.程序作为服务启动有以下几个好处:(1)不用登陆进系统即可运行.(2)具有SYSTEM特权.所以你在进程管理器里面是无法结束它的.笔者在2003年为一公司开发机顶盒项目的时候,曾经写过课件上传和媒体服务,下面就介绍一下如何用Delphi7创建一个Service程序.运行Delphi7,选择菜单File-->New-->Other--->Service Application.将生成一个服务程序的框架.将工程保存为ServiceDemo.dpr和Unit_Main.pas,然后回到主框架.我们注意到,Service有几个属性.其中以下几个是我们比较常用的:(1)DisplayName:服务的显示名称(2)Name:服务名称.我们在这里将DisplayName的值改为"Delphi服务演示程序",Name改为"DelphiService".编译这个项目,将得到ServiceDemo.exe.这已经是一个服务程序了!进入CMD模式,切换致工程所在目录,运行命令"ServiceDemo.exe /install",将提示服务安装成功!然后"net start DelphiService"将启动这个服务.进入控制面版-->管理工具-->服务,将显示这个服务和当前状态.不过这个服务现在什么也干不了,因为我们还没有写代码:)先"net stop DelphiService"停止再"ServiceDemo.exe /uninstall"删除这个服务.回到Delphi7的IDE.我们的计划是为这个服务添加一个主窗口,运行后任务栏显示程序的图标,双击图标将显示主窗口,上面有一个按钮,点击该按钮将实现Ctrl+Alt+Del功能.实际上,服务程序莫认是工作于Winlogon桌面的,可以打开控制面板,查看我们刚才那个服务的属性-->登陆,其中"允许服务与桌面交互"是不打钩的.怎么办?呵呵,回到IDE,注意那个布尔属性:Interactive,当这个属性为True的时候,该服务程序就可以与桌面交互了.File-->New-->Form为服务添加窗口FrmMain,单元保存为Unit_FrmMain,并且把这个窗口设置为手工创建.完成后的代码如下:unit Unit_Main;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, Unit_FrmMain;typeTDelphiService = class(TService)procedure ServiceContinue(Sender: TService; var Continued: Boolean);procedure ServiceExecute(Sender: TService);procedure ServicePause(Sender: TService; var Paused: Boolean);procedure ServiceShutdown(Sender: TService);procedure ServiceStart(Sender: TService; var Started: Boolean);procedure ServiceStop(Sender: TService; var Stopped: Boolean);private{ Private declarations }function GetServiceController: TServiceController; override;{ Public declarations }end;varDelphiService: TDelphiService;FrmMain: TFrmMain;implementation{$R *.DFM}procedure ServiceController(CtrlCode: DWord); stdcall;beginDelphiService.Controller(CtrlCode);end;function TDelphiService.GetServiceController: TServiceController; beginResult := ServiceController;end;procedure TDelphiService.ServiceContinue(Sender: TService;var Continued: Boolean);beginwhile not Terminated dobeginSleep(10);ServiceThread.ProcessRequests(False);end;end;procedure TDelphiService.ServiceExecute(Sender: TService); beginwhile not Terminated dobeginSleep(10);ServiceThread.ProcessRequests(False);end;end;procedure TDelphiService.ServicePause(Sender: TService;var Paused: Boolean);beginPaused := True;end;procedure TDelphiService.ServiceShutdown(Sender: TService); begingbCanClose := true;Status := csStopped;ReportStatus();end;procedure TDelphiService.ServiceStart(Sender: TService;var Started: Boolean);beginStarted := True;Svcmgr.Application.CreateForm(TFrmMain, FrmMain);gbCanClose := False;FrmMain.Hide;end;procedure TDelphiService.ServiceStop(Sender: TService;var Stopped: Boolean);beginStopped := True;gbCanClose := True;FrmMain.Free;end;end.主窗口单元如下:unit Unit_FrmMain;interfaceusesWindows, Messages, SysUtils, V ariants, Classes, ShellApi, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls;constWM_TrayIcon = WM_USER + 1234;typeTFrmMain = class(TForm)Timer1: TTimer;Button1: TButton;procedure FormCreate(Sender: TObject);procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);procedure FormDestroy(Sender: TObject);procedure Timer1Timer(Sender: TObject);procedure Button1Click(Sender: TObject);private{ Private declarations }IconData: TNotifyIconData;procedure AddIconToTray;procedure TrayIconMessage(var Msg: TMessage); message WM_TrayIcon;procedure SysButtonMsg(var Msg: TMessage); message WM_SYSCOMMAND;public{ Public declarations }end;varFrmMain: TFrmMain;gbCanClose: Boolean;implementation{$R *.dfm}procedure TFrmMain.FormCreate(Sender: TObject);beginFormStyle := fsStayOnTop; {窗口最前}SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW); {不在任务栏显示} gbCanClose := False;Timer1.Interval := 1000;Timer1.Enabled := True;end;procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);beginCanClose := gbCanClose;if not CanClose thenbeginHide;end;end;procedure TFrmMain.FormDestroy(Sender: TObject);beginTimer1.Enabled := False;DelIconFromTray;end;procedure TFrmMain.AddIconToTray;beginZeroMemory(@IconData, SizeOf(TNotifyIconData));IconData.cbSize := SizeOf(TNotifyIconData);IconData.Wnd := Handle;IconData.uID := 1;IconData.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;IconData.uCallbackMessage := WM_TrayIcon;IconData.hIcon := Application.Icon.Handle;IconData.szTip := 'Delphi服务演示程序';Shell_NotifyIcon(NIM_ADD, @IconData);end;procedure TFrmMain.DelIconFromTray;beginShell_NotifyIcon(NIM_DELETE, @IconData);end;procedure TFrmMain.SysButtonMsg(var Msg: TMessage);beginif (Msg.wParam = SC_CLOSE) or(Msg.wParam = SC_MINIMIZE) then Hideelse inherited; // 执行默认动作end;procedure TFrmMain.TrayIconMessage(var Msg: TMessage);beginif (Msg.LParam = WM_LBUTTONDBLCLK) then Show();end;procedure TFrmMain.Timer1Timer(Sender: TObject);beginAddIconToTray;end;procedure SendHokKey;stdcall;varHDesk_WL: HDESK;beginHDesk_WL := OpenDesktop ('Winlogon', 0, False, DESKTOP_JOURNALPLAYBACK);if (HDesk_WL <> 0) thenif (SetThreadDesktop (HDesk_WL) = True) thenPostMessage(HWND_BROADCAST, WM_HOTKEY, 0, MAKELONG (MOD_ALT or MOD_CONTROL, VK_DELETE));end;procedure TFrmMain.Button1Click(Sender: TObject);vardwThreadID : DWORD;beginCreateThread(nil, 0, @SendHokKey, nil, 0, dwThreadID);end;end.补充:(1)关于更多服务程序的演示程序,请访问以下Url:/pages.php?id=226,上面包含了多个演示如何控制和管理系统服务的代码.(2)请切记:Windows实际上存在多个桌面.例如屏幕传输会出现白屏,可能有两个原因:一是系统处于锁定或未登陆桌面,二是处于屏幕保护桌面.这时候要将当前桌面切换到该桌面才能抓屏.(3)关于服务程序与桌面交互,还有种动态切换方法.大概单元如下:unit ServiceDesktop;interfacefunction InitServiceDesktop: boolean;procedure DoneServiceDeskTop;implementationuses Windows, SysUtils;constDefaultWindowStation = 'WinSta0';DefaultDesktop = 'Default';varhwinstaSave: HWINSTA;hdeskSave: HDESK;hwinstaUser: HWINSTA;hdeskUser: HDESK;function InitServiceDesktop: boolean;vardwThreadId: DWORD;begindwThreadId := GetCurrentThreadID;// Ensure connection to service window station and desktop, and// save their handles.hwinstaSave := GetProcessWindowStation;hdeskSave := GetThreadDesktop(dwThreadId);hwinstaUser := OpenWindowStation(DefaultWindowStation, FALSE, MAXIMUM_ALLOWED); if hwinstaUser = 0 thenbeginOutputDebugString(PChar('OpenWindowStation failed' + SysErrorMessage(GetLastError))); Result := false;exit;end;if not SetProcessWindowStation(hwinstaUser) thenbeginOutputDebugString('SetProcessWindowStation failed');Result := false;exit;end;hdeskUser := OpenDesktop(DefaultDesktop, 0, FALSE, MAXIMUM_ALLOWED);if hdeskUser = 0 thenbeginSetProcessWindowStation(hwinstaSave);CloseWindowStation(hwinstaUser);Result := false;exit;end;Result := SetThreadDesktop(hdeskUser);if not Result thenOutputDebugString(PChar('SetThreadDesktop' + SysErrorMessage(GetLastError)));end;procedure DoneServiceDeskTop;begin// Restore window station and desktop.SetThreadDesktop(hdeskSave);SetProcessWindowStation(hwinstaSave);if hwinstaUser <> 0 thenCloseWindowStation(hwinstaUser);if hdeskUser <> 0 thenCloseDesktop(hdeskUser);end;initializationInitServiceDesktop;finalizationDoneServiceDesktop;end.更详细的演示代码请参看:/samples/samples/os/isarticle.zip(4)关于安装服务如何添加服务描述.有两种方法:一是修改注册表.服务的详细信息都位于HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Services\下面,例如我们刚才那个服务就位于HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Services\DelphiService下.第二种方法就是先用QueryServiceConfig2函数获取服务信息,然后ChangeServiceConfig2来改变描述.用Delphi实现的话,单元如下:unit WinSvcEx;interfaceuses Windows, WinSvc;const//// Service config info levels//SERVICE_CONFIG_DESCRIPTION = 1;SERVICE_CONFIG_FAILURE_ACTIONS = 2;//// DLL name of imported functions//type//// Service description string//PServiceDescriptionA = ^TServiceDescriptionA;PServiceDescriptionW = ^TServiceDescriptionW;PServiceDescription = PServiceDescriptionA;{$EXTERNALSYM _SERVICE_DESCRIPTIONA}_SERVICE_DESCRIPTIONA = recordlpDescription : PAnsiChar;end;{$EXTERNALSYM _SERVICE_DESCRIPTIONW}_SERVICE_DESCRIPTIONW = recordlpDescription : PWideChar;end;{$EXTERNALSYM _SERVICE_DESCRIPTION}_SERVICE_DESCRIPTION = _SERVICE_DESCRIPTIONA;{$EXTERNALSYM SERVICE_DESCRIPTIONA}SERVICE_DESCRIPTIONA = _SERVICE_DESCRIPTIONA;{$EXTERNALSYM SERVICE_DESCRIPTIONW}SERVICE_DESCRIPTIONW = _SERVICE_DESCRIPTIONW;{$EXTERNALSYM SERVICE_DESCRIPTION}SERVICE_DESCRIPTION = _SERVICE_DESCRIPTIONA;TServiceDescriptionA = _SERVICE_DESCRIPTIONA;TServiceDescriptionW = _SERVICE_DESCRIPTIONW;TServiceDescription = TServiceDescriptionA;//// Actions to take on service failure//{$EXTERNALSYM _SC_ACTION_TYPE}_SC_ACTION_TYPE = (SC_ACTION_NONE, SC_ACTION_RESTART, SC_ACTION_REBOOT, SC_ACTION_RUN_COMMAND);{$EXTERNALSYM SC_ACTION_TYPE}SC_ACTION_TYPE = _SC_ACTION_TYPE;PServiceAction = ^TServiceAction;{$EXTERNALSYM _SC_ACTION}_SC_ACTION = recordaType : SC_ACTION_TYPE;Delay : DWORD;end;{$EXTERNALSYM SC_ACTION}SC_ACTION = _SC_ACTION;TServiceAction = _SC_ACTION;PServiceFailureActionsA = ^TServiceFailureActionsA;PServiceFailureActionsW = ^TServiceFailureActionsW;PServiceFailureActions = PServiceFailureActionsA;_SERVICE_FAILURE_ACTIONSA = recorddwResetPeriod : DWORD;lpRebootMsg : LPSTR;lpCommand : LPSTR;cActions : DWORD;lpsaActions : ^SC_ACTION;end;{$EXTERNALSYM _SERVICE_FAILURE_ACTIONSW}_SERVICE_FAILURE_ACTIONSW = recorddwResetPeriod : DWORD;lpRebootMsg : LPWSTR;lpCommand : LPWSTR;cActions : DWORD;lpsaActions : ^SC_ACTION;end;{$EXTERNALSYM _SERVICE_FAILURE_ACTIONS}_SERVICE_FAILURE_ACTIONS = _SERVICE_FAILURE_ACTIONSA;{$EXTERNALSYM SERVICE_FAILURE_ACTIONSA}SERVICE_FAILURE_ACTIONSA = _SERVICE_FAILURE_ACTIONSA;{$EXTERNALSYM SERVICE_FAILURE_ACTIONSW}SERVICE_FAILURE_ACTIONSW = _SERVICE_FAILURE_ACTIONSW;{$EXTERNALSYM SERVICE_FAILURE_ACTIONS}SERVICE_FAILURE_ACTIONS = _SERVICE_FAILURE_ACTIONSA;TServiceFailureActionsA = _SERVICE_FAILURE_ACTIONSA;TServiceFailureActionsW = _SERVICE_FAILURE_ACTIONSW;TServiceFailureActions = TServiceFailureActionsA;///////////////////////////////////////////////////////////////////////////// API Function Prototypes///////////////////////////////////////////////////////////////////////////TQueryServiceConfig2 = function (hService : SC_HANDLE; dwInfoLevel : DWORD; lpBuffer : pointer;cbBufSize : DWORD; var pcbBytesNeeded) : BOOL; stdcall;TChangeServiceConfig2 = function (hService : SC_HANDLE; dwInfoLevel : DWORD; lpInfo : pointer) : BOOL; stdcall;varhDLL : THandle ;LibLoaded : boolean ;varOSV ersionInfo : TOSV ersionInfo;{$EXTERNALSYM QueryServiceConfig2A}QueryServiceConfig2A : TQueryServiceConfig2;{$EXTERNALSYM QueryServiceConfig2W}QueryServiceConfig2W : TQueryServiceConfig2;{$EXTERNALSYM QueryServiceConfig2}QueryServiceConfig2 : TQueryServiceConfig2;{$EXTERNALSYM ChangeServiceConfig2A}{$EXTERNALSYM ChangeServiceConfig2W}ChangeServiceConfig2W : TChangeServiceConfig2;{$EXTERNALSYM ChangeServiceConfig2}ChangeServiceConfig2 : TChangeServiceConfig2;implementationinitializationOSV ersionInfo.dwOSV ersionInfoSize := SizeOf(OSV ersionInfo);GetV ersionEx(OSV ersionInfo);if (OSV ersionInfo.dwPlatformId = VER_PLA TFORM_WIN32_NT) and (OSV ersionInfo.dwMajorV ersion >= 5) then beginif hDLL = 0 thenbeginhDLL:=GetModuleHandle(AdvApiDLL);LibLoaded := False;if hDLL = 0 thenbeginhDLL := LoadLibrary(AdvApiDLL);LibLoaded := True;end;end;if hDLL <> 0 thenbegin@QueryServiceConfig2A := GetProcAddress(hDLL, 'QueryServiceConfig2A');@QueryServiceConfig2W := GetProcAddress(hDLL, 'QueryServiceConfig2W');@QueryServiceConfig2 := @QueryServiceConfig2A;@ChangeServiceConfig2A := GetProcAddress(hDLL, 'ChangeServiceConfig2A');@ChangeServiceConfig2W := GetProcAddress(hDLL, 'ChangeServiceConfig2W');@ChangeServiceConfig2 := @ChangeServiceConfig2A;end;endelsebegin@QueryServiceConfig2A := nil;@QueryServiceConfig2W := nil;@QueryServiceConfig2 := nil;@ChangeServiceConfig2A := nil;@ChangeServiceConfig2W := nil;@ChangeServiceConfig2 := nil;end;finalizationif (hDLL <> 0) and LibLoaded thenFreeLibrary(hDLL);end.interfaceusesWindows,WinSvc,WinSvcEx;function InstallService(const strServiceName,strDisplayName,strDescription,strFilename: string):Boolean; //eg:InstallService('服务名称','显示名称','描述信息','服务文件');procedure UninstallService(strServiceName:string);implementationfunction StrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar; assembler;asmPUSH EDIPUSH ESIPUSH EBXMOV ESI,EAXMOV EDI,EDXMOV EBX,ECXXOR AL,ALTEST ECX,ECXJZ @@1REPNE SCASBJNE @@1INC ECX@@1: SUB EBX,ECXMOV EDI,ESIMOV ESI,EDXMOV EDX,EDIMOV ECX,EBXSHR ECX,2REP MOVSDMOV ECX,EBXAND ECX,3REP MOVSBSTOSBMOV EAX,EDXPOP EBXPOP ESIPOP EDIend;function StrPCopy(Dest: PChar; const Source: string): PChar;beginResult := StrLCopy(Dest, PChar(Source), Length(Source));end;function InstallService(const strServiceName,strDisplayName,strDescription,strFilename: string):Boolean; var//ss : TServiceStatus;//psTemp : PChar;hSCM,hSCS:THandle;srvdesc : PServiceDescription;desc : string;//SrvType : DWord;lpServiceArgV ectors:pchar;beginResult:=False;//psTemp := nil;//SrvType := SERVICE_WIN32_OWN_PROCESS and SERVICE_INTERACTIVE_PROCESS;hSCM:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);//连接服务数据库if hSCM=0 then Exit;//MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),'服务程序管理器',MB_ICONERROR+MB_TOPMOST);hSCS:=CreateService( //创建服务函数hSCM, // 服务控制管理句柄Pchar(strServiceName), // 服务名称Pchar(strDisplayName), // 显示的服务名称SERVICE_ALL_ACCESS, // 存取权利SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS,// 服务类型SERVICE_WIN32_SHARE_PROCESSSERVICE_AUTO_START, // 启动类型SERVICE_ERROR_IGNORE, // 错误控制类型Pchar(strFilename), // 服务程序nil, // 组服务名称nil, // 组标识nil, // 依赖的服务nil, // 启动服务帐号nil); // 启动服务口令if hSCS=0 then Exit;//MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),Pchar(Application.Title),MB_ICONERROR+MB_TO PMOST);if Assigned(ChangeServiceConfig2) thenbegindesc := Copy(strDescription,1,1024);GetMem(srvdesc,SizeOf(TServiceDescription));GetMem(srvdesc^.lpDescription,Length(desc) + 1);tryStrPCopy(srvdesc^.lpDescription, desc);ChangeServiceConfig2(hSCS,SERVICE_CONFIG_DESCRIPTION,srvdesc);finallyFreeMem(srvdesc^.lpDescription);FreeMem(srvdesc);end;end;lpServiceArgV ectors := nil;if not StartService(hSCS, 0, lpServiceArgV ectors) then //启动服务Exit;//MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),Pchar(Application.Title),MB_ICONERROR+MB_TOPM OST);CloseServiceHandle(hSCS); //关闭句柄Result:=True;end;procedure UninstallService(strServiceName:string);varSCManager: SC_HANDLE;Service: SC_HANDLE;Status: TServiceStatus;beginSCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);if SCManager = 0 then Exit;tryService := OpenService(SCManager, Pchar(strServiceName), SERVICE_ALL_ACCESS);ControlService(Service, SERVICE_CONTROL_STOP, Status);DeleteService(Service);CloseServiceHandle(Service);finallyCloseServiceHandle(SCManager);end;end;end.(5)如何暴力关闭一个服务程序,实现我们以前那个"NT工具箱"的功能?首先,根据进程名称来杀死进程是用以下函数: uses Tlhelp32;function KillTask(ExeFileName: string): Integer;constPROCESS_TERMINA TE = $0001;varContinueLoop: BOOL;FSnapshotHandle: THandle;FProcessEntry32: TProcessEntry32;beginResult := 0;FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);FProcessEntry32.dwSize := SizeOf(FProcessEntry32);ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);while Integer(ContinueLoop) <> 0 dobeginif ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =UpperCase(ExeFileName))) thenResult := Integer(TerminateProcess(OpenProcess(PROCESS_TERMINA TE,BOOL(0),FProcessEntry32.th32ProcessID),0));ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);end;CloseHandle(FSnapshotHandle);end;但是对于服务程序,它会提示"拒绝访问".其实只要程序拥有Debug权限即可: function EnableDebugPrivilege: Boolean;function EnablePrivilege(hToken: Cardinal; PrivName: string; bEnable: Boolean): Boolean; varTP: TOKEN_PRIVILEGES;Dummy: Cardinal;beginTP.PrivilegeCount := 1;LookupPrivilegeV alue(nil, pchar(PrivName), TP.Privileges[0].Luid);if bEnable thenTP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLEDelse TP.Privileges[0].Attributes := 0;AdjustTokenPrivileges(hToken, False, TP, SizeOf(TP), nil, Dummy);Result := GetLastError = ERROR_SUCCESS;end;varhToken: Cardinal;beginOpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken); result:=EnablePrivilege(hToken, 'SeDebugPrivilege', True);CloseHandle(hToken);end;使用方法:EnableDebugPrivilege;//提升权限KillTask('xxxx.exe');//关闭该服务程序.。
第5章 面向Windows开发的基本实现Delphi可以实现Windows系统中的大多数可执行文件类型,这主要包括可执行程序(.EXE)和动态链接库(.DLL)。
其他的一些文件类型,通常以动态链接库的形式编译,只是输出的文件扩展名不同而已(例如.CPL,.SCR,.OCX等)。
Delphi使用动态链接库的格式实现了自己的库文件:包(.BPL)。
本章全面解析Delphi支持这些文件格式的每一个细节。
5.1 Win32应用程序:EXE5.1.1 适应Win32应用程序的最简化内核Nico Bendlin的MiniDExe很好地演示了不使用任何Delphi例程来实现一个Win32应用程序的方法。
对于一个可执行程序.EXE来说,只须满足如下条件,就可以在被Windows系统中执行:是一个以.EXE方式生成的格式正确的PE (Portable Executable)文件有一个正确的入口地址并记录在PE格式文件的头部编译器会按这样的规则生成文件模块,并将一段入口代码的地址记录在PE格式文件的头部。
这段入口代码固定地调用System.pas中的例程_InitExe()。
因此,可以进一步简化Nico Bendlin的MiniDExe://系统初始化单元unit SysInit;interfaceDelphi源代码分析第5章面向Windows开发的基本实现·84·varTlsIndex: Integer = -1;TlsLast: Byte;constPtrToNil: Pointer = nil;implementationend.//系统内核单元unit System;interfaceprocedure _InitExe;procedure _HandleFinally;procedure _Halt0;constKernel32 = 'kernel32.dll';User32 = 'user32.dll';typeTGUID = recordD1: LongWord;D2: Word;D3: Word;D4: array[0..7] of Byte;end;implementationprocedure ExitProcess (uExitCode: LongWord); stdcall; external kernel32 name 'ExitProcess';procedure _InitExe;asmend;procedure _HandleFinally;asmend;Delphi源代码分析5.1 Win32应用程序:EXE ·85·procedure _Halt0;beginExitProcess(0);end;end.//示例程序。
用delphi7编写windows服务程序总结一、服务程序的创建delphi编写服务程序非常简单,点击菜单File->New->Other->New属性页->Service Application,系统自动会创建基本的代码。
这里需要说明的是,在“New属性页”中还有一个Service,这个Service和Service Application还是有区别的,应该说Service Application的范围大,它可以包含几个Service。
一个Service Application可以创建几个Service,service继承自TService,界面表现和TDataModel类似,做过数据库的朋友肯定都不陌生,区别是TDataModel是用来放数据库连接及操作组件的容器,而TService则是可以存放很多没有界面的组件,如indy的IDtcpclient等。
二、重要属性及事件说明属性:DisplayName 显示名称Name 名称,当你用命令提示符来启动、停止服务时,就需要用到Interactive 与界面交互的选项事件:OnCreate:类似于Tform的OnCreateOnDestroy:类似于Tform的OnDestroyOnExecute:非常重要,一般写成下面while not Terminated dobeginSleep(10);ServiceThread.ProcessRequests(False);end;OnPause:服务暂停OnShutdown:不太清楚OnStart:服务启动,重要OnStop:服务停止,重要三、服务的依赖关系因为我的服务是要连接数据库的,所以必须要等sql server的服务起来之后,我才能起来,这样才能连接数据库,因此这里面有个依赖关系的问题。
可以在属性Dependencies 中增加一项,选择MSSQLSERVER。
四、服务与界面的通讯服务也是可以创建form的,只是只是这个窗口,在服务启动时显示,服务停止后就关闭了。
而我想做一个就象sql server 2000的服务管理器哪样的界面,不论服务启动是否,都可以显示,而且也可以在界面上直接控制服务。
所以我就又建了一个应用,而这个应用和原来服务的通讯用自定义消息来传递。
比如,有人通过控制面板停止服务了,服务必须通知界面上的状态。
Delphi获取Windows系统服务的状态function ServiceGetStatus(sMachine, sService: string ): DWord;varschm, schs: SC_Handle;ss: TServiceStatus;dwStat : DWord;begindwStat := 0;schm := OpenSCManager(PChar(sMachine), Nil, SC_MANAGER_CONNECT);if (schm > 0) thenbeginschs := OpenService(schm, PChar(sService), SERVICE_QUERY_STA TUS);if(schs > 0) thenbeginif(QueryServiceStatus(schs, ss))then dwStat := ss.dwCurrentState;CloseServiceHandle(schs);end;CloseServiceHandle(schm);end;Result := dwStat;end;{判断某服务是否安装,未安装返回true,已安装返回false} function ServiceUninstalled(sMachine, sService : string ) : boolean; beginResult := 0 = ServiceGetStatus(sMachine, sService);end;{判断某服务是否启动,启动返回true,未启动返回false}function ServiceRunning(sMachine, sService : string ) : boolean;beginResult := SERVICE_RUNNING = ServiceGetStatus(sMachine, sService ); end;{判断某服务是否停止,停止返回true,未停止返回false}function ServiceStopped(sMachine, sService : string ) : boolean;beginResult := SERVICE_STOPPED = ServiceGetStatus(sMachine, sService );end;Delphi 如何停止、启动windows系统服务//下面是写了一个启动服务的函数StartService,用来启动服务。
function StartService(AServName: string): Boolean; //use WinSvcvarSCManager, hService: SC_HANDLE;lpServiceArgVectors: PChar;beginSCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);Result := SCManager <> 0;if Result thentryhService := OpenService(SCManager, PChar(AServName), SERVICE_ALL_ACCESS); Result := hService <> 0;if (hService = 0) and (GetLastError = ERROR_SERVICE_DOES_NOT_EXIST) then Exception.Create('The specified service does not exist');if hService <> 0 thentrylpServiceArgVectors := nil;Result := WinSvc.StartService(hService, 0, PChar(lpServiceArgVectors));if not Result and (GetLastError = ERROR_SERVICE_ALREADY_RUNNING) then Result := True;finallyCloseServiceHandle(hService);end;finallyCloseServiceHandle(SCManager);end;end;function StartService(AServName: string): Boolean; //use WinSvc<br/>var<br/>SCManager, hService: SC_HANDLE;<br/>lpServiceArgVectors: PChar;<br/>begin<br/>SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);<br/>Result := SCManager <> 0;<br/>if Result then<br/>try<br/>hService := OpenService(SCManager, PChar(AServName), SERVICE_ALL_ACCESS);<br/>Result := hService <> 0;<br/>if (hService = 0) and (GetLastError = ERROR_SERVICE_DOES_NOT_EXIST) then<br/>Exception.Create('The specified service does not exist');<br/>if hService <> 0 then<br/>try<br/>lpServiceArgVectors := nil;<br/>Result := WinSvc.StartService(hService, 0, PChar(lpServiceArgVectors));<br/>if not Result and (GetLastError = ERROR_SERVICE_ALREADY_RUNNING) then<br/>Result := True;<br/>finally<br/>CloseServiceHandle(hService);<br/>end;<br/>finally<br/>CloseServiceHa ndle(SCManager);<br/>end;<br/>end;<br/>下面是停止服务的代码StopServicefunction StopService(AServName: string): Boolean;varSCManager, hService: SC_HANDLE;SvcStatus: TServiceStatus;beginSCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);Result := SCManager <> 0;if Result thentryhService := OpenService(SCManager, PChar(AServName), SERVICE_ALL_ACCESS);Result := hService <> 0;if Result thentry //停止并卸载服务;Result := ControlService(hService, SERVICE_CONTROL_STOP, SvcStatus);//删除服务,这一句可以不要;// DeleteService(hService);finallyCloseServiceHandle(hService);end;finallyCloseServiceHandle(SCManager);end;end;使用delphi新建服务,停止系统服务2009-12-09 15:46本文主要讲解了如何使用delphi新建服务,停止系统服务,以及获取服务状态和新建系统服务器的方法,以下是关键代码:</B>unit Servicescontrol;interfaceuses Windows,Messages,SysUtils,Winsvc,Dialogs;function StartServices(Const SvrName:String):Boolean;function StopServices(Const SvrName:String):Boolean;function QueryServiceStatu(Const SvrName: String):String; function CreateServices(Const SvrName,FilePath:String):Boolean; function DeleteServices(Const SvrName: String):Boolean;implementation//开启服务function StartServices(Const SvrName: String): Boolean;vara,b:SC_HANDLE;c:PChar;beginResult:=False;a:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);if a <=0 then Exit;b:=OpenService(a,PChar(SvrName),SERVICE_ALL_ACCESS);if b <=0 then Exit;tryResult:=StartService(b,0,c);CloseServiceHandle(b);CloseServiceHandle(a);exceptCloseServiceHandle(b);CloseServiceHandle(a);Exit;end;end;//停止服务function StopServices(Const SvrName: String): Boolean;vara,b: SC_HANDLE;d: TServiceStatus;beginResult := False;a :=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);if a <=0 then Exit;b:=OpenService(a,PChar(SvrName),SERVICE_ALL_ACCESS);if b <=0 then Exit;tryResult:=ControlService(b,SERVICE_CONTROL_STOP,d);CloseServiceHandle(a);CloseServiceHandle(b);exceptCloseServiceHandle(a);CloseServiceHandle(b);Exit;end;end;//查询当前服务的状态function QueryServiceStatu(Const SvrName: String): String;a,b: SC_HANDLE;d: TServiceStatus;beginResult := '未安装';a := OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);if a <=0 then Exit;b := OpenService(a,PChar(SvrName),SERVICE_ALL_ACCESS);if b <= 0 then Exit;tryQueryServiceStatus(b,d);if d.dwCurrentState = SERVICE_RUNNING thenResult := '启动' //Runelse if d.dwCurrentState = SERVICE_RUNNING thenResult := 'Wait' //Runingelse if d.dwCurrentState = SERVICE_START_PENDING thenResult := 'Wait' //Pauseelse if d.dwCurrentState = SERVICE_STOP_PENDING thenResult := '停止' //Pauseelse if d.dwCurrentState = SERVICE_PAUSED thenResult := '暂停' //Pauseelse if d.dwCurrentState = SERVICE_STOPPED thenResult := '停止' //Stopelse if d.dwCurrentState = SERVICE_CONTINUE_PENDING thenResult := 'Wait' //Pauseelse if d.dwCurrentState = SERVICE_PAUSE_PENDING thenResult := 'Wait'; //PauseCloseServiceHandle(a);CloseServiceHandle(b);exceptCloseServiceHandle(a);CloseServiceHandle(b);Exit;end;end;{建立服务}function CreateServices(Const SvrName,FilePath: String): Boolean;vara,b:SC_HANDLE;beginResult:=False;if FilePath ='' then Exit;a := OpenSCManager(nil,nil,SC_MANAGER_CREATE_SERVICE);if a <= 0 then Exit;tryb := CreateService(a,PChar(SvrName),PChar(SvrName),SERVICE_ALL_ACCESS,SERVICE_INTERACTIVE_PROCESS or SERVICE_WIN32_OWN_PROCESS,SERVICE_AUTO_START,SERVICE_ERROR_NORMAL,PChar(FilePath),nil,nil,nil,nil,nil);if b <= 0 then beginShowMessage( SysErrorMessage( GetlastError ));Exit;end;CloseServiceHandle(a);CloseServiceHandle(b);Result := True;exceptCloseServiceHandle(a);CloseServiceHandle(b);Exit;end;end;{卸载服务}function DeleteServices(Const SvrName: String): Boolean;vara,b:SC_HANDLE;beginResult:=False;a := OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);if a <= 0 then Exit;b :=OpenService(a,PChar(SvrName),STANDARD_RIGHTS_REQUIRED);if b <= 0 then Exit;tryResult := DeleteService(b);if not Result thenShowMessage(SysErrorMessage(GetlastError));CloseServiceHandle(b);CloseServiceHandle(a);exceptCloseServiceHandle(b);CloseServiceHandle(a);Exit;end;end;end.调用方法:{启动服务}StartServices(服务名);{停止服务}StopServices(服务名);{新建服务}CreateServices(服务名,exe文件路径);{删除服务}DeleteServices(服务名);{获取服务状态}string:=QueryServiceStatu(服务名);用Delphi创建windows服务程序2009-12-09 16:15Windows 2000/XP和2003等支持一种叫做"服务程序"的东西.程序作为服务启动有以下几个好处:(1)不用登陆进系统即可运行.(2)具有SYSTEM特权.所以你在进程管理器里面是无法结束它的.笔者在2003年为一公司开发机顶盒项目的时候,曾经写过课件上传和媒体服务,下面就介绍一下如何用Delphi7创建一个Service程序.运行Delphi7,选择菜单File-->New-->Other--->Service Application.将生成一个服务程序的框架.将工程保存为ServiceDemo.dpr和Unit_Main.pas,然后回到主框架.我们注意到,Service有几个属性.其中以下几个是我们比较常用的:(1)DisplayName:服务的显示名称(2)Name:服务名称.我们在这里将DisplayName的值改为"Delphi服务演示程序",Name改为"DelphiService".编译这个项目,将得到ServiceDemo.exe.这已经是一个服务程序了!进入CMD模式,切换致工程所在目录,运行命令"ServiceDemo.exe /install",将提示服务安装成功!然后"net start DelphiService"将启动这个服务.进入控制面版-->管理工具-->服务,将显示这个服务和当前状态.不过这个服务现在什么也干不了,因为我们还没有写代码:)先"net stop DelphiService"停止再"ServiceDemo.exe /uninstall"删除这个服务.回到Delphi7的IDE.我们的计划是为这个服务添加一个主窗口,运行后任务栏显示程序的图标,双击图标将显示主窗口,上面有一个按钮,点击该按钮将实现Ctrl+Alt+Del功能.实际上,服务程序莫认是工作于Winlogon桌面的,可以打开控制面板,查看我们刚才那个服务的属性-->登陆,其中"允许服务与桌面交互"是不打钩的.怎么办?呵呵,回到IDE,注意那个布尔属性:Interactive,当这个属性为True的时候,该服务程序就可以与桌面交互了.File-->New-->Form为服务添加窗口FrmMain,单元保存为Unit_FrmMain,并且把这个窗口设置为手工创建.完成后的代码如下:unit Unit_Main;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, Unit_FrmMain; typeTDelphiService = class(TService)procedure ServiceContinue(Sender: TService; var Continued: Boolean);procedure ServiceExecute(Sender: TService);procedure ServicePause(Sender: TService; var Paused: Boolean);procedure ServiceShutdown(Sender: TService);procedure ServiceStart(Sender: TService; var Started: Boolean);procedure ServiceStop(Sender: TService; var Stopped: Boolean);private{ Private declarations }publicfunction GetServiceController: TServiceController; override;{ Public declarations }end;varDelphiService: TDelphiService;FrmMain: TFrmMain;implementation{$R *.DFM}procedure ServiceController(CtrlCode: DWord); stdcall;beginDelphiService.Controller(CtrlCode);end;function TDelphiService.GetServiceController: TServiceController; beginResult := ServiceController;end;procedure TDelphiService.ServiceContinue(Sender: TService;var Continued: Boolean);beginwhile not Terminated dobeginSleep(10);ServiceThread.ProcessRequests(False);end;end;procedure TDelphiService.ServiceExecute(Sender: TService); beginwhile not Terminated dobeginSleep(10);ServiceThread.ProcessRequests(False);end;end;procedure TDelphiService.ServicePause(Sender: TService;var Paused: Boolean);beginPaused := True;end;procedure TDelphiService.ServiceShutdown(Sender: TService); begingbCanClose := true;FrmMain.Free;Status := csStopped;ReportStatus();end;procedure TDelphiService.ServiceStart(Sender: TService;var Started: Boolean);beginStarted := True;Svcmgr.Application.CreateForm(TFrmMain, FrmMain); gbCanClose := False;FrmMain.Hide;end;procedure TDelphiService.ServiceStop(Sender: TService; var Stopped: Boolean);beginStopped := True;gbCanClose := True;FrmMain.Free;end;end.。