对NT服务型程序的控制代码。如安装服务、启动、停止服务、取服务状态等。

最近自己要写一个服务型程序。完成这个程序后，自己把一些对服务控制的代码整理成了一个单元文件。方便下次使用。


{*******************************************************************************

XOtecExpress Visual Component Library Copyright (c) 2008 XOtec Studio.

By: PengJunLi Build: 2008-05-24
E-mail: iinsnian@126.com xotec@vip.qq.com
QQ:442801172 (陆岛工作室)

*******************************************************************************}

unit xtSrvUnit;

interface

uses Windows, Messages, SysUtils, Classes, Forms, WinSvc, SvcMgr;

const
SM_BASE = WM_USER + 1736;
SM_INITIALIZE = SM_BASE + 1;
SM_SHUTDOWN = SM_BASE + 2;
SM_BREAKWAIT = SM_BASE + 5;
SM_USERSINFOUPDATE = SM_BASE + 11;

type
EServiceError = class(Exception);
TxtServiceStatus = (ssUnknow, ssStopped, ssStartPending, ssStopPending, ssRuning, ssContinuePending, ssPausePending, ssPaused);

{ TxtServiceApplication }

TxtServiceApplication = class(TServiceApplication)
private
FEventLogger: TEventLogger;
procedure OnExceptionHandler(Sender: TObject; E: Exception);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Run; override;
procedure ContinueRun;
end;


function Application: TxtServiceApplication;

function ServerInstalling: Boolean;

function IsServerIsRuning(ServiceName: string): Boolean;

//取服务状态
function GetServiceStatus(ServiceName: string): TxtServiceStatus;
//服务是否正在运行
function IsServiceRuning(ServiceName: string): Boolean;
//服务是否已停止
function IsServiceStopped(ServiceName: string): Boolean;

//启动服务
function StartService(ServiceName: string): Boolean; overload; // Simple start
function StartService(ServiceName: string; NumberOfArgument: DWORD; ServiceArgVectors: PChar): Boolean;overload; // More complex start
//停止服务
function StopService(ServiceName: string): Boolean;
//暂停服务
function PauseService(ServiceName: string): Boolean;
//继续服务
function ContinueService(ServiceName: string): Boolean;
//关闭服务
function ShutdownService(ServiceName: string): Boolean;
//禁止服务启动
function DisableService(ServiceName: string): Boolean;

//服务是否已安装
function IsServiceInstalled(ServiceName: string): Boolean;
//安装服务
function InstallService(ServiceName, DisplayName, Filename: string; ServiceDescription: string=''): Boolean;
//反安装服务
function UnInstallService(ServiceName: string): Boolean;
//为服务程序添加描述
procedure ServiceUpdateDescription(const ServiceName, Description: string);

//取得系统中所有服务列表
function GetNtServiceList(sMachine: string; AList: TStrings): Boolean;

function InitServiceDesktop: boolean;
procedure DoneServiceDeskTop;

implementation

uses Registry;

const
DefaultWindowStation = 'WinSta0';
DefaultDesktop = 'Default';

var
hwinstaSave: HWINSTA;
hdeskSave: HDESK;
hwinstaUser: HWINSTA;
hdeskUser: HDESK;
FContinueHandlingMessages: Boolean = true;

{ ServerInstalling }

function ServerInstalling: Boolean;
begin
Result := FindCmdLineSwitch('INSTALL',['-','\','/'], True) or
FindCmdLineSwitch('UNINSTALL',['-','\','/'], True);
end;

{ GetServiceStatus }

function GetServiceStatus(ServiceName: string): TxtServiceStatus;
var
ServiceStatus: TServiceStatus;
hSCManager, ServiceHandle: SC_Handle;
begin
Result := ssUnknow;
if (Trim(ServiceName)='') then Exit;

hSCManager := OpenSCManager(nil, SERVICES_ACTIVE_DATABASE, SC_MANAGER_CONNECT);
if hSCManager<>0 then
begin
ServiceHandle := OpenService(hSCManager, PChar(ServiceName), SERVICE_QUERY_STATUS);
if ServiceHandle<>0 then
begin
QueryServiceStatus(ServiceHandle, ServiceStatus);
CloseServiceHandle(ServiceHandle);
end;
CloseServiceHandle(hSCManager);
end;

case ServiceStatus.dwCurrentState of
SERVICE_STOPPED : Result := ssStopped;
SERVICE_START_PENDING : Result := ssStartPending;
SERVICE_STOP_PENDING : Result := ssStopPending;
SERVICE_RUNNING : Result := ssRuning;
SERVICE_CONTINUE_PENDING: Result := ssContinuePending;
SERVICE_PAUSE_PENDING : Result := ssPausePending;
SERVICE_PAUSED : Result := ssPaused;
end;
end;

{ IsServiceRuning }

function IsServiceRuning(ServiceName: string): Boolean;
begin
Result := (GetServiceStatus(ServiceName) = ssRuning);
end;

{ IsServiceStopped }

function IsServiceStopped(ServiceName: string): Boolean;
begin
Result := (GetServiceStatus(ServiceName) = ssStopped);
end;

{ StartService }

function StartService(ServiceName: string): Boolean; overload; // Simple start
begin
Result := StartService(ServiceName, 0, nil);
end;

function StartService(ServiceName: string; NumberOfArgument: DWORD; ServiceArgVectors: PChar): Boolean;overload; // More complex start
var
SCManager, hService: SC_HANDLE;
begin
Result := False;
if (Trim(ServiceName)='') then Exit;

SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
Result := SCManager <> 0;
if Result then
try
hService := OpenService(SCManager, PChar(ServiceName), SERVICE_ALL_ACCESS);
Result := hService <> 0;
if (hService <> 0) then
try
Result := WinSvc.StartService(hService, NumberOfArgument, PChar(ServiceArgVectors));
if not Result and (GetLastError = ERROR_SERVICE_ALREADY_RUNNING) then
Result := True;
finally
CloseServiceHandle(hService);
end;
finally
CloseServiceHandle(SCManager);
end;
end;

function DoControlService(ServiceName: string; ControlFalg: Cardinal): Boolean;
var
ServiceStatus: TServiceStatus;
SCManager, hService: SC_HANDLE;
begin
Result := False;
if (Trim(ServiceName)='') then Exit;

SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if SCManager<>0 then
begin
hService := OpenService(SCManager, PChar(ServiceName), SERVICE_ALL_ACCESS);
if hService<>0 then
begin
Result := ControlService(hService, ControlFalg, ServiceStatus);
CloseServiceHandle(hService);
end;
CloseServiceHandle(SCManager);
end;
end;

{ StopService }

function StopService(ServiceName: string): Boolean;
begin
Result := DoControlService(ServiceName, SERVICE_CONTROL_STOP);
end;
{ PauseService }

function PauseService(ServiceName: string): Boolean;
begin
Result := DoControlService(ServiceName, SERVICE_CONTROL_PAUSE);
end;

{ ContinueService }

function ContinueService(ServiceName: string): Boolean;
begin
Result := DoControlService(ServiceName, SERVICE_CONTROL_CONTINUE);
end;

{ ShutdownService }

function ShutdownService(ServiceName: string): Boolean;
begin
Result := DoControlService(ServiceName, SERVICE_CONTROL_SHUTDOWN);
end;

{ DisableService }

function DisableService(ServiceName: string): Boolean;
var
SCManager, ServiceHandle: SC_HANDLE;
begin
Result := False;
if (Trim(ServiceName)='') then Exit;

SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if SCManager<>0 then
begin
ServiceHandle := OpenService(SCManager, PChar(ServiceName), SERVICE_CHANGE_CONFIG);
if ServiceHandle<>0 then
begin
ChangeServiceConfig(ServiceHandle,
SERVICE_NO_CHANGE, SERVICE_DISABLED, SERVICE_NO_CHANGE,
nil, nil, nil, nil, nil, nil, nil);
CloseServiceHandle(ServiceHandle);
Result := True;
end;
CloseServiceHandle(SCManager);
end;
end;

{ InstallService }

function InstallService(ServiceName, DisplayName, Filename: string; ServiceDescription: string=''): Boolean;
var
SCManager, ServiceHandle: SC_HANDLE;
begin
Result := False;
if (Trim(ServiceName)='') and not FileExists(Filename) then Exit;

SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if SCManager = 0 then Exit;

try
ServiceHandle := CreateService(SCManager, PChar(ServiceName), PChar(DisplayName),
SERVICE_ALL_ACCESS, SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS,
SERVICE_AUTO_START, SERVICE_ERROR_NORMAL, PChar(Filename),
nil, nil, nil, nil, nil);

if IsServiceInstalled(ServiceName) and (ServiceDescription<>'') then
ServiceUpdateDescription(ServiceName, ServiceDescription);
CloseServiceHandle(ServiceHandle);
Result := ServiceHandle<>0;
finally
CloseServiceHandle(SCManager);
end;
end;

{ UnInstallService }

function UnInstallService(ServiceName: string): Boolean;
var
SCManager, ServiceHandle: SC_HANDLE;
begin
Result := False;
if (Trim(ServiceName)='') then Exit;

SCManager := OpenSCManager(nil,nil,GENERIC_WRITE);
if SCManager = 0 then Exit;
try
ServiceHandle := OpenService(SCManager, PChar(ServiceName), _DELETE);
Result := DeleteService(ServiceHandle);
CloseServiceHandle(ServiceHandle);
finally
CloseServiceHandle(SCManager);
end;
end;

procedure ServiceUpdateDescription(const ServiceName, Description: string);
var
reg: TRegistry;
begin
reg := TRegistry.Create;
try
with reg do begin
RootKey := HKEY_LOCAL_MACHINE;
if OpenKey('SYSTEM\CurrentControlSet\Services\' + ServiceName, False) then
begin
WriteString('Description', Description);
end;
CloseKey;
end;
finally
reg.Free;
end;
end;

{ IsServiceInstalled }

function IsServiceInstalled(ServiceName: string): Boolean;
var
Mgr, Svc: Integer;
begin
Result := False;
if (Trim(ServiceName)='') then Exit;

Mgr := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if Mgr <> 0 then
begin
Svc := OpenService(Mgr, PChar(ServiceName), SERVICE_ALL_ACCESS);
Result := Svc <> 0;
if Result then
CloseServiceHandle(Svc);
CloseServiceHandle(Mgr);
end;
end;

{ IsServerIsRuning }

function IsServerIsRuning(ServiceName: string): Boolean;
begin
Result := False;

if (Trim(ServiceName)<>'') and not ServerInstalling then
begin
CreateMutex(nil, True, PChar(ServiceName + '_Mutex'));
Result := GetLastError = ERROR_ALREADY_EXISTS;
end;
end;

function GetNtServiceList(sMachine: string; AList: TStrings): Boolean;
var
i: integer;
sName, sDisplay: string;
SCManager: SC_Handle;
nBytesNeeded, nServices, nResumeHandle: Cardinal;
ServiceStatusRecs: array[0..511] of TEnumServiceStatus;
begin
Result := false;
SCManager := OpenSCManager(PChar(sMachine), nil, SC_MANAGER_ALL_ACCESS);
try
if (SCManager = 0) then Exit;
nResumeHandle := 0;
while True do
begin
EnumServicesStatus(SCManager, SERVICE_WIN32, SERVICE_STATE_ALL, ServiceStatusRecs[0], SizeOf(ServiceStatusRecs),
nBytesNeeded, nServices, nResumeHandle);

for i := 0 to nServices - 1 do
begin
sName := ServiceStatusRecs[i].lpServiceName;
sName := StringReplace(sName, '=', '?', [rfReplaceAll, rfIgnoreCase]);

sDisplay := ServiceStatusRecs[i].lpDisplayName;
sDisplay := StringReplace(sDisplay, '=', '#13#10', [rfReplaceAll, rfIgnoreCase]);
sDisplay := StringReplace(sDisplay, '=', '#13', [rfReplaceAll, rfIgnoreCase]);
sDisplay := StringReplace(sDisplay, '=', '#10', [rfReplaceAll, rfIgnoreCase]);
AList.Add(sName + '=' + sDisplay);
end;

if nBytesNeeded = 0 then Break;
end;
Result := True;
finally
CloseServiceHandle(SCManager);
end;
end;

{ InitServiceDesktop }

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, FALSE, MAXIMUM_ALLOWED);
if hwinstaUser = 0 then
begin
OutputDebugString(PChar('OpenWindowStation failed' + SysErrorMessage(GetLastError)));
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;

{ DoneServiceDeskTop }

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;

{ TServiceStartThread }

type
TServiceTableEntryArray = array of TServiceTableEntry;

TServiceStartThread = class(TThread)
private
FServiceStartTable: TServiceTableEntryArray;
protected
procedure DoTerminate; override;
procedure Execute; override;
public
constructor Create(Services: TServiceTableEntryArray);
end;

constructor TServiceStartThread.Create(Services: TServiceTableEntryArray);
begin
FreeOnTerminate := False;
ReturnValue := 0;
FServiceStartTable := Services;
inherited Create(False);
end;

procedure TServiceStartThread.DoTerminate;
begin
inherited DoTerminate;
// Application run as application on NT or application run on the Win 9x
if (ReturnValue = ERROR_FAILED_SERVICE_CONTROLLER_) or
(ReturnValue = ERROR_CALL_NOT_IMPLEMENTED)
then
begin
// for break Application.ProcessMessages loop
FContinueHandlingMessages := False;
// Send a fake message to Application, for a breaking WaitMessage-loop
PostMessage(Forms.Application.Handle, SM_BREAKWAIT, 0, 0);
end
else
PostMessage(Forms.Application.Handle, WM_QUIT, 0, 0);
end;

procedure TServiceStartThread.Execute;
begin
if StartServiceCtrlDispatcher(FServiceStartTable[0]) then
ReturnValue := 0 else
ReturnValue := GetLastError;
end;

{ DoneServiceApplication }

procedure DoneServiceApplication;
begin
with Forms.Application do
begin
if Handle <> 0 then ShowOwnedPopups(Handle, False);
ShowHint := False;
Destroying;
DestroyComponents;
end;
with Application do
begin
Destroying;
DestroyComponents;
end;
end;

{ TxtServiceApplication }

procedure TxtServiceApplication.ContinueRun;
begin
while not Forms.Application.Terminated do
Forms.Application.HandleMessage;

Forms.Application.Terminate;
end;

constructor TxtServiceApplication.Create(AOwner: TComponent);
begin
FEventLogger := TEventLogger.Create(ExtractFileName(ParamStr(0)));
inherited Create(AOwner);
end;

destructor TxtServiceApplication.Destroy;
begin
inherited Destroy;
FEventLogger.Free;
end;

procedure TxtServiceApplication.OnExceptionHandler(Sender: TObject; E: Exception);
begin
DoHandleException(E);
end;

procedure ServiceMain(Argc: DWord; Argv: PLPSTR); stdcall;
begin
TxtServiceApplication(Application).DispatchServiceMain(Argc, Argv);
end;

procedure TxtServiceApplication.Run;

function FindSwitch(const Switch: string): Boolean;
begin
Result := FindCmdLineSwitch(Switch, ['-', '/'], True);
end;

var
ServiceStartTable: TServiceTableEntryArray;
ServiceCount, i, J: Integer;
StartThread: TServiceStartThread;
begin
AddExitProc(DoneServiceApplication);

if FindSwitch('INSTALL') then
RegisterServices(True, FindSwitch('SILENT')) else
if FindSwitch('UNINSTALL') then
RegisterServices(False, FindSwitch('SILENT')) else
begin
Forms.Application.OnException := OnExceptionHandler;
ServiceCount := 0;
for i := 0 to ComponentCount - 1 do
if Components[i] is TService then Inc(ServiceCount);
SetLength(ServiceStartTable, ServiceCount + 1);
FillChar(ServiceStartTable[0], SizeOf(TServiceTableEntry) * (ServiceCount + 1), 0);
J := 0;
for i := 0 to ComponentCount - 1 do
if Components[i] is TService then
begin
ServiceStartTable[J].lpServiceName := PChar(Components[i].Name);
ServiceStartTable[J].lpServiceProc := @ServiceMain;
Inc(J);
end;
StartThread := TServiceStartThread.Create(ServiceStartTable);
try
while (not Forms.Application.Terminated) and FContinueHandlingMessages do
Forms.Application.HandleMessage;
// Application start as standalone application?
if ((StartThread.ReturnValue = ERROR_FAILED_SERVICE_CONTROLLER_) or
(StartThread.ReturnValue = ERROR_CALL_NOT_IMPLEMENTED)) and (not Forms.Application.Terminated)
then
begin
raise EServiceError.Create('Not as service');
end
else if StartThread.ReturnValue <> 0 then
begin
FEventLogger.LogMessage(SysErrorMessage(GetLastError));
end;
finally
StartThread.Free;
end;
end;
end;

procedure InitApplication;
begin
SvcMgr.Application.Free;
SvcMgr.Application := TxtServiceApplication.Create(nil);
end;

function Application: TxtServiceApplication;
begin
Result := TxtServiceApplication(SvcMgr.Application);
end;

initialization
InitApplication;
InitServiceDesktop;

finalization
DoneServiceDesktop;

end.
作者: 陆岛工作室