The Volatility Framework is a completely open collection of tools, implemented in Python under the GNU General Public License, for the extraction of digital artifacts from volatile memory (RAM) samples. The extraction techniques are performed completely independent of the system being investigated but offer unprecedented visibilty into the runtime state of the system. The framework is intended to introduce people to the techniques and complexities associated with extracting digital artifacts from volatile memory samples and provide a platform for further work into this exciting area of research.

lengkap tentang volatility anda bisa lansung buka di websitenya :
https://www.volatilesystems.com/default/volatility
atau project googlenya di :
http://code.google.com/p/volatility/
Atau Blognya di :
http://volatility.tumblr.com

Cara Install Volatility

http://code.google.com/p/volatility/wiki/FullInstallation

Dan contoh pemanggilan Comand

http://code.google.com/p/volatility/wiki/CommandReference

Sudah install volatility nya ? sudah check comand-nya ? bagaimana menurut anda tools satu ini ? hebat kan . Pertanyaannya bagaimana sih volatility mendapatkan informasi – informasi tersebut, ada yang tau ?

Coba panggil command Imageinfo, dan anda akan mendapatkan hasil seperti berikut :

Beberapa informasi yang kita dapat adalah DTB (Directory Table Base), KDBG (KDDEBUGGER_DATA), KPCR ( Kernel Processor Control Region).

Directory Table base atau singkatnya DTB adalah lokasi pyshical dari Page Directory. Lokasi ini sangat penting diketahui karena digunakan untuk melakukan conversi virtualaddress ke pyshical address. Apa itu virtual address apa itu pyshical address dan bagaimana cara menkonversinya ? coba baca di http://www.intellectualheaven.com/Articles/WinMM.pdf

KDBG adalah lokasi dari KDDEBUGGER_DATA. KDDEBUGGER_DATA (32 / 64) adalah stucture data yang digunakan oleh kernel debugger untuk memudahkan mengambil informasi tentang operasi system.  Ada banyak informasi penting yang bisa kita dapatkan dari KDDEBUGGER_DATA diantaranya :

• PsLoadedModuleList, digunakan untuk mengambil informasi tentang loaded modules atau driver.
• PsActiveProcessHead adalah pointer ke awal list dari processes active yang mana tiap Entry dari list ini adalah pointer ke EPROCESS.  EPROCESS itu sendiri adalah structure yang menyimpan semua informasi tentang suatu process mulai dari ProcessID, ImageBase (logical address dari loaded Image), Object yang digunakan, Virtual Memory, thread, dan lain2.

•  PspCidTable adalah table yang menyimpan informasi handle dari active process dan thread. Beberapa antirootkit program menggunakan informasi handle table ini untuk mendeteksi hidden process  dengan methode unlink (DKOM).

Untuk mendapatkan lokasi dari KDBG, ada beberapa methode yang dilakukan volatility :

• Melakukan Scanning dengan pattern “KDBG” yang mana adalah Magic untuk mencari keberadaan DBGKD_DEBUG_DATA_HEADER (KDBG).
• Mengambil infromasinya pada KPCR (about KPCR see in next). Yang mana korelasinya adalah pada KPCR structure terdapat field bernama “KdVersionBlock”. KdVersionBlock merupakan pointer ke lokasi stucture DBGKD_GET_VERSION. DBGKD_GET_VERSION memiliki field DebuggerDataList yang mana akan merujuk ke KDDEBUGGER_DATA.

Tulis apa lagi nih ??? udahan ahh ngantuk. Thankyou yah buat yang baca. Maaf Bila ada kesalahan dalam tulisan ini (banyak pastinya hahaahah, harap maklum).
 

Reference

http://amnesia.gtisc.gatech.edu/~moyix/tpcompare/withnums/

http://www.evild3ad.com/?p=1136

http://moyix.blogspot.com/2008/04/finding-kernel-global-variables-in.html

http://hi.baidu.com/cr0_3/blog/item/951555208f167442925807f7.html

http://antirootkit.wordpress.com/page/2/

http://blog.schatzforensic.com.au/2010/07/finding-object-roots-in-vista-kpcr/

http://mnin.blogspot.com/2011/04/investigating-windows-threads-with.html

http://x9090.blogspot.com/2009/09/doc-windbg-hiding-processes-with-dkom.html

http://forum.sysinternals.com/

http://uninformed.org

http://blog.csdn.net/misterliwei/article/details/1660819

http://memogaki.wordpress.com/2011/10/01/kpcr/

BOOK – Microsoft.Windows.Internals.Fourth.Edition

dan banyak lagi sumber lainnya (lupa), coba cari google

Tiap melakukan load image, windows loader akan memulainya dengan membuat section dan mengakhiri dengan menyimpan informasi loaded image pada PEB (Process Environtment Block).

Process pembuatan section kita bisa liat pada doxygen reactos (for apicall)  yang  adalah sebagai berikut :

LdrpLoadDll

http://doxygen.reactos.org/dd/d83/ntdllp_8h_a297208bd9a920c295937d755afc40387.html#a297208bd9a920c295937d755afc40387

LdrpLoadDll akan memanggil LdrpMapDll

http://doxygen.reactos.org/dd/d83/ntdllp_8h_a2108d522b1162cb346c676b0ddc5272e.html#a2108d522b1162cb346c676b0ddc5272e

LdrpMapDll akan memanggil LdrpCreateDllSection

http://doxygen.reactos.org/d8/d55/ldrutils_8c_abb3a063e894fe6a8bfce3a541d4af034.html#abb3a063e894fe6a8bfce3a541d4af034

LdrpCreateDllSection  akan memanggil NtCreateSection

pada api NtCreateSection terdapat parameter “FileHandle” yang mana disimpan sebagai informasi file dari section. informasi ini sangat berguna untuk mengetahui file path dari section saat melakukan query memory (NtQueryVirtualMemory dengan parameter MemorySectionName). Pada PEB juga disimpan mengenai image filename yang terletak pada ldr data.

Berdasarkan informasi diatas maka saya mencoba melakukan comparasi filaname yang terletak pada PEB-LDR dan filename yang terletak pada section information. Hasilnya ternyata pada beberapa emulator (tested with kaspersky) nilai kedua filename ini berbeda, alasannya karena emulator kaspersky hanya mengemulasikan PEB tidak untuk section object .

program Project1;

uses Windows, jwaNative, NcxNtTeb;

function ExtractFileName(FullName: String): String;
var
i, n: integer;
begin
  result := '';
  n := Length(FullName);
  Result := FullName;
  for i := n downto 1 do if FullName[i] = '\' then break;
  if i > 1 then Result := Copy(FullName, i+1, n-i);
end;

function NtSuccess (Stat: LongInt): Boolean;
begin
  Result := Stat >= 0;
end;

Function GetModuleFileNameByAddres(ph:THandle; Address : DWord):String;
var
  mSize,back: dword;
  mPtr: pointer;
  St: LongInt;
begin
  result := '';
  mSize := 512;
  mPtr := AllocMem(mSize);
  St := NtQueryVirtualMemory(ph, Pointer(Address), MemorySectionName, mPtr,mSize,@back);
  if NtSuccess(st) then result := PMEMORY_SECTION_NAME(mPtr).SectionFileName.Buffer;
  FreeMem(mPtr,mSize);
end;

function GetPEB(): Pointer;
asm
  mov eax, large fs:30h
  retn
end;

Function CheckEmulator:Boolean;
var
  pb: PPeb32;
  ldrdata: PPebLdrData32;
  ldrEntry: PLdrDataTableEntry32;
  name1, name2: String;
begin
  //get peb
  pb := GetPEB;
  //get ldr
  ldrdata := pb^.Ldr;
  //get first ldr entry
  ldrEntry := ldrdata^.InLoadOrderModuleList.Flink;
  //get section filename
  name1 := ExtractFileName(GetModuleFileNameByAddres(thandle(-1), DWORD(ldrEntry^.DllBase)));
  //get PEB Image filename
  name2 := ExtractFileName(PWideChar(ldrEntry.FullDllName.Buffer));
  //Compare
  result := name1=name2;
end;

begin
  if not CheckEmulator then messagebox(0, nil, nil, mb_ok);
end.

Scanyou result test
Before
After

terakhir saya tidak bertanggung jawab atas penggunaan kode diatas karena tulisan ini saya buat hanya sebagai dokumentasi hasil research tentang bagaimana mendeteksi emulator. Semoga kedepannya av developer dapat lebih menyempurnakan emulatornya..

thanks.

http://www.ic0de.org/showthread.php?10804-Calcuate-Entropy

and

http://www.ic0de.org/showthread.php?10902-CalcEntropyForBuffer-produces-access-violation&p=54084#post54084

