用Delphi编写一个Svchost.exe调用的DLL模块
2011-01-12 15:49
155 查看
文件名: ServiceDll.dpr
概述: 替换由svchost.exe启动的某个系统服务,具体服务由全局变量 ServiceName 决定.
经测试,生成的DLL文件运行完全正常.
测试环境: Windows 2003 Server + Delphi 7.0
作者: 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.
概述: 替换由svchost.exe启动的某个系统服务,具体服务由全局变量 ServiceName 决定.
经测试,生成的DLL文件运行完全正常.
测试环境: Windows 2003 Server + Delphi 7.0
作者: 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.
相关文章推荐
- 用Delphi编写一个Svchost.exe调用的DLL模块
- 用Delphi编写一个Svchost.exe调用的DLL模块
- 用Delphi编写一个Svchost.exe调用的DLL模块
- VS2013编写一个DLL,并创建EXE对DLL进行调用
- 请教一个关于WEBFORM 调用外部EXE程序的问题
- Delphi 调用 C# Dll 时一个编译问题 mscorlib_TLB.h Ambiguity between 'String' and 'System::String'
- 用Delphi编写的一个上网助手
- Silverlight实用窍门系列:22.Silverlight使用WebService调用C++,Delphi编写的DLL文件【实例源码下载】
- 用程序判断一个QQ号码是否在线、是否存在(delphi调用webService)
- JS调用Delphi编写的OCX控件
- Delphi 编写 DLL 返回字符串,.net 调用。
- Delphi中高级DLL的编写和调用
- VB调用Delphi编写的DLL - 2
- 创建SvcHost.exe调用的服务原理与实践
- ubuntu下使用eclipse调用libpcap库编写一个小程序时出的错误:pcap.h没有参与编译
- C# 如何调用 Delphi 编写的 DLL 方法
- 编写一个函数,此函数使用动态存储分配来产生一个字符串的副本。例如函数为strclone,则调用p=strclone(str),将会为一个新的字符串分配和str占内存大小相同的一个字符串,并将字符串st
- Delphi WebService 的编写、调试、发布(IIS)、调用
- Delphi中高级DLL的编写和调用技巧
- 需要这样一个记录本-3 Delphi调用Windows自带图片查看器