网站导航免费论文 原创论文 论文搜索 原创论文 网学软件 学术大家 资料中心 会员中心 问题解答 原创论文 论文素材 设计下载 最新论文 下载排行 论文上传 在线投稿 联系我们
返回网学首页
网学联系
最新论文 推荐专题 热门论文 素材专题
当前位置: 网学 > 编程文档 > DELPHI > 正文
把Delphi程序注册为服务
来源:Http://myeducs.cn 联系QQ:点击这里给我发消息 作者: 用户投稿 来源: 网络 发布时间: 12/10/12
下载{$ArticleTitle}原创论文样式

program Service;

uses
Windows,
WinSvc;

const
ServiceName: pchar = ''AFX Service'';
DisplayName: pchar = ''AFX Demo Service'';

var
Status: TServiceStatus;
StatusHandle: SERVICE_STATUS_HANDLE;
ServiceTable: array [0..1] of TServiceTableEntry;
Stopped: boolean;
Paused: boolean;

procedure ServiceMain;
begin
repeat
if not Paused then
begin
Beep(1000, 1000);
Sleep(1000);
end;
until Stopped;
end;

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 <> 0 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 := 1000;
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 = 0 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;

procedure InstallService(ServiceName, DisplayName: pchar; FileName: string);
var
SCManager: SC_HANDLE;
Service: SC_HANDLE;
Args: pchar;
begin
SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if SCManager = 0 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);
Args := nil;
StartService(Service, 0, Args);
CloseServiceHandle(Service);
finally
CloseServiceHandle(SCManager);
end;
end;

begin
if ParamStr(1) = ''/i'' then
begin
InstallService(ServiceName, DisplayName, ParamStr(0));
end
else if ParamStr(1) = ''/u'' then
begin
UninstallService(ServiceName);
end
else
begin
ServiceTable[0].lpServiceName := ServiceName;
ServiceTable[0].lpServiceProc := @ServiceCtrlDispatcher;
ServiceTable.lpServiceName := nil;
ServiceTable.lpServiceProc := nil;
StartServiceCtrlDispat

  • 上一篇资讯: Borland:光辉岁月
  • 网学推荐

    免费论文

    原创论文

    浏览:
    设为首页 | 加入收藏 | 论文首页 | 论文专题 | 设计下载 | 网学软件 | 论文模板 | 论文资源 | 程序设计 | 关于网学 | 站内搜索 | 网学留言 | 友情链接 | 资料中心
    版权所有 QQ:3710167 邮箱:3710167@qq.com 网学网 [Myeducs.cn] 您电脑的分辨率是 像素
    Copyright 2008-2015 myeducs.Cn www.myeducs.Cn All Rights Reserved
    湘ICP备09003080号