ActiveX DLL不行,要写成标准的API DLL才行,要导出一个函数ServiceMain;
以下为一段DELPHI的代码
{ 文件名: ServiceDll.dpr
概述: 替换由svchost.exe启动的某个系统服务,具体服务由全局变量 ServiceName 决定.
经测试,生成的DLL文件运行完全正常.
测试环境: Windows 2003 Server + Delphi 7.0}
library ServiceDll;
uses
SysUtils,
Classes,
winsvc,
System,
Windows;
{ 定义全局变量 }
var
SvcStatsHandle: SERVICE_STATUS_HANDLE; // 服务控制信息句柄
dwCurrState: DWORD; // 存储服务状态
ServiceName: PChar = 'BITS '; // 服务名称
{ 调试函数,用于输出调试文本 }
procedure OutPutText(CH: PChar);
var
FileHandle: TextFile;
FF: Integer;
begin
try
if not FileExists( 'zztestdll.txt ') then
FF := FileCreate( 'zztestdll.txt ');
finally
if FF > 0 then FileClose(FF);
end;
AssignFile(FileHandle, 'zztestdll.txt ');
Append(FileHandle);
Writeln(FileHandle, CH);
Flush(FileHandle);
CloseFile(FileHandle);
end;
{ dll入口和出口处理函数 }
procedure DLLEntryPoint(dwReason: DWORD);
begin
case dwReason of
DLL_PROCESS_ATTACH:
;
DLL_PROCESS_DETACH:
;
DLL_THREAD_ATTACH:
;
DLL_THREAD_DETACH:
;
end;
end;
{ 与SCM管理器通话 }
function TellSCM(dwState: DWORD; dwExitCode: DWORD; dwProgress: DWORD): LongBool;
var SrvStatus: service_status;
begin
SrvStatus.dwServiceType := SERVICE_WIN32_SHARE_PROCESS;
dwCurrState := dwState;
SrvStatus.dwCurrentState := dwState;
SrvStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_PAUSE_CONTINUE or SERVICE_ACCEPT_SHUTDOWN;
SrvStatus.dwWin32ExitCode := dwExitCode;
SrvStatus.dwServiceSpecificExitCode := 0;
SrvStatus.dwCheckPoint := dwProgress;
SrvStatus.dwWaitHint := 3000;
Result := SetServiceStatus(SvcStatsHandle, SrvStatus);
end;
{ Service 控制函数 }
procedure servicehandler(fdwcontrol: Integer); stdcall;
begin
case fdwcontrol of
SERVICE_CONTROL_STOP:
begin
TellSCM(SERVICE_STOP_PENDING, 0, 1);
Sleep(10);
TellSCM(SERVICE_STOPPED, 0, 0);
end;
SERVICE_CONTROL_PAUSE:
begin
TellSCM(SERVICE_PAUSE_PENDING, 0, 1);
TellSCM(SERVICE_PAUSED, 0, 0);
end;
SERVICE_CONTROL_CONTINUE:
begin
TellSCM(SERVICE_CONTINUE_PENDING, 0, 1);
TellSCM(SERVICE_RUNNING, 0, 0);
end;
SERVICE_CONTROL_INTERROGATE:
TellSCM(dwCurrState, 0, 0);
SERVICE_CONTROL_SHUTDOWN:
TellSCM(SERVICE_STOPPED, 0, 0);
end;
end;
{ service main }
procedure ServiceMain(argc: Integer; var argv: PChar); stdcall;
begin
// 注册控制函数
SvcStatsHandle := RegisterServiceCtrlHandler(ServiceName, @servicehandler);
if (SvcStatsHandle = 0) then
begin
OutPutText( 'Error in RegisterServiceCtrlHandler ');
Exit;
end else FreeConsole();
// 启动服务
TellSCM(SERVICE_START_PENDING, 0, 1);
TellSCM(SERVICE_RUNNING, 0, 0);
OutPutText( 'Service is Running ');
// 这里可以执行我们真正要作的代码
while ((dwCurrState <> SERVICE_STOP_PENDING) and (dwCurrState <> SERVICE_STOPPED)) do
begin
Sleep(1000);
end;
OutPutText( 'Service Exit ');
end;
// 导出函数列表
exports
ServiceMain;
{ dll入口点 }
begin
DllProc := @DLLEntryPoint;
end.
以下为一段DELPHI的代码
{ 文件名: ServiceDll.dpr
概述: 替换由svchost.exe启动的某个系统服务,具体服务由全局变量 ServiceName 决定.
经测试,生成的DLL文件运行完全正常.
测试环境: Windows 2003 Server + Delphi 7.0}
library ServiceDll;
uses
SysUtils,
Classes,
winsvc,
System,
Windows;
{ 定义全局变量 }
var
SvcStatsHandle: SERVICE_STATUS_HANDLE; // 服务控制信息句柄
dwCurrState: DWORD; // 存储服务状态
ServiceName: PChar = 'BITS '; // 服务名称
{ 调试函数,用于输出调试文本 }
procedure OutPutText(CH: PChar);
var
FileHandle: TextFile;
FF: Integer;
begin
try
if not FileExists( 'zztestdll.txt ') then
FF := FileCreate( 'zztestdll.txt ');
finally
if FF > 0 then FileClose(FF);
end;
AssignFile(FileHandle, 'zztestdll.txt ');
Append(FileHandle);
Writeln(FileHandle, CH);
Flush(FileHandle);
CloseFile(FileHandle);
end;
{ dll入口和出口处理函数 }
procedure DLLEntryPoint(dwReason: DWORD);
begin
case dwReason of
DLL_PROCESS_ATTACH:
;
DLL_PROCESS_DETACH:
;
DLL_THREAD_ATTACH:
;
DLL_THREAD_DETACH:
;
end;
end;
{ 与SCM管理器通话 }
function TellSCM(dwState: DWORD; dwExitCode: DWORD; dwProgress: DWORD): LongBool;
var SrvStatus: service_status;
begin
SrvStatus.dwServiceType := SERVICE_WIN32_SHARE_PROCESS;
dwCurrState := dwState;
SrvStatus.dwCurrentState := dwState;
SrvStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_PAUSE_CONTINUE or SERVICE_ACCEPT_SHUTDOWN;
SrvStatus.dwWin32ExitCode := dwExitCode;
SrvStatus.dwServiceSpecificExitCode := 0;
SrvStatus.dwCheckPoint := dwProgress;
SrvStatus.dwWaitHint := 3000;
Result := SetServiceStatus(SvcStatsHandle, SrvStatus);
end;
{ Service 控制函数 }
procedure servicehandler(fdwcontrol: Integer); stdcall;
begin
case fdwcontrol of
SERVICE_CONTROL_STOP:
begin
TellSCM(SERVICE_STOP_PENDING, 0, 1);
Sleep(10);
TellSCM(SERVICE_STOPPED, 0, 0);
end;
SERVICE_CONTROL_PAUSE:
begin
TellSCM(SERVICE_PAUSE_PENDING, 0, 1);
TellSCM(SERVICE_PAUSED, 0, 0);
end;
SERVICE_CONTROL_CONTINUE:
begin
TellSCM(SERVICE_CONTINUE_PENDING, 0, 1);
TellSCM(SERVICE_RUNNING, 0, 0);
end;
SERVICE_CONTROL_INTERROGATE:
TellSCM(dwCurrState, 0, 0);
SERVICE_CONTROL_SHUTDOWN:
TellSCM(SERVICE_STOPPED, 0, 0);
end;
end;
{ service main }
procedure ServiceMain(argc: Integer; var argv: PChar); stdcall;
begin
// 注册控制函数
SvcStatsHandle := RegisterServiceCtrlHandler(ServiceName, @servicehandler);
if (SvcStatsHandle = 0) then
begin
OutPutText( 'Error in RegisterServiceCtrlHandler ');
Exit;
end else FreeConsole();
// 启动服务
TellSCM(SERVICE_START_PENDING, 0, 1);
TellSCM(SERVICE_RUNNING, 0, 0);
OutPutText( 'Service is Running ');
// 这里可以执行我们真正要作的代码
while ((dwCurrState <> SERVICE_STOP_PENDING) and (dwCurrState <> SERVICE_STOPPED)) do
begin
Sleep(1000);
end;
OutPutText( 'Service Exit ');
end;
// 导出函数列表
exports
ServiceMain;
{ dll入口点 }
begin
DllProc := @DLLEntryPoint;
end.