dedememdumps.pas

dede 的源代码 3.10b

unit DeDeMemDumps;
{$A+,B-,C+,D+,E-,F-,G+,H+,I+,J+,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}

{$MINSTACKSIZE $00004000}

{$MAXSTACKSIZE $00100000}

{$IMAGEBASE $00400000}

{$APPTYPE GUI}

interface

uses Windows, Classes;


Type MODULEINFO = Record
       lpBaseOfDll : Pointer;
       SizeOfImage : DWORD ;
       EntryPoint : Pointer;
     end;

Type TEnumProcesses = Function (var buffer; cb : DWORD;  var cbNeeded : DWORD): Boolean;  stdcall;
     TEnumProcessModules = Function (hProcess : THandle; var buffer; cb : DWORD; var lpcbNeeded : DWORD) : Boolean; stdcall;
     TGetModuleBaseNameA = Function (hProcess : THandle; hModule : HMODULE; lpFilename : Pointer; nsize : DWORD) : DWORD; stdcall;
     TGetModuleInformation = function (hProcess : THandle; HMODULE : hModule; var lpmodinfo : MODULEINFO; cb : DWORD) : Boolean; stdcall;


Var  EnumProcesses : TEnumProcesses;
     EnumProcessModules : TEnumProcessModules;
     GetModuleBaseNameA : TGetModuleBaseNameA;
     GetModuleInformation : TGetModuleInformation;


var IsWin9x : Boolean;

Type PIMAGE_SECTION_HEADER = ^IMAGE_SECTION_HEADER;
     TSectionArray  = Array [0..64] of IMAGE_SECTION_HEADER;


Procedure EnumSections(hProcess : THandle; PProcessBase : Pointer; Var buffer : TSectionArray ; var Secnum : Cardinal);
Procedure DumpProcess(PID : DWORD; var MemStr : TMemoryStream; var BoC, PoC, ImB : DWORD);

Function MemGetDelphiVersionOfAProcess(PID : Int64) : DWORD;
Function MemGetDelphiVersion(MemStr : TMemoryStream; ImageBase, CodeRVA, CodeSize, HeaderSize : DWORD) : DWORD;
procedure SaveProcessInformation(PID : DWORD; AsFileName : String);

function GetRVAEntryPoint(MemStr : TMemoryStream; IMB, BOC, SOC : DWORD; DelphiVersion : Integer; bShowWarning : Boolean = true) : DWORD;


implementation

uses DeDeClasses, SysUtils, Dialogs, tlhelp32, DeDeSym, HEXTools, DeDeConstants, DeDeRES;

Procedure EnumSections(hProcess : THandle; PProcessBase : Pointer; Var buffer : TSectionArray; var Secnum : Cardinal);
var peHdrOffset : DWORD;
    cBytesMoved : DWORD;
    ntHdr : IMAGE_NT_HEADERS;
    pSection : PIMAGE_SECTION_HEADER;
    section : IMAGE_SECTION_HEADER;
    i : Shortint;
Begin
    // Read in the offset of the PE header
    if ( not ReadProcessMemory(hProcess,
                            Pointer(LongInt(PProcessBase)+$3C),
                            @peHdrOffset,
                            sizeof(peHdrOffset),
                            cBytesMoved)) then exit;

    // Read in the IMAGE_NT_HEADERS.OptionalHeader.BaseOfCode field
    if ( not ReadProcessMemory(hProcess,
                            Pointer(LongInt(PProcessBase) + peHdrOffset),
                            @ntHdr, sizeof(ntHdr), cBytesMoved)) then exit;


    pSection := Pointer(LongInt(PProcessBase)+peHdrOffset+4
                + sizeof(ntHdr.FileHeader)
                + ntHdr.FileHeader.SizeOfOptionalHeader);

    FillChar(section,0,sizeof(section));
    Secnum:=ntHdr.FileHeader.NumberOfSections;
    for i:=1 to ntHdr.FileHeader.NumberOfSections do
      Begin
        if ( not ReadProcessMemory(hProcess,
                                 Pointer(DWORD(pSection)+(i-1)*40),
                                 @section, 40,
                                 cBytesMoved)) then exit;
          buffer[i]:=section;
     End;
end;

