Delphi中如何实现服务相关功能??

seacode 2004-12-23 02:13:21
已知Windows服务名称,
如何用delphi实现服务的开始与停止?
实现的函数是阻塞型的还是非阻塞型的?
如果是非阻塞型的,如何在开始或停止过程中监控服务当前的状态?好像是ReportStatus

希望有完整的示例代码,谢谢!
...全文
282 8 打赏 收藏 转发到动态 举报
写回复
用AI写文章
8 条回复
切换为时间正序
请发表友善的回复…
发表回复
seacode 2004-12-24
  • 打赏
  • 举报
回复
已经靠调用VC的程序解决了,不过还是感谢楼上几位,你们的方法我也会试试看的,结帖!
firef 2004-12-23
  • 打赏
  • 举报
回复
以下提供了三个简单易用函数,分别是启动,停止和得到服务状态,
以前按着MSDN上的代码转换过来,是阻塞型的,如想非阻塞型,
可考虑将代码放在线程中执行.

unit OperateService;
{
purpose: 操作Windows服务
}

interface

uses Windows, WinSvc;

//启动服务
function StartSampleService(const ServiceName: PAnsiChar): LongBool;

//停止服务
function StopSampleService(const ServiceName: PAnsiChar;
const fStopDependencies: LongBool; const dwTimeout: DWORD): LongBool;
//ServiceName - 服务名.
//fStopDependencies - 有依赖服务时,是否要停止.
//dwTimeout - 最大等待时间(毫秒)

//得到服务的状态
function GetSampleServiceStatus(const ServiceName: PAnsiChar; var
lpServiceStatus:
TServiceStatus): LongBool;

implementation

uses Variants;

function StartSampleService(const ServiceName: PAnsiChar): LongBool;
var
schSCManager, schService: SC_HANDLE;
ssStatus: TServiceStatus;
dwOldCheckPoint, dwStartTickCount, dwWaitTime: DWORD;

lpServiceArgVectors: Pchar;
begin
Result := False;

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

schService := OpenService(schSCManager, ServiceName, SERVICE_ALL_ACCESS);
if schService = 0 then
Exit;
try
lpServiceArgVectors := nil;
if not StartService(schService, 0, lpServiceArgVectors) then
Exit;

if not QueryServiceStatus(schService, ssStatus) then
Exit;

dwStartTickCount := GetTickCount;
dwOldCheckPoint := ssStatus.dwCheckPoint;

while ssStatus.dwCurrentState = SERVICE_START_PENDING do
begin
dwWaitTime := ssStatus.dwWaitHint div 10;
if dwWaitTime < 1000 then
dwWaitTime := 1000
else if dwWaitTime > 10000 then
dwWaitTime := 10000;

Sleep(dwWaitTime);

if not QueryServiceStatus(schService, ssStatus) then
Break;

if ssStatus.dwCheckPoint > dwOldCheckPoint then
begin
dwStartTickCount := GetTickCount;
dwOldCheckPoint := ssStatus.dwCheckPoint;
end
else if GetTickCount - dwStartTickCount > ssStatus.dwWaitHint then
Break;
end;

if ssStatus.dwCurrentState = SERVICE_RUNNING then
Result := True;
finally
CloseServiceHandle(schService);
end;
end;

function StopSampleService(const ServiceName: PAnsiChar;
const fStopDependencies: LongBool; const dwTimeout: DWORD): LongBool;
var
schSCManager, schService, hDepService: SC_HANDLE;
ssStatus: TServiceStatus;
dwStartTime: DWORD;
I, dwBytesNeeded, dwCount: DWORD;
lpDependencies: PEnumServiceStatus;
ess: TEnumServiceStatus;
begin
Result := False;
dwStartTime := GetTickCount;

schSCManager := OpenSCManager(nil, nil, SC_MANAGER_ENUMERATE_SERVICE);
if schSCManager = 0 then
Exit;

schService := OpenService(schSCManager, ServiceName, SERVICE_ALL_ACCESS);
if schService = 0 then
Exit;

if not QueryServiceStatus(schService, ssStatus) then
Exit;

if ssStatus.dwCurrentState = SERVICE_STOPPED then
begin
Result := True;
Exit;
end;

while ssStatus.dwCurrentState = SERVICE_STOP_PENDING do
begin
Sleep(ssStatus.dwWaitHint);

if not QueryServiceStatus(schService, ssStatus) then
Exit;

if ssStatus.dwCurrentState = SERVICE_STOPPED then
begin
Result := True;
Exit;
end;

if (GetTickCount - dwStartTime > dwTimeout) then
Exit;
end;
if fStopDependencies then
begin
lpDependencies := nil;

if EnumDependentServices(schService, SERVICE_ACTIVE, lpDependencies^, 0,
dwBytesNeeded, dwCount) then
begin
end
else
begin
if GetLastError <> ERROR_MORE_DATA then
Exit;

lpDependencies := PEnumServiceStatus(HeapAlloc(GetProcessHeap,
0, dwBytesNeeded));

if not Assigned(lpDependencies) then
Exit;

try
if not EnumDependentServices(schService, SERVICE_ACTIVE,
lpDependencies^,
dwBytesNeeded, dwBytesNeeded, dwCount) then
Exit;

for I := 0 to dwCount - 1 do
begin
ess := lpDependencies^;
hDepService := OpenService(schSCManager, ess.lpServiceName,
SERVICE_STOP or
SERVICE_QUERY_STATUS);
if hDepService = 0 then
Exit;
try
if not ControlService(hDepService, SERVICE_CONTROL_STOP, ssStatus)
then
Exit;

while ssStatus.dwCurrentState <> SERVICE_STOPPED do
begin
Sleep(ssStatus.dwWaitHint);
if not QueryServiceStatus(hDepService, ssStatus) then
Exit;

if ssStatus.dwCurrentState = SERVICE_STOPPED then
begin
Inc(lpDependencies);
Break;
end;

if GetTickCount - dwStartTime > dwTimeout then
Exit;
end;
finally
CloseServiceHandle(hDepService);
end;
Inc(lpDependencies);
end;
finally
HeapFree(GetProcessHeap, 0, lpDependencies);
end;
end;
end;

if not ControlService(schService, SERVICE_CONTROL_STOP, ssStatus) then
Exit;
while ssStatus.dwCurrentState <> SERVICE_STOPPED do
begin
Sleep(ssStatus.dwWaitHint);
if not QueryServiceStatus(schService, ssStatus) then
Exit;
if ssStatus.dwCurrentState = SERVICE_STOPPED then
Break;
if GetTickCount - dwStartTime > dwTimeout then
Exit;
end;
Result := True;
end;

function GetSampleServiceStatus(const ServiceName: PAnsiChar; var
lpServiceStatus:
TServiceStatus): LongBool;
var
schSCManager, schService: SC_HANDLE;
begin
Result := False;

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

schService := OpenService(schSCManager, ServiceName, SERVICE_ALL_ACCESS);
if schService = 0 then
Exit;
try
if not QueryServiceStatus(schService, lpServiceStatus) then
Exit;

Result := True;
finally
CloseServiceHandle(schService);
end;
end;

end.
TechnoFantasy 2004-12-23
  • 打赏
  • 举报
回复
function TServiceControl.Continue: Boolean;
var
CheckPoint: DWord;
SvcMgr, Svc: SC_HANDLE;
SvcStatus: TServiceStatus;
begin
SvcMgr := OpenSCManager(PChar(FMachine), nil, SC_MANAGER_CONNECT);
if SvcMgr = 0 then RaiseLastWin32Error;
try
Svc := OpenService(SvcMgr, PChar(FService), SERVICE_PAUSE_CONTINUE or SE
RVICE_QUERY_STATUS);
if Svc = 0 then RaiseLastWin32Error;
try
if ControlService(Svc, SERVICE_CONTROL_CONTINUE, SvcStatus) then
begin
if not QueryServiceStatus(Svc, SvcStatus) then
RaiseLastWin32Error
else
with SvcStatus do
begin
while (SERVICE_RUNNING <> dwCurrentState) do
begin
CheckPoint := dwCheckPoint;
Sleep(dwWaitHint);
if not QueryServiceStatus(Svc, SvcStatus) then
Break;
if dwCheckPoint < CheckPoint then
Break;
end;
end;
end;
finally
CloseServiceHandle(Svc);
end;
finally
CloseServiceHandle(SvcMgr);
end;
Result := SERVICE_RUNNING = SvcStatus.dwCurrentState;
end;
function TServiceControl.Pause: Boolean;
var
CheckPoint: DWord;
SvcMgr, Svc: SC_HANDLE;
SvcStatus: TServiceStatus;
begin
SvcMgr := OpenSCManager(PChar(FMachine), nil, SC_MANAGER_CONNECT);
if SvcMgr = 0 then RaiseLastWin32Error;
try
Svc := OpenService(SvcMgr, PChar(FService), SERVICE_PAUSE_CONTINUE or SE
RVICE_QUERY_STATUS);
if Svc = 0 then RaiseLastWin32Error;
try
if ControlService(Svc, SERVICE_CONTROL_PAUSE, SvcStatus) then
begin
if not QueryServiceStatus(Svc, SvcStatus) then
RaiseLastWin32Error
else
with SvcStatus do
begin
while (SERVICE_PAUSED <> dwCurrentState) do
begin
CheckPoint := dwCheckPoint;
Sleep(dwWaitHint);
if not QueryServiceStatus(Svc, SvcStatus) then
Break;
if dwCheckPoint < CheckPoint then
Break;
end;
end;
end;
finally
CloseServiceHandle(Svc);
end;
finally
CloseServiceHandle(SvcMgr);
end;
Result := SERVICE_PAUSED = SvcStatus.dwCurrentState;
end;
end.
TechnoFantasy 2004-12-23
  • 打赏
  • 举报
回复

function TServiceControl.Start: Boolean;
var
psTemp: PChar;
CheckPoint: DWord;
SvcMgr, Svc: SC_HANDLE;
SvcStatus: TServiceStatus;
begin
SvcMgr := OpenSCManager(PChar(FMachine), nil, SC_MANAGER_CONNECT);
if SvcMgr = 0 then RaiseLastWin32Error;
try
Svc := OpenService(SvcMgr, PChar(FService), SERVICE_START or SERVICE_QUE
RY_STATUS);
if Svc = 0 then RaiseLastWin32Error;
try
psTemp := nil;
if StartService(Svc, 0, psTemp) then
begin
if not QueryServiceStatus(Svc, SvcStatus) then
RaiseLastWin32Error
else
with SvcStatus do
begin
while (SERVICE_RUNNING <> dwCurrentState) do
begin
CheckPoint := dwCheckPoint;
Sleep(dwWaitHint);
if not QueryServiceStatus(Svc, SvcStatus) then
Break;
if dwCheckPoint < CheckPoint then
Break;
end;
end;
end;
finally
CloseServiceHandle(Svc);
end;
finally
CloseServiceHandle(SvcMgr);
end;
Result := SERVICE_RUNNING = SvcStatus.dwCurrentState;
end;
function TServiceControl.Stop: Boolean;
var
CheckPoint: DWord;
SvcMgr, Svc: SC_HANDLE;
SvcStatus: TServiceStatus;
begin
SvcMgr := OpenSCManager(PChar(FMachine), nil, SC_MANAGER_CONNECT);
if SvcMgr = 0 then RaiseLastWin32Error;
try
Svc := OpenService(SvcMgr, PChar(FService), SERVICE_STOP or SERVICE_QUER
Y_STATUS);
if Svc = 0 then RaiseLastWin32Error;
try
if ControlService(Svc, SERVICE_CONTROL_STOP, SvcStatus) then
begin
if not QueryServiceStatus(Svc, SvcStatus) then
RaiseLastWin32Error
else
with SvcStatus do
begin
while (SERVICE_STOPPED <> dwCurrentState) do
begin
CheckPoint := dwCheckPoint;
Sleep(dwWaitHint);
if not QueryServiceStatus(Svc, SvcStatus) then
Break;
if dwCheckPoint < CheckPoint then
Break;
end;
end;
end;
finally
CloseServiceHandle(Svc);
end;
finally
CloseServiceHandle(SvcMgr);
end;
Result := SERVICE_STOPPED = SvcStatus.dwCurrentState;
end;
TechnoFantasy 2004-12-23
  • 打赏
  • 举报
