系统服务和普通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;}