Behind the connection: Using RTTI to convert record to/from string

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:

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

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

July 27, 2013

Using RTTI to convert record to/from string

1 comment: