如何读取其他进程内存

Question

所以，我有一个 class，它使用 WM_COPYDATA 来允许应用程序进行通信。

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;

发送申请：

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;

正在接收申请：

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;

问题是，如果我同时发送 TypeInfo 和记录，我无法读取第二个。如果我单独发送它们，我可以阅读 TypInfo 或记录。我应该修复什么才能使其正常工作？

Answer 1

您不能跨进程边界使用指针，更不用说指向 RTTI 的指针了。您不应该将指针发送到 TMyRec（并且当然不应该将指针发送到其 RTTI）。您需要发送 actual TMyRec 本身的副本（您已将代码注释掉以做到这一点），例如：

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;

如果您需要在同一个cdtRecord ID下发送多种类型的记录，那么您需要在记录数据之前发送实际的记录类型名称（不是它的RTTI），例如：

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;

否则，您需要使用更精细的序列化机制以更通用的方式识别您的记录类型和字段。

如何读取其他进程内存

How to read other process memory

pointers

rtti

readprocessmemory

wm-copydata

delphi-xe2