码迷，mamicode.com
首页 > Windows程序 > 详细

delphi创建具有托盘的服务程序（service）

时间：2015-08-26 15:58:54      阅读：343      评论：0      收藏：0      [点我收藏+]

标签：

delphi创建具有托盘的服务程序（service）


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,并且把这个窗口设置为手工创建.完成后的代码如下:

[delphi] view plaincopy

  1. unit Unit_Main;  

  2.   

  3. interface  

  4.   

  5. uses  

  6. Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, Unit_FrmMain;  

  7.   

  8. type  

  9. TDelphiService = class(TService)  

  10. procedure ServiceContinue(Sender: TService; var Continued: Boolean);  

  11. procedure ServiceExecute(Sender: TService);  

  12. procedure ServicePause(Sender: TService; var Paused: Boolean);  

  13. procedure ServiceShutdown(Sender: TService);  

  14. procedure ServiceStart(Sender: TService; var Started: Boolean);  

  15. procedure ServiceStop(Sender: TService; var Stopped: Boolean);  

  16. private  

  17. { Private declarations }  

  18. public  

  19. function GetServiceController: TServiceController; override;  

  20. { Public declarations }  

  21. end;  

  22.   

  23. var  

  24. DelphiService: TDelphiService;  

  25. FrmMain: TFrmMain;  

  26. implementation  

  27.   

  28. {$R *.DFM}  

  29.   

  30. procedure ServiceController(CtrlCode: DWord); stdcall;  

  31. begin  

  32.   DelphiService.Controller(CtrlCode);  

  33. end;  

  34.   

  35. function TDelphiService.GetServiceController: TServiceController;  

  36. begin  

  37.   Result := ServiceController;  

  38. end;  

  39.   

  40. procedure TDelphiService.ServiceContinue(Sender: TService;  

  41. var Continued: Boolean);  

  42. begin  

  43.   while not Terminated do  

  44.   begin  

  45.     Sleep(10);  

  46.     ServiceThread.ProcessRequests(False);  

  47.   end;  

  48. end;  

  49.   

  50. procedure TDelphiService.ServiceExecute(Sender: TService);  

  51. begin  

  52.   while not Terminated do  

  53.   begin  

  54.     Sleep(10);  

  55.     ServiceThread.ProcessRequests(False);  

  56.   end;  

  57. end;  

  58.   

  59. procedure TDelphiService.ServicePause(Sender: TService;  

  60. var Paused: Boolean);  

  61. begin  

  62.   Paused := True;  

  63. end;  

  64.   

  65. procedure TDelphiService.ServiceShutdown(Sender: TService);  

  66. begin  

  67.   gbCanClose := true;  

  68.   FrmMain.Free;  

  69.   Status := csStopped;  

  70.   ReportStatus();  

  71. end;  

  72.   

  73. procedure TDelphiService.ServiceStart(Sender: TService;  

  74. var Started: Boolean);  

  75. begin  

  76.   Started := True;  

  77.   Svcmgr.Application.CreateForm(TFrmMain, FrmMain);  

  78.   gbCanClose := False;  

  79.   FrmMain.Hide;  

  80. end;  

  81.   

  82. procedure TDelphiService.ServiceStop(Sender: TService;  

  83. var Stopped: Boolean);  

  84. begin  

  85.   Stopped := True;  

  86.   gbCanClose := True;  

  87.   FrmMain.Free;  

  88. end;  

  89.   

  90. end.  