procedure LinkPSAPI;
var hMdl : HMODULE;
begin
 If   ((GetVersion and $F0000000)=0)
   or ((GetVersion and $0000000F)=5) Then
    Begin
       hMdl:=LoadLibrary('PSAPI.DLL');
       @EnumProcesses:=GetProcAddress(hMdl,PChar('EnumProcesses'));
       @EnumProcessModules:=GetProcAddress(hMdl,PChar('EnumProcessModules'));
       @GetModuleBaseNameA:=GetProcAddress(hMdl,PChar('GetModuleBaseNameA'));
       @GetModuleInformation:=GetProcAddress(hMdl,PChar('GetModuleInformation'));
    End;
end;


procedure LinkToolHelp32;
var hMdl : HMODULE;
    err  : Cardinal;
    p : Pointer;
begin
 If IsWin9x Then
    Begin
    End;
end;

Function MemGetDelphiVersion(MemStr : TMemoryStream; ImageBase, CodeRVA, CodeSize, HeaderSize : DWORD) : DWORD;
const IDS = 'TControl';
      arrBoolean : Array [0..7] of byte = ($07,$42,$6F,$6F,$6C,$65,$61,$6E);
var b1, b2 : Byte;
    dw, dw1, bkup, Delta, i : DWORD;
    s : String;
    buff : Array of Byte;
    bD2, bClassFound : Boolean;

    function InCODE(DW : DWORD) : boolean;
    begin
     result:=(dw>ImageBase+(CodeRVA)) and (dw<ImageBase+(CodeRVA)+CodeSize)
    end;

begin
  Result:=$FFFE;
  bD2:=False;
  Delta:=ImageBase+CodeRVA-HeaderSize;

  MemStr.Seek(HeaderSize+5,soFromBeginning);
  //MemStr.Seek(HeaderSize+1,soFromBeginning); FOR Delphi 2
  SetLength(buff,9);
  MemStr.ReadBuffer(buff[0],9);
  If Not CompareMem(@buff[0],@arrBoolean[0],8)
    Then begin
      // Check For Delphi 2
      MemStr.Seek(HeaderSize+1,soFromBeginning);
      SetLength(buff,9);
      MemStr.ReadBuffer(buff[0],9);
      If Not CompareMem(@buff[0],@arrBoolean[0],8)
        Then bD2:=False
        Else bD2:=True;
    end;
  if bD2 then Result:=$FFF0
         else Result:=$FFFF;


  MemStr.Seek(HeaderSize,soFromBeginning);
  Repeat
    MemStr.ReadBuffer(dw,4);
    bkup:=MemStr.Position;
    bClassFound:=dw-Delta=MemStr.Position;

    If bClassFound Then
      Begin
        MemStr.ReadBuffer(b1,1);
        if b1<=16 Then
         begin
            //Nasty anti-tirck for nasty dump-hide trick
            if CodeSize=0 then CodeSize:=$7F000000;
            MemStr.ReadBuffer(b2,1);
            SetLength(s,b2);
            MemStr.ReadBuffer(s[1],b2);
            MemStr.ReadBuffer(dw,4);
            If InCODE(dw) then
              begin
               dw1:=dw-Delta;
               MemStr.Seek(dw1-40,soFromBeginning);
               MemStr.ReadBuffer(dw,4);
               If s=IDS then begin
                 Result:=dw;
                 exit;
               end;
              end;
          end;
       end;
       MemStr.seek(bkup,soFromBeginning);
  Until (MemStr.Position>=CodeSize);

{  MemStr.Seek(CodeRVA+5,soFromBeginning);
  SetLength(s,3);
  MemStr.ReadBuffer(s[1],3);

  // Correction for BCB5
  if s='C++' then if dw=$120 then Result:=$121;
}

//  $0    : 'D3';
//  $B4   : 'BCB4'
//  $114  : 'D4';
//  $120  : 'D5';
//  $121  : 'BCB5';
//  $15C, $160 : D6
//  $FFFF : 'Unknown';
//  $FFF0 : 'D2'
end;


Function MemGetDelphiVersionOfAProcess(PID : Int64) : DWORD;
var hProcess : THandle;
    ModuleArr : Array of Cardinal;
    mi : MODULEINFO;
    ntHdr : IMAGE_NT_HEADERS;
    peHdrOffset, SOC, sz : DWORD;
    sections : TSectionArray;
    MemStr : TMemoryStream;
    buff : Array of Byte;
    hSnapShot : THandle;
    lppe : PROCESSENTRY32;
    m : MODULEENTRY32;
