Parsi Coders

Parsi Coders > Software Development Programming > Pascal/Delphi > Delphi > Write 64 Bit Program Delphi
نسخه‌ی کامل: Write 64 Bit Program Delphi
شما در حال مشاهده نسخه آرشیو هستید. برای مشاهده نسخه کامل کلیک کنید.

Amin_Mansouri

10-24-2011، 04:45 PM
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.

در سورس زیر در دلفی اشنا میشید با نوشتن برنامه 64 بیتی
لینک توضیحات بیشتر:
http://en.wikipedia.org/wiki/WoW64

کد:
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.

Amin_Mansouri

10-24-2011، 04:58 PM
ust 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 .

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

کد:
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;
Parsi Coders > Software Development Programming > Pascal/Delphi > Delphi > Write 64 Bit Program Delphi