delphi服务程序编写

本文主要讲解了如何使用delphi新建服务，停止系统服务，以及获取服务状态和新建系统服务器的方法，以下是关键代码：

unit Servicescontrol;

interface

uses Windows,Messages,SysUtils,Winsvc,Dialogs;

function StartServices(Const SvrName:String):Boolean;

function StopServices(Const SvrName:String):Boolean;

function QueryServiceStatu(Const SvrName: String):String;

function CreateServices(Const SvrName,FilePath:String):Boolean;

function DeleteServices(Const SvrName: String):Boolean;

implementation

//开启服务

function StartServices(Const SvrName: String): Boolean;

var

a,b:SC_HANDLE;

c:PChar;

begin

Result:=False;

a:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);

if a <=0 then Exit;

b:=OpenService(a,PChar(SvrName),SERVICE_ALL_ACCESS);

if b <=0 then Exit;

try

Result:=StartService(b,0,c);

CloseServiceHandle(b);

CloseServiceHandle(a);

except

CloseServiceHandle(b);

CloseServiceHandle(a);

Exit;

end;

end;

//停止服务

function StopServices(Const SvrName: String): Boolean;

var

a,b: SC_HANDLE;

d: TServiceStatus;

begin

Result := False;

a :=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);

if a <=0 then Exit;

b:=OpenService(a,PChar(SvrName),SERVICE_ALL_ACCESS);

if b <=0 then Exit;

try

Result:=ControlService(b,SERVICE_CONTROL_STOP,d);

CloseServiceHandle(a);

CloseServiceHandle(b);

except

CloseServiceHandle(a);

CloseServiceHandle(b);

Exit;

end;

end;

//查询当前服务的状态

function QueryServiceStatu(Const SvrName: String): String;

var

a,b: SC_HANDLE;

d: TServiceStatus;

begin

Result := '未安装';

a := OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);

if a <=0 then Exit;

b := OpenService(a,PChar(SvrName),SERVICE_ALL_ACCESS);

if b <= 0 then Exit;

try

QueryServiceStatus(b,d);

if d.dwCurrentState = SERVICE_RUNNING then

Result := '启动' //Run

else if d.dwCurrentState = SERVICE_RUNNING then

Result := 'Wait' //Runing

else if d.dwCurrentState = SERVICE_START_PENDING then

Result := 'Wait' //Pause

else if d.dwCurrentState = SERVICE_STOP_PENDING then

Result := '停止' //Pause

else if d.dwCurrentState = SERVICE_PAUSED then

Result := '暂停' //Pause

else if d.dwCurrentState = SERVICE_STOPPED then

Result := '停止' //Stop

else if d.dwCurrentState = SERVICE_CONTINUE_PENDING then

Result := 'Wait' //Pause

else if d.dwCurrentState = SERVICE_PAUSE_PENDING then

Result := 'Wait'; //Pause

CloseServiceHandle(a);

CloseServiceHandle(b);

except

CloseServiceHandle(a);

CloseServiceHandle(b);

Exit;

end;

end;

{建立服务}

function CreateServices(Const SvrName,FilePath: String): Boolean;

var

a,b:SC_HANDLE;

begin

Result:=False;

if FilePath ='' then Exit;

a := OpenSCManager(nil,nil,SC_MANAGER_CREATE_SERVICE);

if a <= 0 then Exit;

try

b := CreateService(a,PChar(SvrName),

PChar(SvrName),

SERVICE_ALL_ACCESS,

SERVICE_INTERACTIVE_PROCESS or SERVICE_WIN32_OWN_PROCESS,

SERVICE_AUTO_START,SERVICE_ERROR_NORMAL,

PChar(FilePath),nil,nil,nil,nil,nil);

if b <= 0 then begin

ShowMessage( SysErrorMessage( GetlastError ));

Exit;

end;

CloseServiceHandle(a);

CloseServiceHandle(b);

Result := True;

except

CloseServiceHandle(a);

CloseServiceHandle(b);

Exit;

end;

end;

{卸载服务}

function DeleteServices(Const SvrName: String): Boolean;

var

a,b:SC_HANDLE;

begin

Result:=False;

a := OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);

if a <= 0 then Exit;

b :=OpenService(a,PChar(SvrName),STANDARD_RIGHTS_REQUIRED);

