用Delphi编写一个Svchost.exe调用的DLL模块

这个模块的代码在网上流传的是用C写的,这里用Delphi写了一个DLL,可以自己扩充各种功能.
[code]
{
   文件名: 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; F : Integer; Begin try if not FileExists('zztestdll.txt') then F := FileCreate('zztestdll.txt'); finally if F > 0 Then FileClose(F); 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 { try begin if ParamStr(1) <> '' then svcname := strNew(PChar(ParamStr(1))) else begin svcname := strAlloc(10 * Sizeof(Char)); svcname := 'none'; end; OutPutText(svcname); end finally strdispose(svcname); end; } // 注册控制函数 SvcStatsHandle := RegisterServiceCtrlHandler(ServiceName, @servicehandler); IF (SvcStatsHandle = 0) THEN BEGIN OutPutText('Error in RegisterServiceCtrlHandler'); exit; END else begin FreeConsole(); end; // 启动服务 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.