系统服务和普通FORMS程序共存一体的实现

要求：一个EXE，如何将它做成这样的效果：
1、双击它时，像一个FORMS程序那样正常显示窗体运行。
2、注册成系统服务，每次都可以从service.msc中启动它。

也就是说，没注册之前，它可以当作普通FORMS程序运行，注册之后，它就可以当系统服务运行。

做法：

参考Delphi 里面scktsrvr的源代码，Program Files/Borland/Delphi7/Bin 搜索scktsrvr 就会看到有个scktsrvr.dpr，查看它的工程源程序，原理：在启动程序时，通过启动的方式来决定如何加载程序。

必须的地方使用红色标记：

program RODBLayer;

{#ROGEN:RODBLayerServices.rodl} // RemObjects: Careful, do not remove!

uses
uROComInit,

//增加引用
SvcMgr, Forms, SysUtils, WinSvc,

RODBLayerService in 'RODBLayerService.pas' {RODBServices: TService},
RODBLayerServices_Intf in 'RODBLayerServices_Intf.pas',
RODBLayerServices_Invk in 'RODBLayerServices_Invk.pas',
uADOConnectionPool in 'uADOConnectionPool.pas',
uConnectionPool in 'uConnectionPool.pas',
Comm in 'Comm.pas',
Config in 'Config.pas' {ConfigFrm},
RODBLayerServices_Impl in 'RODBLayerServices_Impl.pas';

{$R *.RES}
{$R RODLFile.res}

//步骤一、查找是否通过命令行来注册或注消，如是则表明是系统服务
function Installing: Boolean;

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

//步骤二、检测是否是系统服务中启动服务；
function StartService: Boolean;

var
Mgr, Svc: Integer;
UserName, ServiceStartName: string;
Config: Pointer;
Size: DWord;
begin
Result := False;
Mgr := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if Mgr <> 0 then
begin

//'RODBServices'代表服务名(services name)，不是指服务显示名(services display name)

//它根据你的服务而定。
    Svc := OpenService(Mgr, PChar('RODBServices'), SERVICE_ALL_ACCESS);
    Result := Svc <> 0;
    if Result then
    begin
      QueryServiceConfig(Svc, nil, 0, Size);
      Config := AllocMem(Size);
      try
        QueryServiceConfig(Svc, Config, Size, Size);
        ServiceStartName := PQueryServiceConfig(Config)^.lpServiceStartName;
        if CompareText(ServiceStartName, 'LocalSystem') = 0 then
          ServiceStartName := 'SYSTEM';
      finally
        Dispose(Config);
      end;
      CloseServiceHandle(Svc);
    end;
    CloseServiceHandle(Mgr);
end;
if Result then
begin
    Size := 256;
    SetLength(UserName, Size);
    GetUserName(PChar(UserName), Size);
    SetLength(UserName, StrLen(PChar(UserName)));
    Result := CompareText(UserName, ServiceStartName) = 0;
end;
end;

//步骤三、判断

begin
if not Installing then
begin
    CreateMutex(nil, True, 'RODBServices');  //创建一个互斥体;
    if GetLastError = ERROR_ALREADY_EXISTS then
    begin
      MessageBox(0, PChar('The RODBServices is already running'), '提示', MB_ICONERROR);
      Halt;
    end;
end;
if Installing or StartService then  //两者之一为真，表明是系统服务。否则为Forms程序;
begin
     SvcMgr.Application.Initialize;
     SvcMgr.Application.CreateForm(TRODBServices, RODBServices);
SvcMgr.Application.CreateForm(TConfigFrm, ConfigFrm);
     ConfigAppName:='SvcMgr'; //使用它来标识出Application属于哪种，从而为关闭TConfigFrm窗体提供依据；这一行只跟你的实际应用有关。不过程序要退出时，要根据是系统服务还是普通FORMS做出不同的退出动作。如下：
     SvcMgr.Application.Run;
end else
begin
     Forms.Application.Initialize;
     Forms.Application.CreateForm(TRODBServices, RODBServices);
     Forms.Application.CreateForm(TConfigFrm,ConfigFrm);
     ConfigAppName:='Forms';
     Forms.Application.Run;
end;
end.

{接上，用来说明不同的退出动作如何做的。

procedure TConfigFrm.BtnCloseClick(Sender: TObject);
begin
if MessageDlgPos('您确定要退出服务端吗?',mtConfirmation,[mbOK, mbCancel],0,
Mouse.CursorPos.X-160,Mouse.CursorPos.Y-130)<>mrOk then Exit;
RODBServices.ServiceStop(RODBServices,IsConsole) ;
if ConfigAppName='SvcMgr' then   //前面代码都相同，仅这里要变一下。
    RODBServices.Status:=csStopped
else
    Close;
end;}

秒客网

系统服务和普通FORMS程序共存一体的实现

相关文章