用Delphi编写Windows服务程序.doc

用Delphi编写Windows服务程序(1)一、Windows服务简介服务程序（Service Application）是一种运行于WinNT的后台程序，每个服务程序（Service Application）中可能包含若干个服务（Service），每个服务就是其中的一个线程（该服务也可以创建多个子线程）。采用服务，应用程序可以获得特殊的权限，而且不会被用户通过Win2000的任务管理器直接结束程序，所以服务常常用来实现一些特殊的目标。通过Win2000控制面板中的服务管理工具，我们可以设置/查看服务的特性：（1）服务名称；（2）显示名称；（3）描述；（4）启动类型；（5）依赖关系；其中，服务名称是标识给服务的。以Win2000的C:WINNTSystem32services.exe程序为例子，该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对象，正好对应上述的服务程序和服务之间的数量关系。通过阅读TServiceApplication和TService类的定义，可以得知，TServiceApplication从TComponent类继承而来，TService从类TDataModule基础而来，Application对象负责各个TService对象的Create和Destroy。跟踪下列代码Application.CreateForm(TService1, Service1);可以发现创建的TService对象的Owner都是Application对象；在VCL FrameWork中Owner总是负责Destroy各个Component对象（VCL的TComponent类采用了Composite模式），所以TServiceApplication也将Destroy各个TService对象。下面跟踪TServiceApplication.Run的代码，可以发现TServiceApplication首先解析运行参数，实现了服务的Install和Uninstall。然后，初始化一个ServiceStartTable数组，该数组包含了各个service对象的服务名称和运行入口；最后创建一个TServiceStartThread 对象，该对象是一个线程对象，从线程调用API：StartServiceCtrlDispatcher来启动ServiceStartTable中指定的若干个服务；而ServiceApplication主线程就不断循环，处理消息，比如接收请求来停止/暂停某个服务。三、TServiceTService类继承自类 TDataModule，这意味着我们可以加入大量的VCL控件，实现丰富的功能。此外，我们还可以处理OnStart，OnPause，OnStop，OnContinue，OnCreate，OnShutDown等事件。其中需要说明的是：OnStop表示该服务被停止；而OnShutDown表示该ServiceApplication停止运行，这意味着其他服务也被终止了；两者含义是不一样的。前面讲过，ServiceApplication通过调用StartServiceCtrlDispatcher来启动各个服务。StartServiceCtrlDispatcher启动TService的入口，该入库就是TService.Main。TService.Main首先注册该服务，然后调用TService.DoStart。TService.DoStart创建一个内部TServiceThread成员对象，这是一个线程对象；考察TServiceThread.Execute可以得知，当我们处理的TService1. OnExecute，那么TService会把所有的请求委托给该TServiceThread成员对象处理，该对象以默认的方式处理所有的请求。TService. ServiceExecute是TService的主体内容。一个服务要正常运行，除了需要处理它要关注的目标（比如监听某个端口、执行某个任务等）外，还要响应外部命令/请求：比如终止、暂停、恢复该服务。因此可以考虑创建一个专门的线程来完成该任务，而在ServiceExecute中处理外面命令/请求。因此代码如下： while not Terminated do begin ServiceThread.ProcessRequests(False); end;当然，也可以在OnExecute中处理某些任务，如监听某个端口，但是这常常会导致该Service不能及时响应Stop/Pause等请求。当OnExecute执行完了，该服务实际上就完成了任务要结束了（terminate）。用Delphi编写Windows服务程序(2)Windows的服务是一个比较实用的功能，你的程序可以在Windows未进行登录的时候就开始运行，不受用户注销的影响，也不容易被用户误关闭。但是编写服务也许不是一件容易的事情，幸好Delphi给我们提供了一个模板，可以很容易的编写一个标准的Windows服务程序。首先，在Delphi内新建一个Service Application。此时，Delphi已经给我们建好了一个Service程序的框架，我们只需要把我们的代码加到合适的位置就行了。一般情况下，Service内需要一个线程来不断的工作，也许定时器也可以，但线程工作起来更好。Delphi会生成一个可视化的Service容器，你可以一些必要的控件在它上面，但是由于它是服务程序，是没有界面显示的，因此不建议在上面安放Edit之类的控件，服务只是应该做处理工作的，显示界面应该由其它的程序来完成。Service控件的DisplayName属性是显示在管理工具-服务的左边的名称的内容，而Name属性则是服务名称，当你用命令提示符来启动、停止服务时，就需要用到。在事件OnStart内，我们应该完成启动线程的工作。如：procedureTS2HConv.ServiceStart(Sender:TService;varStarted:Boolean);varReg:TRegistry;LogFileName,LogPath:String;slTemp:TStringList;beginCoInitialize(nil);Reg:=TRegistry.Create;Reg.RootKey:=HKEY_LOCAL_MACHINE;Reg.OpenKey(SoftWareBHomeEducation,True);LogPath:=Trim(Reg.ReadString(LogPath);SourceConnStr:=Trim(Reg.ReadString(SourceConnStr);ifTrim(LogPath)=thenLogPath:=C:;Reg.CloseKey;Reg.Free;ifRightStr(LogPath,1)thenLogPath:=LogPath+;LogFileName:=LogPath+FormatDateTime(yyyymmdd,Now)+Log.txt;TryifnotFileExists(LogFileName)thenbeginslTemp:=TStringList.Create;slTemp.Clear;slTemp.SaveToFile(LogFileName);slTemp.Free;end;AssignFile(LogFile,LogFileName);Append(LogFile);ExceptStarted:=False;Exit;End;Started:=True;tryAC_Source:=TADOConnection.Create(nil);Q_Source:=TADOQuery.Create(nil);Q_Source.Connection:=AC_Source;tryAC_Source.Close;AC_Source.ConnectionString:=SourceConnStr;AC_Source.Open;SYSLog(与源数据库连接成功！);DBOK:=True;ExceptonE:ExceptiondobeginDBOK:=False;SYSLog(数据库连接失败！+E.Message);end;End;MyPHSThread:=TPHSSendThread.Create();MyPHSThread.FreeOnTerminate:=True;MyPHSThread.Priority:=tpLower;end;在OnStop事件内，我们应该停止线程，并释放打开的资源，需要注意的是当你停止线程时，一般用Terminate方法，在线程内用Terminated属性来判断是否需要结束线程，而由于是线程，和主进程是时间运行的，有可能你刚好在进行Terminate时，线程已经刚进行过Terminated判断，正在进行比较费时的处理工作，而此时主进程立即执行Terminate后就进行释放资源的工作时，会造成线程执行错误，因此应该等到线程真正的正确停止后，主进程才能进行资源释放工作。如：procedureTS2HConv.ServiceStop(Sender:TService;varStopped:Boolean);begintryMyPHSThread.Terminate;while_ThreadIsRundosleep(1000);AC_Source.Close;CloseFile(LogFile);FreeAndNil(Q_Source);FreeAndNil(AC_Source);CoUnInitialize;ExceptEnd;Stopped:=True;end;分类:Delphi(转载)用Delphi创建windows服务程序(3)Windows2000/XP和2003等支持一种叫做服务程序的东西.程序作为服务启动有以下几个好处:(1)不用登陆进系统即可运行.(2)具有SYSTEM特权.所以你在进程管理器里面是无法结束它的.笔者在2003年为一公司开发机顶盒项目的时候,曾经写过课件上传和媒体服务,下面就介绍一下如何用Delphi7创建一个Service程序.运行Delphi7,选择菜单File-New-Other-ServiceApplication.将生成一个服务程序的框架.将工程保存为ServiceDemo.dpr和Unit_Main.pas,然后回到主框架.我们注意到,Service有几个属性.其中以下几个是我们比较常用的:(1)DisplayName:服务的显示名称(2)Name:服务名称.我们在这里将DisplayName的值改为Delphi服务演示程序,Name改为DelphiService.编译这个项目,将得到ServiceDemo.exe.这已经是一个服务程序了!进入CMD模式,切换致工程所在目录,运行命令ServiceDemo.exe/install,将提示服务安装成功!然后netstartDelphiService将启动这个服务.进入控制面版-管理工具-服务,将显示这个服务和当前状态.不过这个服务现在什么也干不了,因为我们还没有写代码:)先netstopDelphiService停止再ServiceDemo.exe/uninstall删除这个服务.回到Delphi7的IDE.我们的计划是为这个服务添加一个主窗口,运行后任务栏显示程序的图标,双击图标将显示主窗口,上面有一个按钮,点击该按钮将实现Ctrl+Alt+Del功能.实际上,服务程序莫认是工作于Winlogon桌面的,可以打开控制面板,查看我们刚才那个服务的属性-登陆,其中允许服务与桌面交互是不打钩的.怎么办?呵呵,回到IDE,注意那个布尔属性:Interactive,当这个属性为True的时候,该服务程序就可以与桌面交互了.File-New-Form为服务添加窗口FrmMain,单元保存为Unit_FrmMain,并且把这个窗口设置为手工创建.完成后的代码如下:unitUnit_Main;interfaceusesWindows,Messages,SysUtils,Classes,Graphics,Controls,SvcMgr,Dialogs,Unit_FrmMain;typeTDelphiService=class(TService)procedureServiceContinue(Sender:TService;varContinued:Boolean);procedureServiceExecute(Sender:TService);procedureServicePause(Sender:TService;varPaused:Boolean);procedureServiceShutdown(Sender:TService);procedureServiceStart(Sender:TService;varStarted:Boolean);procedureServiceStop(Sender:TService;varStopped:Boolean);privatePrivatedeclarationspublicfunctionGetServiceController:TServiceController;override;Publicdeclarationsend;varDelphiService:TDelphiService;FrmMain:TFrmMain;implementation$R*.DFMprocedureServiceController(CtrlCode:DWord);stdcall;beginDelphiService.Controller(CtrlCode);end;functionTDelphiService.GetServiceController:TServiceController;beginResult:=ServiceController;end;procedureTDelphiService.ServiceContinue(Sender:TService;varContinued:Boolean);beginwhilenotTerminateddobeginSleep(10);ServiceThread.ProcessRequests(False);end;end;procedureTDelphiService.ServiceExecute(Sender:TService);beginwhilenotTerminateddobeginSleep(10);ServiceThread.ProcessRequests(False);end;end;procedureTDelphiService.ServicePause(Sender:TService;varPaused:Boolean);beginPaused:=True;end;procedureTDelphiService.ServiceShutdown(Sender:TService);begingbCanClose:=true;FrmMain.Free;Status:=csStopped;ReportStatus();end;procedureTDelphiService.ServiceStart(Sender:TService;varStarted:Boolean);beginStarted:=True;Svcmgr.Application.CreateForm(TFrmMain,FrmMain);gbCanClose:=False;FrmMain.Hide;end;procedureTDelphiService.ServiceStop(Sender:TService;varStopped:Boolean);beginStopped:=True;gbCanClose:=True;FrmMain.Free;end;end.主窗口单元如下:unitUnit_FrmMain;interfaceusesWindows,Messages,SysUtils,Variants,Classes,ShellApi,Graphics,Controls,Forms,Dialogs,ExtCtrls,StdCtrls;constWM_TrayIcon=WM_USER+1234;typeTFrmMain=class(TForm)Timer1:TTimer;Button1:TButton;procedureFormCreate(Sender:TObject);procedureFormCloseQuery(Sender:TObject;varCanClose:Boolean);procedureFormDestroy(Sender:TObject);procedureTimer1Timer(Sender:TObject);procedureButton1Click(Sender:TObject);privatePrivatedeclarationsIconData:TNotifyIconData;procedureAddIconToTray;procedureDelIconFromTray;procedureTrayIconMessage(varMsg:TMessage);messageWM_TrayIcon;procedureSysButtonMsg(varMsg:TMessage);messageWM_SYSCOMMAND;publicPublicdeclarationsend;varFrmMain:TFrmMain;gbCanClose:Boolean;implementation$R*.dfmprocedureTFrmMain.FormCreate(Sender:TObject);beginFormStyle:=fsStayOnTop;SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);gbCanClose:=False;Timer1.Interval:=1000;Timer1.Enabled:=True;end;procedureTFrmMain.FormCloseQuery(Sender:TObject;varCanClose:Boolean);beginCanClose:=gbCanClose;ifnotCanClosethenbeginHide;end;end;procedureTFrmMain.FormDestroy(Sender:TObject);beginTimer1.Enabled:=False;DelIconFromTray;end;procedureTFrmMain.AddIconToTray;beginZeroMemory(IconData,SizeOf(TNotifyIconData);IconData.cbSize:=SizeOf(TNotifyIconData);IconData.Wnd:=Handle;IconData.uID:=1;IconData.uFlags:=NIF_MESSAGEorNIF_ICONorNIF_TIP;IconData.uCallbackMessage:=WM_TrayIcon;IconData.hIcon:=Application.Icon.Handle;IconData.szTip:=Delphi服务演示程序;Shell_NotifyIcon(NIM_ADD,IconData);end;procedureTFrmMain.DelIconFromTray;beginShell_NotifyIcon(NIM_DELETE,IconData);end;procedureTFrmMain.SysButtonMsg(varMsg:TMessage);beginif(Msg.wParam=SC_CLOSE)or(Msg.wParam=SC_MINIMIZE)thenHideelseinherited;/执行默认动作end;procedureTFrmMain.TrayIconMessage(varMsg:TMessage);beginif(Msg.LParam=WM_LBUTTONDBLCLK)thenShow();end;procedureTFrmMain.Timer1Timer(Sender:TObject);beginAddIconToTray;end;procedureSendHokKey;stdcall;varHDesk_WL:HDESK;beginHDesk_WL:=OpenDesktop(Winlogon,0,False,DESKTOP_JOURNALPLAYBACK);if(HDesk_WL0)thenif(SetThreadDesktop(HDesk_WL)=True)thenPostMessage(HWND_BROADCAST,WM_HOTKEY,0,MAKELONG(MOD_ALTorMOD_CONTROL,VK_DELETE);end;procedureTFrmMain.Button1Click(Sender:TObject);vardwThreadID:DWORD;beginCreateThread(nil,0,SendHokKey,nil,0,dwThreadID);end;end.补充:(1)关于更多服务程序的演示程序,请访问以下Url/pages.php?id=226,上面包含了多个演示如何控制和管理系统服务的代码.(2)请切记:Windows实际上存在多个桌面.例如屏幕传输会出现白屏,可能有两个原因:一是系统处于锁定或未登陆桌面,二是处于屏幕保护桌面.这时候要将当前桌面切换到该桌面才能抓屏.(3)关于服务程序与桌面交互,还有种动态切换方法.大概单元如下:unitServiceDesktop;interfacefunctionInitServiceDesktop:boolean;procedureDoneServiceDeskTop;implementationusesWindows,SysUtils;constDefaultWindowStation=WinSta0;DefaultDesktop=Default;varhwinstaSave:HWINSTA;hdeskSave:HDESK;hwinstaUser:HWINSTA;hdeskUser:HDESK;functionInitServiceDesktop:boolean;vardwThreadId:DWORD;begindwThreadId:=GetCurrentThreadID;/Ensureconnectiontoservicewindowstationanddesktop,and/savetheirhandles.hwinstaSave:=GetProcessWindowStation;hdeskSave:=GetThreadDesktop(dwThreadId);hwinstaUser:=OpenWindowStation(DefaultWindowStation,FALSE,MAXIMUM_ALLOWED);ifhwinstaUser=0thenbeginOutputDebugString(PChar(OpenWindowStationfailed+SysErrorMessage(GetLastError);Result:=false;exit;end;ifnotSetProcessWindowStation(hwinstaUser)thenbeginOutputDebugString(SetProcessWindowStationfailed);Result:=false;exit;end;hdeskUser:=OpenDesktop(DefaultDesktop,0,FALSE,MAXIMUM_ALLOWED);ifhdeskUser=0thenbeginOutputDebugString(OpenDesktopfailed);SetProcessWindowStation(hwinstaSave);CloseWindowStation(hwinstaUser);Result:=false;exit;end;Result:=SetThreadDesktop(hdeskUser);ifnotResultthenOutputDebugString(PChar(SetThreadDesktop+SysErrorMessage(GetLastError);end;procedureDoneServiceDeskTop;begin/Restorewindowstationanddesktop.SetThreadDesktop(hdeskSave);SetProcessWindowStation(hwinstaSave);ifhwinstaUser0thenCloseWindowStation(hwinstaUser);ifhdeskUser0thenCloseDesktop(hdeskUser);end;initializationInitServiceDesktop;finalizationDoneServiceDesktop;end.更详细的演示代码请参看/samples/samples/os/isarticle.zip(4)关于安装服务如何添加服务描述.有两种方法:一是修改注册表.服务的详细信息都位于HKEY_LOCAL_MACHINESYSTEMControlSet001Services下面,例如我们刚才那个服务就位于HKEY_LOCAL_MACHINESYSTEMControlSet001ServicesDelphiService下.第二种方法就是先用QueryServiceConfig2函数获取服务信息,然后ChangeServiceConfig2来改变描述.用Delphi实现的话,单元如下:unitWinSvcEx;interfaceusesWindows,WinSvc;const/Serviceconfiginfolevels/SERVICE_CONFIG_DESCRIPTION=1;SERVICE_CONFIG_FAILURE_ACTIONS=2;/DLLnameofimportedfunctions/AdvApiDLL=advapi32.dll;type/Servicedescriptionstring/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;$EXTERNALSYMSERVICE_DESCRIPTIONASERVICE_DESCRIPTIONA=_SERVICE_DESCRIPTIONA;$EXTERNALSYMSERVICE_DESCRIPTIONWSERVICE_DESCRIPTIONW=_SERVICE_DESCRIPTIONW;$EXTERNALSYMSERVICE_DESCRIPTIONSERVICE_DESCRIPTION=_SERVICE_DESCRIPTIONA;TServiceDescriptionA=_SERVICE_DESCRIPTIONA;TServiceDescriptionW=_SERVICE_DESCRIPTIONW;TServiceDescription=TServiceDescriptionA;/Actionstotakeonservicefailure/$EXTERNALSYM_SC_ACTION_TYPE_SC_ACTION_TYPE=(SC_ACTION_NONE,SC_ACTION_RESTART,SC_ACTION_REBOOT,SC_ACTION_RUN_COMMAND);$EXTERNALSYMSC_ACTION_TYPESC_ACTION_TYPE=_SC_ACTION_TYPE;PServiceAction=TServiceAction;$EXTERNALSYM_SC_ACTION_SC_ACTION=recordaType:SC_ACTION_TYPE;Delay:DWORD;end;$EXTERNALSYMSC_ACTIONSC_ACTION=_SC_ACTION;TServiceAction=_SC_ACTION;PServiceFailureActionsA=TServiceFailureActionsA;PServiceFailureActionsW=TServiceFailureActionsW;PServiceFailureActions=PServiceFailureActionsA;$EXTERNALSYM_SERVICE_FAILURE_ACTIONSA_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;$EXTERNALSYMSERVICE_FAILURE_ACTIONSASERVICE_FAILURE_ACTIONSA=_SERVICE_FAILURE_ACTIONSA;$EXTERNALSYMSERVICE_FAILURE_ACTIONSWSERVICE_FAILURE_ACTIONSW=_SERVICE_FAILURE_ACTIONSW;$EXTERNALSYMSERVICE_FAILURE_ACTIONSSERVICE_FAILURE_ACTIONS=_SERVICE_FAILURE_ACTIONSA;TServiceFailureActionsA=_SERVICE_FAILURE_ACTIONSA;TServiceFailureActionsW=_SERVICE_FAILURE_ACTIONSW;TServiceFailureActions=TServiceFailureActionsA;/APIFunctionPrototypes/TQueryServiceConfig2=function(hService:SC_HANDLE;dwInfoLevel:DWORD;lpBuffer:pointer;cbBufSize:DWORD;varpcbBytesNeeded):BOOL;stdcall;TChangeServiceConfig2=function(hService:SC_HANDLE;dwInfoLevel:DWORD;lpInfo:pointer):BOOL;stdcall;varhDLL:THandle;LibLoaded:boolean;varOSVersionInfo:TOSVersionInfo;$EXTERNALSYMQueryServiceConfig2AQueryServiceConfig2A:TQueryServiceConfig2;$EXTERNALSYMQueryServiceConfig2WQueryServiceConfig2W:TQueryServiceConfig2;$EXTERNALSYMQueryServiceConfig2QueryServiceConfig2:TQueryServiceConfig2;$EXTERNALSYMChangeServiceConfig2AChangeServiceConfig2A:TChangeServiceConfig2;$EXTERNALSYMChangeServiceConfig2WChangeServiceConfig2W:TChangeServiceConfig2;$EXTERNALSYMChangeServiceConfig2ChangeServiceConfig2:TChangeServiceConfig2;implementationinitializationOSVersionInfo.dwOSVersionInfoSize:=SizeOf(OSVersionInfo);GetVersionEx(OSVersionInfo);if(OSVersionInfo.dwPlatformId=VER_PLATFORM_WIN32_NT)and(OSVersionInfo.dwMajorVersion=5)thenbeginifhDLL=0thenbeginhDLL:=GetModuleHandle(AdvApiDLL);LibLoaded:=False;ifhDLL=0thenbeginhDLL:=LoadLibrary(AdvApiDLL);LibLoaded:=True;end;end;ifhDLL0thenbeginQueryServiceConfig2A:=GetProcAddress(hDLL,QueryServiceConfig2A);QueryServiceConfig2W:=GetProcAddress(hDLL,QueryServiceConfig2W);QueryServiceConfig2:=QueryServiceConfig2A;ChangeServiceConfig2A:=GetProcAddress(hDLL,ChangeServiceConfig2A);ChangeServiceConfig2W:=GetProcAddress(hDLL,ChangeServiceConfig2W);ChangeServiceConfig2:=ChangeServiceConfig2A;end;endelsebeginQueryServiceConfig2A:=nil;QueryServiceConfig2W:=nil;QueryServiceConfig2:=nil;ChangeServiceConfig2A:=nil;ChangeServiceConfig2W:=nil;ChangeServiceConfig2:=nil;end;finalizationif(hDLL0)andLibLoadedthenFreeLibrary(hDLL);end.unitwinntService;interfaceusesWindows,WinSvc,WinSvcEx;functionInstallService(conststrServiceName,strDisplayName,strDescription,strFilename:string):Boolean;/eg:InstallService(服务名称,显示名称,描述信息,服务文件);procedureUninstallService(strServiceName:string);implementationfunctionStrLCopy(Dest:PChar;constSource:PChar;MaxLen:Cardinal):PChar;assembler;asmPUSHEDIPUSHESIPUSHEBXMOVESI,EAXMOVEDI,EDXMOVEBX,ECXXORAL,ALTESTECX,ECXJZ1REPNESCASBJNE1INCECX