Search code examples
delphiwinapifpc

Check if memory is readable or why do it not catches the exception?


I have this code that gets called from an injected DLL from a foreign process. It sould read some memory ranges but I sometimes get a segmentation fault at this line DataBuffer := TCharPointer(Address + CharOffset)^;. So is there any way to check if the memory is readable?

function GetCurrentData(Address: Pointer): PChar;
var
  DataBuffer: Char;
  CharArray: Array of Char;
  CharOffset: Integer;
  ReadBytes: longword;
begin
  CharOffset := 0;
  SetLength(CharArray, 0);
  repeat
    DataBuffer := TCharPointer(Address + CharOffset)^;
    CharOffset := CharOffset + 1;
    SetLength(CharArray, CharOffset);
    CharArray[CharOffset - 1] := DataBuffer;
  until (Ord(DataBuffer) = 0);
  Result := PChar(@CharArray[0]);
end;

i also tryed to catch the exception but for some reason this is not working. The host programm still crashes.

unit UnitEventBridgeExports;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Windows, ShellAPI, JwaTlHelp32, SimpleIPC;

type
  TCharPointer = ^Char;

const
  WOWEXE = 'TestProgramm.exe';

var
  IPCClient: TSimpleIPCClient;
  PID: DWord;
  Process: THandle;

procedure EventCalled;
procedure InitializeWoWEventBridge; stdcall;

implementation


function GetProcessIDByName(Exename: String): DWord;
var
  hProcSnap: THandle;
  pe32: TProcessEntry32;
begin
  Result := 0;
  hProcSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  if hProcSnap <> INVALID_HANDLE_VALUE then
  begin
    pe32.dwSize := SizeOf(ProcessEntry32);
    if Process32First(hProcSnap, pe32) = True then
    begin
      while Process32Next(hProcSnap, pe32) = True do
      begin
        if pos(Exename, pe32.szExeFile) <> 0 then
          Result := pe32.th32ProcessID;
      end;
    end;
    CloseHandle(hProcSnap);
  end;
end;


procedure InitializeEventBridge; stdcall;
begin
  IPCClient := TSimpleIPCClient.Create(nil);
  IPCClient.ServerID := 'EventBridgeServer';
  IPCClient.Active := True;
  IPCClient.SendStringMessage('init');
  PID := GetProcessIDByName(EXE);
  Process := OpenProcess(PROCESS_ALL_ACCESS, False, PID);
end;


function GetCurrentData(Address: Pointer): PChar;
var
  DataBuffer: Char;
  CharArray: Array of Char;
  CharOffset: Integer;
  ReadBytes: longword;
  CharPointer: TCharPointer;
  BreakLoop: Boolean;
begin
  CharOffset := 0;
  SetLength(CharArray, 0);
  BreakLoop := False;
  repeat
    try
      CharPointer := TCharPointer(Address + CharOffset);
      DataBuffer := CharPointer^;
      CharOffset := CharOffset + 1;
      SetLength(CharArray, CharOffset);
      CharArray[CharOffset - 1] := DataBuffer;
    except
      BreakLoop := True;
    end;
  until (Ord(DataBuffer) = 0) or BreakLoop;
  Result := PChar(@CharArray[0]);
end;


procedure EventCalled;
var
  TmpAddress: Pointer;
  StringData: PChar;
begin
  {$ASMMODE intel}
  asm
    mov [TmpAddress], edi
  end;
  StringData := GetCurrentData(TmpAddress);
  IPCClient.SendStringMessage('update:' + StringData);
  //IPCClient.SendStringMessage('update');
end;

end.

Solution

  • Your GetCurrentData() implementation is returning a pointer to a local array that goees out of scope when the function exits, then EventCalled() tries to use that poiner after it is no longer valid. Try this instead:

    function GetCurrentData(Address: Pointer): AnsiString; 
    var 
      Offset: Integer; 
    begin 
      Result := '';
      Offset := 0; 
      repeat 
        try 
          if PByte(Longint(Address) + Offset)^ = #0 then Break;
          Inc(Offset); 
        except 
          Break; 
        end; 
      until False; 
      SetString(Result, PAnsiChar(Address), Offset); 
    end; 
    
    procedure EventCalled; 
    var 
      TmpAddress: Pointer; 
      StringData: AnsiString; 
    begin 
      {$ASMMODE intel} 
      asm 
        mov [TmpAddress], edi 
      end; 
      StringData := GetCurrentData(TmpAddress); 
      IPCClient.SendStringMessage('update:' + StringData); 
      //IPCClient.SendStringMessage('update'); 
    end;