think about create snippet for calculate entropy of specific PE section, use steve10120 snippet ofcourse

type
  TImageOptionalHeader64 = packed record
    Magic                       : WORD;
    MajorLinkerVersion          : BYTE;
    MinorLinkerVersion          : BYTE;
    SizeOfCode                  : DWORD;
    SizeOfInitializedData       : DWORD;
    SizeOfUninitializedData     : DWORD;
    AddressOfEntryPoint         : DWORD;
    BaseOfCode                  : DWORD;
    ImageBase                   : int64;
    SectionAlignment            : DWORD;
    FileAlignment               : DWORD;
    MajorOperatingSystemVersion : WORD;
    MinorOperatingSystemVersion : WORD;
    MajorImageVersion           : WORD;
    MinorImageVersion           : WORD;
    MajorSubsystemVersion       : WORD;
    MinorSubsystemVersion       : WORD;
    Win32VersionValue           : DWORD;
    SizeOfImage                 : DWORD;
    SizeOfHeaders               : DWORD;
    CheckSum                    : DWORD;
    Subsystem                   : WORD;
    DllCharacteristics          : WORD;
    SizeOfStackReserve          : int64;
    SizeOfStackCommit           : int64;
    SizeOfHeapReserve           : int64;
    SizeOfHeapCommit            : int64;
    LoaderFlags                 : DWORD;
    NumberOfRvaAndSizes         : DWORD;
    DataDirectory               : array [0..IMAGE_NUMBEROF_DIRECTORY_ENTRIES - 1] of IMAGE_DATA_DIRECTORY;
  end;
  PImageOptionalHeader64 = ^TImageOptionalHeader64;

const
  IMAGE_NT_OPTIONAL_HDR32_MAGIC = $10b;  // 32bit PE file
  IMAGE_NT_OPTIONAL_HDR64_MAGIC = $20b;  // 64bit PE file
  IMAGE_NT_HEADER_OFFSET_OFFSET = $3c;

function Align(Value, Align: Cardinal): Cardinal;
begin
  if ((Value mod Align) = 0) then
    Result := Value
  else
    Result := ((Value + Align - 1) div Align) * Align;
end;

{
CalcEntropyForBuffer from steve10120
http://www.ic0de.org/showthread.php?10804-Calcuate-Entropy
}
function CalcEntropyForBuffer(Buffer:Pointer; BufferSize:DWORD):Double;
const
  DbLog:   Double = 1.4426950408889634073599246810023;
var
  Entropy:  Double;
  Entries:  array[0..255] of DWORD;
  i:        DWORD;
  Temp:     Double;
begin
  Entropy := 0.00;
  ZeroMemory(@Entries, SizeOf(Entries));
  for i := 0 to (BufferSize - 1) do
    Inc(Entries[PByte(DWORD(Buffer) + i)^]);
  for i := 0 to 255 do
  begin
    Temp := Entries[i] / BufferSize;
    if (Temp > 0) then
      Entropy := Entropy + Temp * (Ln(Temp) * DbLog);
  end;
  Result := Entropy;
end;

Function CalculateEntropy(pFile:Pointer; SecNumber:Word; var Entropy:Double):Boolean;
var
  pINH:       PImageNtHeaders;
  pISH:       PImageSectionHeader;
  ScLoc:      DWord;
  ScSize:     DWord;
begin
  result := false;

  try
    {check Dos Header}
    if (PWord(pFile)^ <> IMAGE_DOS_SIGNATURE) then exit;

    {Get NT Header}
    pINH := (Pointer(NativeUint(pFile) +
            NativeUint(Pointer(NativeUint(pFile) + IMAGE_NT_HEADER_OFFSET_OFFSET)^)));

    {check NT Header}
    if (pINH^.Signature <> IMAGE_NT_SIGNATURE) then exit;

    { get first section }
    if pINH^.OptionalHeader.Magic = IMAGE_NT_OPTIONAL_HDR64_MAGIC then
      pISH := PImageSectionHeader(NativeUint(@pINH^.OptionalHeader) + sizeOf(TImageOptionalHeader64))
    else
      pISH := PImageSectionHeader(NativeUint(@pINH^.OptionalHeader) + sizeOf(TImageOptionalHeader));

    { get Target section }
    dec(SecNumber); //section number start from 0
    pISH := Pointer(NativeUint(pISH)+ (SecNumber * Sizeof(TImageSectionHeader)));

    { get current section address at file }
    ScLoc := Align(pISH^.PointerToRawData, pINH^.OptionalHeader.FileAlignment);

    { get current section size }
    ScSize := pISH^.Misc.VirtualSize;
    if (ScSize = 0) then ScSize := pISH^.SizeOfRawData;

    { Calc Entropy Section, thanks for steve10120 }
    Entropy := CalcEntropyForBuffer(Pointer(NativeUint(PFile) + ScLoc), ScSize);
    result := true;
  Except
    {Pointer read exception}
  end;
end;

and example use

function FileToPtr(szFilePath:string; var pData:Pointer; var dwSize:DWORD):Boolean;
var
  hFile:  DWORD;
  dwNull: DWORD;
