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

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. interface
  3. uses
  4. Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, Unit_FrmMain;
  5. type
  6. TDelphiService = class(TService)
  7. procedure ServiceContinue(Sender: TService; var Continued: Boolean);
  8. procedure ServiceExecute(Sender: TService);
  9. procedure ServicePause(Sender: TService; var Paused: Boolean);
  10. procedure ServiceShutdown(Sender: TService);
  11. procedure ServiceStart(Sender: TService; var Started: Boolean);
  12. procedure ServiceStop(Sender: TService; var Stopped: Boolean);
  13. private
  14. { Private declarations }
  15. public
  16. function GetServiceController: TServiceController; override;
  17. { Public declarations }
  18. end;
  19. var
  20. DelphiService: TDelphiService;
  21. FrmMain: TFrmMain;
  22. implementation
  23. {$R *.DFM}
  24. procedure ServiceController(CtrlCode: DWord); stdcall;
  25. begin
  26. DelphiService.Controller(CtrlCode);
  27. end;
  28. function TDelphiService.GetServiceController: TServiceController;
  29. begin
  30. Result := ServiceController;
  31. end;
  32. procedure TDelphiService.ServiceContinue(Sender: TService;
  33. var Continued: Boolean);
  34. begin
  35. while not Terminated do
  36. begin
  37. Sleep(10);
  38. ServiceThread.ProcessRequests(False);
  39. end;
  40. end;
  41. procedure TDelphiService.ServiceExecute(Sender: TService);
  42. begin
  43. while not Terminated do
  44. begin
  45. Sleep(10);
  46. ServiceThread.ProcessRequests(False);
  47. end;
  48. end;
  49. procedure TDelphiService.ServicePause(Sender: TService;
  50. var Paused: Boolean);
  51. begin
  52. Paused := True;
  53. end;
  54. procedure TDelphiService.ServiceShutdown(Sender: TService);
  55. begin
  56. gbCanClose := true;
  57. FrmMain.Free;
  58. Status := csStopped;
  59. ReportStatus();
  60. end;
  61. procedure TDelphiService.ServiceStart(Sender: TService;
  62. var Started: Boolean);
  63. begin
  64. Started := True;
  65. Svcmgr.Application.CreateForm(TFrmMain, FrmMain);
  66. gbCanClose := False;
  67. FrmMain.Hide;
  68. end;
  69. procedure TDelphiService.ServiceStop(Sender: TService;
  70. var Stopped: Boolean);
  71. begin
  72. Stopped := True;
  73. gbCanClose := True;
  74. FrmMain.Free;
  75. end;
  76. end.

[delphi] view plaincopy

  1. unit Unit_Main;
  2. interface
  3. uses
  4. Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, Unit_FrmMain;
  5. type
  6. TDelphiService = class(TService)
  7. procedure ServiceContinue(Sender: TService; var Continued: Boolean);
  8. procedure ServiceExecute(Sender: TService);
  9. procedure ServicePause(Sender: TService; var Paused: Boolean);
  10. procedure ServiceShutdown(Sender: TService);
  11. procedure ServiceStart(Sender: TService; var Started: Boolean);
  12. procedure ServiceStop(Sender: TService; var Stopped: Boolean);
  13. private
  14. { Private declarations }
  15. public
  16. function GetServiceController: TServiceController; override;
  17. { Public declarations }
  18. end;
  19. var
  20. DelphiService: TDelphiService;
  21. FrmMain: TFrmMain;
  22. implementation
  23. {$R *.DFM}
  24. procedure ServiceController(CtrlCode: DWord); stdcall;
  25. begin
  26. DelphiService.Controller(CtrlCode);
  27. end;
  28. function TDelphiService.GetServiceController: TServiceController;
  29. begin
  30. Result := ServiceController;
  31. end;
  32. procedure TDelphiService.ServiceContinue(Sender: TService;
  33. var Continued: Boolean);
  34. begin
  35. while not Terminated do
  36. begin
  37. Sleep(10);
  38. ServiceThread.ProcessRequests(False);
  39. end;
  40. end;
  41. procedure TDelphiService.ServiceExecute(Sender: TService);
  42. begin
  43. while not Terminated do
  44. begin
  45. Sleep(10);
  46. ServiceThread.ProcessRequests(False);
  47. end;
  48. end;
  49. procedure TDelphiService.ServicePause(Sender: TService;
  50. var Paused: Boolean);
  51. begin
  52. Paused := True;
  53. end;
  54. procedure TDelphiService.ServiceShutdown(Sender: TService);
  55. begin
  56. gbCanClose := true;
  57. FrmMain.Free;
  58. Status := csStopped;
  59. ReportStatus();
  60. end;
  61. procedure TDelphiService.ServiceStart(Sender: TService;
  62. var Started: Boolean);
  63. begin
  64. Started := True;
  65. Svcmgr.Application.CreateForm(TFrmMain, FrmMain);
  66. gbCanClose := False;
  67. FrmMain.Hide;
  68. end;
  69. procedure TDelphiService.ServiceStop(Sender: TService;
  70. var Stopped: Boolean);
  71. begin
  72. Stopped := True;
  73. gbCanClose := True;
  74. FrmMain.Free;
  75. end;
  76. end.

主窗口单元如下:

[delphi] view plaincopy

  1. unit Unit_FrmMain;
  2. interface
  3. uses
  4. Windows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics, Controls, Forms,
  5. Dialogs, ExtCtrls, StdCtrls;
  6. const
  7. WM_TrayIcon = WM_USER + 1234;
  8. type
  9. TFrmMain = class(TForm)
  10. Timer1: TTimer;
  11. Button1: TButton;
  12. procedure FormCreate(Sender: TObject);
  13. procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  14. procedure FormDestroy(Sender: TObject);
  15. procedure Timer1Timer(Sender: TObject);
  16. procedure Button1Click(Sender: TObject);
  17. private
  18. { Private declarations }
  19. IconData: TNotifyIconData;
  20. procedure AddIconToTray;
  21. procedure DelIconFromTray;
  22. procedure TrayIconMessage(var Msg: TMessage); message WM_TrayIcon;
  23. procedure SysButtonMsg(var Msg: TMessage); message WM_SYSCOMMAND;
  24. public
  25. { Public declarations }
  26. end;
  27. var
  28. FrmMain: TFrmMain;
  29. gbCanClose: Boolean;
  30. implementation
  31. {$R *.dfm}
  32. procedure TFrmMain.FormCreate(Sender: TObject);
  33. begin
  34. FormStyle := fsStayOnTop; {窗口最前}
  35. SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW); {不在任务栏显示}
  36. gbCanClose := False;
  37. Timer1.Interval := 1000;
  38. Timer1.Enabled := True;
  39. end;
  40. procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  41. begin
  42. CanClose := gbCanClose;
  43. if not CanClose then
  44. begin
  45. Hide;
  46. end;
  47. end;
  48. procedure TFrmMain.FormDestroy(Sender: TObject);
  49. begin
  50. Timer1.Enabled := False;
  51. DelIconFromTray;
  52. end;
  53. procedure TFrmMain.AddIconToTray;
  54. begin
  55. ZeroMemory(@IconData, SizeOf(TNotifyIconData));
  56. IconData.cbSize := SizeOf(TNotifyIconData);
  57. IconData.Wnd := Handle;
  58. IconData.uID := 1;
  59. IconData.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
  60. IconData.uCallbackMessage := WM_TrayIcon;
  61. IconData.hIcon := Application.Icon.Handle;
  62. IconData.szTip := ‘Delphi服务演示程序‘;
  63. Shell_NotifyIcon(NIM_ADD, @IconData);
  64. end;
  65. procedure TFrmMain.DelIconFromTray;
  66. begin
  67. Shell_NotifyIcon(NIM_DELETE, @IconData);
  68. end;
  69. procedure TFrmMain.SysButtonMsg(var Msg: TMessage);
  70. begin
  71. if (Msg.wParam = SC_CLOSE) or
  72. (Msg.wParam = SC_MINIMIZE) then Hide
  73. else inherited; // 执行默认动作
  74. end;
  75. procedure TFrmMain.TrayIconMessage(var Msg: TMessage);
  76. begin
  77. if (Msg.LParam = WM_LBUTTONDBLCLK) then Show();
  78. end;
  79. procedure TFrmMain.Timer1Timer(Sender: TObject);
  80. begin
  81. AddIconToTray;
  82. end;
  83. procedure SendHokKey;stdcall;
  84. var
  85. HDesk_WL: HDESK;
  86. begin
  87. HDesk_WL := OpenDesktop (‘Winlogon‘, 0, False, DESKTOP_JOURNALPLAYBACK);
  88. if (HDesk_WL <> 0) then
  89. if (SetThreadDesktop (HDesk_WL) = True) then
  90. PostMessage(HWND_BROADCAST, WM_HOTKEY, 0, MAKELONG (MOD_ALT or MOD_CONTROL, VK_DELETE));
  91. end;
  92. procedure TFrmMain.Button1Click(Sender: TObject);
  93. var
  94. dwThreadID : DWORD;
  95. begin
  96. CreateThread(nil, 0, @SendHokKey, nil, 0, dwThreadID);
  97. end;
  98. end.
  99. program ServiceDemo;
  100. uses
  101. SvcMgr,
  102. Unit_Main in ‘Unit_Main.pas‘ {DelphiService: TService},
  103. Unit_frmMain in ‘Unit_frmMain.pas‘ {frmMain};
  104. {$R *.RES}
  105. begin
  106. Application.Initialize;
  107. Application.CreateForm(TDelphiService, DelphiService);
  108. Application.Run;
  109. end.

