How to send records containing strings between applications

Question

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

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

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;

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,
    WPARAM(FLocalReceiverForm.Handle), LPARAM(@ADataToSend));

  Result := _SendResponse <> 0;
end;

Sender 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;
    _AppCommunication.SendRecord(TTypeInfo(System.TypeInfo(TMyRec)^).Name, @_Rec, SizeOf(_Rec));
  finally
    FreeAndNil(_ms);
    FreeAndNil(_AppCommunication);
  end;
end;

Receiver app:

procedure TReceiverMainForm.OnAppMessageReceived(const ASender
  : TPair<HWND, string>; const AReceivedData: TCopyDataStruct;
  var AResult: integer);
var
  _MyRec: TMyRec;
  _RecType: ShortString;
  _RecData: Pointer;
begin
  ...
  else
  begin
    if (AReceivedData.dwData) = Ord(TCopyDataType.cdtRecord) then
    begin
    _RecType := PShortString(AReceivedData.lpData)^;
      _RecData := PByte(AReceivedData.lpData)+1+Length(_RecType);
      if (_RecType = TTypeInfo(System.TypeInfo(TMyRec)^).Name) then
      begin
        _MyRec := TMyRec(_RecData^);
        ShowMessage(_MyRec.Name + ', Age: ' + IntToStr(_MyRec.Age) + ', birthday: ' +
          DateToStr(_MyRec.Birthday));
      end;
    end;
    AResult := -1;
  end;
end;

The problem is that crash occur when I change Name: string[255]; to Name: string; in TMyRec. How do I overcome this? I do not want to edit all my records to change string to something else and I want to have one function to send all kind of records (as far as my idea goes none of them will contain objects).

EDITED: Used answer provided by Remy and made some tweaks so I would by able to send any kind of record using only one SendRecord function:

function TAppCommunication.SendRecord(const ARecordToSend, ARecordTypInfo: Pointer): Boolean;
var
  _Stream: TMemoryStream;
  _RType: TRTTIType;
  _RFields: TArray<TRttiField>;
  i: Integer;
begin
  _Stream := TMemoryStream.Create;
  try
    _RType := TRTTIContext.Create.GetType(ARecordTypInfo);

    _Stream.WriteString(_RType.ToString);
    _RFields := _RType.GetFields;
    for i := 0 to High(_RFields) do
    begin
      if _RFields[i].FieldType.TypeKind = TTypeKind.tkUString then
        _Stream.WriteString(_RFields[i].GetValue(ARecordToSend).ToString)
      else if _RFields[i].FieldType.TypeKind = TTypeKind.tkInteger then
        _Stream.WriteInteger(_RFields[i].GetValue(ARecordToSend).AsType<integer>)
      else if _RFields[i].FieldType.TypeKind = TTypeKind.tkFloat then
        _Stream.WriteDouble(_RFields[i].GetValue(ARecordToSend).AsType<Double>)
    end;
    _Stream.Position := 0;
    Result := SendStreamData(_Stream, TCopyDataType.cdtRecord);
  finally
    FreeAndNil(_Stream);
  end;
end;

Sender:

_AppCommunication.SendRecord(@_Rec, System.TypeInfo(TMyRec));

`if (_RecType = TTypeInfo(System.TypeInfo(TMyRec)^).Name) then` is completely overkill. As shown in my earlier answer, just use `if (_RecType = 'TMyRec' ) then` instead. — Remy Lebeau, Oct 17 '17 at 05:39
Thats just in case someone later on renames the record. Believe me, such things happens and only clients will find out that it happened. — Edijs Kolesnikovičs, Oct 17 '17 at 05:42
you can't rename the records sent over the comm without breaking the protocol — Remy Lebeau, Oct 17 '17 at 06:40

Remy Lebeau · Accepted Answer · 2017-10-17T14:54:21.170

A ShortString has a fixed size of 256 bytes max (1 byte length + up to 255 AnsiChars), so it is easy to embed in records and send as-is.

A String, on the other hand, is a pointer to dynamically allocated memory for an array of Chars. So, it requires a little more work to serialize back and forth.

To do what you are asking, you can't simply replace ShortString with String without also changing everything else in between to account for that difference.

You already have the basic framework to send variable-length strings (send the length before sending the data), so you can expand on that to handle string values, eg:

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

  TStreamHelper = class helper for TStream
  public
    function ReadInteger: Integer;
    function ReadDouble: Double;
    function ReadString: String;
    ...
    procedure WriteInteger(Value: Integer);
    procedure WriteDouble(Strm: Value: Double);
    procedure WriteString(const Value: String);
  end;

