* PEB data structure
*/
typedef struct _PEB
{                                                                 /* win32/win64 */
   BOOLEAN                      InheritedAddressSpace;             /* 000/000 */
   BOOLEAN                      ReadImageFileExecOptions;          /* 001/001 */
   BOOLEAN                      BeingDebugged;                     /* 002/002 */
   BOOLEAN                      SpareBool;                         /* 003/003 */
   HANDLE                       Mutant;                            /* 004/008 */
   HMODULE                      ImageBaseAddress;                  /* 008/010 */
   PPEB_LDR_DATA                LdrData;                           /* 00c/018 */
   RTL_USER_PROCESS_PARAMETERS *ProcessParameters;                 /* 010/020 */

NtWow64QueryInformationProcess64, NtWow64ReadVirtualMemory64

type
 NTSTATUS = Integer;

 PROCESS_BASIC_INFORMATION = packed record
   Reserved1: UINT64;
   PebBaseAddress: UINT64;
   Reserved2: array [0 .. 1] of UINT64;
   UniqueProcessId: UINT64;
   Reserved3: UINT64;
 end;

 PPROCESS_BASIC_INFORMATION = ^PROCESS_BASIC_INFORMATION;

 TNtQueryInformationProcess = function(ProcessHandle: THANDLE; ProcessInformationClass: ULONG; ProcessInformation: Pointer; ProcessInformationLength: ULONG; ReturnLength: Pointer): NTSTATUS; stdcall;
 TNtReadVirtualMemory = function(ProcessHandle: THANDLE; BaseAddress: UINT64; Buffer: Pointer; BufferLength: UINT64; ReturnLength: Pointer): NTSTATUS; stdcall;

var
 NtQueryInformationProcess: TNtQueryInformationProcess;
 NtReadVirtualMemory: TNtReadVirtualMemory;

function AddCurrentProcessPrivilege(PrivilegeName: WideString): Boolean;
var
 TokenHandle: THandle;
 TokenPrivileges: TTokenPrivileges;
 ReturnLength: Cardinal;
begin
 Result := False;
 if OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, TokenHandle) then
 begin
   try
     LookupPrivilegeValueW(nil, PWideChar(PrivilegeName), TokenPrivileges.Privileges[0].Luid);
     TokenPrivileges.PrivilegeCount := 1;
     TokenPrivileges.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
     if AdjustTokenPrivileges(TokenHandle, False, TokenPrivileges, 0, nil, ReturnLength) then
       Result := True;
   finally
     CloseHandle(TokenHandle);
   end;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
 hLibrary: HMODULE;
 ProcessHandle: THandle;
 PBI: PROCESS_BASIC_INFORMATION;
 ReturnLength: UINT64;
 i: ULONG;
 Buffer: UINT64;
 Data: array [0 .. 666] of Byte;
begin
 AddCurrentProcessPrivilege('SeDebugPrivilege');

 hLibrary := LoadLibrary('ntdll.dll');
 if hLibrary <> 0 then
 begin
     @NtQueryInformationProcess := GetProcAddress(hLibrary, 'NtWow64QueryInformationProcess64');
     @NtReadVirtualMemory := GetProcAddress(hLibrary, 'NtWow64ReadVirtualMemory64');
 end;

 ProcessHandle:= OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, True, 4040);

 if NtQueryInformationProcess(ProcessHandle, 0, @PBI, SizeOf(PBI), nil) = 0 then
 begin
   if NtReadVirtualMemory(ProcessHandle, PBI.PebBaseAddress + $20, @Buffer, SizeOf(Buffer), @ReturnLength) = 0 then
   begin
     if NtReadVirtualMemory(ProcessHandle, Buffer + $78, @Buffer, SizeOf(Buffer), @ReturnLength) = 0 then
     begin
       if NtReadVirtualMemory(ProcessHandle, Buffer, @Data, SizeOf(Data), @ReturnLength) = 0 then
       begin
         for i := 0 to 666 do
          Form1.Memo1.Text := Form1.Memo1.Text + (Char(Data[i]));
       end;
     end;
   end;
 end;
end;