[delphi] view plaincopy技术分享技术分享

  1. unit Unit_Main;  

  2.   

  3. interface  

  4.   

  5. uses  

  6. Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, Unit_FrmMain;  

  7.   

  8. type  

  9. TDelphiService = class(TService)  

  10. procedure ServiceContinue(Sender: TService; var Continued: Boolean);  

  11. procedure ServiceExecute(Sender: TService);  

  12. procedure ServicePause(Sender: TService; var Paused: Boolean);  

  13. procedure ServiceShutdown(Sender: TService);  

  14. procedure ServiceStart(Sender: TService; var Started: Boolean);  

  15. procedure ServiceStop(Sender: TService; var Stopped: Boolean);  

  16. private  

  17. { Private declarations }  

  18. public  

  19. function GetServiceController: TServiceController; override;  

  20. { Public declarations }  

  21. end;  

  22.   

  23. var  

  24. DelphiService: TDelphiService;  

  25. FrmMain: TFrmMain;  

  26. implementation  

  27.   

  28. {$R *.DFM}  

  29.   

  30. procedure ServiceController(CtrlCode: DWord); stdcall;  

  31. begin  

  32.   DelphiService.Controller(CtrlCode);  

  33. end;  

  34.   

  35. function TDelphiService.GetServiceController: TServiceController;  

  36. begin  

  37.   Result := ServiceController;  

  38. end;  

  39.   

  40. procedure TDelphiService.ServiceContinue(Sender: TService;  

  41. var Continued: Boolean);  

  42. begin  

  43.   while not Terminated do  

  44.   begin  

  45.     Sleep(10);  

  46.     ServiceThread.ProcessRequests(False);  

  47.   end;  

  48. end;  

  49.   

  50. procedure TDelphiService.ServiceExecute(Sender: TService);  

  51. begin  

  52.   while not Terminated do  

  53.   begin  

  54.     Sleep(10);  

  55.     ServiceThread.ProcessRequests(False);  

  56.   end;  

  57. end;  

  58.   

  59. procedure TDelphiService.ServicePause(Sender: TService;  

  60. var Paused: Boolean);  

  61. begin  

  62.   Paused := True;  

  63. end;  

  64.   

  65. procedure TDelphiService.ServiceShutdown(Sender: TService);  

  66. begin  

  67.   gbCanClose := true;  

  68.   FrmMain.Free;  

  69.   Status := csStopped;  

  70.   ReportStatus();  

  71. end;  

  72.   

  73. procedure TDelphiService.ServiceStart(Sender: TService;  

  74. var Started: Boolean);  

  75. begin  

  76.   Started := True;  

  77.   Svcmgr.Application.CreateForm(TFrmMain, FrmMain);  

  78.   gbCanClose := False;  

  79.   FrmMain.Hide;  

  80. end;  

  81.   

  82. procedure TDelphiService.ServiceStop(Sender: TService;  

  83. var Stopped: Boolean);  

  84. begin  

  85.   Stopped := True;  

  86.   gbCanClose := True;  

  87.   FrmMain.Free;  

  88. end;  

  89.   

  90. end.  


主窗口单元如下:

[delphi] view plaincopy

  1. unit Unit_FrmMain;  

  2.   

  3. interface  

  4.   

  5. uses  

  6. Windows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics, Controls, Forms,  

  7. Dialogs, ExtCtrls, StdCtrls;  

  8.   

  9. const  

  10. WM_TrayIcon = WM_USER + 1234;  

  11. type  

  12. TFrmMain = class(TForm)  

  13. Timer1: TTimer;  

  14. Button1: TButton;  

  15. procedure FormCreate(Sender: TObject);  

  16. procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);  

  17. procedure FormDestroy(Sender: TObject);  

  18. procedure Timer1Timer(Sender: TObject);  

  19. procedure Button1Click(Sender: TObject);  

  20. private  

  21. { Private declarations }  

  22. IconData: TNotifyIconData;  

  23. procedure AddIconToTray;  

  24. procedure DelIconFromTray;  

  25. procedure TrayIconMessage(var Msg: TMessage); message WM_TrayIcon;  

  26. procedure SysButtonMsg(var Msg: TMessage); message WM_SYSCOMMAND;  

  27. public  

  28. { Public declarations }  

  29. end;  

  30.   

  31. var  

  32. FrmMain: TFrmMain;  

  33. gbCanClose: Boolean;  

  34. implementation  

  35.   

  36. {$R *.dfm}  

  37.   

  38. procedure TFrmMain.FormCreate(Sender: TObject);  

  39. begin  

  40.   FormStyle := fsStayOnTop; {窗口最前}  

  41.   SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW); {不在任务栏显示}  

  42.   gbCanClose := False;  

  43.   Timer1.Interval := 1000;  

  44.   Timer1.Enabled := True;  

  45. end;  

  46.   

  47. procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);  

  48. begin  

  49.   CanClose := gbCanClose;  

  50.   if not CanClose then  

  51.   begin  

  52.     Hide;  

  53.   end;  

  54. end;  

  55.   

  56. procedure TFrmMain.FormDestroy(Sender: TObject);  

  57. begin  

  58.   Timer1.Enabled := False;  

  59.   DelIconFromTray;  

  60. end;  

  61.   

  62. procedure TFrmMain.AddIconToTray;  

  63. begin  

  64.   ZeroMemory(@IconData, SizeOf(TNotifyIconData));  

  65.   IconData.cbSize := SizeOf(TNotifyIconData);  

  66.   IconData.Wnd := Handle;  

  67.   IconData.uID := 1;  

  68.   IconData.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;  

  69.   IconData.uCallbackMessage := WM_TrayIcon;  

  70.   IconData.hIcon := Application.Icon.Handle;  

  71.   IconData.szTip := ‘Delphi服务演示程序‘;  

  72.   Shell_NotifyIcon(NIM_ADD, @IconData);  

  73. end;  

  74.   

  75. procedure TFrmMain.DelIconFromTray;  

  76. begin  

  77.   Shell_NotifyIcon(NIM_DELETE, @IconData);  

  78. end;  

  79.   

  80. procedure TFrmMain.SysButtonMsg(var Msg: TMessage);  

  81. begin  

  82.   if (Msg.wParam = SC_CLOSE) or  

  83.   (Msg.wParam = SC_MINIMIZE) then Hide  

  84.   else inherited; // 执行默认动作  

  85. end;  

  86.   

  87. procedure TFrmMain.TrayIconMessage(var Msg: TMessage);  

  88. begin  

  89.   if (Msg.LParam = WM_LBUTTONDBLCLK) then Show();  

  90. end;  

  91.   

  92. procedure TFrmMain.Timer1Timer(Sender: TObject);  

  93. begin  

  94.   AddIconToTray;  

  95. end;  

  96.   

  97. procedure SendHokKey;stdcall;  

  98. var  

  99. HDesk_WL: HDESK;  

  100. begin  

  101.   HDesk_WL := OpenDesktop (‘Winlogon‘, 0, False, DESKTOP_JOURNALPLAYBACK);  

  102.   if (HDesk_WL <> 0) then  

  103.   if (SetThreadDesktop (HDesk_WL) = True) then  

  104.   PostMessage(HWND_BROADCAST, WM_HOTKEY, 0, MAKELONG (MOD_ALT or MOD_CONTROL, VK_DELETE));  

  105. end;  

  106.   

  107. procedure TFrmMain.Button1Click(Sender: TObject);  

  108. var  

  109. dwThreadID : DWORD;  

  110. begin  

  111.   CreateThread(nil, 0, @SendHokKey, nil, 0, dwThreadID);  

  112. end;  

  113.   

  114. end.  

  115.   

  116. program ServiceDemo;  

  117.   

  118. uses  

  119. SvcMgr,  

  120. Unit_Main in ‘Unit_Main.pas‘ {DelphiService: TService},  

  121. Unit_frmMain in ‘Unit_frmMain.pas‘ {frmMain};  

  122.   

  123. {$R *.RES}  

  124.   

  125. begin  

  126.   Application.Initialize;  

  127.   Application.CreateForm(TDelphiService, DelphiService);  

  128.   Application.Run;  

  129. end.  

