Comment envoyer des enregistrements contenant des chaînes entre les applications

Question

J'ai donc une classe qui utilise WM_COPYDATA pour permettre aux applications de communiquer.

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; 

application Auteur:

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; 

récepteur 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; 

Le problème est que l'accident se produire lorsque je change Name: string[255];-Name: string; en TMyRec. Comment puis-je surmonter cela? Je ne veux pas éditer tous mes enregistrements pour changer de chaîne à quelque chose d'autre et je veux avoir une fonction pour envoyer tous les types d'enregistrements (dans la mesure où mon idée va qu'aucun d'entre eux ne contiendra des objets).

ÉDITÉE: réponse Utilisé fourni par Remy et a fait quelques coups secs je voudrais donc en mesure d'envoyer tout type d'enregistrement en utilisant une seule fonction SendRecord:

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; 

Auteur:

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

Answer 1

Un ShortString a une taille fixe de 256 octets max (longueur de 1 octet + jusqu'à 255 AnsiChar s), il est donc facile de l'incorporer dans des enregistrements et de l'envoyer tel quel.

Par contre, un String est un pointeur vers une mémoire allouée dynamiquement pour un tableau de Char s. Donc, il faut un peu plus de travail pour sérialiser d'avant en arrière.

Pour faire ce que vous demandez, vous ne pouvez pas simplement remplacer ShortString par String sans également modifier tout le reste pour tenir compte de cette différence.

Vous avez déjà le cadre de base pour envoyer des chaînes de longueur variable (envoyer la longueur avant d'envoyer les données), de sorte que vous pouvez étendre sur cela pour gérer string valeurs, par exemple:

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;