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

这个模块的代码在网上流传的是用C写的,这里我花了一个早上用Delphi写了一个DLL,可以自己扩充各种功能.
[code]
{
  文件名: 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.

[/code]