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

  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.  
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.

主窗口单元如下:

  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 <> 0then  
  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(nil0, @SendHokKey, nil0, 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.  
unit Unit_FrmMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics, Controls, Forms,
Dialogs, 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', 0, False, DESKTOP_JOURNALPLAYBACK);
  if (HDesk_WL <> 0) then
  if (SetThreadDesktop (HDesk_WL) = True) then
  PostMessage(HWND_BROADCAST, WM_HOTKEY, 0, MAKELONG (MOD_ALT or MOD_CONTROL, VK_DELETE));
end;

procedure TFrmMain.Button1Click(Sender: TObject);
var
dwThreadID : DWORD;
begin
  CreateThread(nil, 0, @SendHokKey, nil, 0, 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.

窗体代码如下:

  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   
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 



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

目前基本有两种方法:
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一般是按照这个方法来做。这样调试起来更方便。

评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值