Begin
    hProcess:=OpenProcess(PROCESS_ALL_ACCESS,False,PID);
    MemStr:=TMemoryStream.Create;
    mi.lpBaseOfDll:=nil;
    Try
      If IsWin9x Then
        Begin
           hSnapShot:=CreateToolhelp32Snapshot(TH32CS_SNAPALL, PID);
           If hSnapShot<>INVALID_HANDLE_VALUE Then
            Begin
             Fillchar(lppe.szExeFile,259,0);
             m.dwSize:=SizeOf(MODULEENTRY32);
             lppe.dwSize:=SizeOf(PROCESSENTRY32);
             Process32First(hSnapShot,lppe);
             Module32First(hSnapShot,m);

             While Process32Next(hSnapShot,lppe) do
              begin
                Module32Next(hSnapShot,m);
                if lppe.th32ProcessID=PID
                   then begin
                     mi.lpBaseOfDll:=Pointer(m.modBaseAddr);
                     mi.lpBaseOfDll:=Pointer($400000);
                     break;
                   end;
              end;

             CloseHandle(hSnapShot);
            End;

         If mi.lpBaseOfDll=nil Then Exit; 
        End
        Else Begin
          SetLength(ModuleArr,256);
          EnumProcessModules(hProcess,ModuleArr[0],256,sz);
          GetModuleInformation(hProcess,ModuleArr[0],mi,sz);
        End;  

      ReadProcessMemory(hProcess,Pointer(LongInt(mi.lpBaseOfDll)+$3C),@peHdrOffset, sizeof(peHdrOffset),sz);
      ReadProcessMemory(hProcess,Pointer(LongInt(mi.lpBaseOfDll) + peHdrOffset),@ntHdr, sizeof(ntHdr), sz);

      EnumSections(hProcess,mi.lpBaseOfDll,sections,sz);

      // Dump Header
      SetLength(buff,ntHdr.OptionalHeader.SizeOfHeaders);
      ReadProcessMemory(hProcess,mi.lpBaseOfDll,@buff[0],ntHdr.OptionalHeader.SizeOfHeaders,sz);
      MemStr.WriteBuffer(buff[0],ntHdr.OptionalHeader.SizeOfHeaders);
            
      if ntHdr.OptionalHeader.SizeOfCode<sections[1].Misc.VirtualSize
         then SOC:=sections[1].Misc.VirtualSize
         else SOC:=ntHdr.OptionalHeader.SizeOfCode;

      // Dump Code
      SetLength(buff,SOC);
      ReadProcessMemory(hProcess,Pointer(LongInt(mi.lpBaseOfDll)+ntHdr.OptionalHeader.BaseOfCode),@buff[0],SOC,sz);
      MemStr.WriteBuffer(buff[0],SOC);

      Result:=MemGetDelphiVersion(MemStr,ntHdr.OptionalHeader.ImageBase,ntHdr.OptionalHeader.BaseOfCode,ntHdr.OptionalHeader.SizeOfCode,ntHdr.OptionalHeader.SizeOfHeaders);
    Finally
      CloseHandle(hProcess);
      MemStr.Free;
    End
End;

Procedure DumpProcess(PID : DWORD; var MemStr : TMemoryStream; var BoC, PoC, ImB : DWORD);
var hProcess : THandle;
    ModuleArr : Array of Cardinal;
    sz : Cardinal;
    ntHdr : IMAGE_NT_HEADERS;
    mi : MODULEINFO;
    peHdrOffset, SOC : DWORD;
    buff : Array of Byte;
    i : Integer;
    dw, ResPhys : DWORD;
    Objects : Array [1..8] of TPEObject;
    sections : TSectionArray;
    b : array [0..7] of Byte;
    SecNum : Word;
    s : String;
    dw1,{dw2,dw3,dw4,dw5,dw6,dw7,dw8,} PEP : DWORD;
    hSnapShot : THandle;
    lppe : tlhelp32.PROCESSENTRY32;
    m : tlhelp32.tagMODULEENTRY32;
    DVer : Integer;