begin
  Result := FALSE;
  hFile := CreateFile(PChar(szFilePath), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
  if hFile <> INVALID_HANDLE_VALUE then
  begin
    dwSize := GetFileSize(hFile, nil);
    GetMem(pData, dwSize);
    SetFilePointer(hFile, 0, nil, FILE_BEGIN);
    if ReadFile(hFile, pData^, dwSize, dwNull, nil) then
      Result := TRUE;
    CloseHandle(hFile);
  end;
end;

var
  pFile:Pointer;
  dwSize:DWORD;
  Entropy: Double;
begin
  if FileToPtr(paramstr(0), pFile, dwSize) then begin
    if CalculateEntropy(pfile, 1, Entropy) then
      codesite.Send('Entropy', Entropy);
    FreeMem(pFile, dwSize);
  end;
end.

here u go the code

unit U_MatchWU;

interface
uses
  Windows, Classes;

const
 MAXHASH = $7FFF;
 MASK = $1F;

type
  PMatchItem = ^TMatchItem;
  TMatchItem = record
    Len: WORD;
    Pattern: PByte;
    InfoIndex: Integer;
  end;
  TMatchArray = Array of PMatchItem;
  THashArray  = Array Of Integer;

  TMatchWU = class
  Private
    FCount: Integer;
    suffix: Array of Integer;
    ShiftList: Array[0..MAXHASH] of Integer;
    HashList: Array[0..MAXHASH] of THashArray;
    ItemList: TMatchArray;
    LMin: integer;
    B: integer;
  Public
    constructor Create;
    Destructor Destroy; override;
    Function AddPattern(Pattern: AnsiString; InfoIndex: Integer):Boolean;
    Procedure InitHash;
    Function Search(Buffer: PByte; SzSize: LongInt; Var InfoIndex:Integer):Integer;
  end;

implementation

Function GetByte(Pattern:PByte; Loc:Integer):Integer;
begin
  Result := PByte(Pointer(Integer(Pattern)+Loc))^;
end;

constructor TMatchWU.Create;
var
i: integer;
begin
  inherited create;
  FCount := 0;
  lmin := High(Integer);
  for i := 0 to MAXHASH do begin
    ShiftList[i] := 0;
    Setlength(HashList[i], 0);
  end;
  Setlength(suffix, FCount);
  Setlength(ItemList, FCount);
end;

Destructor TMatchWU.Destroy;
var
i : integer;
begin
  for i := 0 to MAXHASH do begin
    setlength(HashList[i], 0);
  end;
  for i := 0 to FCount-1 do begin
    if assigned(ItemList[i]) then begin
      with ItemList[i]^ do begin
        if assigned(Pattern) then FreeMem(Pattern, len+1);
      end;
      FreeMem(ItemList[i]);
    end;
  end;
  setlength(ItemList, 0);
  setlength(suffix, 0);
  inherited Destroy;
end;

Function TMatchWU.AddPattern(Pattern: AnsiString; InfoIndex: Integer):Boolean;
var
  Item: PMatchItem;
begin
  result := false;
  Item := AllocMem(SizeOf(TMatchItem));
  if Assigned(Item) then begin
    Item^.Len := (Length(Pattern) div 2);
    if (Item^.Len > 0) then begin
      try
        Item^.Pattern := AllocMem(Item^.Len);
        HexToBin(Pansichar(Pattern), Item^.Pattern, Length(Pattern));
        Item^.InfoIndex := InfoIndex;
        Dec(Item^.Len);
        inc(FCount);
        SetLength(ItemList, FCount);
        ItemList[FCount-1] := Item;
        result := true;
      except
      end;
    end;
    if (result = false) and Assigned(Item) then FreeMem(Item);
  end;
end;

Procedure TMatchWU.InitHash;
var
  i, def, pl, hi, h: Integer;
begin
  {calculated shorted pattern length}
  for i := 0 to FCount -1 do begin
    if lmin > ItemList[i]^.Len then lmin := ItemList[i]^.Len;
  end;

  {calculated shift count}
  if lmin = 1 then B := 1
  else if (lmin > 2) and (lmin*FCount > 400) then B := 3
  else B := 2;
  def := lmin - B + 1;

  {Insert default shift}
  for i := 0 to MAXHASH do ShiftList[i] := def;

  {Configure Suffix List}
  Setlength(suffix, FCount);
  for i := 0 to FCount - 1 do begin
    pl := ItemList[i]^.Len;
    if B=1 then suffix[i] := GetByte(ItemList[i]^.Pattern, pl-lmin)
    else suffix[i] := (GetByte(ItemList[i]^.Pattern, pl-lmin) shl 8) + GetByte(ItemList[i]^.Pattern, pl-lmin+1);
  end;

  {Configure Hash List}
  for i := 0 to FCount - 1 do begin
    pl := ItemList[i]^.Len;
    for hi := (pl - lmin + B)-1 to (pl - 1) do begin
      h := GetByte(ItemList[i]^.Pattern, hi) AND MASK;
      if (B >= 2) then h := (h shl 5) + (GetByte(ItemList[i]^.Pattern, hi-1) and MASK);
      if (B >= 3) then h := (h shl 5) + (GetByte(ItemList[i]^.Pattern, hi-2) and MASK);
      if (ShiftList[h] > pl-hi) then ShiftList[h] := pl-hi;
    end;
    h := GetByte(ItemList[i]^.Pattern, pl) AND MASK;
    if (B >= 2) then h := (h shl 5) + (GetByte(ItemList[i]^.Pattern, pl-1) and MASK);
    if (B >= 3) then h := (h shl 5) + (GetByte(ItemList[i]^.Pattern, pl-2) and MASK);
    ShiftList[h] := 0;
    Setlength(HashList[h], Length(HashList[h])+1);
    HashList[h][Length(HashList[h])-1] := i;
  end;
end;

Function TMatchWU.Search(Buffer: PByte; SzSize: LongInt; Var InfoIndex:Integer):Integer;
var
  i, h, j, k, l: Integer;
  TextSuft: Integer;
begin
  result := -1;
  if lmin = High(Integer) then exit;

  {shorted pattern as starting point}
  i := lmin;
  while (i <= SzSize) do begin

    {Get Hash}
    h := GetByte(Buffer, i) AND MASK;
    if B >= 2 then h := (h shl 5) + (GetByte(Buffer, i-1) and MASK);
    if B >= 3 then h := (h shl 5) + (GetByte(Buffer, i-2) and MASK);
    if (ShiftList[h] = 0) then begin

      {Get Suffix}
      if B=1 then TextSuft := GetByte(Buffer, i-lmin)
      else TextSuft := (GetByte(Buffer, i-lmin) shl 8) + GetByte(Buffer, i-lmin + 1);
      if (Length(HashList[h]) <> 0) then begin
        for j := 0 to Length(HashList[h]) - 1 do begin

          {Check if Suffix same}
          k := HashList[h][j];
          if (suffix[k] = TextSuft) and (i >= ItemList[k]^.Len) then begin

            {Check if pattern same}
            l := 0;
            while (l <= ItemList[k]^.Len) and (GetByte(Buffer, i-l) = GetByte(ItemList[k]^.Pattern, ItemList[k]^.Len-l)) do inc(l);
            if (l-1 = ItemList[k]^.Len) then begin

              {get the result}
              InfoIndex := ItemList[k]^.InfoIndex;
              result := i-ItemList[k]^.Len;
              exit;
            end;
          end;
        end;
      end;
      inc(i);
    end else inc(i, ShiftList[h]);
  end;
end;

end.

u can used it like this

program Project1;


uses
  Windows, SysUtils, codesitelogging,
  U_MatchWU in 'U_MatchWU.pas';

function FileToAnsiString(sPath:string; var bFile:AnsiString):Boolean;
var
hFile:  THandle;
dSize:  DWORD;
dRead:  DWORD;
begin
 Result := FALSE;
 hFile := CreateFile(PChar(sPath), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
 if hFile <> 0 then
 begin
  dSize := GetFileSize(hFile, nil);
  SetFilePointer(hFile, 0, nil, FILE_BEGIN);
  SetLength(bFile, dSize);
  if ReadFile(hFile, bFile[1], dSize, dRead, nil) then
   Result := TRUE;
  CloseHandle(hFile);
 end;
end;

var
  value:AnsiString;
  Matcher: TMatchWU;
  i, infoIndex:Integer;
begin
  FileToAnsiString(paramstr(0), value);
  codesite.SendMemoryAsHex('value', @value[1], length(value));
  Matcher := TMatchWU.Create;
  try
    Matcher.AddPattern('546869732070726F', 1);
    Matcher.AddPattern('504500004C010A00', 2);
    Matcher.InitHash;
    i := Matcher.Search(@value[1], length(value), infoIndex);
    codesite.Send('%x : %d', [i, infoIndex]);
  finally
    Matcher.Free;
  end;
end.

program MemMd5;

uses
  Windows,
  Sysutils,
  JwaNative,
  JwaNtStatus,
  JwaWinType,
  NcxTypes,
  NcxNtDef,
  NcxNtTeb,
  codesitelogging,
  U_UnionApi,
  U_Md5;

type
  PROCESS_BASIC_INFORMATION = record
    ExitStatus: Cardinal;
    PebBaseAddress: PVOID;
    AffinityMask: Cardinal;
    BasePriority: Cardinal;
    UniqueProcessId: Cardinal;
    InheritedFromUniqueProcessId: Cardinal;
  end;
  TProcessBasicInformation = PROCESS_BASIC_INFORMATION;
  PProcessBasicInformation = ^TProcessBasicInformation;

  TImageOptionalHeader64 = packed record
    Magic                       : WORD;
    MajorLinkerVersion          : BYTE;
    MinorLinkerVersion          : BYTE;
    SizeOfCode                  : DWORD;
    SizeOfInitializedData       : DWORD;
    SizeOfUninitializedData     : DWORD;
    AddressOfEntryPoint         : DWORD;
    BaseOfCode                  : DWORD;
    ImageBase                   : int64;
    SectionAlignment            : DWORD;
    FileAlignment               : DWORD;
    MajorOperatingSystemVersion : WORD;
    MinorOperatingSystemVersion : WORD;
    MajorImageVersion           : WORD;
    MinorImageVersion           : WORD;
    MajorSubsystemVersion       : WORD;
    MinorSubsystemVersion       : WORD;
    Win32VersionValue           : DWORD;
    SizeOfImage                 : DWORD;
    SizeOfHeaders               : DWORD;
    CheckSum                    : DWORD;
    Subsystem                   : WORD;
    DllCharacteristics          : WORD;
    SizeOfStackReserve          : int64;
    SizeOfStackCommit           : int64;
    SizeOfHeapReserve           : int64;
    SizeOfHeapCommit            : int64;
    LoaderFlags                 : DWORD;
    NumberOfRvaAndSizes         : DWORD;
    DataDirectory               : array [0..IMAGE_NUMBEROF_DIRECTORY_ENTRIES - 1] of IMAGE_DATA_DIRECTORY;
  end;
  PImageOptionalHeader64 = ^TImageOptionalHeader64;

  PImageBaseRelocation = ^TImageBaseRelocation;
  _IMAGE_BASE_RELOCATION = packed record
    VirtualAddress: DWORD;
    SizeOfBlock: DWORD;
  end;
  TImageBaseRelocation = _IMAGE_BASE_RELOCATION;
  IMAGE_BASE_RELOCATION = _IMAGE_BASE_RELOCATION;

const
  IMAGE_NT_OPTIONAL_HDR32_MAGIC = $10b;  // 32bit PE file
  IMAGE_NT_OPTIONAL_HDR64_MAGIC = $20b;  // 64bit PE file

function NtSuccess(API:AnsiString; AStatus: LongInt): Boolean; overload;
var
  error : DWord;
begin
  Result := AStatus >= 0;
  if result=false then begin
    error := RtlNtStatusToDosError(AStatus);
    SetLastError(error);
    codesite.Sendwinerror('api', error);
  end;
end;

function NtSuccess(AStatus: LongInt): Boolean; overload;
begin
  Result := AStatus >= 0;
end;

function NTApiCall(ApiName: AnsiString; Arg: Array of Const): DWORD; stdcall;
begin
  result := ApiCall32(ApiName, Arg);
  NtSuccess(ApiName, result);
end;

Function GetModuleString(Buff:PWideChar):string;
var
  temp:String;
  I: Integer;
begin
  SetString(temp, Buff, StrLen(Buff));
  I := LastDelimiter('.' + PathDelim + DriveDelim, temp);
  if (I > 0) and (temp[I] = '.') then
    result := Copy(temp, 1, I+3)
  else
    result := temp;
end;

function Align(Value, Align: Cardinal): Cardinal;
begin
  if ((Value mod Align) = 0) then
    Result := Value
  else
    Result := ((Value + Align - 1) div Align) * Align;
end;

Function SetMemProtection(ph: THandle; lpAddress: Pointer; dwSize, flNewProtect: DWORD; var OldProtect: DWORD):boolean;
var
  status: NTStatus;
begin
  Status := NTApiCall('NtProtectVirtualMemory', [
              ph,
              @lpAddress,
              @dwSize,
              flNewProtect,
              @OldProtect
            ]);

  result := NtSuccess(Status);
end;

function GetPeb32(ph : THandle; var PEB : TPeb32):Boolean;
var
  PBI           : PROCESS_BASIC_INFORMATION;
begin
  result := false;

  {Get PROCESS_BASIC_INFORMATION}
  if not NtSuccess(NTApiCall('NtQueryInformationProcess', [ph, Pointer(ProcessBasicInformation), @PBI, SizeOf(PBI), nil])) then begin
    {$IFDEF DebugMode}Codesite.SendWinError('Failed Get PROCESS BASIC INFORMATION  ', Getlasterror);{$ENDIF}
    exit;
  end;

  {Reading PEB}
  if not NtSuccess(NTApiCall('NtReadVirtualMemory', [ph, pbi.PebBaseAddress, @PEB, sizeof(PEB), nil])) then begin
    {$IFDEF DebugMode}Codesite.SendWinError('Failed Reading PEB', Getlasterror);{$ENDIF}
    exit;
  end;

  result := true;
end;

function MD5FirstSectionModule(ph: Thandle; ImageBase:Pointer): String;
var
  pImage:     Pointer;
  pSection:   Pointer;
  INH:        PImageNtHeaders;
  pISH:       PImageSectionHeader;
  Scaddr:     DWord;
  ScSize:     DWord;
  Protect:    DWORD;
begin
  result := '';
  pImage := AllocMem($1000);
  try

    { Read Image }
    if not NtSuccess(NTApiCall('NtReadVirtualMemory', [ph, ImageBase, pImage, $1000, nil])) then begin
      {$IFDEF DebugMode}Codesite.SendWinError('Failed Reading Image ', Getlasterror);{$ENDIF}
      exit;
    end;

    { Check Dos Header }
    if (PImageDosHeader(pImage)^.e_magic <> IMAGE_DOS_SIGNATURE) then exit;

    { Check PE Header }
    INH := Pointer(NativeUint(pImage) + NativeUint(PImageDosHeader(pImage)^._lfanew));
    if (INH^.Signature <> IMAGE_NT_SIGNATURE) then exit;

    { get first section }
    if INH^.OptionalHeader.Magic = IMAGE_NT_OPTIONAL_HDR64_MAGIC then
      pISH := PImageSectionHeader(NativeUint(@INH^.OptionalHeader) + sizeOf(TImageOptionalHeader64))
    else
      pISH := PImageSectionHeader(NativeUint(@INH^.OptionalHeader) + sizeOf(TImageOptionalHeader));

    { get section address }
    Scaddr := Align(pISH^.VirtualAddress, INH^.OptionalHeader.SectionAlignment);

    { get section size }
    ScSize := pISH^.Misc.VirtualSize;
    if (ScSize = 0) then ScSize := pISH^.SizeOfRawData;

    pSection := AllocMem(ScSize);
    try

      { get memory protection }
      SetMemProtection(ph, Pointer(NativeUint(ImageBase)+Scaddr), ScSize, PAGE_EXECUTE_READWRITE, Protect);

      { check if can access}
      if ((Protect and PAGE_NOACCESS) = PAGE_NOACCESS) then begin
        SetMemProtection(ph, Pointer(NativeUint(ImageBase)+Scaddr), ScSize, Protect, Protect);
      end else begin

        { read section }
        if NtSuccess(NTApiCall('NtReadVirtualMemory', [ph, Pointer(NativeUint(ImageBase)+Scaddr), pSection, ScSize, nil])) then begin

          { Get MD5}
          result := MD5DigestToString(MD5Buffer(pSection^, ScSize));
        end;

        { restore the protection }
        SetMemProtection(ph, Pointer(NativeUint(ImageBase)+Scaddr), ScSize, Protect, Protect);
      end;
    finally
      FreeMem(pSection);
    end;
  finally
    FreeMem(pImage);
  end;
end;

procedure PEB32ModuleList(ph : THandle);
var
  PEB           : TPeb32;
  LdrData       : TPebLdrData32;
  LdrModule     : TLdrDataTableEntry32;
  BaseDllName   : Pointer;
  i, dwread     : DWord;
  Head,Current  : DWord;
begin
  if not GetPeb32(ph, PEB) then exit;

  { Reading LoaderData }
  if not NtSuccess(NTApiCall('NtReadVirtualMemory', [ph, PEB.Ldr, @LdrData, sizeof(TPebLdrData32), @dwread])) then begin
    {$IFDEF DebugMode}Codesite.SendWinError('Failed Reading LoaderData ', Getlasterror);{$ENDIF}
    exit;
  end;

  { init for enum the linked list }
  i := 0;
  Head := 0;
  Current := DWord(LdrData.InLoadOrderModuleList.Flink);

  { loop for all ldr entry or module }
  repeat

    { Reading Current entry }
    if not NtSuccess(NTApiCall('NtReadVirtualMemory', [ph, Ptr(Current), @LdrModule, SizeOf(LdrModule), @dwread])) then begin
      {$IFDEF DebugMode}Codesite.SendWinError('Failed Reading Current entry ', Getlasterror);{$ENDIF}
      break;
    end;

    BaseDllName := AllocMem(LdrModule.BaseDllName.Length);
    try

      { Reading BaseDllName }
      if not NtSuccess(NTApiCall('NtReadVirtualMemory', [ph, LdrModule.BaseDllName.Buffer, BaseDllName, LdrModule.BaseDllName.Length, @dwread])) then begin
        {$IFDEF DebugMode}Codesite.SendWinError('Failed Reading BaseDllName', Getlasterror);{$ENDIF}
        break;
      end;

      codesite.send('%s | %s ',[GetModuleString(BaseDllName), MD5FirstSectionModule(ph, LdrModule.DllBase)]);
    finally
      FreeMem(BaseDllName, LdrModule.BaseDllName.Length);
    end;

    { Next Module }
    if i=0 then Head := Dword(LdrModule.InLoadOrderLinks.Blink);
    Current := Dword(LdrModule.InLoadOrderLinks.Flink);
    inc(i);
  until Current = Head;
end;


begin
  try
    PEB32ModuleList(thandle(-1));
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

hmm btw untuk module enumerasi anda bisa menggunakan methode lain misalkan dengan query memory.

AnsiToFile: function for write ansistring value to file use native api
FileToAnsi: function for read file to ansistring use native api

function AnsiToFile(wsFileName: WideString; Buff:AnsiString):Boolean;
var
  hFile:  THANDLE;
  Oa:     TObjectAttributes;
  Us:     TUnicodeString;
  iosb:   IO_STATUS_BLOCK;
  st:     NTSTATUS;
begin
  result := false;
  RtlDosPathNameToNtPathName_U(@wsFileName[1], Us, nil, nil);
  InitializeObjectAttributes(@Oa, @Us, $40, 0, nil);

  {Create file}
  st := NtCreateFile(
    @hFile,
    FILE_WRITE_DATA or SYNCHRONIZE,
    @oa,
    @iosb,
    nil,
    0,
    FILE_SHARE_READ,
    FILE_CREATE,
    FILE_SYNCHRONOUS_IO_NONALERT,
    nil,
    0
  );
  if st <> STATUS_SUCCESS then exit;

  {WriteBuff}
  NtWriteFile(
    hFile,
    0,
    nil,
    nil,
    @iosb,
    @Buff[1],
    length(Buff),
    nil,
    nil
  );

  NtClose(hFile);
end;

function FileToAnsi(wsFileName: WideString):AnsiString;
var
  hFile:  THANDLE;
  Oa:     TObjectAttributes;
  Us:     TUnicodeString;
  iosb:   IO_STATUS_BLOCK;
  fsi:    FILE_STANDARD_INFORMATION;
  st:     NTSTATUS;
  fsize:  Cardinal;
begin
  result := '';
  RtlDosPathNameToNtPathName_U(@wsFileName[1], Us, nil, nil);
  InitializeObjectAttributes(@Oa, @Us, $40, 0, nil);

  {open file}
  st := NtOpenFile(
    @hFile,
    FILE_READ_DATA or SYNCHRONIZE,
    @oa,
    @iosb,
    FILE_SHARE_READ,
    FILE_SYNCHRONOUS_IO_NONALERT
  );
  if st <> STATUS_SUCCESS then exit;

  {Query Information File}
  st := NtQueryInformationFile(
    hFile,
    @iosb,
    @fsi,
    Sizeof(FILE_STANDARD_INFORMATION),
    FileStandardInformation//FileStandardInformation
  );
  if st <> STATUS_SUCCESS then begin
    NtClose(hFile);
    exit;
  end;

  {Get FileSize}
  fsize := fsi.EndOfFile.LowPart;
  Setlength(result, fsize);

  {ReadFile}
  NtReadFile(
    hFile,
    0,
    nil,
    nil,
    @iosb,
    @result[1],
    fsize,
    nil,
    nil
  );

  NtClose(hFile);

end;

example:

var
  buff:ansistring;
begin
  buff := FileToAnsi(paramstr(0));
  AnsiToFile('test.exe', buff);
end.

about WoW64 :
[url]http://en.wikipedia.org/wiki/WoW64[/url]
[url]http://msdn.microsoft.com/en-us/library/aa384274(v=vs.85).aspx[/url]

Instead of using the x86 system-service call sequence, 32-bit binaries that make system calls are rebuilt to use a custom calling sequence. This calling sequence is inexpensive for WOW64 to intercept because it remains entirely in user mode. When the custom calling sequence is detected, the WOW64 CPU transitions back to native 64-bit mode and calls into Wow64.dll. Thunking is done in user mode to reduce the impact on the 64-bit kernel and to reduce the risk of a bug in the thunk that might cause a kernel-mode crash, data corruption, or a security hole. The thunks extract arguments from the 32-bit stack, extend them to 64 bits, then make the native system call.

program Test;

uses
  windows,
  JwaNative,
  JwaNtStatus,
  JwaWinType,
  NcxTypes,
  NcxNtDef,
  NcxNtTeb;

var
  WOW32Reserved: Cardinal;

function IsWow:NativeUint; stdcall;
asm
  xor   eax, eax
  mov   eax, fs:[eax+$18] //teb
  mov   eax, [eax+$C0] //WOW32Reserved
end;

(******************************************************************************
 | Native WOW64                                                                |
 ******************************************************************************)
function  NtWow64QueryInformationProcess64(
    ProcessHandle : THANDLE;
    ProcessInformationClass : PROCESSINFOCLASS;
    ProcessInformation : Pointer;
    ProcessInformationLength : ULONG;
    ReturnLength : PUInt64
  ): NTSTATUS; stdcall; external ntdll;


function  NtWow64ReadVirtualMemory64(
    ProcessHandle : THANDLE;
    BaseAddress : UInt64;
    Buffer : Pointer;
    BufferLength : UInt64;
    ReturnLength : PUInt64
  ): NTSTATUS; stdcall; external ntdll;


 (******************************************************************************
 | Native Misc                                                                 |
 ******************************************************************************)
function NtSuccess(AStatus: LongInt): Boolean;
var
  error : DWord;
begin
  Result := AStatus >= 0;
  if result=false then begin
    error := RtlNtStatusToDosError(AStatus);
    SetLastError(error);
    {$IFDEF DebugMode}Codesite.SendWinError(error);{$ENDIF}
  end;
end;

Function GetInformation(Table:SYSTEM_INFORMATION_CLASS):Pointer;
var
  mSize: dword;
  mPtr: pointer;
  St: LongInt;
begin
  result := nil;
  mSize := $4000;
  repeat
    GetMem(mPtr, mSize);
    St := NtQuerySystemInformation(Table, mPtr, mSize, nil);
    if (St = STATUS_INFO_LENGTH_MISMATCH) then begin
      FreeMem(mPtr);
      mSize := mSize * 2;
    end;
  until St <> STATUS_INFO_LENGTH_MISMATCH;
  if (St = STATUS_SUCCESS) then result := mPtr
  else FreeMem(mPtr);
end;

function ExOpenProcess(dwDesiredAccess: DWord; Id : DWord):THANDLE;
var
  hProcess: THANDLE;
  attr: OBJECT_ATTRIBUTES;
  cli: CLIENT_ID;
begin
  InitializeObjectAttributes(@attr, nil, 0, 0, nil);
  cli.UniqueProcess := THandle(Id);
  cli.UniqueThread := 0;
  result := 0;
  if NtSuccess(NtOpenProcess(@hProcess, dwDesiredAccess, @attr, @cli)) then result := hProcess
end;

function ExOpenThread(dwDesiredAccess: DWord; Id : DWord):THANDLE;
var
  hThread: THANDLE;
  attr: OBJECT_ATTRIBUTES;
  cli: CLIENT_ID;
begin
  InitializeObjectAttributes(@attr, nil, 0, 0, nil);
  cli.UniqueProcess := 0;
  cli.UniqueThread := THandle(Id);
  result := 0;
  if NtSuccess(NtOpenThread(@hThread, dwDesiredAccess, @attr, @cli)) then result := hThread
end;

function Is64BitProcess(ph:DWORD):Boolean;
var
  isWow64: ULONG_PTR;
begin
  result := false;
  isWow64 := 1;
  if ph=GetcurrentProcess then exit;

  try
    {Get PROCESS_BASIC_INFORMATION}
    if not NtSuccess(NtQueryInformationProcess(ph, ProcessWow64Information, @isWow64, SizeOf(isWow64), nil)) then begin
      {$IFDEF DebugMode}Codesite.SendWinError('Failed Get ProcessWow64Information', Getlasterror);{$ENDIF}
      exit;
    end;
  finally
  end;

  if (WOW32Reserved<>0) then
    result := (isWow64=0)
  else
    result := (isWow64<>0)

end;

Type
  PROCESS_BASIC_INFORMATION = record
    ExitStatus: Cardinal;
    PebBaseAddress: PVOID;
    AffinityMask: Cardinal;
    BasePriority: Cardinal;
    UniqueProcessId: Cardinal;
    InheritedFromUniqueProcessId: Cardinal;
  end;
  TProcessBasicInformation = PROCESS_BASIC_INFORMATION;
  PProcessBasicInformation = ^TProcessBasicInformation;

  PROCESS_BASIC_INFORMATION64 = record
    ExitStatus: Cardinal;
    Pad1:Cardinal;
    PebBaseAddress: UInt64;
    AffinityMask: UInt64;
    BasePriority: Cardinal;
    Pad2:Cardinal;
    UniqueProcessId: UInt64;
    InheritedFromUniqueProcessId: UInt64;
  end;
  TProcessBasicInformation64 = PROCESS_BASIC_INFORMATION64;
  PProcessBasicInformation64 = ^TProcessBasicInformation64;

(******************************************************************************
 | PEB Misc                                                                    |
 ******************************************************************************)
function GetPeb32(ph : THandle; var PEB : TPeb32):Boolean;
var
  PBI           : PROCESS_BASIC_INFORMATION;
begin
  result := false;

  {Get PROCESS_BASIC_INFORMATION}
  if not NtSuccess(NtQueryInformationProcess(ph, ProcessBasicInformation, @PBI, SizeOf(PBI), nil)) then begin
    {$IFDEF DebugMode}Codesite.SendWinError('Failed Get PROCESS BASIC INFORMATION  ', Getlasterror);{$ENDIF}
    exit;
  end;

  {Reading PEB}
  if not NtSuccess(NtReadVirtualMemory(ph, pbi.PebBaseAddress, @PEB, sizeof(PEB), nil)) then begin
    {$IFDEF DebugMode}Codesite.SendWinError('Failed Reading PEB', Getlasterror);{$ENDIF}
    exit;
  end;

  result := true;
end;

function GetPeb64(ph : THandle; var PEB : TPeb64):Boolean;
var
  PBI           : PROCESS_BASIC_INFORMATION64;
begin
  result := false;

  {Get PROCESS_BASIC_INFORMATION}
  if not NtSuccess(NtWow64QueryInformationProcess64(ph, ProcessBasicInformation, @PBI, SizeOf(PBI), nil)) then begin
    {$IFDEF DebugMode}Codesite.SendWinError('Failed Get PROCESS BASIC INFORMATION  ', Getlasterror);{$ENDIF}
    exit;
  end;

  {Reading PEB}
  if not NtSuccess(NtWow64ReadVirtualMemory64(ph, pbi.PebBaseAddress, @PEB, sizeof(PEB), nil)) then begin
    {$IFDEF DebugMode}Codesite.SendWinError('Failed Reading PEB', Getlasterror);{$ENDIF}
    exit;
  end;

  result := true;
end;

Function PEB32ProcName(ph : THandle; Base:boolean):String;
var
  PEB           : TPeb32;
  LdrData       : TPebLdrData32;
  LdrModule     : TLdrDataTableEntry32;
  BaseDllName   : array[0..MAX_PATH] of widechar;
  dwread,
  Current       : DWORD;
begin
  result := '';
  if not GetPeb32(ph, PEB) then exit;

  Fillchar(BaseDllName, sizeof(BaseDllName), 0);

  {Reading LoaderData}
  if not NtSuccess(NtReadVirtualMemory(ph, PEB.Ldr, @LdrData, sizeof(LdrData), @dwread)) then begin
    {$IFDEF DebugMode}Codesite.SendWinError('Failed Reading LdrData ',Getlasterror);{$ENDIF}
    exit;
  end;

  Current := DWord(LdrData.InLoadOrderModuleList.Flink);

  {Reading First entry}
  if not NtSuccess(NtReadVirtualMemory(ph, Ptr(Current), @LdrModule, SizeOf(LdrModule), @dwread)) then begin
    {$IFDEF DebugMode}Codesite.SendWinError('Failed Reading Current Module ',Getlasterror); {$ENDIF}
    exit;
  end;

  if base then begin
    {Reading BaseDllName}
    if not NtSuccess(NtReadVirtualMemory(ph, LdrModule.BaseDllName.Buffer, @BaseDllName, LdrModule.BaseDllName.Length, nil)) then begin
      {$IFDEF DebugMode}Codesite.SendWinError('Failed Reading BaseDllName ',Getlasterror);{$ENDIF}
      exit;
    end;
  end else begin
    {Reading FullDllName}
    if not NtSuccess(NtReadVirtualMemory(ph, LdrModule.FullDllName.Buffer, @BaseDllName, LdrModule.FullDllName.Length, nil)) then begin
      {$IFDEF DebugMode}Codesite.SendWinError('Failed Reading FullDllName ',Getlasterror);{$ENDIF}
      exit;
    end;
  end;

  result := String(BaseDllName);
end;

Function PEB64ProcName(ph : THandle; Base:boolean):String;
var
  PEB           : TPeb64;
  LdrData       : TPebLdrData64;
  LdrModule     : TLdrDataTableEntry64;
  BaseDllName   : array[0..MAX_PATH] of widechar;
  dwread,
  Current:        Uint64;
begin
  result := '';
  if not GetPeb64(ph, PEB) then exit;

  Fillchar(BaseDllName, sizeof(BaseDllName), 0);

  {Reading LoaderData}
  if not NtSuccess(NtWow64ReadVirtualMemory64(ph, PEB.Ldr, @LdrData, sizeof(LdrData), @dwread)) then begin
    {$IFDEF DebugMode}Codesite.SendWinError('Failed Reading LdrData', Getlasterror);{$ENDIF}
    exit;
  end;

  Current := Uint64(LdrData.InLoadOrderModuleList.Flink);

  {Reading First entry}
  if not NtSuccess(NtWow64ReadVirtualMemory64(ph, Current, @LdrModule, sizeof(LdrModule), @dwread)) then begin
    {$IFDEF DebugMode}Codesite.SendWinError('Failed Reading Current Module ',Getlasterror); {$ENDIF}
    exit;
  end;

  if base then begin
    {Reading BaseDllName}
    if not NtSuccess(NtWow64ReadVirtualMemory64(ph, NativeUint(LdrModule.BaseDllName.Buffer), @BaseDllName, LdrModule.BaseDllName.Length, nil)) then begin
      {$IFDEF DebugMode}Codesite.SendWinError('Failed Reading BaseDllName ',Getlasterror);{$ENDIF}
      exit;
    end;
  end else begin
    {Reading FullDllName}
    if not NtSuccess(NtWow64ReadVirtualMemory64(ph, NativeUint(LdrModule.FullDllName.Buffer), @BaseDllName, LdrModule.FullDllName.Length, nil)) then begin
      {$IFDEF DebugMode}Codesite.SendWinError('Failed Reading FullDllName ',Getlasterror);{$ENDIF}
      exit;
    end;
  end;

  result := String(BaseDllName);
end;

type
  TProcessInfo = record
    is64 : Boolean;
    PID :Cardinal;
    ProcName,
    Filename : String;
  end;
  TProcList = array of TProcessInfo;

Function NativeEnumProcess:TProcList;
var
  buffer: Pointer;
  pInfo:  PSystemProcesses;
  ph:     THandle;
begin
  SetLength(result, 0);

  { Get WOW32Reserved for check if this x64 OS }
  WOW32Reserved := IsWow;

  { Get SystemProcessesAndThreads Information }
  buffer := GetInformation(SystemProcessesAndThreadsInformation);  //5
  if not assigned(buffer) then exit;
  pInfo := PSystemProcesses(buffer);

  try
    { Enum All Info }
    Repeat

      setlength(result, length(result)+1);
      with result[High(result)] do begin
        PID := pInfo^.ProcessId;

        { OpenProcess }
        ph := ExOpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, PID);
        if (ph<>0) and (ph<>INVALID_HANDLE_VALUE) then begin

          is64 := Is64BitProcess(ph);
          if is64 then begin
            ProcName := PEB64ProcName(ph, True);
            Filename := PEB64ProcName(ph, False);
          end else begin
            ProcName := PEB32ProcName(ph, True);
            Filename := PEB32ProcName(ph, False);
          end;

          { Close Opened Process }
          NtClose(ph);
        end;
      end;

      { Next Info }
      if pInfo^.NextEntryDelta = 0 then break;
      pInfo := pointer(dword(pInfo) + pInfo^.NextEntryDelta);
    until false;
  finally
    FreeMem(buffer);
  end;
end;


begin
  NativeEnumProcess;
end.

Btw here u go alternative getmodulehandle compatible 32 and 64bit pe (xe2)

[CODE]
function GetLdr:Pointer; stdcall;
asm
{$IFDEF CPUX86}
xor eax, eax
mov eax, fs:[eax+$18] //teb
mov eax, [eax+$30] //peb
mov eax, [eax+$0C] //ldr
{$ELSE}
xor rax, rax
mov rax, gs:[rax+$30] //teb
mov rax, [rax+$60] //peb
mov rax, [rax+$18] //ldr
{$ENDIF}
end;

function ExGetmoduleHandle(name: PWideChar): THANDLE;
var
x, f, cur : NativeUint;
begin
result := 0;
//getLdr
x := NativeUint(GetLdr);
{$IFDEF CPUX86}
//InMemoryOrderModuleList
f := x+$14;
//InMemoryOrderModuleList.Flink
cur := PNativeUint(f)^;
while (cur f) do begin
x := cur – $8;
//BaseDllName
if (StrComp(PWideChar(PNativeUint(x+$30)^), name) = 0) then begin
//DllBase
result := PNativeUint(x+$18)^;
exit;
end;
cur := PNativeUint(cur)^;
end;
{$ELSE}
//InMemoryOrderModuleList
f := x+$20;
//InMemoryOrderModuleList.Flink
cur := PNativeUint(f)^;
while (cur f) do begin
x := cur – $10;
//BaseDllName
if (StrComp(PWideChar(PNativeUint(x+$60)^), name) = 0) then begin
//DllBase
result := PNativeUint(x+$30)^;
exit;
end;
cur := PNativeUint(cur)^;
end;
{$ENDIF}
end;
[/CODE]

(method walking the export directory table for function address)

type
  PUInt32 = ^UInt32;
  UInt32 = LongWord;
  PUInt64 = ^UInt64;
  UInt64 = System.UInt64;

  PSizeT = ^TSizeT;
  TSizeT = {$IFDEF CPUX64} UInt64 {$ELSE} UInt32 {$ENDIF};

const
  // PE header constants
  IMAGE_NT_OPTIONAL_HDR32_MAGIC = $10b;  // 32bit PE file
  IMAGE_NT_OPTIONAL_HDR64_MAGIC = $20b;  // 64bit PE file

Function xGetProcAddress(Module: TSizeT; ProcName: String):Pointer;
var
  pIDH: PImageDosHeader absolute Module;
  pINH : PImageNtHeaders32;
  pIDD: PImageDataDirectory;
  pIED: PImageExportDirectory;
  pdwFuncs1,
  pdwFuncs,
  pdwNames: PULONG;
  pdwOrdinals: PWORD;
  dwOrd1, i, k: cardinal;
  apiname:PAnsiChar;
begin
  result := nil;
  if (Module=0) then exit;

  if (pIDH^.e_magic <> IMAGE_DOS_SIGNATURE) then exit;
  pINH := Pointer(Pbyte(pIDH) + pIDH^._lfanew);
  if (pINH^.Signature <> IMAGE_NT_SIGNATURE) then exit;

  if pINH^.OptionalHeader.Magic = IMAGE_NT_OPTIONAL_HDR64_MAGIC then
    pIDD := @PImageOptionalHeader64(@pINH^.OptionalHeader).DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT]
  else
    pIDD := @pINH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT];

  pIED := Pointer(Pbyte(pIDH) + pIDD^.VirtualAddress);
  if (pIED=nil) then exit;

  pdwFuncs := PULONG(Pbyte(pIDH) + Cardinal(pIED^.AddressOfFunctions));
  pdwNames := PULONG(Pbyte(pIDH) + Cardinal(pIED^.AddressOfNames));
  pdwOrdinals := PWORD(Pbyte(pIDH) + Cardinal(pIED^.AddressOfNameOrdinals));
  pdwFuncs1 := pdwFuncs;
  for I := 0 to pIED^.NumberOfFunctions do begin

    dwOrd1 := pdwOrdinals^;
    k := 0;
    pdwFuncs := pdwFuncs1;
    while (k < dwOrd1) do begin
      inc(pdwFuncs);
      inc(k);
    end;

    if (pdwFuncs^ < pIDD^.VirtualAddress) or (pdwFuncs^ >= pIDD^.VirtualAddress + pIDD^.Size) then begin
      apiname := PAnsiChar(Pbyte(pIDH) + pdwNames^);
      if (AnsiStrComp(apiname, Pansichar(AnsiString(ProcName))) = 0) then begin
        result := Pointer(Pbyte(pIDH) + pdwFuncs^);
        exit;
      end;
    end;

    inc(pdwOrdinals);
    inc(pdwNames);
  end;
