Search code examples
pointersdelphi-xe2rttireadprocessmemorywm-copydata

How to read other process memory


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?


Solution

  • 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.