delphi创建具有托盘的服务程序(service)
发布时间:2020-12-15 10:03:38 所属栏目:大数据 来源:网络整理
导读:Windows 2000/XP和2003等支持一种叫做"服务程序"的东西.程序作为服务启动有以下几个好处: ????(1)不用登陆进系统即可运行. ????(2)具有SYSTEM特权.所以你在进程管理器里面是无法结束它的. ????笔者在2003年为一公司开发机顶盒项目的时候,曾经写过课件上传和
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; interface uses Windows,Messages,SysUtils,Classes,Graphics,Controls,SvcMgr,Dialogs,Unit_FrmMain; type TDelphiService = 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 } public function GetServiceController: TServiceController; override; { Public declarations } end; var DelphiService: TDelphiService; FrmMain: TFrmMain; implementation {$R *.DFM} procedure ServiceController(CtrlCode: DWord); stdcall; begin DelphiService.Controller(CtrlCode); end; function TDelphiService.GetServiceController: TServiceController; begin Result := ServiceController; end; procedure TDelphiService.ServiceContinue(Sender: TService; var Continued: Boolean); begin while not Terminated do begin Sleep(10); ServiceThread.ProcessRequests(False); end; end; procedure TDelphiService.ServiceExecute(Sender: TService); begin while not Terminated do begin Sleep(10); ServiceThread.ProcessRequests(False); end; end; procedure TDelphiService.ServicePause(Sender: TService; var Paused: Boolean); begin Paused := True; end; procedure TDelphiService.ServiceShutdown(Sender: TService); begin gbCanClose := true; FrmMain.Free; Status := csStopped; ReportStatus(); end; procedure TDelphiService.ServiceStart(Sender: TService; var Started: Boolean); begin Started := True; Svcmgr.Application.CreateForm(TFrmMain,FrmMain); gbCanClose := False; FrmMain.Hide; end; procedure TDelphiService.ServiceStop(Sender: TService; var Stopped: Boolean); begin Stopped := True; gbCanClose := True; FrmMain.Free; end; end. 主窗口单元如下: unit Unit_FrmMain; interface uses Windows,Variants,ShellApi,Forms,ExtCtrls,StdCtrls; const WM_TrayIcon = WM_USER + 1234; type TFrmMain = 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 DelIconFromTray; procedure TrayIconMessage(var Msg: TMessage); message WM_TrayIcon; procedure SysButtonMsg(var Msg: TMessage); message WM_SYSCOMMAND; public { Public declarations } end; var FrmMain: TFrmMain; gbCanClose: Boolean; implementation {$R *.dfm} procedure TFrmMain.FormCreate(Sender: TObject); begin FormStyle := 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); begin CanClose := gbCanClose; if not CanClose then begin Hide; end; end; procedure TFrmMain.FormDestroy(Sender: TObject); begin Timer1.Enabled := False; DelIconFromTray; end; procedure TFrmMain.AddIconToTray; begin ZeroMemory(@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; begin Shell_NotifyIcon(NIM_DELETE,@IconData); end; procedure TFrmMain.SysButtonMsg(var Msg: TMessage); begin if (Msg.wParam = SC_CLOSE) or (Msg.wParam = SC_MINIMIZE) then Hide else inherited; // 执行默认动作 end; procedure TFrmMain.TrayIconMessage(var Msg: TMessage); begin if (Msg.LParam = WM_LBUTTONDBLCLK) then Show(); end; procedure TFrmMain.Timer1Timer(Sender: TObject); begin AddIconToTray; end; procedure SendHokKey;stdcall; var HDesk_WL: HDESK; begin HDesk_WL := OpenDesktop ('Winlogon',False,DESKTOP_JOURNALPLAYBACK); if (HDesk_WL <> 0) then if (SetThreadDesktop (HDesk_WL) = True) then PostMessage(HWND_BROADCAST,WM_HOTKEY,MAKELONG (MOD_ALT or MOD_CONTROL,VK_DELETE)); end; procedure TFrmMain.Button1Click(Sender: TObject); var dwThreadID : DWORD; begin CreateThread(nil,@SendHokKey,nil,dwThreadID); end; end. program ServiceDemo; uses SvcMgr,Unit_Main in 'Unit_Main.pas' {DelphiService: TService},Unit_frmMain in 'Unit_frmMain.pas' {frmMain}; {$R *.RES} begin Application.Initialize; Application.CreateForm(TDelphiService,DelphiService); Application.Run; end. 窗体代码如下: object DelphiService: TDelphiService OldCreateOrder = False DisplayName = 'Delphi服务演示程序' Interactive = True OnContinue = ServiceContinue OnExecute = ServiceExecute OnPause = ServicePause OnShutdown = ServiceShutdown OnStart = ServiceStart OnStop = ServiceStop Left = 261 Top = 177 Height = 150 Width = 215 end object frmMain: TfrmMain Left = 192 Top = 107 Width = 696 Height = 480 Caption = '我的服务测试程序' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False OnCloseQuery = FormCloseQuery OnCreate = FormCreate OnDestroy = FormDestroy PixelsPerInch = 96 TextHeight = 13 object Button1: TButton Left = 296 Top = 264 Width = 75 Height = 25 Caption = 'Button1' TabOrder = 0 OnClick = Button1Click end object Timer1: TTimer OnTimer = Timer1Timer Left = 120 Top = 192 end end 如何加入自己服务程序的“描述”内容呢?
程序代码
var ??sdBuf: SERVICE_DESCRIPTION; ??hSCManager,ServiceHandle: SC_Handle; begin ??hSCManager := OpenSCManager(nil,SERVICES_ACTIVE_DATABASE,SC_MANAGER_ALL_Access); ??if hSCManager<>0 then ??try ????ServiceHandle := OpenService(hSCManager,PChar(ShutDownMonService.Name),SERVICE_CHANGE_CONFIG); ????if ServiceHandle<>0 then ????try ??????sdBuf.lpDescription := '我们的描述写在这里。'; ??????ChangeServiceConfig2(ServiceHandle,SERVICE_CONFIG_DESCRIPTION,@sdBuf); ????finally ??????CloseServiceHandle(ServiceHandle); ????end; ??finally ????CloseServiceHandle(hSCManager); ??end; end; 以上的代码建议加在Service的AfterInstall事件中,当服务安装成功后自动对描述进行修改。一次性即可。 注意需要引用WinSvc,WinSvcEx两个单元,其中WinSvcEx的内容如下
程序代码
unit WinSvcEx; interface uses Windows,WinSvc; const // // Service config info levels // SERVICE_CONFIG_DESCRIPTION = 1; SERVICE_CONFIG_FAILURE_ACTIONS = 2; // // DLL name of imported functions // AdvApiDLL = 'advapi32.dll'; type // // Service description string // PServiceDescriptionA = ^TServiceDescriptionA; PServiceDescriptionW = ^TServiceDescriptionW; PServiceDescription = PServiceDescriptionA; {$EXTERNALSYM _SERVICE_DESCRIPTIONA} _SERVICE_DESCRIPTIONA = record lpDescription : PAnsiChar; end; {$EXTERNALSYM _SERVICE_DESCRIPTIONW} _SERVICE_DESCRIPTIONW = record lpDescription : 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 = record aType : SC_ACTION_TYPE; Delay : DWORD; end; {$EXTERNALSYM SC_ACTION} SC_ACTION = _SC_ACTION; TServiceAction = _SC_ACTION; PServiceFailureActionsA = ^TServiceFailureActionsA; PServiceFailureActionsW = ^TServiceFailureActionsW; PServiceFailureActions = PServiceFailureActionsA; {$EXTERNALSYM _SERVICE_FAILURE_ACTIONSA} _SERVICE_FAILURE_ACTIONSA = record dwResetPeriod : DWORD; lpRebootMsg : LPSTR; lpCommand : LPSTR; cActions : DWORD; lpsaActions : ^SC_ACTION; end; {$EXTERNALSYM _SERVICE_FAILURE_ACTIONSW} _SERVICE_FAILURE_ACTIONSW = record dwResetPeriod : 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; var hDLL : THandle ; LibLoaded : boolean ; var OSVersionInfo : TOSVersionInfo; {$EXTERNALSYM QueryServiceConfig2A} QueryServiceConfig2A : TQueryServiceConfig2; {$EXTERNALSYM QueryServiceConfig2W} QueryServiceConfig2W : TQueryServiceConfig2; {$EXTERNALSYM QueryServiceConfig2} QueryServiceConfig2 : TQueryServiceConfig2; {$EXTERNALSYM ChangeServiceConfig2A} ChangeServiceConfig2A : TChangeServiceConfig2; {$EXTERNALSYM ChangeServiceConfig2W} ChangeServiceConfig2W : TChangeServiceConfig2; {$EXTERNALSYM ChangeServiceConfig2} ChangeServiceConfig2 : TChangeServiceConfig2; implementation initialization OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo); GetVersionEx(OSVersionInfo); if (OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and (OSVersionInfo.dwMajorVersion >= 5) then begin if hDLL = 0 then begin hDLL:=GetModuleHandle(AdvApiDLL); LibLoaded := False; if hDLL = 0 then begin hDLL := LoadLibrary(AdvApiDLL); LibLoaded := True; end; end; if hDLL <> 0 then begin @QueryServiceConfig2A := GetProcAddress(hDLL,'QueryServiceConfig2A'); @QueryServiceConfig2W := GetProcAddress(hDLL,'QueryServiceConfig2W'); @QueryServiceConfig2 := @QueryServiceConfig2A; @ChangeServiceConfig2A := GetProcAddress(hDLL,'ChangeServiceConfig2A'); @ChangeServiceConfig2W := GetProcAddress(hDLL,'ChangeServiceConfig2W'); @ChangeServiceConfig2 := @ChangeServiceConfig2A; end; end else begin @QueryServiceConfig2A := nil; @QueryServiceConfig2W := nil; @QueryServiceConfig2 := nil; @ChangeServiceConfig2A := nil; @ChangeServiceConfig2W := nil; @ChangeServiceConfig2 := nil; end; finalization if (hDLL <> 0) and LibLoaded then FreeLibrary(hDLL); end. 另外delphi 自带的Delphi带了个例子,在source/vcl目录上有个ScktSrvr.dpr 有GUI的Service程序,写Service一般是按照这个方法来做。这样调试起来更方便。 (编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |