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

  • 相关阅读:
    mysql创建和删除表
    性能测试工具curlloader(linux)
    Linux安装与硬盘分区
    linux那点事儿(上)
    Linux文件传输与mysql数据库安装
    性能测试工具curlloader二测试分析
    菜鸟学自动化测试(六)selenium 命令之文字范本匹配
    git/github初级运用自如
    开源自动化测试框架Tellurium
    菜鸟学自动化测试(五)selenium命令之定位页面元素
  • 原文地址:https://www.cnblogs.com/key-ok/p/3417731.html
Copyright © 2020-2023  润新知