end;

jelasnya tentang virtualMemory baca di
http://www.rohitab.com/discuss/topic/31139-tutorial-paging-memory-mapping-with-a-recursive-page-directory/

Windows on 32 bit x86 systems can access up to 4GB of physical memory. This is due to the fact
that the processor’s address bus which is 32 lines or 32 bits can only access address range from
0×00000000 to 0xFFFFFFFF which is 4GB. Windows also allows each process to have its own
4GB logical address space. The lower 2GB of this address space is available for the user mode
process and upper 2GB is reserved for Windows Kernel mode code. How does Windows give 4GB
address space each to multiple processes when the total memory it can access is also limited to
4GB. To achieve this Windows uses a feature of x86 processor (386 and above) known as paging.
Paging allows the software to use a different memory address (known as logical address) than the
physical memory address. The Processor’s paging unit translates this logical address to the physical
address transparently. This allows every process in the system to have its own 4GB logical address
space.

here u go the code

{ U_VMemory
Author: Abhe
Description: VirtualMemory Implementasion (ported from Libemu)
Release Date: 20th September 2011
Website: http://cybercoding.wordpress.com/
}
unit U_VMemory;

interface
{$I Build.inc}
uses
Windows, U_VUtils, U_VLog, TypInfo;

type
  PArrayPointer = ^TArrayPointer;
  TArrayPointer = Array [0..1023] of Pointer;
  TSegment = (s_cs, s_ss, s_ds, s_es, s_fs, s_gs);

  TMemRange = record
    id: Char;
    start, Stop : Cardinal;
  end;

  TVMemory = class
  Private
    {Physical Directory Table}
    PDT: Pointer;

    {SegMent}
    ST: Array [TSegment] of DWORD;
    SO: DWORD;
    SC: TSegment;

    MemPoints: Array of DWORD;
    MemRangess: Array of TMemRange;

    Procedure MemoryCheck(addr, len: DWORD; mode:char);
    Function PageAlloc(addr:DWORD):Boolean;
    Function PageDealloc(addr:DWORD):Boolean;
    Procedure Clear;
    Function PageIsAlloc(addr: DWORD):Boolean;
    Function Translate(addr: DWORD):Integer;
  Public
    OnMemPoints: Procedure (addr: DWORD);
    OnMemRangess: Procedure (id, mode: char; addr: DWORD);

    constructor Create;
    Destructor Destroy; override;

    function AllocMemory(var addr: DWORD; Size:DWORD):boolean;
    Procedure DeallocMemory(addr: DWORD; Size:DWORD);

    Function ReadBlock(addr: DWORD; Size:DWORD; dest:Pointer):Integer;
    Function WriteBlock(addr:DWORD; Write:Pointer; Size:DWORD):integer;

    Procedure SelectSegment(s: TSegment);
    Function GetSegMent: TSegment;

    Procedure AddMonitorPoint(addr: DWORD);
    Procedure AddMonitorRange(id:Char; start,Stop: DWORD);
    Procedure ClearMonitorPoint;
    Procedure ClearMonitorRange;
  end;


