Title: Variant to String XML and String XML to Variant
Question: How can we serialize a variant into a string XML and deserialize it back into a variant.
Answer:
I have created two functions: VarToXML and XMLToVar. VarToXML simply receives a variant and return a string XML. XMLToVar simply receives a XML string and return a variant. I think this string XML can be helpful in many places, and modification can be done easily by converting it into a variant first then converting it back into a string XML again. I haven't tested them toroughly so if you found bugs please let me know. Here's the source code:
PS:
Sorry my XML tags can't be visible at your browser, I'll upload the file.
function VarToXML(aVariant:variant):string;
var
i:integer;
vType:integer;
begin
vType:=VarType(aVariant);
case vType of
varEmpty:
Result:='';
varNull:
Result:='';
varSmallInt:
Result:=''+VarToStr(VarAsType(aVariant,varSmallInt))+'';
varInteger:
Result:=''+VarToStr(aVariant)+'';
varSingle:
Result:=''+VarToStr(aVariant)+'';
varDouble:
Result:=''+VarToStr(aVariant)+'';
varCurrency:
Result:=''+VarToStr(aVariant)+'';
varDate:
Result:=''+FormatDateTime('yyyy/mm/dd hh:nn:ss:zzz',VarToDateTime(aVariant))+'';
varError:
Result:=''+VarToStr(aVariant)+'';
varByte:
Result:=''+VarToStr(aVariant)+'';
varString,varOleStr:
Result:=''+VarToStr(aVariant)+'';
varArray,8204:
begin
Result:=''+inttostr(VarArrayLowBound(aVariant,1))+
''+''+inttostr(VarArrayHighBound(aVariant,1))+
'';
for i:=VarArrayLowBound(aVariant,1) to VarArrayHighBound(aVariant,1) do
Result:=Result+VarToXML(aVariant[i]);
Result:=Result+'';
end;
end;
end;
function StringToDateTime(aStringDate:string):TDateTime;
begin
with TStringList.Create do
try
aStringDate:=StringReplace(aStringDate,'/',#10,[rfReplaceAll]);
aStringDate:=StringReplace(aStringDate,':',#10,[rfReplaceAll]);
aStringDate:=StringReplace(aStringDate,' ',#10,[rfReplaceAll]);
Text:=aStringDate;
result:=EncodeDate(StrToInt(Strings[0]),StrToInt(Strings[1]),StrToInt(Strings[2]))+
EncodeTime(StrToInt(Strings[3]),StrToInt(Strings[4]),StrToInt(Strings[5]),StrToInt(Strings[6]));
finally
Free;
end;
end;
function XMLToVar(aXML:string):variant;
procedure FindTag(aXML:string;lwrBnd,uprBnd:integer;var tagName:string;var lwrValIdx,uprValIdx,endTagIdx:integer);
var
i,n:integer;
tagStr:string;
aStrList:TStringList;
startTag,endTag:boolean;
startTagIdx:integer;
begin
startTagIdx:=0;
aStrList:=TStringList.Create;
try
i:=lwrBnd;
startTag:=false;
endTag:=false;
tagStr:='';
while i begin
if startTag then
tagStr:=tagStr+aXML[i];
if tagStr=' endTag:=true;
case aXML[i] of
' begin
startTag:=true;
startTagIdx:=i;
tagStr:=' end;
'':
begin
startTag:=false;
with aStrList do
begin
n:=Count;
if n=0 then//no tag in stack record lower value index
begin
lwrValIdx:=i+1;
Append(tagStr);
tagName:=tagStr;
end
else
if endTag then
if (StringReplace(tagStr,' begin
if n=1 then//top most end tag found
begin
uprValIdx:=startTagIdx-1;
endTagIdx:=i;
break;
end;
Delete(n-1);
end
else
Exception.Create('Invalid XML!')
else
Append(tagStr);
end;
endTag:=false;
end;
end;
inc(i);
end;
finally
aStrList.Free;
end;
end;
function XML2Var(aXML:string;lwrBnd,uprBnd:integer):variant;
var
tagName,tagValue:string;
i,lwrValIdx,uprValIdx,endTagIdx,startTagIdx,varUprValIdx:integer;
lwrBound,uprBound:integer;
begin
lwrBound:=0;
uprBound:=0;
FindTag(aXML,lwrBnd,uprBnd,tagName,lwrValIdx,uprValIdx,endTagIdx);
varUprValIdx:=uprValIdx;
if tagName='' then//array found
begin
FindTag(aXML,lwrValIdx,varUprValIdx,tagName,lwrValIdx,uprValIdx,endTagIdx);
if tagName='' then
begin
tagValue:=Copy(aXML,lwrValIdx,uprValIdx-lwrValIdx+1);
lwrBound:=StrToInt(tagValue);
end;
FindTag(aXML,endTagIdx+1,varUprValIdx,tagName,lwrValIdx,uprValIdx,endTagIdx);
if tagName='' then
begin
tagValue:=Copy(aXML,lwrValIdx,uprValIdx-lwrValIdx+1);
uprBound:=StrToInt(tagValue);
end;
result:=VarArrayCreate([lwrBound,uprBound],varVariant);
for i:=lwrBound to uprBound do
begin
startTagIdx:=endTagIdx+1;
FindTag(aXML,startTagIdx,varUprValIdx,tagName,lwrValIdx,uprValIdx,endTagIdx);
result[i]:=XML2Var(aXML,startTagIdx,endTagIdx);
end;
end
else if tagName='' then//null found
result:=null
else if tagName='' then//empty found
result:=unassigned
else
begin
tagValue:=Copy(aXML,lwrValIdx,uprValIdx-lwrValIdx+1);
if tagName='' then
result:=VarAsType(tagValue,varSmallInt)
else if tagName='' then
result:=VarAsType(tagValue,varInteger)
else if tagName='' then
result:=VarAsType(tagValue,varSingle)
else if tagName='' then
result:=VarAsType(tagValue,varDouble)
else if tagName='' then
result:=VarAsType(tagValue,varCurrency)
else if tagName='' then
result:=StringToDateTime(tagValue)
else if tagName='' then
result:=VarAsType(tagValue,varError)
else if tagName='' then
result:=VarAsType(tagValue,varByte)
else if tagName='' then
result:=tagValue;
end;
end;
begin
result:=XML2Var(aXML,1,length(aXML));
end;
//test case
procedure TForm1.btnRunClick(Sender: TObject);
var
srcVariant:variant;
aVariant:variant;
begin
srcVariant:=1.23456;
aVariant:=VarArrayCreate([1,9],varVariant);
aVariant[1]:=VarArrayOf(['abcde',now,1.2345]);
aVariant[2]:=VarAsType(srcVariant,varSmallInt);
aVariant[3]:=VarAsType(srcVariant,varInteger);
aVariant[4]:=VarAsType(srcVariant,varSingle);
aVariant[5]:=VarAsType(srcVariant,varDouble);
aVariant[6]:=VarAsType(srcVariant,varCurrency);
aVariant[7]:=VarFromDateTime(now-1);
aVariant[8]:=null;
memoXML.Text:=VarToXML(aVariant);
aVariant:=XMLToVar(memoXML.Text);
memoXML2.Text:=VarToXML(aVariant);
end;