[delphi] view plaincopy技术分享技术分享

  1. unit Unit_FrmMain;  

  2.   

  3. interface  

  4.   

  5. uses  

  6. Windows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics, Controls, Forms,  

  7. Dialogs, ExtCtrls, StdCtrls;  

  8.   

  9. const  

  10. WM_TrayIcon = WM_USER + 1234;  

  11. type  

  12. TFrmMain = class(TForm)  

  13. Timer1: TTimer;  

  14. Button1: TButton;  

  15. procedure FormCreate(Sender: TObject);  

  16. procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);  

  17. procedure FormDestroy(Sender: TObject);  

  18. procedure Timer1Timer(Sender: TObject);  

  19. procedure Button1Click(Sender: TObject);  

  20. private  

  21. { Private declarations }  

  22. IconData: TNotifyIconData;  

  23. procedure AddIconToTray;  

  24. procedure DelIconFromTray;  

  25. procedure TrayIconMessage(var Msg: TMessage); message WM_TrayIcon;  

  26. procedure SysButtonMsg(var Msg: TMessage); message WM_SYSCOMMAND;  

  27. public  

  28. { Public declarations }  

  29. end;  

  30.   

  31. var  

  32. FrmMain: TFrmMain;  

  33. gbCanClose: Boolean;  

  34. implementation  

  35.   

  36. {$R *.dfm}  

  37.   

  38. procedure TFrmMain.FormCreate(Sender: TObject);  

  39. begin  

  40.   FormStyle := fsStayOnTop; {窗口最前}  

  41.   SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW); {不在任务栏显示}  

  42.   gbCanClose := False;  

  43.   Timer1.Interval := 1000;  

  44.   Timer1.Enabled := True;  

  45. end;  

  46.   

  47. procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);  

  48. begin  

  49.   CanClose := gbCanClose;  

  50.   if not CanClose then  

  51.   begin  

  52.     Hide;  

  53.   end;  

  54. end;  

  55.   

  56. procedure TFrmMain.FormDestroy(Sender: TObject);  

  57. begin  

  58.   Timer1.Enabled := False;  

  59.   DelIconFromTray;  

  60. end;  

  61.   

  62. procedure TFrmMain.AddIconToTray;  

  63. begin  

  64.   ZeroMemory(@IconData, SizeOf(TNotifyIconData));  

  65.   IconData.cbSize := SizeOf(TNotifyIconData);  

  66.   IconData.Wnd := Handle;  

  67.   IconData.uID := 1;  

  68.   IconData.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;  

  69.   IconData.uCallbackMessage := WM_TrayIcon;  

  70.   IconData.hIcon := Application.Icon.Handle;  

  71.   IconData.szTip := ‘Delphi服务演示程序‘;  

  72.   Shell_NotifyIcon(NIM_ADD, @IconData);  

  73. end;  

  74.   

  75. procedure TFrmMain.DelIconFromTray;  

  76. begin  

  77.   Shell_NotifyIcon(NIM_DELETE, @IconData);  

  78. end;  

  79.   

  80. procedure TFrmMain.SysButtonMsg(var Msg: TMessage);  

  81. begin  

  82.   if (Msg.wParam = SC_CLOSE) or  

  83.   (Msg.wParam = SC_MINIMIZE) then Hide  

  84.   else inherited; // 执行默认动作  

  85. end;  

  86.   

  87. procedure TFrmMain.TrayIconMessage(var Msg: TMessage);  

  88. begin  

  89.   if (Msg.LParam = WM_LBUTTONDBLCLK) then Show();  

  90. end;  

  91.   

  92. procedure TFrmMain.Timer1Timer(Sender: TObject);  

  93. begin  

  94.   AddIconToTray;  

  95. end;  

  96.   

  97. procedure SendHokKey;stdcall;  

  98. var  

  99. HDesk_WL: HDESK;  

  100. begin  

  101.   HDesk_WL := OpenDesktop (‘Winlogon‘, 0, False, DESKTOP_JOURNALPLAYBACK);  

  102.   if (HDesk_WL <> 0) then  

  103.   if (SetThreadDesktop (HDesk_WL) = True) then  

  104.   PostMessage(HWND_BROADCAST, WM_HOTKEY, 0, MAKELONG (MOD_ALT or MOD_CONTROL, VK_DELETE));  

  105. end;  

  106.   

  107. procedure TFrmMain.Button1Click(Sender: TObject);  

  108. var  

  109. dwThreadID : DWORD;  

  110. begin  

  111.   CreateThread(nil, 0, @SendHokKey, nil, 0, dwThreadID);  

  112. end;  

  113.   

  114. end.  

  115.   

  116. program ServiceDemo;  

  117.   

  118. uses  

  119. SvcMgr,  

  120. Unit_Main in ‘Unit_Main.pas‘ {DelphiService: TService},  

  121. Unit_frmMain in ‘Unit_frmMain.pas‘ {frmMain};  

  122.   

  123. {$R *.RES}  

  124.   

  125. begin  

  126.   Application.Initialize;  

  127.   Application.CreateForm(TDelphiService, DelphiService);  

  128.   Application.Run;  

  129. end.  


窗体代码如下:

[delphi] view plaincopy

  1. object DelphiService: TDelphiService  

  2. OldCreateOrder = False  

  3. DisplayName = ‘Delphi服务演示程序‘  

  4. Interactive = True  

  5. OnContinue = ServiceContinue  

  6. OnExecute = ServiceExecute  

  7. OnPause = ServicePause  

  8. OnShutdown = ServiceShutdown  

  9. OnStart = ServiceStart  

  10. OnStop = ServiceStop  

  11. Left = 261  

  12. Top = 177  

  13. Height = 150  

  14. Width = 215  

  15. end  

  16.   

  17. object frmMain: TfrmMain  

  18. Left = 192  

  19. Top = 107  

  20. Width = 696  

  21. Height = 480  

  22. Caption = ‘我的服务测试程序‘  

  23. Color = clBtnFace  

  24. Font.Charset = DEFAULT_CHARSET  

  25. Font.Color = clWindowText  

  26. Font.Height = -11  

  27. Font.Name = ‘MS Sans Serif‘  

  28. Font.Style = []  

  29. OldCreateOrder = False  

  30. OnCloseQuery = FormCloseQuery  

  31. OnCreate = FormCreate  

  32. OnDestroy = FormDestroy  

  33. PixelsPerInch = 96  

  34. TextHeight = 13  

  35. object Button1: TButton  

  36. Left = 296  

  37. Top = 264  

  38. Width = 75  

  39. Height = 25  

  40. Caption = ‘Button1‘  

  41. TabOrder = 0  

  42. OnClick = Button1Click  

  43. end  

  44. object Timer1: TTimer  

  45. OnTimer = Timer1Timer  

  46. Left = 120  

  47. Top = 192  

  48. end  

  49. end   

[delphi] view plaincopy技术分享技术分享

  1. object DelphiService: TDelphiService  

  2. OldCreateOrder = False  

  3. DisplayName = ‘Delphi服务演示程序‘  

  4. Interactive = True  

  5. OnContinue = ServiceContinue  

  6. OnExecute = ServiceExecute  

  7. OnPause = ServicePause  

  8. OnShutdown = ServiceShutdown  

  9. OnStart = ServiceStart  

  10. OnStop = ServiceStop  

  11. Left = 261  

  12. Top = 177  

  13. Height = 150  

  14. Width = 215  

  15. end  

  16.   

  17. object frmMain: TfrmMain  

  18. Left = 192  

  19. Top = 107  

  20. Width = 696  

  21. Height = 480  

  22. Caption = ‘我的服务测试程序‘  

  23. Color = clBtnFace  

  24. Font.Charset = DEFAULT_CHARSET  

  25. Font.Color = clWindowText  

  26. Font.Height = -11  

  27. Font.Name = ‘MS Sans Serif‘  

  28. Font.Style = []  

  29. OldCreateOrder = False  

  30. OnCloseQuery = FormCloseQuery  

  31. OnCreate = FormCreate  

  32. OnDestroy = FormDestroy  

  33. PixelsPerInch = 96  

  34. TextHeight = 13  

  35. object Button1: TButton  

  36. Left = 296  

  37. Top = 264  

  38. Width = 75  

  39. Height = 25  

  40. Caption = ‘Button1‘  

  41. TabOrder = 0  

  42. OnClick = Button1Click  

  43. end  

  44. object Timer1: TTimer  

  45. OnTimer = Timer1Timer  

  46. Left = 120  

  47. Top = 192  

  48. end  

  49. end   




如何加入自己服务程序的“描述”内容呢？

目前基本有两种方法：
1、修改注册表，在
HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet001\Services下找到自己的服务名称键值，然后加入一个名为Description的字符串字段，字段内容就是描述的内容。
这种方法通过实验是有效的，但因为不是通过API实现，而是直接写注册表，不太清楚适用性如何，不同的系统不知是否通用。

2、可通过ChangeServiceConfig2函数实现对服务的描述的修改。网上的ChangeServiceConfig2函数举例都根本无法成功运行，通过摸索改进，现提供ChangeServiceConfig2的正确用法如下，可成功有效地修改服务程序的描述。

程序代码


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一般是按照这个方法来做。这样调试起来更方便。


delphi创建具有托盘的服务程序（service）

标签：

原文地址：http://my.oschina.net/u/582827/blog/497303
踩
(0)
赞
(0)
   
举报
评论 一句话评论（0）
登录后才能评论！
分享档案
更多>
2021年07月29日 (22)
2021年07月28日 (40)
2021年07月27日 (32)
2021年07月26日 (79)
2021年07月23日 (29)
2021年07月22日 (30)
2021年07月21日 (42)
2021年07月20日 (16)
2021年07月19日 (90)
2021年07月16日 (35)
周排行
mamicode.com排行更多图片
更多
友情链接
兰亭集智   国之画   百度统计   站长统计   阿里云   chrome插件   新版天听网
关于我们 - 联系我们 - 留言反馈
© 2014 mamicode.com 版权所有  联系我们:gaon5@hotmail.com
迷上了代码！