{$IFDEF VirtualMemory} var  VMemory : TVMemory; {$ENDIF}

type
  TMem = Record
    class function Read<T>(addr:DWORD): T; static;
    class function Write<T>(addr:DWORD; Data:T): Integer; static;
    class function Alloc(var addr:DWORD; Size:DWORD): boolean; static;
    class Procedure Dealloc(addr:DWORD; Size:DWORD); static;
    class Function ReadBlock(addr: DWORD; dest:Pointer; Size:Dword):Integer; static;
    class Function WriteBlock(addr:DWORD; Write:Pointer; Size:DWord):integer; static;
  end;

const
  PAGE_BITS = 12;
  PAGESET_BITS = 10;
  PAGE_SIZE = (1 shl PAGE_BITS);
  PAGESET_SIZE = (1 shl PAGESET_BITS);
  FS_SEGMENT_DEFAULT_OFFSET = $7ffdf000;

implementation

class Function TMem.ReadBlock(addr: DWORD; dest:Pointer; Size:DWORD):Integer;
begin
{$IFDEF VirtualMemory}
  result := VMemory.ReadBlock(addr, Size, dest);
{$ELSE}
  if (Pointer(addr)=nil) then Log('Read UnAllocated Memory %x', lgError, [addr]);
  CopyMemory(dest, Pointer(addr), Size);
  result := Size;
{$ENDIF}
end;