if b <= 0 then Exit;

try

Result := DeleteService(b);

if not Result then

ShowMessage(SysErrorMessage(GetlastError));

CloseServiceHandle(b);

CloseServiceHandle(a);

except

CloseServiceHandle(b);

CloseServiceHandle(a);

Exit;

end;

end;

end.

调用方法：

{启动服务}

StartServices(服务名);

{停止服务}

StopServices(服务名);

{新建服务}

CreateServices(服务名,exe文件路径);

{删除服务}

DeleteServices(服务名);

{获取服务状态}

string:=QueryServiceStatu(服务名);

创建具有托盘的服务程序

运行Delphi7,选择菜单File-->New-->Other--->Service Application.将生成一个服务程序的框架.将工程保存为ServiceDemo.dpr和Unit_Main.pas,然后回到主框架.我们注意到,Service有几个属性.其中以下几个是我们比较常用的:

(1)DisplayName:服务的显示名称

(2)Name:服务名称.

我们在这里将DisplayName的值改为\"Delphi服务演示程序\改为\"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,并且把这个窗口设置为手工创建.完成后的代码如下:

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

补充:

(1)关于更多服务程序的演示程序,请访问以下Url:http://www.torry.net/pages.php?id=226,上面包含了多个演示如何控制和管理系统服务的代码.

(2)请切记:Windows实际上存在多个桌面.例如屏幕传输会出现白屏,可能有两个原因:一是系统处于锁定或未登陆桌面,二是处于屏幕保护桌面.这时候要将当前桌面切换到该桌面才能抓屏.

(3)关于服务程序与桌面交互,还有种动态切换方法.大概单元如下:

unit ServiceDesktop;

interface

function InitServiceDesktop: boolean;

procedure DoneServiceDeskTop;

implementation

uses Windows, SysUtils;

const

DefaultWindowStation = WinSta0;

DefaultDesktop = Default;

var

hwinstaSave: HWINSTA;

hdeskSave: HDESK;

hwinstaUser: HWINSTA;

hdeskUser: HDESK;

function InitServiceDesktop: boolean;

var

dwThreadId: DWORD;

begin

dwThreadId := GetCurrentThreadID;

// Ensure connection to service window station and desktop, and

// save their handles.

hwinstaSave := GetProcessWindowStation;

hdeskSave := GetThreadDesktop(dwThreadId);

hwinstaUser := OpenWindowStation(DefaultWindowStation, MAXIMUM_ALLOWED);

if hwinstaUser = 0 then

begin

OutputDebugString(PChar(OpenWindowStation failed SysErrorMessage(GetLastError)));

+

FALSE,

Result := false;

exit;

end;

if not SetProcessWindowStation(hwinstaUser) then

begin

OutputDebugString(SetProcessWindowStation failed);

Result := false;

exit;

end;

hdeskUser := OpenDesktop(DefaultDesktop, 0, FALSE, MAXIMUM_ALLOWED);

if hdeskUser = 0 then

begin

OutputDebugString(OpenDesktop failed);

SetProcessWindowStation(hwinstaSave);

CloseWindowStation(hwinstaUser);

Result := false;

exit;

end;

Result := SetThreadDesktop(hdeskUser);

if not Result then

OutputDebugString(PChar(SetThreadDesktop SysErrorMessage(GetLastError)));

end;

procedure DoneServiceDeskTop;

begin

// Restore window station and desktop.

SetThreadDesktop(hdeskSave);

+

SetProcessWindowStation(hwinstaSave);

if hwinstaUser <> 0 then

CloseWindowStation(hwinstaUser);

if hdeskUser <> 0 then

CloseDesktop(hdeskUser);

end;

initialization

InitServiceDesktop;

finalization

DoneServiceDesktop;

end.

更详细的演示代码请参看:http://www.torry.net/samples/samples/os/isarticle.zip

(4)关于安装服务如何添加服务描述.有两种方法:一是修改注册表.服务的详细信息都位于HKEY_LOCAL_MACHINE\\SYSTEM\\ ControlSet001\\Services\\下面,例如我们刚才那

个服务就位于HKEY_LOCAL_MACHINE\\SYSTEM\\

ControlSet001\\Services\\DelphiService下.第二种方法就是先用QueryServiceConfig2函数获取服务信息,然后ChangeServiceConfig2来改变描述.用Delphi实现的话,单元如下:

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

SC_ACTION_RESTART,

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) (OSVersionInfo.dwMajorVersion >= 5) then

begin

if hDLL = 0 then

and

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 ChangeServiceConfig2W);

:= GetProcAddress(hDLL,

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

unit winntService;

interface

uses

Windows,WinSvc,WinSvcEx;

function InstallService(const

strServiceName,strDisplayName,strDescription,strFilename: string):Boolean;

//eg:InstallService(服务名称,显示名称,描述信息,服务文件);

procedure UninstallService(strServiceName:string);

implementation

function StrLCopy(Dest: PChar; const Source: PChar; MaxLen: Cardinal): PChar; assembler;

asm

PUSH EDI

PUSH ESI

PUSH EBX

MOV ESI,EAX

MOV EDI,EDX

MOV EBX,ECX

XOR AL,AL

TEST ECX,ECX

JZ @@1

REPNE SCASB

JNE @@1

INC ECX

@@1: SUB EBX,ECX

MOV EDI,ESI

MOV ESI,EDX

MOV EDX,EDI

MOV ECX,EBX

SHR ECX,2

REP MOVSD

MOV ECX,EBX

AND ECX,3

REP MOVSB

STOSB

MOV EAX,EDX

POP EBX

POP ESI

POP EDI

end;

function StrPCopy(Dest: PChar; const Source: string): PChar;

begin

Result := StrLCopy(Dest, PChar(Source), Length(Source));

end;

function InstallService(const

strServiceName,strDisplayName,strDescription,strFilename: string):Boolean;

var

//ss : TServiceStatus;

//psTemp : PChar;

hSCM,hSCS:THandle;

srvdesc : PServiceDescription;

desc : string;

//SrvType : DWord;

lpServiceArgVectors:pchar;

begin

Result:=False;

//psTemp := nil;

//SrvType := SERVICE_WIN32_OWN_PROCESS and

SERVICE_INTERACTIVE_PROCESS;

hSCM:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);//连接服务数据库

if hSCM=0 then

Exit;//MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),服务程序管理器,MB_ICONERROR+MB_TOPMOST);

hSCS:=CreateService( //创建服务函数

hSCM, // 服务控制管理句柄

Pchar(strServiceName), // 服务名称

Pchar(strDisplayName), // 显示的服务名称

SERVICE_ALL_ACCESS, // 存取权利

SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS,// 服务类型 SERVICE_WIN32_SHARE_PROCESS

SERVICE_AUTO_START, // 启动类型

SERVICE_ERROR_IGNORE, // 错误控制类型

Pchar(strFilename), // 服务程序

nil, // 组服务名称

nil, // 组标识

nil, // 依赖的服务

nil, // 启动服务帐号

nil); // 启动服务口令

if hSCS=0 then

Exit;//MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),Pchar(Application.Title),MB_ICONERROR+MB_TOPMOST);

if Assigned(ChangeServiceConfig2) then

begin

desc := Copy(strDescription,1,1024);

GetMem(srvdesc,SizeOf(TServiceDescription));

GetMem(srvdesc^.lpDescription,Length(desc) + 1);

try

StrPCopy(srvdesc^.lpDescription, desc);

ChangeServiceConfig2(hSCS,SERVICE_CONFIG_DESCRIPTION,srvdesc);

finally

FreeMem(srvdesc^.lpDescription);

FreeMem(srvdesc);

end;

end;

lpServiceArgVectors := nil;

if not StartService(hSCS, 0, lpServiceArgVectors) then //启动服务

Exit;

//MessageBox(hHandle,Pchar(SysErrorMessage(GetLastError)),Pchar(Application.Title),MB_ICONERROR+MB_TOPMOST);

CloseServiceHandle(hSCS); //关闭句柄

Result:=True;

end;

procedure UninstallService(strServiceName:string);

var

SCManager: SC_HANDLE;

Service: SC_HANDLE;

Status: TServiceStatus;

begin

SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);

if SCManager = 0 then Exit;

try

Service := OpenService(SCManager, Pchar(strServiceName),

SERVICE_ALL_ACCESS);

ControlService(Service, SERVICE_CONTROL_STOP, Status);

DeleteService(Service);

CloseServiceHandle(Service);

finally

CloseServiceHandle(SCManager);

end;

end;

end.

(5)如何暴力关闭一个服务程序,实现我们以前那个\"NT工具箱\"的功能?首先,根据进程名称来杀死进程是用以下函数:

uses Tlhelp32;

function KillTask(ExeFileName: string): Integer;

const

PROCESS_TERMINATE = 01;

var

ContinueLoop: BOOL;

FSnapshotHandle: THandle;

FProcessEntry32: TProcessEntry32;

begin

Result := 0;

FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);

FProcessEntry32.dwSize := SizeOf(FProcessEntry32);

ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);

while Integer(ContinueLoop) <> 0 do

begin

if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =

UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =

UpperCase(ExeFileName))) then

Result := Integer(TerminateProcess(

OpenProcess(PROCESS_TERMINATE,

BOOL(0),

FProcessEntry32.th32ProcessID),

0));

ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);

end;

CloseHandle(FSnapshotHandle);

end;

但是对于服务程序,它会提示\"拒绝访问\".其实只要程序拥有Debug权限即可:

function EnableDebugPrivilege: Boolean;

function EnablePrivilege(hToken: Cardinal; PrivName: string; bEnable: Boolean): Boolean;

var

TP: TOKEN_PRIVILEGES;

Dummy: Cardinal;

begin

TP.PrivilegeCount := 1;

LookupPrivilegeValue(nil, pchar(PrivName), TP.Privileges[0].Luid);

if bEnable then

TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED

else TP.Privileges[0].Attributes := 0;

AdjustTokenPrivileges(hToken, False, TP, SizeOf(TP), nil, Dummy);

Result := GetLastError = ERROR_SUCCESS;

end;

var

hToken: Cardinal;

begin

OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken);

result:=EnablePrivilege(hToken, SeDebugPrivilege, True);

CloseHandle(hToken);

end;

使用方法:

EnableDebugPrivilege;//提升权限

KillTask(xxxx.exe);//关闭该服务程序.

用delphi7编写windows服务程序总结

一、服务程序的创建

delphi编写服务程序非常简单，点击菜单 File－>New－>Other－>New属性页－>Service Application，系统自动会创建基本的代码。这里需要说明的是，在“New属性页”中还有一个Service，这个Service和Service Application还是有区别的，应该说Service Application的范围大，它可以包含几个Service。

一个Service Application可以创建几个Service，service继承自TService，界面表现和TDataModel类似，做过数据库的朋友肯定都不陌生，区别是TDataModel是用来放数据库连接及操作组件的容器，而TService则是可以存放很多没有界面的组件，如indy的IDtcpclient等。

二、重要属性及事件说明

属性：DisplayName 显示名称

Name 名称，当你用命令提示符来启动、停止服务时，就需要用到

Interactive 与界面交互的选项

事件：OnCreate：类似于Tform的OnCreate

OnDestroy：类似于Tform的OnDestroy

OnExecute：非常重要，一般写成下面

while not Terminated do

begin

Sleep(10);

ServiceThread.ProcessRequests(False);

end;

OnPause：服务暂停

OnShutdown：不太清楚

OnStart：服务启动，重要

OnStop：服务停止，重要

三、服务的依赖关系

因为我的服务是要连接数据库的，所以必须要等sql server的服务起来之后，我才能起来，这样才能连接数据库，因此这里面有个依赖关系的问题。可以在属性Dependencies中增加一项，选择MSSQLSERVER。

四、服务与界面的通讯

服务也是可以创建form的，只是只是这个窗口，在服务启动时显示，服务停止后就关闭了。而我想做一个就象sql server 2000的服务管理器哪样的界面，不论服务启动是否，都可以显示，而且也可以在界面上直接控制服务。所以我就又建了一个应用，而这个应用和原来服务的通讯用自定义消息来传递。比如，有人通过控制面板停止服务了，服务必须通知界面上的状态。

Delphi获取Windows系统服务的状态

function ServiceGetStatus(sMachine, sService: string ): DWord;

var

schm, schs: SC_Handle;

ss: TServiceStatus;

dwStat : DWord;

begin

dwStat := 0;

schm := OpenSCManager(PChar(sMachine), Nil, SC_MANAGER_CONNECT);

if (schm > 0) then

begin

schs := OpenService(schm, PChar(sService), SERVICE_QUERY_STATUS);

if(schs > 0) then

begin

if(QueryServiceStatus(schs, ss))then dwStat := ss.dwCurrentState;

CloseServiceHandle(schs);

end;

CloseServiceHandle(schm);

end;

Result := dwStat;

end;

{判断某服务是否安装，未安装返回true，已安装返回false}

function ServiceUninstalled(sMachine, sService : string ) : boolean;

begin

Result := 0 = ServiceGetStatus(sMachine, sService);

end;

{判断某服务是否启动，启动返回true，未启动返回false}

function ServiceRunning(sMachine, sService : string ) : boolean;

begin

Result := SERVICE_RUNNING = ServiceGetStatus(sMachine, sService );

end;

{判断某服务是否停止，停止返回true，未停止返回false}

function ServiceStopped(sMachine, sService : string ) : boolean;

begin

Result := SERVICE_STOPPED = ServiceGetStatus(sMachine, sService );

end;

Delphi 如何停止、启动windows系统服务

//下面是 写了一个启动服务的函数 StartService，用来启动服务。。。

function StartService(AServName: string): Boolean; //use WinSvc

var

SCManager, hService: SC_HANDLE;

lpServiceArgVectors: PChar;

begin

SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);

Result := SCManager <> 0;

if Result then

try

hService := OpenService(SCManager, PChar(AServName),

SERVICE_ALL_ACCESS);

Result := hService <> 0;

if (hService = 0) and (GetLastError = ERROR_SERVICE_DOES_NOT_EXIST) then

Exception.Create('The specified service does not exist');

if hService <> 0 then

try

lpServiceArgVectors := nil;

Result := WinSvc.StartService(hService, 0, PChar(lpServiceArgVectors));

if not Result and (GetLastError = ERROR_SERVICE_ALREADY_RUNNING) then

Result := True;

finally

CloseServiceHandle(hService);

end;

finally

CloseServiceHandle(SCManager);

end;

end;

function StartService(AServName: string): Boolean; //use hService:

WinSvc
var
SCManager,

SC_HANDLE;
lpServiceArgVectors: PChar;
begin
SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
Result := SCManager <> 0;
if Result then
try
hService := OpenService(SCManager, PChar(AServName), SERVICE_ALL_ACCESS);
Result := hService <> 0;
if (hService = 0) and (GetLastError = ERROR_SERVICE_DOES_NOT_EXIST) then
Exception.Create('The specified service does not exist');
if hService <>

0

then
try
lpServiceArgVectors

:=

nil;
Result

:=

WinSvc.StartService(hService, 0, PChar(lpServiceArgVectors));
if not Result and (GetLastError = ERROR_SERVICE_ALREADY_RUNNING) then
Result := True;
finally
CloseServiceHandle(hService);
end;
finally
CloseServiceHandle(SCManager);
end;
end;

下面是停止服务的代码 StopService

function StopService(AServName: string): Boolean;

var

SCManager, hService: SC_HANDLE;

SvcStatus: TServiceStatus;

begin

SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);

Result := SCManager <> 0;

if Result then

try

hService := OpenService(SCManager, PChar(AServName),

SERVICE_ALL_ACCESS);

Result := hService <> 0;

if Result then

try //停止并卸载服务;

Result := ControlService(hService, SERVICE_CONTROL_STOP, SvcStatus);

//删除服务，这一句可以不要;

// DeleteService(hService);

finally

CloseServiceHandle(hService);

end;

finally

CloseServiceHandle(SCManager);

end;

end;

使用delphi新建服务，停止系统服务

2009-12-09 15:46本文主要讲解了如何使用delphi新建服务，停止系统服务，以及获取服务状态和新建系统服务器的方法，以下是关键代码：

unit Servicescontrol;

interface

uses Windows,Messages,SysUtils,Winsvc,Dialogs;

function StartServices(Const SvrName:String):Boolean;

function StopServices(Const SvrName:String):Boolean;

function QueryServiceStatu(Const SvrName: String):String;

function CreateServices(Const SvrName,FilePath:String):Boolean;

function DeleteServices(Const SvrName: String):Boolean;

implementation

//开启服务

function StartServices(Const SvrName: String): Boolean;

var

a,b:SC_HANDLE;

c:PChar;

begin

Result:=False;

a:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);

if a <=0 then Exit;

