delphi完美的线程注入和卸载

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.