Delphi RTTI can be easily used to convert a record (Or a class by the way) to a string representation without taking care of how the record is changed during software maintenance.
RTTI has a set of methods to handle metadata collected by the compiler at compile time. For example, you can iterate thru all fields of a record to find out his name, data type and get or set his value. I used those methods as a simple way to marshal record values between two different processes communicating using sockets.
To simplify my original problem without removing features, I designed a very simple sample program demonstrating the RTTI usage. This simple program simply adds two methods “ToString” and “FromString” to a record. Instead of hardcoding each field in the conversion, I used RTTI to iterate all fields.
Basically, to use RTTI with records, you need the following data types: TRttiContext, TRttiRecordType and TRttiField.
Assuming we handle a record type name “THdr”, the simplest code looks like this:
AContext := TRttiContext.Create;
try
ARecord := AContext.GetType(TypeInfo(THdr)).AsRecord;
for AField in ARecord.GetFields do begin
AFldName := AField.Name;
end;
finally
AContext.Free;
end;
As you can see, we have to create a TRttiContext instance. We then use his method “GetType” to get an instance of TRttiRecord related to the record we are handling. Finally we can iterate thru all fields using a for..in construct. Each field has a corresponding TRttiField instance which can be used to get field name, set or get his value and so on.
My sample code use a loop similar to the above twice: one for converting all fields to a string and one for extracting values from a string and assigning the values to the corresponding fields.
To achieve the goal, I used two support functions: “ParamByNameAsString” and “EscapeQuotes”. They are required to be able to store any fieldname=”fieldvalue” pair into a simple string. There is a simple escape mechanism so that the value can contain embedded double quote.
Here is the full source code:
unit RttiTestForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, Rtti, TypInfo, Vcl.StdCtrls;
type
THdr = record
Name : String;
Phrase : String;
ActionDate : TDateTime;
procedure FromString(const FromValue: String);
function ToString : String;
end;
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
// This will take an inut string having the format:
// name1=value1;name2=value2;...
// Value may also be placed between double quotes if it contain spaces.
// Double quotes inside the value is escaped with a backslash
// Backslashes are double. See EscapeQuotes below.
function ParamByNameAsString(
const Params : String;
const ParamName : String;
var Status : Boolean;
const DefValue : String) : String;
var
I, J : Integer;
Ch : Char;
begin
Status := FALSE;
I := 1;
while I <= Length(Params) do begin
J := I;
while (I <= Length(Params)) and (Params[I] <> '=') do
Inc(I);
if I > Length(Params) then begin
Result := DefValue;
Exit; // Not found
end;
if SameText(ParamName, Trim(Copy(Params, J, I - J))) then begin
// Found parameter name, extract value
Inc(I); // Skip '='
if (I <= Length(Params)) and (Params[I] = '"') then begin
// Value is between double quotes
// Embedded double quotes and backslashes are prefixed
// by backslash
Status := TRUE;
Result := '';
Inc(I); // Skip starting delimiter
while I <= Length(Params) do begin
Ch := Params[I];
if Ch = '\' then begin
Inc(I); // Skip escape character
if I > Length(Params) then
break;
Ch := Params[I];
end
else if Ch = '"' then
break;
Result := Result + Ch;
Inc(I);
end;
end
else begin
// Value is up to semicolon or end of string
J := I;
while (I <= Length(Params)) and (Params[I] <> ';') do
Inc(I);
Result := Copy(Params, J, I - J);
Status := TRUE;
end;
Exit;
end;
// Not good parameter name, skip to next
Inc(I); // Skip '='
if (I <= Length(Params)) and (Params[I] = '"') then begin
Inc(I); // Skip starting delimiter
while I <= Length(Params) do begin
Ch := Params[I];
if Ch = '\' then begin
Inc(I); // Skip escape character
if I > Length(Params) then
break;
end
else if Ch = '"' then
break;
Inc(I);
end;
Inc(I); // Skip ending delimiter
end;
// Param ends with ';'
while (I <= Length(Params)) and (Params[I] <> ';') do
Inc(I);
Inc(I); // Skip semicolon
end;
Result := DefValue;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function EscapeQuotes(const S: String) : String;
begin
// Easy but not best performance
Result := StringReplace(S, '\', '\\', [rfReplaceAll]);
Result := StringReplace(Result, '"', '\"', [rfReplaceAll]);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THdr.FromString(const FromValue: String);
var
Status : Boolean;
Value : String;
AValue : TValue;
AContext : TRttiContext;
ARecord : TRttiRecordType;
AField : TRttiField;
AFldName : String;
begin
if FromValue = '' then
Exit;
// We use RTTI to iterate thru all fields of THdr and use each field name
// to get field value from metadata string and then set value into Hdr.
AContext := TRttiContext.Create;
try
ARecord := AContext.GetType(TypeInfo(THdr)).AsRecord;
for AField in ARecord.GetFields do begin
AFldName := AField.Name;
Value := ParamByNameAsString(FromValue, AFldName, Status, '0');
if Status then begin
try
case AField.FieldType.TypeKind of
tkFloat: // Also for TDateTime !
begin
if Pos('/', Value) >= 1 then
AValue := StrToDateTime(Value)
else
AValue := StrToFloat(Value);
AField.SetValue(@Self, AValue);
end;
tkInteger:
begin
AValue := StrToInt(Value);
AField.SetValue(@Self, AValue);
end;
tkUString:
begin
AValue := Value;
AField.SetValue(@Self, AValue);
end;
// You should add other types as well
end;
except
// Ignore any exception here. Likely to be caused by
// invalid value format
end;
end
else begin
// Do whatever you need if the string lacks a field
// For example clear the field, or just do nothing
end;
end;
finally
AContext.Free;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function THdr.ToString: String;
var
AContext : TRttiContext;
AField : TRttiField;
ARecord : TRttiRecordType;
AFldName : String;
AValue : TValue;
begin
Result := '';
AContext := TRttiContext.Create;
try
ARecord := AContext.GetType(TypeInfo(THDR)).AsRecord;
for AField in ARecord.GetFields do begin
AFldName := AField.Name;
AValue := AField.GetValue(@Self);
Result := Result + AFldName + '="' +
EscapeQuotes(AValue.ToString) + '";';
end;
finally
AContext.Free;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TForm1.Button1Click(Sender: TObject);
var
Hdr1 : THdr;
Hdr2 : THdr;
Buf : String;
begin
Hdr1.Name := 'Francois Piette';
Hdr1.Phrase := 'I said "\Hello\"';
Hdr1.ActionDate := Now;
Memo1.Lines.Add(Hdr1.Phrase);
Buf := Hdr1.ToString;
Memo1.Lines.Add(Buf);
Hdr2.FromString(Buf);
Memo1.Lines.Add(Hdr2.Phrase);
Memo1.Lines.Add(Hdr2.ToString);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
end.
Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be
1 comment:
Great Francois! Thank you. You have just inspired me a lot.
Post a Comment