How to read other process memory

Question

So, I have a class that uses WM_COPYDATA to allow applications to communicate.

type
  TMyRec = record
    Name: string[255];
    Age: integer;
    Birthday: TDateTime;
  end;

function TAppCommunication.SendRecord(const ARecordToSend: Pointer; const ARecordType: PTypeInfo): Boolean;
var
  _Stream: TMemoryStream;
begin
  _Stream := TMemoryStream.Create;
  try
    _Stream.Write(NativeInt(ARecordType), SizeOf(TTypeInfo));
    _Stream.Write(NativeInt(ARecordToSend), SizeOf(ARecordToSend));
    _Stream.Position := 0;

    Result := SendStreamData(_Stream, TCopyDataType.cdtRecord)
  finally
    FreeAndNil(_Stream);
  end;
end;

function TAppCommunication.SendStreamData(const AStream: TMemoryStream;
  const ADataType: TCopyDataType): Boolean;
var
  _CopyDataStruct: TCopyDataStruct;
begin
  Result := False;

  if AStream.Size = 0 then
    Exit;

  _CopyDataStruct.dwData := integer(ADataType);
  _CopyDataStruct.cbData := AStream.Size;
  _CopyDataStruct.lpData := AStream.Memory;

  Result := SendData(_CopyDataStruct);
end;

function TAppCommunication.SendData(const ADataToSend: TCopyDataStruct)
  : Boolean;
var
  _SendResponse: integer;
  _ReceiverHandle: THandle;
begin
  Result := False;

  _ReceiverHandle := GetRemoteReceiverHandle;
  if (_ReceiverHandle = 0) then
    Exit;

  _SendResponse := SendMessage(_ReceiverHandle, WM_COPYDATA,
    integer(FLocalReceiverForm.Handle), integer(@ADataToSend));

  Result := _SendResponse <> 0;
end;

Sending application:

procedure TSenderMainForm.BitBtn1Click(Sender: TObject);
var
  _AppCommunication: TAppCommunication;
  _ms: TMemoryStream;
  _Rec: TMyRec;
  _Record: TAttrData;
begin
  _AppCommunication := TAppCommunication.Create('LocalReceiverName', OnAppMessageReceived);
  _ms := TMemoryStream.Create;
  try
    _AppCommunication.SetRemoteReceiverName('LocalReceiverNameServer');
    _AppCommunication.SendString('ąčęėįšųūž123');
    _AppCommunication.SendInteger(998);
    _AppCommunication.SendDouble(0.95);

    _Rec.Name := 'Edijs';
    _Rec.Age := 29;
    _Rec.Birthday := EncodeDate(1988, 10, 06);
    _Record.Len := 1988;
    //_ms.Write(_Rec, SizeOf(TMyRec));
    //_AppCommunication.SendStreamData(_ms, TCopyDataType.cdtRecord);
    _AppCommunication.SendRecord(@_rec, System.TypeInfo(TMyRec));
    //_AppCommunication.SendRecord(@_Record, System.TypeInfo(TAttrData));
  finally
    FreeAndNil(_ms);
    FreeAndNil(_AppCommunication);
  end;
end;

Receiving application:

procedure TReceiverMainForm.OnAppMessageReceived(const ASender
  : TPair<HWND, string>; const AReceivedData: TCopyDataStruct;
  var AResult: integer);
var
  Info: PTypeInfo;
  Data: PTypeData;
  KindName: String;
  SubName: String;
  _TypeInfo: TTypeInfo;
  _MyRec: TMyRec;
begin
....
  else
  begin
    memLog.Lines.Add('Unknown data received.');

    if (AReceivedData.dwData) = integer(TCopyDataType.cdtRecord) then
    begin
      memLog.Lines.Add('Record received.');

       // This one works fine if "_Stream.Write(NativeInt(ARecordType), SizeOf(TTypeInfo));"
       // is commented out
      //_MyRec := GetProcessMyRec(ASender.Key, pointer(NativeUint(AReceivedData.lpData^)), SizeOf(TMyRec));

      _TypeInfo := GetProcessTypeInfo(ASender.Key,
        Pointer(AReceivedData.lpData^), SizeOf(TTypeInfo));

      Info := System.TypeInfo(TMyRec);
      if (_TypeInfo.Name = Info^.Name) and (_TypeInfo.Kind = Info^.Kind) then
      begin
        // _MyRec := GetProcessMyRec(ASender.Key, Pointer(AReceivedData.lpData^), SizeOf(TMyRec)); works
        _MyRec := GetProcessMyRec(ASender.Key, pointer(NativeInt(AReceivedData.lpData^) +
          SizeOf(TTypeInfo)), SizeOf(TMyRec));

        ShowMessage(_MyRec.Name + ', Age: ' + IntToStr(_MyRec.Age) + ', birthday: ' +
          DateToStr(_MyRec.Birthday));
      end;
    end;
    AResult := -1;
  end;