Begin
    hProcess:=OpenProcess(PROCESS_ALL_ACCESS,False,PID);
    Try
     mi.lpBaseOfDll:=nil;

     if isWin9x then
      begin
       hSnapShot:=CreateToolhelp32Snapshot(TH32CS_SNAPALL, GetCurrentProcessID);
       If hSnapShot<>INVALID_HANDLE_VALUE Then
        Begin
         lppe.dwSize:=sizeof(PROCESSENTRY32);
         Fillchar(lppe.szExeFile,259,0);
         Process32First(hSnapShot,lppe);
         Module32First(hSnapShot,m);

         While Process32Next(hSnapShot,lppe) Do
           Begin
             Module32Next(hSnapShot,m);
             if lppe.th32ProcessID=PID then
                begin
                   mi.lpBaseOfDll:=Pointer(m.modBaseAddr);
                   mi.lpBaseOfDll:=Pointer($400000);
                   Break;
                end;
           end;
        end;
        CloseHandle(hSnapShot);
      end
      else begin
        SetLength(ModuleArr,256);
        EnumProcessModules(hProcess,ModuleArr[0],256,sz);
        GetModuleInformation(hProcess,ModuleArr[0],mi,sz);
      end;

      if mi.lpBaseOfDll=nil Then Raise Exception.Create(err_invalid_process);

      ReadProcessMemory(hProcess,Pointer(LongInt(mi.lpBaseOfDll)+$3C),@peHdrOffset, sizeof(peHdrOffset),sz);
      ReadProcessMemory(hProcess,Pointer(LongInt(mi.lpBaseOfDll) + peHdrOffset),@ntHdr, sizeof(ntHdr), sz);

      EnumSections(hProcess,mi.lpBaseOfDll,sections,sz);
      MemStr.Clear;

      // UPX Check
      s:=StrPas(@sections[1].Name[0]);
      If s='UPX0' Then
         If MessageDlg(wrn_upx,mtWarning,[mbYes,mbNo],0)=idNo Then Exit;

      // NeoLite Check
      s:=StrPas(@sections[sz].Name[0]);
      If s='.neolit' Then
         If MessageDlg(wrn_neolit,mtWarning,[mbYes,mbNo],0)=idNo Then Exit;

      // Dump Header
      SetLength(buff,ntHdr.OptionalHeader.SizeOfHeaders);
      ReadProcessMemory(hProcess,mi.lpBaseOfDll,@buff[0],ntHdr.OptionalHeader.SizeOfHeaders,sz);
      MemStr.WriteBuffer(buff[0],ntHdr.OptionalHeader.SizeOfHeaders);

      if ntHdr.OptionalHeader.SizeOfCode<sections[1].Misc.VirtualSize
         then SOC:=sections[1].Misc.VirtualSize
         else SOC:=ntHdr.OptionalHeader.SizeOfCode;

      // Dump Code
      SetLength(buff,SOC);
      ReadProcessMemory(hProcess,Pointer(LongInt(mi.lpBaseOfDll)+ntHdr.OptionalHeader.BaseOfCode),@buff[0],SOC,sz);
      MemStr.WriteBuffer(buff[0],SOC);

      // Finds The Program Entry Point
      dw1:=MemGetDelphiVersion(MemStr,ntHdr.OptionalHeader.ImageBase,ntHdr.OptionalHeader.BaseOfCode,ntHdr.OptionalHeader.SizeOfCode,ntHdr.OptionalHeader.SizeOfHeaders);
      Case dw1 of
        $FFF0 : DVer:=2;
           0  : DVer:=3;
        $114  : DVer:=4;
        $120  : DVer:=5;
        $15C  : DVer:=6;
      end;
      dw1:=GetRVAEntryPoint(MemStr,$400000,0,0,DVer,false);
      PEP:=dw1+ntHdr.OptionalHeader.BaseOfCode-ntHdr.OptionalHeader.SizeOfHeaders;

      MemStr.Seek(0,soFromEnd);
      // Dump Resources
      SetLength(buff,ntHdr.OptionalHeader.DataDirectory[2].Size);
      ReadProcessMemory(hProcess,Pointer(LongInt(mi.lpBaseOfDll)+ntHdr.OptionalHeader.DataDirectory[2].VirtualAddress),@buff[0],ntHdr.OptionalHeader.DataDirectory[2].Size,sz);
      ResPhys:=MemStr.Size;
      MemStr.WriteBuffer(buff[0],ntHdr.OptionalHeader.DataDirectory[2].Size);


      // Correct PEHeader

      // CODE Section Data
      Objects[1].RVA:=ntHdr.OptionalHeader.BaseOfCode;
      Objects[1].VIRTUAL_SIZE:=SOC;
      Objects[1].PHYSICAL_SIZE:=SOC;
      Objects[1].PHYSICAL_OFFSET:=ntHdr.OptionalHeader.SizeOfHeaders;

      //Return the base of code and physical offset for for corrections
      BoC:=Objects[1].RVA;
      PoC:=Objects[1].PHYSICAL_OFFSET;
      ImB:=ntHdr.OptionalHeader.ImageBase;

      // .idata Section Data (No Import references with packed executables)