+- Parsi Coders (http://parsicoders.com)
+-- انجمن: Software Development Programming (http://parsicoders.com/forumdisplay.php?fid=37)
+--- انجمن: Pascal/Delphi (http://parsicoders.com/forumdisplay.php?fid=45)
+---- انجمن: Delphi (http://parsicoders.com/forumdisplay.php?fid=69)
+---- موضوع: Write 64 Bit Program Delphi (/showthread.php?tid=1136)
Write 64 Bit Program Delphi - Amin_Mansouri - 10-24-2011
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.RE: Write 64 Bit Program Delphi - Amin_Mansouri - 10-24-2011
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;