delphi建立具備托盤的服務程序（service）

時間  2019-11-06
標籤 delphi 建立 具備 托盤 服務 程序 service 欄目 Delphi 简体版
原文   原文鏈接

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的時候,該服務程序就能夠與桌面交互了.

api

    File-->New-->Form爲服務添加窗口FrmMain,單元保存爲Unit_FrmMain,而且把這個窗口設置爲手工建立.完成後的代碼以下:框架

[delphi] view plaincopyide

  1. unit Unit_Main;  函數

  2.   

  3. interface  工具

  4.   

  5. uses  測試

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

  7.   

  8. type  .net

  9. TDelphiService = class(TService)  調試

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

  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在CODE上查看代碼片派生到個人代碼片

  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在CODE上查看代碼片派生到個人代碼片

  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在CODE上查看代碼片派生到個人代碼片

  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   




如何加入本身服務程序的「描述」內容呢？

目前基本有兩種方法：
一、修改註冊表，在
HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet001\Services下找到本身的服務名稱鍵值，而後加入一個名爲Description的字符串字段，字段內容就是描述的內容。
這種方法經過實驗是有效的，但由於不是經過API實現，而是直接寫註冊表，不太清楚適用性如何，不一樣的系統不知是否通用。

二、可經過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通常是按照這個方法來作。這樣調試起來更方便。

相關文章
相關標籤/搜索
每日一句
    每一个你不满意的现在，都有一个你没有努力的曾经。
本站公眾號
   歡迎關注本站公眾號,獲取更多信息
聯繫我們 最近搜索 最新文章 沪ICP备13005482号-10 MyBatis教程 SQL 教程 MySQL教程 Java 教程 Thymeleaf 教程 Hibernate教程 Spring教程 Redis教程