系列文章目录链接:
把windows服务程序的安装、启动等功能集成到自身的桌面程序上,需要引入单元uszhnServiceUtils.pas。
该单元包括如下函数:
unit uszhnServiceUtils;
interface
uses
WinApi.Windows, WinApi.Messages, System.SysUtils, WinApi.Winsvc, VCL.Dialogs,
vcl.ExtCtrls,
system.Classes,
System.Win.Registry;
type
TServiceState = (ssUnKnow, ssTimeOut, ssRuning{运行中},
ssWait{等待},
ssStop{停止},
ssUnInstall{未安装},
ssPause{暂停});
//启动服务
function StartServices(const SvrName: string): Boolean;
function Always_StartServices(const SvrName: string; var ErrorMsg: String): Boolean;
//SvrName服务名;下同
//停止服务
function StopServices(const SvrName: string): Boolean;
///一直停,直到服务停下为止
function Always_StopServices(const SvrName: string; var ErrorMsg: String): Boolean;
//查询服务状态;返回状态类型
function QueryServiceState(const SvrName: string): TServiceState;
///持续询问
function Always_QueryServiceState(const SvrName: string; const tgtState: TServiceState; TimeOut: Integer = 5*60*1000): TServiceState;
//注册服务
///建立一个服务
function CreateServices(const SvrName, FilePath: string): Boolean;
///建立一个服务;并且有服务描述
function CreateServiceWithDesc(const SvrName, FilePath, SrvDesc: string): Boolean;
function AddServiceDesc(const SvrName, SrvDesc: String): Boolean;
//服务名,FilePath: 服务路径
//卸载服务
function DeleteServices(const SvrName: string): Boolean;
//服务名
procedure GetServiceNames(Names: TStrings; DisplayNames: TStrings = nil;
const Service_Type: integer = $30; const Computer: PChar = nil);
我们在桌面程序界面上增加如下按键:安装服务、启动服务、停止服务、卸载服务。
uMainForm_Application.pas单元代码如下:
unit uMainForm_Application;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
system.DateUtils,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
type
TForm_Application = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Panel1: TPanel;
Label1: TLabel;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form_Application: TForm_Application;
implementation
uses
uWorkerThread, uszhnServiceUtils;
{$R *.dfm}
procedure TForm_Application.Button1Click(Sender: TObject);
begin
//创建工作线程
if WorkThread = nil then
WorkThread := TWorkThread.Create;
WorkThread.FreeOnTerminate := True; //完成后直接释放
end;
procedure TForm_Application.Button2Click(Sender: TObject);
begin
WorkThread.Pause;
end;
procedure TForm_Application.Button3Click(Sender: TObject);
begin
WorkThread.Continue;
end;
procedure TForm_Application.Button4Click(Sender: TObject);
begin
WorkThread.Terminate;
while not WorkThread.Finished do
begin
Sleep(200);
end;
WorkThread := nil;
end;
procedure TForm_Application.Button5Click(Sender: TObject);
begin
if CreateServices('Service1', ParamStr(0)) then
begin
Memo1.Lines.Add('服务安装成功: Service1');
end
else
begin
Memo1.Lines.Add('服务安装失败: Service1 xxxxx');
end;
end;
procedure TForm_Application.Button6Click(Sender: TObject);
var
T : TDateTime;
FServiceState : TServiceState;
begin
if StartServices('Service1') then
begin
FServiceState := QueryServiceState('Service1');
T := IncSecond(Now,10);
while FServiceState <> ssRuning do
begin
if Now > T then
begin
Memo1.Lines.Add('服务: Service1 启动失败!(Service), 超时未启动(10秒)');
Exit;
end;
Application.ProcessMessages;
Sleep(200);
FServiceState := QueryServiceState('Service1');
end;
Memo1.Lines.Add(' ----------------------------------------------');
Memo1.Lines.Add(' | 启动服务成功: Service1' );
Memo1.Lines.Add(' ----------------------------------------------');
end
else
begin
Memo1.Lines.Add('*********************************************************');
Memo1.Lines.Add('* Service 服务启动失败 *');
Memo1.Lines.Add('* ServiceName: Service1 (服务启动后名称)');
Memo1.Lines.Add('*********************************************************');
end;
end;
procedure TForm_Application.Button7Click(Sender: TObject);
var
FServiceState : TServiceState;
begin
if StopServices('Service1') then
begin
FServiceState := QueryServiceState('Service1');
while FServiceState <> ssStop do
begin
Application.ProcessMessages;
Sleep(100);
FServiceState := QueryServiceState('Service1');
end;
Memo1.Lines.Add(' ----------------------------------------------');
Memo1.Lines.Add(' | 停止服务成功: Service1' );
Memo1.Lines.Add(' ----------------------------------------------');
end
else
begin
Memo1.Lines.Add('*********************************************************');
Memo1.Lines.Add('* Service 服务停止失败 *');
Memo1.Lines.Add('* ServiceName: Service1 (服务启动后名称)');
Memo1.Lines.Add('*********************************************************');
end;
end;
procedure TForm_Application.Button8Click(Sender: TObject);
var
FServiceState : TServiceState;
begin
if DeleteServices('Service1') then
begin
FServiceState := QueryServiceState('Service1');
while FServiceState <> ssUnInstall do
begin
FServiceState := QueryServiceState('Service1');
Application.ProcessMessages;
end;
Memo1.Lines.Add('服务卸载成功: Service1');
end
else
begin
Memo1.Lines.Add('服务卸载失败: Service1');
end;
end;
end.
经过以上步骤,就彻底实现了双模程序,及实现了windows服务程序的完美调试,也实现了在程序自身完成服务的安装、启动、停止、卸载等功能。
本系列文章完整程序目录:
下一篇:windows 服务程序和桌面程序集成(七)效果演示及源程序下载