[delphi] view plaincopy

  1. unit Unit_FrmMain;
  2. interface
  3. uses
  4. Windows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics, Controls, Forms,
  5. Dialogs, ExtCtrls, StdCtrls;
  6. const
  7. WM_TrayIcon = WM_USER + 1234;
  8. type
  9. TFrmMain = class(TForm)
  10. Timer1: TTimer;
  11. Button1: TButton;
  12. procedure FormCreate(Sender: TObject);
  13. procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  14. procedure FormDestroy(Sender: TObject);
  15. procedure Timer1Timer(Sender: TObject);
  16. procedure Button1Click(Sender: TObject);
  17. private
  18. { Private declarations }
  19. IconData: TNotifyIconData;
  20. procedure AddIconToTray;
  21. procedure DelIconFromTray;
  22. procedure TrayIconMessage(var Msg: TMessage); message WM_TrayIcon;
  23. procedure SysButtonMsg(var Msg: TMessage); message WM_SYSCOMMAND;
  24. public
  25. { Public declarations }
  26. end;
  27. var
  28. FrmMain: TFrmMain;
  29. gbCanClose: Boolean;
  30. implementation
  31. {$R *.dfm}
  32. procedure TFrmMain.FormCreate(Sender: TObject);
  33. begin
  34. FormStyle := fsStayOnTop; {窗口最前}
  35. SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW); {不在任务栏显示}
  36. gbCanClose := False;
  37. Timer1.Interval := 1000;
  38. Timer1.Enabled := True;
  39. end;
  40. procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  41. begin
  42. CanClose := gbCanClose;
  43. if not CanClose then
  44. begin
  45. Hide;
  46. end;
  47. end;
  48. procedure TFrmMain.FormDestroy(Sender: TObject);
  49. begin
  50. Timer1.Enabled := False;
  51. DelIconFromTray;
  52. end;
  53. procedure TFrmMain.AddIconToTray;
  54. begin
  55. ZeroMemory(@IconData, SizeOf(TNotifyIconData));
  56. IconData.cbSize := SizeOf(TNotifyIconData);
  57. IconData.Wnd := Handle;
  58. IconData.uID := 1;
  59. IconData.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
  60. IconData.uCallbackMessage := WM_TrayIcon;
  61. IconData.hIcon := Application.Icon.Handle;
  62. IconData.szTip := ‘Delphi服务演示程序‘;
  63. Shell_NotifyIcon(NIM_ADD, @IconData);
  64. end;
  65. procedure TFrmMain.DelIconFromTray;
  66. begin
  67. Shell_NotifyIcon(NIM_DELETE, @IconData);
  68. end;
  69. procedure TFrmMain.SysButtonMsg(var Msg: TMessage);
  70. begin
  71. if (Msg.wParam = SC_CLOSE) or
  72. (Msg.wParam = SC_MINIMIZE) then Hide
  73. else inherited; // 执行默认动作
  74. end;
  75. procedure TFrmMain.TrayIconMessage(var Msg: TMessage);
  76. begin
  77. if (Msg.LParam = WM_LBUTTONDBLCLK) then Show();
  78. end;
  79. procedure TFrmMain.Timer1Timer(Sender: TObject);
  80. begin
  81. AddIconToTray;
  82. end;
  83. procedure SendHokKey;stdcall;
  84. var
  85. HDesk_WL: HDESK;
  86. begin
  87. HDesk_WL := OpenDesktop (‘Winlogon‘, 0, False, DESKTOP_JOURNALPLAYBACK);
  88. if (HDesk_WL <> 0) then
  89. if (SetThreadDesktop (HDesk_WL) = True) then
  90. PostMessage(HWND_BROADCAST, WM_HOTKEY, 0, MAKELONG (MOD_ALT or MOD_CONTROL, VK_DELETE));
  91. end;
  92. procedure TFrmMain.Button1Click(Sender: TObject);
  93. var
  94. dwThreadID : DWORD;
  95. begin
  96. CreateThread(nil, 0, @SendHokKey, nil, 0, dwThreadID);
  97. end;
  98. end.
  99. program ServiceDemo;
  100. uses
  101. SvcMgr,
  102. Unit_Main in ‘Unit_Main.pas‘ {DelphiService: TService},
  103. Unit_frmMain in ‘Unit_frmMain.pas‘ {frmMain};
  104. {$R *.RES}
  105. begin
  106. Application.Initialize;
  107. Application.CreateForm(TDelphiService, DelphiService);
  108. Application.Run;
  109. 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. object frmMain: TfrmMain
  17. Left = 192
  18. Top = 107
  19. Width = 696
  20. Height = 480
  21. Caption = ‘我的服务测试程序‘
  22. Color = clBtnFace
  23. Font.Charset = DEFAULT_CHARSET
  24. Font.Color = clWindowText
  25. Font.Height = -11
  26. Font.Name = ‘MS Sans Serif‘
  27. Font.Style = []
  28. OldCreateOrder = False
  29. OnCloseQuery = FormCloseQuery
  30. OnCreate = FormCreate
  31. OnDestroy = FormDestroy
  32. PixelsPerInch = 96
  33. TextHeight = 13
  34. object Button1: TButton
  35. Left = 296
  36. Top = 264
  37. Width = 75
  38. Height = 25
  39. Caption = ‘Button1‘
  40. TabOrder = 0
  41. OnClick = Button1Click
  42. end
  43. object Timer1: TTimer
  44. OnTimer = Timer1Timer
  45. Left = 120
  46. Top = 192
  47. end
  48. 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. object frmMain: TfrmMain
  17. Left = 192
  18. Top = 107
  19. Width = 696
  20. Height = 480
  21. Caption = ‘我的服务测试程序‘
  22. Color = clBtnFace
  23. Font.Charset = DEFAULT_CHARSET
  24. Font.Color = clWindowText
  25. Font.Height = -11
  26. Font.Name = ‘MS Sans Serif‘
  27. Font.Style = []
  28. OldCreateOrder = False
  29. OnCloseQuery = FormCloseQuery
  30. OnCreate = FormCreate
  31. OnDestroy = FormDestroy
  32. PixelsPerInch = 96
  33. TextHeight = 13
  34. object Button1: TButton
  35. Left = 296
  36. Top = 264
  37. Width = 75
  38. Height = 25
  39. Caption = ‘Button1‘
  40. TabOrder = 0
  41. OnClick = Button1Click
  42. end
  43. object Timer1: TTimer
  44. OnTimer = Timer1Timer
  45. Left = 120
  46. Top = 192
  47. end
  48. 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一般是按照这个方法来做。这样调试起来更方便。

