Delphi 不使用自带模板创建服务
program Project1; uses
Windows,
WinSvc; const
ServiceName: pchar = 'SnowWings Service';
DisplayName: pchar = 'Skysword';
Description: pchar = '服务器控制台'; var
Status: TServiceStatus;
StatusHandle: SERVICE_STATUS_HANDLE;
ServiceTable: array [ .. ] of TServiceTableEntry;
Stopped: boolean;
Paused: boolean; { 我们自己要实现的功能代码写在这里 }
procedure ServiceMain;
begin
repeat
if not Paused then
begin
// Beep(1000, 1000);
Sleep();
end;
until Stopped;
end;
{ 服务处理程序:一个服务处理程序内可以包含一个服务或多个服务的执行代码,但是它们都拥有固定的三个部分:服务main函数,服务ServiceMain函数和服务Control Handler函数。
服务配置程序:服务配置程序包括:服务的创建、服务的卸载、服务信息的查询、修改等; } procedure ServiceCtrlHandler(Control: dword); stdcall; // 服务控制函数
begin
case Control of
SERVICE_CONTROL_STOP: // 停止服务
begin
Stopped := True;
Status.dwCurrentState := SERVICE_STOP_PENDING;
SetServiceStatus(StatusHandle, Status);
end;
SERVICE_CONTROL_PAUSE: // 暂停服务
begin
Paused := True;
Status.dwCurrentState := SERVICE_PAUSED;
SetServiceStatus(StatusHandle, Status);
end;
SERVICE_CONTROL_CONTINUE: // 继续服务
begin
Paused := False;
Status.dwCurrentState := SERVICE_RUNNING;
SetServiceStatus(StatusHandle, Status);
end;
SERVICE_CONTROL_INTERROGATE:
SetServiceStatus(StatusHandle, Status);
SERVICE_CONTROL_SHUTDOWN:
Stopped := True;
end;
end; procedure ServiceCtrlDispatcher(dwArgc: dword; var lpszArgv: pchar); stdcall;
begin
StatusHandle := RegisterServiceCtrlHandler(ServiceName, @ServiceCtrlHandler);
if StatusHandle <> then
begin
ZeroMemory(@Status, SizeOf(Status));
Status.dwServiceType := SERVICE_WIN32_OWN_PROCESS or
SERVICE_INTERACTIVE_PROCESS;
Status.dwCurrentState := SERVICE_START_PENDING;
Status.dwControlsAccepted := SERVICE_ACCEPT_STOP or
SERVICE_ACCEPT_PAUSE_CONTINUE;
Status.dwWaitHint := ;
SetServiceStatus(StatusHandle, Status);
Stopped := False;
Paused := False;
Status.dwCurrentState := SERVICE_RUNNING;
SetServiceStatus(StatusHandle, Status);
ServiceMain; // 入口
Status.dwCurrentState := SERVICE_STOPPED;
SetServiceStatus(StatusHandle, Status);
end;
end; procedure UninstallService(ServiceName: pchar);
var
SCManager: SC_HANDLE;
Service: SC_HANDLE;
begin
SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if SCManager = then
Exit;
try
Service := OpenService(SCManager, ServiceName, SERVICE_ALL_ACCESS);
ControlService(Service, SERVICE_CONTROL_STOP, Status);
DeleteService(Service);
CloseServiceHandle(Service);
finally
CloseServiceHandle(SCManager);
end;
end; /// ////////////////
{ 添加一个服务的描述信息,你是否采用了更简洁的方法,这是一个例子 }
function SetServiceDescription(SH: THandle; Desc: pchar): Bool;
const
SERVICE_CONFIG_DESCRIPTION: dword = ;
var
OSVersionInfo: TOSVersionInfo;
ChangeServiceConfig2: function(hService: SC_HANDLE; dwInfoLevel: dword;
lpInfo: Pointer): Bool; StdCall;
LH: THandle;
begin
Result := False;
OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
GetVersionEx(OSVersionInfo);
if (OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and // NT? 环境判断 ,可以去掉
(OSVersionInfo.dwMajorVersion >= ) then
begin
LH := GetModuleHandle(advapi32);
Result := LH <> ;
if not Result then
Exit;
ChangeServiceConfig2 := GetProcAddress(LH, 'ChangeServiceConfig2A');
Result := @ChangeServiceConfig2 <> nil;
if not Result then
Exit;
Result := ChangeServiceConfig2(SH, SERVICE_CONFIG_DESCRIPTION, @Desc);
{ if Result then
FreeLibrary(LH); }
end;
end; procedure InstallService(ServiceName, DisplayName, Description: pchar;
FileName: string);
const
SERVICE_CONFIG_DESCRIPTION: dword = ;
var
SCManager: SC_HANDLE;
Service: SC_HANDLE;
Args: pchar;
begin
SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if SCManager = then
Exit;
try
Service := CreateService(SCManager, ServiceName, DisplayName,
SERVICE_ALL_ACCESS, SERVICE_WIN32_OWN_PROCESS or
SERVICE_INTERACTIVE_PROCESS, SERVICE_AUTO_START, SERVICE_ERROR_IGNORE,
pchar(FileName), nil, nil, nil, nil, nil);
try
SetServiceDescription(Service, Description);
except
end;
Args := nil;
StartService(Service, , Args);
CloseServiceHandle(Service);
finally
CloseServiceHandle(SCManager);
end;
end; begin
if ParamStr() = '/u' then
begin
UninstallService(ServiceName);
end
else
begin
ServiceTable[].lpServiceName := ServiceName;
ServiceTable[].lpServiceProc := @ServiceCtrlDispatcher;
ServiceTable[].lpServiceName := nil;
ServiceTable[].lpServiceProc := nil;
StartServiceCtrlDispatcher(ServiceTable[]);
InstallService(ServiceName, DisplayName, Description,
pchar(ParamStr()));
end; end.
Delphi 不使用自带模板创建服务的更多相关文章
- 通过zabbix自带模板监控windowsPC机器
通过zabbix自带模板监控windowsPC机器 作者:尹正杰 版权声明:原创作品,谢绝转载!否则将追究法律责任. 欢迎加入:高级运维工程师之路 598432640 相信有很多 ...
- Zabbix Server 自带模板监控有密码MySQL数据库
Zabbix Server 自带模板监控有密码MySQL数据库 作者:尹正杰 版权声明:原创作品,谢绝转载!否则将追究法律责任. 一.Zabbix-agent端的配置 1>.为数据库设置密码 ...
- 007-Zabbix Server 自带模板监控MySQL数据库
监控数据库分为三种: 1.Zabbix Server 自带模板监控无密码MySQL数据库 2.Zabbix Server 自带模板监控有密码MySQL数据库 3.Zabbix Server 自带模板监 ...
- Zabbix4.0.1使用自带模板监控Linux主机 CPU、内存、硬盘、网卡
环境: 前提已经安装好zabbix服务端.zabbix客户端, zabbix_server端ip和主机名信息: ip:192.168.1.204 hostname: www.test.com ...
- nodejs零基础详细教程2:模块化、fs文件操作模块、http创建服务模块
第二章 建议学习时间4小时 课程共10章 学习方式:详细阅读,并手动实现相关代码 学习目标:此教程将教会大家 安装Node.搭建服务器.express.mysql.mongodb.编写后台业务逻辑 ...
- (原创)带模板的OLE输出EXCEL
其实带模板的OLE输出EXCEL就是将要输出的EXCEL中一些拥有固定值(如标题,表头行等)的单元格先填充好数据和设置好格式后作为模板上传到SAP 中.这样后续在输出EXCEL时只需从SAP中将模板下 ...
- 03_Weblogic之配置简单域:启动和配置域,使用模板创建域,使用控制台
1 域:概览 是Oracle Weblogic Server的基本管理单元 始终包含一个配置为管理服务器的Oracle WebLogic Server实例 域中可以包括一些称为受管服务器的Ora ...
- Zabbix Server 自带模板监控更加灵活MySQL数据库
Zabbix Server 自带模板监控更加灵活MySQL数据库 作者:尹正杰 版权声明:原创作品,谢绝转载!否则将追究法律责任. 一.zabbix-agent端配置 1>.修改zabbix的 ...
- Zabbix Server 自带模板监控无密码MySQL数据库
Zabbix Server 自带模板监控无密码MySQL数据库 作者:尹正杰 版权声明:原创作品,谢绝转载!否则将追究法律责任. 一.安装MariaDB 1>.安装MariaDB [root ...
随机推荐
- Jquery ajax回调函数不执行
ajax如下: $.post( "${pageContext.request.contextPath}/deptHead_assign.action", {"studen ...
- ZooKeeper系列(10):ZooKeeper与Dubbo的结合
1. Dubbo的快速讲解 以防有人对Dubbo不了解,快速过一下Dubbo的基本概念,下面简单引用一下官方的介绍 1.1 架构 1.2.角色说明 Provider:暴露服务的提供方 Consumer ...
- 【LeetCode】4. 寻找两个有序数组的中位数
给定两个大小为 m 和 n 的有序数组 nums1 和 nums2. 请你找出这两个有序数组的中位数,并且要求算法的时间复杂度为 O(log(m + n)). 你可以假设 nums1 和 nums2 ...
- Linux性能优化 第五章 性能工具:特定进程内存
5.1 Linux内存子系统 在诊断内存性能问题的时候,也许有必要观察应用程序在内存子系统的不同层次上是怎样执行的.在顶层,操作系统决定如何利用交换内存和物理内存.它决定应用程序的哪一块地址空间将被放 ...
- MySQL · 最佳实践 · 分区表基本类型
MySQL · 最佳实践 · 分区表基本类型 MySQL分区表概述 随着MySQL越来越流行,Mysql里面的保存的数据也越来越大.在日常的工作中,我们经常遇到一张表里面保存了上亿甚至过十亿的记录.这 ...
- ant编译时提示一大堆软件包不存在的问题
ant编译时提示一大堆软件包不存在的问题 解决方案: 把项目的 lib 里的jar包 放的 jdk的jre的ext的目录下 例如 java home 是 D:JavaEEJavajdk1.8.0_1 ...
- anchor values list
- Oracle exp/imp 导出/导入
set NLS_LANG=AMERICAN_AMERICA.AL32UTF8 exp jjhd_test/11111111@a_syj file="d:\jjhd_test.dmp" ...
- CDH 安装遇到的问题
CDH 遇到的问题 l JAVA_HOME问题 这里, 很明显可以看到, JAVA_HOME 并没有设置成功.using as ... 感觉完全就是没有设置JAVA_HOME 这个环境变量.可是呢 ...
- exe加载DLL的时候会有一系列的搜索路径
假如安全DLL搜索模式启用,搜索顺序如下: 1. 应用程序所在的路径 2. Windows SYSTEM目录.通过调用GetSystemDirectory函数可以获取这个目录的路径. 3. 16位系统 ...