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

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

{ 文件名: 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.