回复
一个控制Service的对象,可以方便实现对Service

unit ServiceControl;
interface
uses
Windows, SysUtils, WinSvc, SvcMgr;
type
TServiceControl = class(TObject)
private
FMachine, FService: string;
function GetNTStatus: DWord;
function GetStatus: TCurrentStatus;
protected
public
function Start: Boolean;
function Stop: Boolean;
function Pause: Boolean;
function Continue: Boolean;
constructor Create(Service: string; Machine: string = '');
property NTStatus: DWord read GetNTStatus;
property Status: TCurrentStatus read GetStatus;
property Service: string read FService write FService;
property Machine: string read FMachine write FMachine;
published
end; { TServiceControl }
function StatusToNT(Status: TCurrentStatus): DWord;
function StatusFromNt(Status: DWord): TCurrentStatus;
implementation
function StatusToNT(Status: TCurrentStatus): DWord;
const
NTServiceStatus: array[TCurrentStatus] of DWord = (SERVICE_STOPPED,
SERVICE_START_PENDING, SERVICE_STOP_PENDING, SERVICE_RUNNING,
SERVICE_CONTINUE_PENDING, SERVICE_PAUSE_PENDING, SERVICE_PAUSED);
begin
Result := NTServiceStatus[Status];
end;
function StatusFromNt(Status: DWord): TCurrentStatus;
const
CurrentStatus: array[1..7] of TCurrentStatus = (csStopped, csStartPending,

csStopPending, csRunning, csContinuePending, csPausePending, csPaused);
begin
Result := CurrentStatus[Status];
end;
{ TServiceControl }
constructor TServiceControl.Create(Service: string; Machine: string = '');
begin
FService := Service;
FMachine := Machine;
end;
function TServiceControl.GetStatus: TCurrentStatus;
begin
Result := StatusFromNT(GetNTStatus);
end;
function TServiceControl.GetNTStatus: DWord;
var
SvcMgr, Svc: SC_HANDLE;
SvcStatus: TServiceStatus;
begin
Result := 0;
SvcMgr := OpenSCManager(PChar(FMachine), nil, SC_MANAGER_CONNECT);
if SvcMgr = 0 then RaiseLastWin32Error;
try
Svc := OpenService(SvcMgr, PChar(FService), SERVICE_QUERY_STATUS);
if Svc = 0 then RaiseLastWin32Error;
try
if QueryServiceStatus(Svc, SvcStatus) then
Result := SvcStatus.dwCurrentState
else
RaiseLastWin32Error;
finally
CloseServiceHandle(Svc);
end;
finally
CloseServiceHandle(SvcMgr);
end;
end;
seacode 2004-12-23
  • 打赏
  • 举报
回复
Delphi里有个关于服务的类,可我不会用,难道没人懂吗?
seacode 2004-12-23
  • 打赏
  • 举报
回复
不好意思,小弟不是DELPHI出身,这些API我都知道,应该都是sdk的吧?转DELPHI的参数我不熟,强烈需要示例代码,另外,我的DELPHI是日文帮助,没得看,头疼……
lxpbuaa 2004-12-23
  • 打赏
  • 举报
回复
需要用到以下API,具体看帮助
OpenService
QueryServiceStatus
OpenSCManager
StartService
ControlService

1,183

社区成员

发帖
与我相关
我的任务
社区描述
Delphi Windows SDK/API
社区管理员
  • Windows SDK/API社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