class Function TMem.WriteBlock(addr:DWORD; Write:Pointer; Size:DWORD):integer;
begin
{$IFDEF VirtualMemory}
  result := VMemory.WriteBlock(addr, Write, Size);
{$ELSE}
  if (Pointer(addr)=nil) then Log('Write UnAllocated Memory %x', lgError, [addr]);
  CopyMemory(Pointer(addr), Write, Size);
{$ENDIF}
end;

class function TMem.Read<T>(addr:DWORD): T;
var
  ti: PTypeInfo;
  ds: integer;
  Size:Integer;
begin
  ti := System.TypeInfo(T);
  if assigned(ti) then begin
    ds := GetInlineSize(ti);
    TMem.ReadBlock(addr, @result, ds);
  end;
end;

class function TMem.Write<T>(addr:DWORD; Data:T): Integer;
var
  ti: PTypeInfo;
  ds: integer;
  dt: Pointer;
begin
  result := -1;
  ti := System.TypeInfo(T);
  if assigned(ti) then begin
    ds := GetInlineSize(ti);
    result := TMem.WriteBlock(addr, @Data, ds);
  end;
end;

class function TMem.Alloc(var addr:DWORD; Size:DWORD): boolean;
begin
{$IFDEF VirtualMemory}
  result := VMemory.AllocMemory(Addr, Size);
{$ELSE}
  addr := Cardinal(AllocMem(Size));
  result := true;
{$ENDIF}
end;