b:=OpenService(a,PChar(SvrName),SERVICE_ALL_ACCESS);

if b <=0 then Exit;

try

Result:=StartService(b,0,c);

CloseServiceHandle(b);

CloseServiceHandle(a);

except

CloseServiceHandle(b);

CloseServiceHandle(a);

Exit;

end;

end;

//停止服务

function StopServices(Const SvrName: String): Boolean;

var

a,b: SC_HANDLE;

d: TServiceStatus;

begin

Result := False;

a :=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);

if a <=0 then Exit;

b:=OpenService(a,PChar(SvrName),SERVICE_ALL_ACCESS);

if b <=0 then Exit;

try

Result:=ControlService(b,SERVICE_CONTROL_STOP,d);

CloseServiceHandle(a);

CloseServiceHandle(b);

except

CloseServiceHandle(a);

CloseServiceHandle(b);

Exit;

end;

end;

//查询当前服务的状态

function QueryServiceStatu(Const SvrName: String): String;

var

a,b: SC_HANDLE;

d: TServiceStatus;

begin

Result := '未安装';

a := OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);

if a <=0 then Exit;

b := OpenService(a,PChar(SvrName),SERVICE_ALL_ACCESS);

if b <= 0 then Exit;

try

QueryServiceStatus(b,d);

if d.dwCurrentState = SERVICE_RUNNING then

Result := '启动' //Run

else if d.dwCurrentState = SERVICE_RUNNING then

Result := 'Wait' //Runing

else if d.dwCurrentState = SERVICE_START_PENDING then

Result := 'Wait' //Pause

else if d.dwCurrentState = SERVICE_STOP_PENDING then

Result := '停止' //Pause

else if d.dwCurrentState = SERVICE_PAUSED then

Result := '暂停' //Pause

else if d.dwCurrentState = SERVICE_STOPPED then

Result := '停止' //Stop

else if d.dwCurrentState =

SERVICE_CONTINUE_PENDING then

Result := 'Wait' //Pause

else if d.dwCurrentState = SERVICE_PAUSE_PENDING then

Result := 'Wait'; //Pause

CloseServiceHandle(a);

CloseServiceHandle(b);

except

CloseServiceHandle(a);

CloseServiceHandle(b);

Exit;

end;

end;

{建立服务}

function CreateServices(Const SvrName,FilePath: String):

Boolean;

var

a,b:SC_HANDLE;

begin

Result:=False;

if FilePath ='' then Exit;

a := OpenSCManager(nil,nil,SC_MANAGER_CREATE_SERVICE); if a <= 0 then Exit;

try

b := CreateService(a,PChar(SvrName),

PChar(SvrName),

SERVICE_ALL_ACCESS,

SERVICE_INTERACTIVE_PROCESS SERVICE_WIN32_OWN_PROCESS,

SERVICE_AUTO_START,SERVICE_ERROR_NORMAL,

or

PChar(FilePath),nil,nil,nil,nil,nil);

if b <= 0 then begin

ShowMessage( SysErrorMessage( GetlastError ));

Exit;

end;

CloseServiceHandle(a);

CloseServiceHandle(b);

Result := True;

except

CloseServiceHandle(a);

CloseServiceHandle(b);

Exit;

end;

end;

{卸载服务}

function DeleteServices(Const SvrName: String): Boolean;

var

a,b:SC_HANDLE;

begin

Result:=False;

a := OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);

if a <= 0 then Exit;

b :=OpenService(a,PChar(SvrName),STANDARD_RIGHTS_REQUIRED);

if b <= 0 then Exit;

try

Result := DeleteService(b);

if not Result then

ShowMessage(SysErrorMessage(GetlastError));

CloseServiceHandle(b);

CloseServiceHandle(a);

except

CloseServiceHandle(b);

CloseServiceHandle(a);

Exit;

end;

end;

end.

调用方法：

{启动服务}

StartServices(服务名);

{停止服务}

StopServices(服务名);

{新建服务}

CreateServices(服务名,exe文件路径);

{删除服务}

DeleteServices(服务名);

{获取服务状态}

string:=QueryServiceStatu(服务名);

用Delphi创建windows服务程序

2009-12-09 16:15Windows 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服务演示程序\改为\"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,并且把这个窗口设置为手工创建.完成后的代码如下:

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.