大悟还俗

邮箱 key_ok@qq.com 我的收集 http://pan.baidu.com/share/home?uk=1177427271
posts - 236, comments - 8, trackbacks - 0, articles - 0
  新随笔  :: 联系 :: 订阅 订阅  :: 管理

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

Posted on 2013-11-11 13:05 大悟还俗 阅读(...) 评论(...) 编辑 收藏

要求:一个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 StartServiceBoolean;

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;}