class Procedure TMem.Dealloc(addr:DWORD; Size:DWORD);
begin
{$IFDEF VirtualMemory}
  VMemory.DeallocMemory(Addr, Size);
{$ELSE}
  FreeMem(Pointer(addr), Size);
{$ENDIF}
end;

function PAGESET(x: DWORD): DWORD;
begin
  result := ((x) shr (PAGESET_BITS + PAGE_BITS));
end;

function PAGE(x: DWORD): DWORD;
begin
  result := (((x) shr PAGE_BITS) and ((1 shl PAGESET_BITS) - 1));
end;

function OFFSET(x: DWORD): DWORD;
begin
  result := (((1 shl PAGE_BITS) - 1) and (x));
end;

constructor TVMemory.Create;
begin
  inherited create;
  PDT := AllocMem((1 shl (32 - PAGE_BITS - PAGESET_BITS))*4);
  ST[s_fs] := FS_SEGMENT_DEFAULT_OFFSET;
  SO := 0;
end;

Destructor TVMemory.Destroy;
begin
  Clear;
  inherited Destroy;
end;

Procedure TVMemory.Clear;
var
  i,j: DWORD;
  PT: Pointer;
  PG: Pointer;
begin
  if (PDT=nil) then exit;

  for i := 0 to (1 shl (32 - PAGE_BITS - PAGESET_BITS)) -1 do begin

    {Page Directory Traversal}
    if PInteger(DWORD(PDT)+i*4)^=0 then continue;
    PT := Pointer(PInteger(DWORD(PDT)+i*4)^);
    if (PT=nil) then begin
      Log('Allocated But Nil [Table: %d = %x]', lgerror, [i, DWORD(PT)]);
      continue;
    end;

    {Page Table Traversal}
    for j := 0 to PAGESET_SIZE -1 do begin
      if PInteger(DWORD(PT)+j*4)^=0 then continue;
      PG := Pointer(PInteger(DWORD(PT)+j*4)^);
      if (PG=nil) then begin
        Log('Allocated But Nil [Page: %d = %x]', lgerror, [i, DWORD(PG)]);
        continue;
      end;
      Freemem(PG, PAGE_SIZE);
    end;

    Freemem(PT, PAGESET_SIZE*4);
  end;
  Freemem(PDT, (1 shl (32 - PAGE_BITS - PAGESET_BITS))*4);
