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

 这个模块的代码在网上流传的是用C写的,这里用Delphi写的一个DLL,可以自己扩充各种功能.

　　{
　　 文件名: ServiceDll.dpr
　　 概述: 替换由svchost.exe启动的某个系统服务,具体服务由全局变量 ServiceName 决定.
　　
　　 经测试,生成的DLL文件运行完全正常.
　　 测试环境: Windows 2003 Server + Delphi 7.0
　　
　　 代码只实现了一个框架,没有任何实际动作,仅作为学习用.如果你使用本代码
　　 进行了任何扩充和修改,希望您能将代码寄一份给我.
　　
　　 日期: 2005-04-01
　　 作者: yanxizhen yanxizhen#163.com
　　}
　　
　　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.