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

发布时间：2020-12-15 10:00:45 所属栏目：大数据来源：网络整理

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

[delphi] view plain copy print ?

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

主窗口单元如下:

[delphi] view plain copy print ?

unit?Unit_FrmMain;??
??
interface??
??
uses??
Windows,?Variants,?ShellApi,?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,?@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.??

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.

窗体代码如下:

[delphi] view plain copy print ?

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

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_MACHINESYSTEMCurrentControlSet001Services下找到自己的服务名称键值，然后加入一个名为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一般是按照这个方法来做。这样调试起来更方便。

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!