end;

Function TVMemory.PageAlloc(addr:DWORD):Boolean;
var
  PT:Pointer;
  PG:Pointer;
begin
  result := false;

  {Alloc PageTables}
  if PInteger(DWORD(PDT)+PAGESET(addr)*4)^=0 then begin
    PT := AllocMem(PAGESET_SIZE*4);
    PInteger(DWORD(PDT)+PAGESET(addr)*4)^ := DWORD(PT);
  end;

  {Alloc Page}
  PT := Pointer(PInteger(DWORD(PDT)+PAGESET(addr)*4)^);
  if PInteger(DWORD(PT)+PAGE(addr)*4)^=0 then begin
    PG := AllocMem(PAGE_SIZE);
    PInteger(DWORD(PT)+PAGE(addr)*4)^ := DWORD(PG);
    result := true;
  end;
end;

Function TVMemory.PageIsAlloc(addr: DWORD):Boolean;
var
  PT:Pointer;
begin
  result := false;
  if PInteger(DWORD(PDT)+PAGESET(addr)*4)^=0 then exit;
  PT := Pointer(PInteger(DWORD(PDT)+PAGESET(addr)*4)^);
  if (PT=nil) then exit;
  result := PInteger(DWORD(PT)+PAGE(addr)*4)^ <> 0;
end;

Function TVMemory.Translate(addr: DWORD):Integer;
var
  PT:Pointer;
  base:DWORD;
begin
  result := 0;
  if PInteger(DWORD(PDT)+PAGESET(addr)*4)^=0 then exit;
  PT := Pointer(PInteger(DWORD(PDT)+PAGESET(addr)*4)^);
  if (PT=nil) then exit;
  base := PInteger(DWORD(PT)+PAGE(addr)*4)^;
  result := base+OFFSET(addr);
end;

Function TVMemory.PageDealloc(addr:DWORD):Boolean;
var
  PT:Pointer;
  PG: Pointer;
begin
  result := false;
  if PInteger(DWORD(PDT)+PAGESET(addr)*4)^=0 then exit;
  PT := Pointer(PInteger(DWORD(PDT)+PAGESET(addr)*4)^);
  if (PT=nil) then exit;
  PG := Pointer(PInteger(DWORD(PT)+PAGE(addr)*4)^);
  FreeMem(PG, PAGE_SIZE);
  PInteger(DWORD(PT)+PAGE(addr)*4)^ := 0;
  result := true;
end;

Procedure TVMemory.DeallocMemory(addr: DWORD; Size:DWORD);
var
  i, pages : Cardinal;
begin
  if Size=0 then exit;
  pages := Size div PAGE_SIZE;
  if( Size mod PAGE_SIZE <> 0 ) then inc(pages);
  for i:=0 to pages -1 do PageDealloc(addr + i * PAGE_SIZE);
end;

function TVMemory.AllocMemory(var addr: DWORD; Size:DWORD): Boolean;
var
  i, pages : DWORD;
begin
  result := false;
  if Size=0 then exit;
  addr := $00200000;
  pages := Size div PAGE_SIZE;
  if( Size mod PAGE_SIZE <> 0 ) then inc(pages);
  while 1=1 do begin
    for i:=0 to pages -1 do begin
      if not PageIsAlloc(addr + i * PAGE_SIZE) then break;
    end;
    if i=pages-1 then begin
      for i:=0 to pages -1 do begin
        if not PageAlloc(addr + i * PAGE_SIZE) then exit;
      end;
      result := true;
      exit;
    end;
    addr := addr +  PAGE_SIZE;
  end;
end;

Function TVMemory.ReadBlock(addr: DWORD; Size:DWORD; dest:Pointer): integer;
var
  address: DWORD;
  oaddr: DWORD;
  cb: DWORD;
begin
  result := -1;

  oaddr := addr;
  addr := addr + SO;
  MemoryCheck(addr, Size, 'r');
  address := translate(addr);
  if ( address = 0 ) and (Pointer(address) = nil) then begin
    Log('accessing %x', lgError, [addr]);
    exit;
  end;

  if (OFFSET(addr) + Size <= PAGE_SIZE) then begin
    CopyMemory(dest, Pointer(address), Size);
    result := Size;
  end else begin
    cb := PAGE_SIZE - OFFSET(addr);
    CopyMemory(dest, Pointer(address), cb);
    result := result + readblock(oaddr + cb, Size - cb, Pointer(DWord(dest)+cb));
  end;
end;

Function TVMemory.WriteBlock(addr:DWORD; Write:Pointer; Size:DWORD):integer;
var
  address: DWORD;
  oaddr: DWORD;
  cb: DWORD;
begin
  result := -1;

  oaddr := addr;
  addr := addr + SO;
  MemoryCheck(addr, Size, 'w');

  if( addr < $1000 ) then begin
    Log('accessing %x', lgError, [addr]);
    exit;
  end;

  address := translate(addr);
  if ( address = 0 ) and (Pointer(address) = nil) then begin
    if not PageAlloc(addr) then exit;
    address := translate(addr);
  end;

  if (OFFSET(addr) + size <= PAGE_SIZE) then begin
    copymemory(Pointer(address), Write, Size);
    result := Size;
  end else begin
    cb := PAGE_SIZE - OFFSET(addr);;
    copymemory(Pointer(address), Write, Size);
    result := result + WriteBlock(oaddr + cb, Pointer(DWORD(Write)+cb),size - cb);
  end;
end;

Procedure TVMemory.SelectSegment(s: TSegment);
begin
  SC := s;
  SO := ST[s];
end;

Function TVMemory.GetSegMent: TSegment;
begin
  result := SC;
end;

Procedure TVMemory.MemoryCheck(addr, len: DWORD; mode:char);
var
  i: DWORD;
begin
  if (@OnMemPoints<>nil) then begin
    for i:=0 to length(MemPoints)-1 do begin
      if( (MemPoints[i] >= addr) and (MemPoints[i] <= (addr + len) )) then
        OnMemPoints(addr);
    end;
  end;

  if (@OnMemRangess<>nil) then begin
    for i:=0 to length(MemRangess)-1 do begin
      if( (addr >= MemRangess[i].start) and (addr <= MemRangess[i].stop )) then begin
        OnMemRangess(MemRangess[i].id, mode,  addr);
        break;
      end;

      if (addr < MemRangess[i].start) and ( (addr + len) >= MemRangess[i].start) then begin
        OnMemRangess(MemRangess[i].id, mode,  addr);
        break;
      end;
    end;
  end;
end;

procedure TVMemory.AddMonitorPoint(addr: DWORD);
begin
  setlength(MemPoints, length(MemPoints)+1);
  MemPoints[length(MemPoints)-1] := addr;
end;

Procedure TVMemory.AddMonitorRange(id:Char; start,Stop: DWORD);
begin
  setlength(MemRangess, length(MemRangess)+1);
  MemRangess[length(MemRangess)-1].id := id;
  MemRangess[length(MemRangess)-1].start := start;
  MemRangess[length(MemRangess)-1].Stop := Stop;
end;

Procedure TVMemory.ClearMonitorPoint;
begin
   setlength(MemPoints, 0);
end;

Procedure TVMemory.ClearMonitorRange;
begin
  setlength(MemRangess, 0);
end;


{$IFDEF VirtualMemory}
initialization
  VMemory := TVMemory.Create;

finalization
  VMemory.Free;

{$ENDIF}


end.

sample

var
  x: Cardinal;
begin
  TMem.Alloc(x, 1);
  TMem.Write<BYTE>(x, $4);
  codesite.Send('x', TMem.Read<Byte>(x));
end.