本文整理自网络，侵删。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
function GetExplorId:Cardinal;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
AsmBuf:Array [0..20] of Byte = ($B8,$00,$00,$00,$00,$68,$00,$00,$00,$00,$FF,$D0,$B8,$00,$00,$00,00,$6A,$00,$FF,$D0);
function EnabledDebugPrivilege(const bEnabled: Boolean):Boolean;
var
hToken: THandle;
tp: TOKEN_PRIVILEGES;
a: DWORD;
const
SE_DEBUG_NAME = 'SeDebugPrivilege';
begin
Result:=False;
if (OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES, hToken)) then
begin
tp.PrivilegeCount :=1;
LookupPrivilegeValue(nil,SE_DEBUG_NAME ,tp.Privileges[0].Luid);
if bEnabled then
tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
else
tp.Privileges[0].Attributes := 0;
a:=0;
AdjustTokenPrivileges(hToken,False,tp,SizeOf(tp),nil,a);
Result:= GetLastError = ERROR_SUCCESS;
CloseHandle(hToken);
end;
end;
function InjectDll(pid:cardinal;Dll:string):Cardinal;
var
hProc:Cardinal;
wDllPath:PwideChar;
pRemote:Pointer;
cbSize:cardinal;
TempVar:Cardinal;
begin
result:=0;
if pid=0 then exit;
EnabledDebugPrivilege(true);
cbSize:= length(Dll)*2+21;
GetMem(wDllPath,cbSize);
StringToWideChar(Dll,wDllPath,cbSize);
hProc:=OpenProcess(PROCESS_ALL_ACCESS,false,pid);
try
pRemote:=VirtualAllocEx( hProc, nil, cbSize, MEM_COMMIT, PAGE_READWRITE);
if WriteProcessMemory(hProc,pRemote, wDllPath, cbSize, TempVar) then
begin
TempVar:=0;
Result := CreateRemoteThread(hProc, nil, 0,
GetProcAddress(GetModuleHandle('Kernel32'),
'LoadLibraryW'), pRemote, 0, TempVar);
end;
finally
CloseHandle(hProc);
FreeMem(wDllPath);
end;
end;
function EjectDll(pid:cardinal;Dll:string):Cardinal;
type
PDebugModule = ^TDebugModule;
TDebugModule = packed record
Reserved: array [0..1] of Cardinal;
Base: Cardinal;
Size: Cardinal;
Flags: Cardinal;
Index: Word;
Unknown: Word;
LoadCount: Word;
ModuleNameOffset: Word;
ImageName: array [0..$FF] of Char;
end;
type
PDebugModuleInformation = ^TDebugModuleInformation;
TDebugModuleInformation = record
Count: Cardinal;
Modules: array [0..0] of TDebugModule;
end;
type
PDebugBuffer = ^TDebugBuffer;
TDebugBuffer = record
SectionHandle: THandle;
SectionBase: Pointer;
RemoteSectionBase: Pointer;
SectionBaseDelta: Cardinal;
EventPairHandle: THandle;
Unknown: array [0..1] of Cardinal;
RemoteThreadHandle: THandle;
InfoClassMask: Cardinal;
SizeOfInfo: Cardinal;
AllocatedSize: Cardinal;
SectionSize: Cardinal;
ModuleInformation: PDebugModuleInformation;
BackTraceInformation: Pointer;
HeapInformation: Pointer;
LockInformation: Pointer;
Reserved: array [0..7] of Pointer;
end;
const
PDI_MODULES = $01;
ntdll = 'ntdll.dll';
var
HNtDll: HMODULE;
type
TFNRtlCreateQueryDebugBuffer = function(Size: Cardinal;EventPair: Boolean): PDebugBuffer;stdcall;
TFNRtlQueryProcessDebugInformation = function(ProcessId,
DebugInfoClassMask: Cardinal; var DebugBuffer: TDebugBuffer): Integer;stdcall;
TFNRtlDestroyQueryDebugBuffer = function(DebugBuffer: PDebugBuffer): Integer;stdcall;
var
RtlCreateQueryDebugBuffer: TFNRtlCreateQueryDebugBuffer;
RtlQueryProcessDebugInformation: TFNRtlQueryProcessDebugInformation;
RtlDestroyQueryDebugBuffer: TFNRtlDestroyQueryDebugBuffer;
function LoadRtlQueryDebug: LongBool;
begin
HNtDll := LoadLibrary(ntdll);
if HNtDll <> 0 then
begin
RtlCreateQueryDebugBuffer := GetProcAddress(HNtDll, 'RtlCreateQueryDebugBuffer');
RtlQueryProcessDebugInformation := GetProcAddress(HNtDll, 'RtlQueryProcessDebugInformation');
RtlDestroyQueryDebugBuffer := GetProcAddress(HNtDll, 'RtlDestroyQueryDebugBuffer');
end;
Result := Assigned(RtlCreateQueryDebugBuffer) and
Assigned(RtlQueryProcessDebugInformation) and
Assigned(RtlQueryProcessDebugInformation);
end;
function ReleaseRtlQueryDebug: LongBool;
begin
result:=FreeLibrary(HNtDll);
end;
var
hProc:Cardinal;
hMod:cardinal;
TempVar:Cardinal;
DbgBuffer: PDebugBuffer;
i,j:integer;
pd:PDWORD;
pRemoteFunc:pointer;
begin
result:=0;
if pid=0 then exit;
EnabledDebugPrivilege(true);
LoadRtlQueryDebug;
DbgBuffer := RtlCreateQueryDebugBuffer(0, False);
if Assigned(DbgBuffer) then
try
if RtlQueryProcessDebugInformation(pid, PDI_MODULES, DbgBuffer^) >= 0 then
for i:=0 to DbgBuffer.ModuleInformation.Count-1 do
if UpperCase(DbgBuffer.ModuleInformation.Modules[i].ImageName)=
UpperCase(Dll) then
begin
hMod:=DbgBuffer.ModuleInformation.Modules[i].Base;
j:=DbgBuffer.ModuleInformation.Modules[i].LoadCount;
Break;
end;
finally
RtlDestroyQueryDebugBuffer(DbgBuffer);
ReleaseRtlQueryDebug;
end;
hProc:=OpenProcess(PROCESS_ALL_ACCESS,false,pid);
try
TempVar:=DWORD(GetProcAddress(GetModuleHandle('Kernel32'),'FreeLibrary'));
pd:=@AsmBuf[1];
pd^:=TempVar;
pd:=@AsmBuf[6];
pd^:=hMod;
TempVar:=DWORD(GetProcAddress(GetModuleHandle('Kernel32'),'ExitThread'));
pd:=@AsmBuf[13];
pd^:=TempVar;
pRemoteFunc:=VirtualAllocEx( hProc, nil, 21, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
if WriteProcessMemory(hProc, pRemoteFunc, @AsmBuf[0], 21, TempVar) then
for i:=0 to j-1 do
begin
TempVar:=0;
Result := CreateRemoteThread(hProc, nil, 0, pRemoteFunc, nil, 0, TempVar);
end;
finally
CloseHandle(hProc);
end;
end;
function TForm1.GetExplorId:Cardinal;
begin
GetWindowThreadProcessId(GetWindow(Handle,GW_HWNDLAST),@result);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
InjectDll(GetExplorId,'c:\ExHook.Dll');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
EjectDll(GetExplorId,'c:\ExHook.Dll');
end;
end.
相关阅读 >>
Delphi2010读取mysql数据库text类型乱码的解决方案
Delphi 如何使用sendmessage发送后台组合键消息(ctrl+xxx)
Delphi ioutils 单元(6): tpath(结构体)路径的提取和处理
Delphi api �c multibytetowidechar的用法
更多相关阅读请进入《Delphi》频道 >>
