注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

BCB-DG's Blog

...

 
 
 

日志

 
 

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

2008-06-16 20:36:26|  分类: Delphi |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
  这个模块的代码在网上流传的是用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.
  评论这张
 
阅读(1258)| 评论(1)
推荐 转载

历史上的今天

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017