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));
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;