end;

The problem is that if I am sending TypeInfo and the record together, i fail at reading second one. I can read TypInfo or record if I send them separately. What should I fix to make it to work?

Remy Lebeau · Accepted Answer · 2017-10-16T20:32:11.873

You cannot use pointers across process boundaries, let alone pointers to RTTI. You should not be sending a pointer to a TMyRec (and certainly not a pointer to its RTTI). You need to send a copy of the actual TMyRec itself (you have code commented out to do exact that), eg:

type
  PMyRec = ^TMyRec;
  TMyRec = packed record
    Name: string[255];
    Age: integer;
    Birthday: TDateTime;
  end;

function TAppCommunication.SendRecord(const ARecordToSend: Pointer; ARecordSize: Integer): Boolean;
var
  _Stream: TMemoryStream;
begin
  _Stream := TMemoryStream.Create;
  try
    _Stream.WriteBuffer(ARecordToSend^, ARecordSize);
    _Stream.Position := 0;
    Result := SendStreamData(_Stream, TCopyDataType.cdtRecord);
  finally
    FreeAndNil(_Stream);
  end;
end;

...

// need to cast to WPARAM and LPARAM, not Integer...
_SendResponse := SendMessage(_ReceiverHandle, WM_COPYDATA, WPARAM(FLocalReceiverForm.Handle), LPARAM(@ADataToSend)); 

... 

var
   _Rec: TMyRec;

_Rec.Name := 'Edijs';
_Rec.Age := 29;
_Rec.Birthday := EncodeDate(1988, 10, 06);
_AppCommunication.SendRecord(@_Rec, SizeOf(_Rec));

procedure TReceiverMainForm.OnAppMessageReceived(const ASender : TPair<HWND, string>; const AReceivedData: TCopyDataStruct; var AResult: integer);
var
  _MyRec: PMyRec;
begin
  ....
  else
  begin
    if AReceivedData.dwData = Ord(TCopyDataType.cdtRecord) then
    begin
      memLog.Lines.Add('Record received.');
      _MyRec := PMyRec(AReceivedData.lpData);
      // Use _MyRec^ data as needed...
      ShowMessage(_MyRec.Name + ', Age: ' + IntToStr(_MyRec.Age) + ', birthday: ' + DateToStr(_MyRec.Birthday));
    end else
      memLog.Lines.Add('Unknown data received.');
    AResult := -1;
  end;
end;

If you need to send multiple types of records under the same cdtRecord ID then you need to send the actual record type name (not its RTTI) before the record data, eg:

function TAppCommunication.SendRecord(const ARecordType: ShortString; const ARecordToSend: Pointer; ARecordSize: Integer): Boolean;
var
  _Stream: TMemoryStream;
begin
  _Stream := TMemoryStream.Create;
  try
    _Stream.WriteBuffer(@ARecordType, 1+Length(ARecordType));
    _Stream.WriteBuffer(ARecordToSend^, ARecordSize);
    _Stream.Position := 0;
    Result := SendStreamData(_Stream, TCopyDataType.cdtRecord);
  finally
    FreeAndNil(_Stream);
  end;
end;

var
   _Rec: TMyRec;

_Rec.Name := 'Edijs';
_Rec.Age := 29;
_Rec.Birthday := EncodeDate(1988, 10, 06);
_AppCommunication.SendRecord('TMyRec', @_Rec, SizeOf(_Rec));

procedure TReceiverMainForm.OnAppMessageReceived(const ASender : TPair<HWND, string>; const AReceivedData: TCopyDataStruct; var AResult: integer);
var
  _RecType: ShortString;
  _RecData: Pointer;
  _MyRec: PMyRec;
begin
  ....
  else
  begin
    if AReceivedData.dwData = Ord(TCopyDataType.cdtRecord) then
    begin
      memLog.Lines.Add('Record received.');
      _RecType := PShortString(AReceivedData.lpData)^;
      _RecData := PByte(AReceivedData.lpData)+1+Length(_RecType);
      if (_RetType = 'TMyRec') then
      begin
        _MyRec := PMyRec(_RecData);
        // Use _MyRec^ data as needed...
        ShowMessage(_MyRec.Name + ', Age: ' + IntToStr(_MyRec.Age) + ', birthday: ' + DateToStr(_MyRec.Birthday));
      end
      else
      ...
    end else
      memLog.Lines.Add('Unknown data received.');
    AResult := -1;
  end;
end;

Otherwise, you need to use a more elaborate serialization mechanism to identify your record types and fields in a more generalized manner.

How to read other process memory

1 Answers1