以前弄的一个权当参考资料吧 unit Insvc;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, WinSvc, Buttons;type TForm1 = class(TForm) btn1: TBitBtn; btn2: TBitBtn; btn3: TBitBtn; lbl1: TLabel; lbl2: TLabel; procedure btn1Click(Sender: TObject); procedure btn2Click(Sender: TObject); procedure btn3Click(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end;var Form1: TForm1; status: string; implementation{$R *.dfm} { InStall SerVice Demo } { } { 2011元旦By[haiou327] } { } { }function InstallService(PathName, Name, DisplayName: PChar): Boolean; var schSCManager, schService: THANDLE; //strDir: array[0..1023] of char; //lpszBinaryPathName: PChar; begin schSCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS); if schSCManager = 0 then begin MessageBox(0, '联接服务控制管理器失败', 'Error', MB_OK); Result := false; exit; end; //GetCurrentDirectory(1024, strDir); // 取到应用程序所在的目录 //strlcat(strDir, '\ScvProject.exe', 1024); // 当前目录下的服务应用 //lpszBinaryPathName := strDir; schService := CreateService( schSCManager, // 服务控制管理句柄 Name, // 服务名称 需要和 服务应用名 相同 DisplayName, // 显示的服务名称 SERVICE_ALL_ACCESS, // 存取权利 SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS, // 服务类型 and SERVICE_INTERACTIVE_PROCESS SERVICE_AUTO_START, // 启动类型 SERVICE_ERROR_NORMAL, // 错误控制类型 PathName, // 服务程序 nil, // 组服务名称 nil, // 组标识 nil, // 依赖的服务 nil, // 启动服务帐号 nil); // 启动服务口令 if schService = 0 then begin MessageBox(0, '无法建立指定的服务对象', 'Error', MB_OK); Result := false; exit; end; CloseServiceHandle(schService); MessageBox(0, '已经成功地安装了服务对象', '信息', MB_OK); Result := true; end;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 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; function GetServiceStatusString(sServiceName: string): string; var hService, hSCManager: SC_HANDLE; SS: TServiceStatus; begin hSCManager := OpenSCManager(nil, SERVICES_ACTIVE_DATABASE, SC_MANAGER_CONNECT); if hSCManager = 0 then begin result := 'Can not open the service control manager'; exit; end; hService := OpenService(hSCManager, PChar(sServiceName), SERVICE_QUERY_STATUS); if hService = 0 then begin CloseServiceHandle(hSCManager); result := 'Can not open the service'; exit; end; if not QueryServiceStatus(hService, SS) then result := 'Can not query the service status' else begin case SS.dwCurrentState of SERVICE_CONTINUE_PENDING: result := 'continue is pending'; SERVICE_PAUSE_PENDING: result := ' pause is pending'; SERVICE_PAUSED: result := ' is paused'; SERVICE_RUNNING: result := 'is running'; SERVICE_START_PENDING: result := 'is starting'; SERVICE_STOP_PENDING: result := 'is stopping'; SERVICE_STOPPED: result := 'is not running'; else result := 'Unknown Status'; end; end; CloseServiceHandle(hSCManager); CloseServiceHandle(hService); end;procedure scanstatus; begin begin status := GetServiceStatusString('test'); //Form1.btn1.Caption:='安装服务'; Form1.lbl1.Caption := status; Form1.btn1.Enabled := True; Form1.btn2.Enabled := True; Form1.btn3.Enabled := True; if status = 'is not running' then begin Form1.btn1.Caption:='服务已安装'; Form1.btn3.Caption:='已停止...'; Form1.btn2.Caption:='运行服务'; Form1.btn1.Enabled := False; Form1.btn3.Enabled := False; end; if status = 'is running' then begin Form1.btn1.Caption:='服务已安装'; Form1.btn2.Caption:='运行中...'; Form1.btn3.Caption:='停止服务'; Form1.btn1.Enabled := False; Form1.btn2.Enabled := False; end; if status = 'is starting' then begin Form1.btn1.Caption:='服务已安装'; Form1.btn2.Caption:='运行中...'; Form1.btn1.Enabled := False; Form1.btn2.Enabled := False; end; if status = 'Can not open the service' then begin Form1.btn1.Caption:='安装服务';; Form1.btn2.Caption:='运行服务'; Form1.btn3.Caption:='停止服务'; Form1.btn2.Enabled := False; Form1.btn3.Enabled := False; end; end; end;procedure TForm1.btn1Click(Sender: TObject); begin InstallService('c:\delphi_out\sct.exe', 'Test', '0haiou'); status := GetServiceStatusString('test'); ScanStatus; end;procedure TForm1.btn2Click(Sender: TObject); begin if StartService('TEst') = True then ShowMessage('服务启动成功') else ShowMessage('error'); scanstatus; end;procedure TForm1.btn3Click(Sender: TObject); begin if StopService('TEst') = True then ShowMessage('成功停止') else ShowMessage('error'); scanstatus; end;procedure TForm1.FormCreate(Sender: TObject); begin scanstatus; end;end.
不好意思,语言表达有误,
说明一下 WIN级 就是WIN下运行的服务程序,就像如下图的 服务程序
不知可否帮我编写一个DELPHI的服务程序 实例呀,
先谢谢了
http://www.oschina.net/code/snippet_222150_20458
http://blog.csdn.net/lbird/article/details/1422308如果仅仅是想写个服务,那几本delphi名著都有讲win服务的章节,翻书看看吧
unit Insvc;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, WinSvc, Buttons;type
TForm1 = class(TForm)
btn1: TBitBtn;
btn2: TBitBtn;
btn3: TBitBtn;
lbl1: TLabel;
lbl2: TLabel;
procedure btn1Click(Sender: TObject);
procedure btn2Click(Sender: TObject);
procedure btn3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;
status: string;
implementation{$R *.dfm}
{ InStall SerVice Demo }
{ }
{ 2011元旦By[haiou327] }
{ }
{ }function InstallService(PathName, Name, DisplayName: PChar): Boolean;
var
schSCManager, schService: THANDLE;
//strDir: array[0..1023] of char;
//lpszBinaryPathName: PChar;
begin
schSCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if schSCManager = 0 then
begin
MessageBox(0, '联接服务控制管理器失败', 'Error', MB_OK);
Result := false;
exit;
end;
//GetCurrentDirectory(1024, strDir); // 取到应用程序所在的目录
//strlcat(strDir, '\ScvProject.exe', 1024); // 当前目录下的服务应用
//lpszBinaryPathName := strDir;
schService := CreateService(
schSCManager, // 服务控制管理句柄
Name, // 服务名称 需要和 服务应用名 相同
DisplayName, // 显示的服务名称
SERVICE_ALL_ACCESS, // 存取权利
SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS, // 服务类型 and SERVICE_INTERACTIVE_PROCESS
SERVICE_AUTO_START, // 启动类型
SERVICE_ERROR_NORMAL, // 错误控制类型
PathName, // 服务程序
nil, // 组服务名称
nil, // 组标识
nil, // 依赖的服务
nil, // 启动服务帐号
nil); // 启动服务口令
if schService = 0 then
begin
MessageBox(0, '无法建立指定的服务对象', 'Error', MB_OK);
Result := false; exit;
end;
CloseServiceHandle(schService);
MessageBox(0, '已经成功地安装了服务对象', '信息', MB_OK);
Result := true;
end;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 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;
function GetServiceStatusString(sServiceName: string): string;
var
hService, hSCManager: SC_HANDLE;
SS: TServiceStatus;
begin
hSCManager := OpenSCManager(nil, SERVICES_ACTIVE_DATABASE, SC_MANAGER_CONNECT);
if hSCManager = 0 then
begin
result := 'Can not open the service control manager';
exit;
end;
hService := OpenService(hSCManager, PChar(sServiceName), SERVICE_QUERY_STATUS);
if hService = 0 then
begin
CloseServiceHandle(hSCManager);
result := 'Can not open the service';
exit;
end;
if not QueryServiceStatus(hService, SS) then
result := 'Can not query the service status'
else
begin
case SS.dwCurrentState of
SERVICE_CONTINUE_PENDING:
result := 'continue is pending';
SERVICE_PAUSE_PENDING:
result := ' pause is pending';
SERVICE_PAUSED:
result := ' is paused';
SERVICE_RUNNING:
result := 'is running';
SERVICE_START_PENDING:
result := 'is starting';
SERVICE_STOP_PENDING:
result := 'is stopping';
SERVICE_STOPPED:
result := 'is not running';
else
result := 'Unknown Status';
end;
end;
CloseServiceHandle(hSCManager);
CloseServiceHandle(hService);
end;procedure scanstatus;
begin
begin
status := GetServiceStatusString('test');
//Form1.btn1.Caption:='安装服务';
Form1.lbl1.Caption := status;
Form1.btn1.Enabled := True;
Form1.btn2.Enabled := True;
Form1.btn3.Enabled := True;
if status = 'is not running' then
begin
Form1.btn1.Caption:='服务已安装';
Form1.btn3.Caption:='已停止...';
Form1.btn2.Caption:='运行服务';
Form1.btn1.Enabled := False;
Form1.btn3.Enabled := False;
end;
if status = 'is running' then
begin
Form1.btn1.Caption:='服务已安装';
Form1.btn2.Caption:='运行中...';
Form1.btn3.Caption:='停止服务';
Form1.btn1.Enabled := False;
Form1.btn2.Enabled := False;
end;
if status = 'is starting' then
begin
Form1.btn1.Caption:='服务已安装';
Form1.btn2.Caption:='运行中...';
Form1.btn1.Enabled := False;
Form1.btn2.Enabled := False;
end;
if status = 'Can not open the service' then
begin
Form1.btn1.Caption:='安装服务';;
Form1.btn2.Caption:='运行服务';
Form1.btn3.Caption:='停止服务';
Form1.btn2.Enabled := False;
Form1.btn3.Enabled := False;
end;
end;
end;procedure TForm1.btn1Click(Sender: TObject);
begin
InstallService('c:\delphi_out\sct.exe', 'Test', '0haiou');
status := GetServiceStatusString('test');
ScanStatus;
end;procedure TForm1.btn2Click(Sender: TObject);
begin
if StartService('TEst') = True then
ShowMessage('服务启动成功')
else
ShowMessage('error');
scanstatus;
end;procedure TForm1.btn3Click(Sender: TObject);
begin
if StopService('TEst') = True then
ShowMessage('成功停止')
else
ShowMessage('error');
scanstatus;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
scanstatus;
end;end.
给编写个 完整些的 DEMO实例吧
再次感谢
Sct.exe是服务程序,timer每秒弹出一个提示框,没有其它任何功能,一个演示而已,
http://pan.baidu.com/share/link?shareid=1102866282&uk=2500077576
再次感谢