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

系统服务和普通FORMS程序共存一体的实现的更多相关文章

  1. .net core 开发 Windows Forms 程序

    我是一名 ASP.NET 程序员,专注于 B/S 项目开发.累计文章阅读量超过一千万,我的博客主页地址:https://www.itsvse.com/blog_xzz.html 引言 .net cor ...

  2. 分析现有 WPF / Windows Forms 程序能否顺利迁移到 .NET Core 3.0

    本文转自 https://blog.csdn.net/WPwalter/article/details/82859449 使用 .NET Core 3.0 Desktop API Analyzer 分 ...

  3. 分析现有 WPF / Windows Forms 程序能否顺利迁移到 .NET Core 3.0(使用 .NET Core 3.0 Desktop API Analyzer )

    今年五月的 Build 大会上,微软说 .NET Core 3.0 将带来 WPF / Windows Forms 这些桌面应用的支持.当然,是通过 Windows 兼容包(Windows Compa ...

  4. 关于oracle 11g 64位与 32位的 plsql、及其他32位应用程序共存的问题

    因为 plsql 不支持 64位 oracle 客户端,所以plsql 必须使用 oracle 的 32位 instanclient 包.  解压缩后放一个目录,例如: D:\Oracle\insta ...

  5. DELPHI编写服务程序总结(在系统服务和桌面程序之间共享内存,在服务中使用COM组件)

    DELPHI编写服务程序总结 一.服务程序和桌面程序的区别 Windows 2000/XP/2003等支持一种叫做“系统服务程序”的进程,系统服务和桌面程序的区别是:系统服务不用登陆系统即可运行:系统 ...

  6. atitit.添加win 系统服务 bat批处理程序服务的法总结instsrv srvany java linux

    atitit.添加win 系统服务 bat批处理程序服务的法总结instsrv srvany  java linux 系统服务不同于普通视窗系统应用程式.不可能简简单单地通过运行一个EXE就启动视窗系 ...

  7. 如何为Windows Forms应用程序添加启动参数(Start-Up Parameters)

    很多场合下,我们需要通过命令行或者快捷方式在Windows Forms程序启动时向其传递参数. 这些参数可能是用来加载某一个文档,或者是应用程序的初始化配置文件. 特别是对那些需要高度自定义配置的大程 ...

  8. atitit.加入win 系统服务 bat批处理程序服务的法总结instsrv srvany java linux

    atitit.加入win 系统服务 bat批处理程序服务的法总结instsrv srvany  java linux 系统服务不同于普通视窗系统应用程式.不可能简简单单地通过执行一个EXE就启动视窗系 ...

  9. DOS程序员手册(九)

    第14章参考手册概述     本书余下的章节将向读者们介绍BIOS.DOS各种各样API函数和服务,作为一名程 序员,了解和掌握这些知识是很有好处的.在所介绍的参考手册中,每部手册都汇集了大 量的资源 ...

随机推荐

  1. iOS原生和React-Native之间的交互1

    今天,记录一下iOS原生和React-Native之间的交互.如果第一次接触最好先移步至 http://www.cnblogs.com/shaoting/p/6388502.html 先看一下怎么在i ...

  2. 交换机的默认网关(跨网段telnet)

    实验要求:配置一台交换机,并配置默认网关,使不同网段的主机能够远程telnet连接到交换机 拓扑图如下: 交换机配置: enable 进入特权模式 configure terminal 进入全局模式 ...

  3. ejs-模板

    我今天第一次使用,使用的时候,遇到一些问题,还好有朋友帮我一起解决; 我先说说我使用过程中遇到的问题; 在express框架中引用 app.set('views',__dirname + '/view ...

  4. Django之静态文件配置

    在项目目录中打开settings.py,在最下面配置静态文件(css文件,js文件以及其他静态配置文件),比如说html使用到了jQuery框架,我们要在项目根目录下创建statics(可自定义),将 ...

  5. make命令回显Makefile执行脚本命令

    /********************************************************************** * make命令回显Makefile执行脚本命令 * 说 ...

  6. flask使用蓝图,创建副本

    随着flask的发展,flask框架越来越复杂,我们需要进行模块化处理,因为之前学过python模块化管理,我可以对一个flask程序进行简单的模块化处理. 我们都有一个博客程序,由此可知博客的前端界 ...

  7. 2017.4.28 KVM 内存虚拟化及其实现

    概述 KVM(Kernel Virtual Machine) , 作为开源的内核虚拟机,越来越受到 IBM,Redhat,HP,Intel 等各大公司的大力支持,基于 KVM 的开源虚拟化生态系统也日 ...

  8. (19)模型层 -ORM之msql 跨表查询(正向和反向查询)

    基于对象的跨表查询 基于对象的跨表查询'''正向和反向查询'''# 正向 ----> 关联字段在当前表中,从当前表向外查叫正向# 反向 ---> 关联字段不在当前表中,当当前表向外查叫反向 ...

  9. ajax解决跨域

    http://www.cnblogs.com/sunxucool/p/3433992.html 为什么会出现跨域跨域问题来源于JavaScript的同源策略,即只有 协议+主机名+端口号 (如存在)相 ...

  10. gxx -L和/etc/ld.so.conf的理解

    编程之路刚刚开始,错误难免,希望大家能够指出. 今天编了个动态库,然后自己测试了一下. 忘记设置程序运行时系统搜索库的路径发生错误: 忘记设置程序编译的时候 -L 指定路径报的错误: -L : 告诉程 ...