Delphi 不使用自带模板创建服务

时间：2017-02-01 10:39:38 阅读：272 评论：0 收藏：0 [点我收藏+]

[delphi] view plain copy

<pre name="code" class="delphi">program Project1;
uses
Windows,
WinSvc;
const
ServiceName: pchar = ‘SnowWings Service‘;
DisplayName: pchar = ‘Skysword‘;
Description: pchar = ‘雪羽服务器控制台‘;
var
Status: TServiceStatus;
StatusHandle: SERVICE_STATUS_HANDLE;
ServiceTable: array [0 .. 1] of TServiceTableEntry;
Stopped: boolean;
Paused: boolean;
{ 我们自己要实现的功能代码写在这里 }
procedure ServiceMain;
begin
repeat
if not Paused then
begin
// Beep(1000, 1000);
Sleep(1000);
end;
until Stopped;
end;
{ 服务处理程序：一个服务处理程序内可以包含一个服务或多个服务的执行代码，但是它们都拥有固定的三个部分：服务main函数，服务ServiceMain函数和服务Control Handler函数。
服务配置程序：服务配置程序包括：服务的创建、服务的卸载、服务信息的查询、修改等； }
procedure ServiceCtrlHandler(Control: dword); stdcall; // 服务控制函数
begin
case Control of
SERVICE_CONTROL_STOP: // 停止服务
begin
Stopped := True;
Status.dwCurrentState := SERVICE_STOP_PENDING;
SetServiceStatus(StatusHandle, Status);
end;
SERVICE_CONTROL_PAUSE: // 暂停服务
begin
Paused := True;
Status.dwCurrentState := SERVICE_PAUSED;
SetServiceStatus(StatusHandle, Status);
end;
SERVICE_CONTROL_CONTINUE: // 继续服务
begin
Paused := False;
Status.dwCurrentState := SERVICE_RUNNING;
SetServiceStatus(StatusHandle, Status);
end;
SERVICE_CONTROL_INTERROGATE:
SetServiceStatus(StatusHandle, Status);
SERVICE_CONTROL_SHUTDOWN:
Stopped := True;
end;
end;
procedure ServiceCtrlDispatcher(dwArgc: dword; var lpszArgv: pchar); stdcall;
begin
StatusHandle := RegisterServiceCtrlHandler(ServiceName, @ServiceCtrlHandler);
if StatusHandle <> 0 then
begin
ZeroMemory(@Status, SizeOf(Status));
Status.dwServiceType := SERVICE_WIN32_OWN_PROCESS or
SERVICE_INTERACTIVE_PROCESS;
Status.dwCurrentState := SERVICE_START_PENDING;
Status.dwControlsAccepted := SERVICE_ACCEPT_STOP or
SERVICE_ACCEPT_PAUSE_CONTINUE;
Status.dwWaitHint := 1000;
SetServiceStatus(StatusHandle, Status);
Stopped := False;
Paused := False;
Status.dwCurrentState := SERVICE_RUNNING;
SetServiceStatus(StatusHandle, Status);
ServiceMain; // 入口
Status.dwCurrentState := SERVICE_STOPPED;
SetServiceStatus(StatusHandle, Status);
end;
end;
procedure UninstallService(ServiceName: pchar);
var
SCManager: SC_HANDLE;
Service: SC_HANDLE;
begin
SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if SCManager = 0 then
Exit;
try
Service := OpenService(SCManager, ServiceName, SERVICE_ALL_ACCESS);
ControlService(Service, SERVICE_CONTROL_STOP, Status);
DeleteService(Service);
CloseServiceHandle(Service);
finally
CloseServiceHandle(SCManager);
end;
end;
/// ////////////////
{ 添加一个服务的描述信息,你是否采用了更简洁的方法,这是一个例子 }
function SetServiceDescription(SH: THandle; Desc: pchar): Bool;
const
SERVICE_CONFIG_DESCRIPTION: dword = 1;
var
OSVersionInfo: TOSVersionInfo;
ChangeServiceConfig2: function(hService: SC_HANDLE; dwInfoLevel: dword;
lpInfo: Pointer): Bool; StdCall;
LH: THandle;
begin
Result := False;
OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
GetVersionEx(OSVersionInfo);
if (OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and // NT? 环境判断，可以去掉
(OSVersionInfo.dwMajorVersion >= 5) then
begin
LH := GetModuleHandle(advapi32);
Result := LH <> 0;
if not Result then
Exit;
ChangeServiceConfig2 := GetProcAddress(LH, ‘ChangeServiceConfig2A‘);
Result := @ChangeServiceConfig2 <> nil;
if not Result then
Exit;
Result := ChangeServiceConfig2(SH, SERVICE_CONFIG_DESCRIPTION, @Desc);
{ if Result then
FreeLibrary(LH); }
end;
end;
procedure InstallService(ServiceName, DisplayName, Description: pchar;
FileName: string);
const
SERVICE_CONFIG_DESCRIPTION: dword = 1;
var
SCManager: SC_HANDLE;
Service: SC_HANDLE;
Args: pchar;
begin
SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if SCManager = 0 then
Exit;
try
Service := CreateService(SCManager, ServiceName, DisplayName,
SERVICE_ALL_ACCESS, SERVICE_WIN32_OWN_PROCESS or
SERVICE_INTERACTIVE_PROCESS, SERVICE_AUTO_START, SERVICE_ERROR_IGNORE,
pchar(FileName), nil, nil, nil, nil, nil);
try
SetServiceDescription(Service, Description);
except
end;
Args := nil;
StartService(Service, 0, Args);
CloseServiceHandle(Service);
finally
CloseServiceHandle(SCManager);
end;
end;
begin
if ParamStr(1) = ‘/u‘ then
begin
UninstallService(ServiceName);
end
else
begin
ServiceTable[0].lpServiceName := ServiceName;
ServiceTable[0].lpServiceProc := @ServiceCtrlDispatcher;
ServiceTable[1].lpServiceName := nil;
ServiceTable[1].lpServiceProc := nil;
StartServiceCtrlDispatcher(ServiceTable[0]);
InstallService(ServiceName, DisplayName, Description,
pchar(ParamStr(0)));
end;
end.</pre><br>
<br>
<pre></pre>
<br>

http://blog.csdn.net/warrially/article/details/8258911

Delphi 不使用自带模板创建服务

原文：http://www.cnblogs.com/findumars/p/6359756.html

踩

(0)

评论一句话评论（0）

分享档案

更多>

2021年09月23日 (328)
2021年09月24日 (313)
2021年09月17日 (191)
2021年09月15日 (369)
2021年09月16日 (411)
2021年09月13日 (439)
2021年09月11日 (398)
2021年09月12日 (393)
2021年09月10日 (160)
2021年09月08日 (222)