function TStreamHelper.ReadInteger: Integer;
begin
  Self.ReadBuffer(Result, SizeOf(Integer));
end;

function TStreamHelper.ReadDouble: Double;
begin
  Self.ReadBuffer(Result, SizeOf(Double));
end;

function TStreamHelper.ReadString: String;
var
  _Bytes: TBytes;
  _Len: Integer;
begin
  _Len := ReadInteger;
  SetLength(_Bytes, _Len);
  Self.ReadBuffer(PByte(_Bytes)^, _Len);
  Result := TEncoding.UTF8.GetString(_Bytes);
end;

...

procedure TStreamHelper.WriteInteger(Value: Integer);
begin
  Self.WriteBuffer(Value, SizeOf(Value));
end;

procedure TStreamHelper.WriteDouble(Value: Double);
begin
  Self.WriteBuffer(Value, SizeOf(Value));
end;

procedure TStreamHelper.WriteString(const Value: String);
var
  _Bytes: TBytes;
  _Len: Integer;
begin
  _Bytes := TEncoding.UTF8.GetBytes(Value);
  _Len := Length(_Bytes);
  WriteInteger(_Len);
  Self.WriteBuffer(PByte(_Bytes)^, _Len);
end;

function TAppCommunication.SendRecord(const ARecord: TMyRec): Boolean;
var
  _Stream: TMemoryStream;
begin
  _Stream := TMemoryStream.Create;
  try
    _Stream.WriteString('TMyRec');
    _Stream.WriteString(ARecord.Name);
    _Stream.WriteInteger(ARecord.Age);
    _Stream.WriteDouble(ARecord.Birthday);
    _Stream.Position := 0;
    Result := SendStreamData(_Stream, TCopyDataType.cdtRecord);
  finally
    FreeAndNil(_Stream);
  end;
end;

// more overloads of SendRecord()
// for other kinds of records as needed...

procedure TSenderMainForm.BitBtn1Click(Sender: TObject);
var
  ...
  _Rec: TMyRec;
begin
  ...
  _Rec.Name := 'Edijs';
  _Rec.Age := 29;
  _Rec.Birthday := EncodeDate(1988, 10, 06);
  _AppCommunication.SendRecord(_Rec);
  ...
end;

type
  TReadOnlyMemoryStream = class(TCustomMemoryStream)
  public
    constructor Create(APtr: Pointer; ASize: NativeInt);
    function Write(const Buffer; Count: Longint): Longint; override;
  end;

constructor TReadOnlyMemoryStream.Create(APtr: Pointer; ASize: NativeInt);
begin
  inherited Create;
  SetPointer(APtr, ASize);
end;

function TReadOnlyMemoryStream.Write(const Buffer; Count: Longint): Longint;
begin
  Result := 0;
end;

procedure TReceiverMainForm.OnAppMessageReceived(const ASender : TPair<HWND, string>; const AReceivedData: TCopyDataStruct; var AResult: integer);
var
  ... 
  _Stream: TReadOnlyMemoryStream;
  _MyRec: TMyRec;
  _RecType: String;
begin
  ...
  else
  begin
    if (AReceivedData.dwData = Ord(TCopyDataType.cdtRecord)) then
    begin
      _Stream := TReadOnlyMemoryStream(AReceivedData.lpData, AReceivedData.cbData);
      try
        _RecType := _Stream.ReadString;
        if (_RecType = 'TMyRec') then
        begin
          _MyRec.Name := _Stream.ReadString;
          _MyRec.Age := _Stream.ReadInteger;
          _MyRec.Birthday := _Stream.ReadDouble;
          ShowMessage(_MyRec.Name + ', Age: ' + IntToStr(_MyRec.Age) + ', birthday: ' + DateToStr(_MyRec.Birthday));
        end;
      finally
        _Stream.Free;
      end;
    end;
    AResult := -1;
  end;
end;

SendRecord is kinda supposed to work with any kind of records, but seems I will have to take a look into that. Maybe serialization? — Edijs Kolesnikovičs, Oct 17 '17 at 10:35
@EdijsKolesnikovičs yes, this is the basics of serialization. Converting structured/dynamic data into a flat format for transmission, then converting it back. It is difficult to have a single function handle multiple types, especially when dealing with dynamic data. But there are ways to do it, even dedicated libraries, RTTI-based approaches (using Extended RTTI, not legacy RTTI), if you can live with the complexities and overhead. Personally, I prefer simpler approaches — Remy Lebeau, Oct 17 '17 at 14:53

How to send records containing strings between applications

1 Answers1