时间： 2024-11-09 02:46:24

delphi创建具有托盘的服务程序（service）的相关文章

delphi创建服务程序

创建一个自己的服务程序: File -> New -> Other -> New(选项) -> Service Application 这样delphi会自动生成服务程序的框架. 保存合适的项目名称.(这里单元名为UnitServer.pas, 工程名为ProjectServer.dpr) 在新建的服务里,会发现有DisplayName.Name等属性: DisplayName:  服务里显示的名称:(服务名: delphi服务演示程序) Name:服务运行的名称:(服务程序名:D

delphi服务程序(service)的调试方法

delphi服务程序(service)的调试方法         delphi service 调试 方法一: 1.调试delphi 写的服务程序,有这么一个办法.原来每次都是用attach to process方法,很麻烦.并且按照服务线程的执行线路,可能会停不到想要的断点.笨办法是,在procedure TsvcFrm.ServiceExecute(Sender: TService);中想要下断的语句前加个人定胜天的sleep(20000),但实际上这种办法是主观臆测的.可行,没问题.记得大

C# 创建和安装Windows服务程序

1.新建一个windows服务程序. 2.点击这个服务类,从工具箱中添加一个Timer控件,右键这个Timer控件 命名为 timerOrderDeductionDetailJob,Enable设为True. 3.右键这个服务类,在OnStart方法中设置Timer控件的启动间隔时间. protected override void OnStart(string[] args) { // TODO: 在此处添加代码以启动服务. this.timerOrderDeductionDetailJob.

创建不被杀死的service

service 在android app里 应用 越来越多,特别是联网的app中,不管app是否启动,总需要一个service来维护与后台数据的连接,接收服务端的推送,获取及时的数据信息. 可是 service 总是在后台不知不觉的别系统回收 或者被 一些优化软件 给 "优化"了,怎么解决这个问题? 查资料 找到了  Service对象的onStartCommand(Intent,int,int)方法 ,此方法介绍: onStartCommand有4种返回值: START_STICKY

如何创建和发布.asmx Web Service

创建和发布Web ServiceWeb服务方法中可以返回一个DataSet对象 WEB服务可以说是下一代WEB应用程序的基础,无论客户端是WINDOWS应用.ASP.NET Web Form程序.甚至其他语言的客户端,都可以与同一个WEB服务通信,其平台和语言无关性使其有了广阔的发展空间. 利用VS2005和IIS我们可以很容易地发布一个WEB SERVICE 环境:Windows Server 2003,.Net FrameWork 2.0,IIS6.0 工具:VS2005 1.首先VS200

用Delphi创建windows服务程序

Windows 2000/XP和2003等支持一种叫做"服务程序"的东西.程序作为服务启动有以下几个好处: (1)不用登陆进系统即可运行.(2)具有SYSTEM特权.所以你在进程管理器里面是无法结束它的. 笔者在2003年为一公司开发机顶盒项目的时候,曾经写过课件上传和媒体服务,下面就介绍一下如何用Delphi7创建一个Service程序.运行Delphi7,选择菜单File-->New-->Other--->Service Application.将生成一个服务程序

浅谈delphi创建Windows服务程序与窗体实现交互

我想实现的功能是创建一个服务程序,然后在服务Start时动态创建一个窗体Form,然后把Form缩小时变成TrayIcon放在Windows托盘上. 我在服务程序的OnStart事件中写到 Started := True; writeWorkLog('serve2 start'); // 写日志 Svcmgr.Application.CreateForm(TForm1, Form1); Form1.show; 日志过程为: procedure writeWorkLog(sqlstr: strin

用delphi创建服务程式

视窗系统 2000/XP和2003等支持一种叫做"服务程式"的东西.程式作为服务启动有以下几个好处: (1)不用登陆进系统即可运行. (2)具有SYSTEM特权.所以你在进程管理器里面是无法结束他的. 笔者在2003年为一公司研发机顶盒项目的时候,原来写过课件上传和媒体服务,下面就介绍一下怎么用Delphi7创建一个Service程式. 运行Delphi7,选择菜单File-->New-->Other--->Service Application.将生成一个服务程式的

创建BDC(Business Data Connectivity Service)

创建Business Data Connectivity http://blog.csdn.net/spfarm/article/details/44015915 创建和使用Business Data Connectivity Service: http://www.cnblogs.com/mingmingruyuedlut/archive/2012/11/24/2784412.html 新建外部内容类型.解决访问被拒绝的问题: 在SharePoint Designer中创建外部内容类型,访问被