david
e4d0fcb01d
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@46 b6239004-a887-0f4b-9937-50029ccdca16
643 lines
21 KiB
ObjectPascal
643 lines
21 KiB
ObjectPascal
unit uDAXMLUtils;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ Data Abstract Library - Core Library }
|
|
{ }
|
|
{ compiler: Delphi 6 and up, Kylix 3 and up }
|
|
{ platform: Win32, Linux }
|
|
{ }
|
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
|
{ }
|
|
{ Using this code requires a valid license of the Data Abstract }
|
|
{ which can be obtained at http://www.remobjects.com. }
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$I DataAbstract.inc}
|
|
|
|
interface
|
|
|
|
uses Classes, TypInfo, uROXMLIntf, uDAInterfaces;
|
|
|
|
const
|
|
// Misc
|
|
ValueNIL = 'NIL';
|
|
|
|
// Attribute names
|
|
attr_Type = 'Type';
|
|
attr_IsObject = 'IsObject';
|
|
attr_ByRef = 'ByRef';
|
|
attr_RefName = 'RefName';
|
|
attr_Owner = 'Owner';
|
|
attr_IsCollection = 'IsCollection';
|
|
attr_IsArray = 'IsArray';
|
|
attr_Count = 'Count';
|
|
attr_ItemClass = 'ItemClass';
|
|
attr_Item = 'Item';
|
|
attr_ClassName = 'ClassName';
|
|
attr_IsNull = 'IsNull';
|
|
|
|
type
|
|
{ Misc }
|
|
TROXMLStreamerOption = (soIncludeType);
|
|
TROXMLStreamerOptions = set of TROXMLStreamerOption;
|
|
|
|
{ TROXMLStreamer }
|
|
TROXMLStreamer = class(TComponent)
|
|
private
|
|
fXMLStreamerOptions: TROXMLStreamerOptions;
|
|
fPropertiesToIgnore: TStringList;
|
|
|
|
procedure SetPropertiesToIgnore(const Value: TStrings);
|
|
function GetPropertiesToIgnore: TStrings;
|
|
|
|
protected
|
|
procedure SerializeSimpleType(const aTargetNode: IXMLNode; anObject: TObject; aPropertyInfo: PPropInfo);
|
|
procedure SerializeObject(const anObjectNode: IXMLNode; anObject: TObject; IsRoot: boolean = FALSE);
|
|
|
|
procedure DeserializeObject(const anObjectNode: IXMLNode; anObject: TObject; IsRoot: boolean = FALSE);
|
|
|
|
public
|
|
constructor Create(aOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
procedure Serialize(const aSource: TObject; const anObjectNode: IXMLNode; IsRoot: boolean = True); overload;
|
|
procedure Serialize(const aSource: TObject; aStream: TStream); overload;
|
|
procedure Deserialize(aStream: TStream; aDestination: TObject);
|
|
|
|
published
|
|
property StreamerOptions: TROXMLStreamerOptions read fXMLStreamerOptions write fXMLStreamerOptions;
|
|
property PropertiesToIgnore: TStrings read GetPropertiesToIgnore write SetPropertiesToIgnore;
|
|
end;
|
|
|
|
// Quick access functions
|
|
procedure SaveObjectToXMLNode(aSource: TObject; anObjectNode: IXMLNode; somePropertiesToIgnore: array of string; someStreamerOptions: TROXMLStreamerOptions = []; IsRoot: boolean = True);
|
|
procedure SaveObjectToStream(aSource: TObject; aStream: TStream; somePropertiesToIgnore: array of string; someStreamerOptions: TROXMLStreamerOptions = []);
|
|
procedure LoadObjectFromStream(aStream: TStream; aDestination: TObject; somePropertiesToIgnore: array of string);
|
|
|
|
procedure SaveObjectToFile(aSource: TObject; const aFileName: string; somePropertiesToIgnore: array of string; someStreamerOptions: TROXMLStreamerOptions = []);
|
|
procedure LoadObjectFromFile(const aFileName: string; aDestination: TObject; somePropertiesToIgnore: array of string);
|
|
|
|
// Dataset oriented functions
|
|
function DatasetToXML(
|
|
const aDataset : IDADataset;
|
|
const RootNodeName : string = '';
|
|
const RecordNodeName : string = 'Record';
|
|
IncludeSchema : boolean = TRUE) : IXMLDocument;
|
|
|
|
procedure XMLToCommandParams(const aCommand : IDASQLCommand; const XML : string);
|
|
function XMLToUpdateCommand(const aConnection : IDAConnection;
|
|
const aReferencedDataset : TDADataset;
|
|
const aTargetTableName : string;
|
|
const aXML : string) : IDASQLCommand;
|
|
|
|
|
|
implementation
|
|
|
|
uses SysUtils, uROTypes, Variants;
|
|
|
|
procedure SaveObjectToXMLNode(aSource: TObject; anObjectNode: IXMLNode; somePropertiesToIgnore: array of string; someStreamerOptions: TROXMLStreamerOptions = []; IsRoot: boolean = True);
|
|
var
|
|
i: integer;
|
|
begin
|
|
with TROXMLStreamer.Create(nil) do try
|
|
for i := 0 to High(somePropertiesToIgnore) do
|
|
PropertiesToIgnore.Add(somePropertiesToIgnore[i]);
|
|
|
|
StreamerOptions := someStreamerOptions;
|
|
Serialize(aSource, anObjectNode,IsRoot);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure SaveObjectToStream(aSource: TObject; aStream: TStream; somePropertiesToIgnore: array of string; someStreamerOptions: TROXMLStreamerOptions = []);
|
|
var
|
|
i: integer;
|
|
begin
|
|
with TROXMLStreamer.Create(nil) do try
|
|
for i := 0 to High(somePropertiesToIgnore) do
|
|
PropertiesToIgnore.Add(somePropertiesToIgnore[i]);
|
|
|
|
StreamerOptions := someStreamerOptions;
|
|
Serialize(aSource, aStream);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure LoadObjectFromStream(aStream: TStream; aDestination: TObject; somePropertiesToIgnore: array of string);
|
|
var
|
|
i: integer;
|
|
begin
|
|
with TROXMLStreamer.Create(nil) do try
|
|
for i := 0 to High(somePropertiesToIgnore) do
|
|
PropertiesToIgnore.Add(somePropertiesToIgnore[i]);
|
|
|
|
Deserialize(aStream, aDestination);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure SaveObjectToFile(aSource: TObject; const aFileName: string; somePropertiesToIgnore: array of string; someStreamerOptions: TROXMLStreamerOptions = []);
|
|
var
|
|
fs: TFileStream;
|
|
begin
|
|
fs := TFileStream.Create(aFileName, fmCreate);
|
|
try
|
|
SaveObjectToStream(aSource, fs, somePropertiesToIgnore, someStreamerOptions);
|
|
finally
|
|
fs.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure LoadObjectFromFile(const aFileName: string; aDestination: TObject; somePropertiesToIgnore: array of string);
|
|
var
|
|
fs: TFileStream;
|
|
begin
|
|
fs := TFileStream.Create(aFileName, fmOpenRead + fmShareDenyWrite);
|
|
try
|
|
LoadObjectFromStream(fs, aDestination, somePropertiesToIgnore);
|
|
finally
|
|
fs.Free;
|
|
end;
|
|
end;
|
|
|
|
{ TROXMLStreamer }
|
|
|
|
constructor TROXMLStreamer.Create(aOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
|
|
fPropertiesToIgnore := TStringList.Create;
|
|
fPropertiesToIgnore.Sorted := TRUE;
|
|
fPropertiesToIgnore.Duplicates := dupError;
|
|
|
|
fXMLStreamerOptions := [soIncludeType];
|
|
end;
|
|
|
|
destructor TROXMLStreamer.Destroy;
|
|
begin
|
|
fPropertiesToIgnore.Free;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TROXMLStreamer.Deserialize(aStream: TStream; aDestination: TObject);
|
|
var
|
|
xml: IXMLDocument;
|
|
begin
|
|
if (aStream = nil) then raise Exception.Create('Invalid stream');
|
|
|
|
xml := NewROXmlDocument;
|
|
xml.New('');
|
|
xml.LoadFromStream(aStream);
|
|
|
|
if (xml.DocumentNode.Value = ValueNIL) then
|
|
FreeAndNIL(aDestination)
|
|
else
|
|
DeserializeObject(xml.DocumentNode, aDestination, TRUE);
|
|
end;
|
|
|
|
procedure TROXMLStreamer.Serialize(const aSource: TObject; aStream: TStream);
|
|
var
|
|
xml: IXMLDocument;
|
|
begin
|
|
if (aStream = nil) then raise Exception.Create('Invalid stream');
|
|
|
|
xml := NewROXmlDocument;
|
|
try
|
|
if (aSource = nil) then begin
|
|
xml.New(ValueNIL);
|
|
Exit;
|
|
end
|
|
else
|
|
xml.New(aSource.ClassName);
|
|
|
|
// Serializes the object
|
|
SerializeObject(xml.DocumentNode, aSource, TRUE);
|
|
finally
|
|
xml.SaveToStream(aStream);
|
|
end;
|
|
end;
|
|
|
|
procedure TROXMLStreamer.SerializeSimpleType(const aTargetNode: IXMLNode; anObject: TObject; aPropertyInfo: PPropInfo);
|
|
var
|
|
int64val: int64;
|
|
intval: integer;
|
|
dblval: double;
|
|
strval: string;
|
|
{$IFNDEF DELPHI5}wstrval: widestring;
|
|
{$ENDIF}
|
|
lName: string;
|
|
begin
|
|
lName := {$IFDEF UNICODE}UTF8ToString{$ENDIF}(aPropertyInfo^.Name);
|
|
case aPropertyInfo^.PropType^.Kind of
|
|
{$IFDEF FPC}tkBool,{$ENDIF}
|
|
tkEnumeration: begin
|
|
//enuval := GetOrdProp(anObject, lName);
|
|
aTargetNode.Value := GetPropValue(anObject, lName, TRUE);
|
|
end;
|
|
|
|
tkInteger: begin
|
|
intval := GetOrdProp(anObject, lName);
|
|
aTargetNode.Value := intval;
|
|
end;
|
|
|
|
tkFloat: begin
|
|
dblval := GetFloatProp(anObject, lName);
|
|
aTargetNode.Value := dblval;
|
|
end;
|
|
|
|
tkLString,
|
|
{$IFDEF FPC}tkAString,{$ENDIF}
|
|
tkString: begin
|
|
strval := GetStrProp(anObject, lName);
|
|
aTargetNode.Value := strval;
|
|
end;
|
|
|
|
tkInt64: begin
|
|
int64val := GetInt64Prop(anObject, lName);
|
|
aTargetNode.Value := int64val;
|
|
end;
|
|
{$IFDEF UNICODE}tkUString,{$ENDIF}
|
|
tkWString: begin
|
|
{$IFDEF DELPHI5}
|
|
strval := GetStrProp(anObject, lName);
|
|
aTargetNode.Value := strval;
|
|
{$ELSE}
|
|
wstrval := GetWideStrProp(anObject, lName);
|
|
aTargetNode.Value := wstrval;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
tkVariant, tkSet: begin
|
|
aTargetNode.Value := GetVariantProp(anObject, lName);
|
|
end;
|
|
|
|
else
|
|
raise Exception.Create(Format('Type not supported %s', [GetEnumName(TypeInfo(TTypeKind), Ord(aPropertyInfo^.PropType^.Kind))]))
|
|
end;
|
|
end;
|
|
|
|
procedure TROXMLStreamer.SerializeObject(const anObjectNode: IXMLNode; anObject: TObject; IsRoot: boolean = FALSE);
|
|
var
|
|
props: PPropList;
|
|
x, cnt, i: integer;
|
|
subnode, node: IXMLNode;
|
|
coll: TCollection;
|
|
// Temporary variables
|
|
objval: TObject;
|
|
pdata: PTypeData;
|
|
lname: string;
|
|
begin
|
|
if (anObject <> nil) and (anObject.ClassInfo <> nil) then begin
|
|
pdata := GetTypeData(anObject.ClassInfo);
|
|
|
|
if (pdata <> nil) then begin
|
|
|
|
cnt := pdata.PropCount;
|
|
|
|
if (cnt > 0) then begin
|
|
GetMem(props, cnt * SizeOf(PPropInfo));
|
|
|
|
try
|
|
cnt := GetPropList(PTypeInfo(anObject.ClassInfo), tkProperties, props);
|
|
|
|
for i := 0 to (cnt - 1) do begin
|
|
lName := {$IFDEF UNICODE}UTF8ToString{$ENDIF}(props^[i]^.Name);
|
|
if IsRoot and (fPropertiesToIgnore.IndexOf(lName) >= 0)
|
|
or not IsStoredProp(anObject, props^[i]) then Continue;
|
|
|
|
node := anObjectNode.Add(lName);
|
|
|
|
with props^[i]^ do
|
|
// Class types
|
|
if (PropType^.Kind = tkClass) then begin
|
|
node.AddAttribute(attr_Type, props^[i]^.PropType^.Name); // Always set fo object types
|
|
objval := GetObjectProp(anObject, lName);
|
|
node.AddAttribute(attr_IsObject, XMLBooleans[TRUE]);
|
|
|
|
if Assigned(objval) then begin
|
|
// TComponent
|
|
|
|
if (objval is TStrings) then begin
|
|
node.Value := TStrings(objval).Text;
|
|
end else
|
|
if (objval is TComponent) then begin
|
|
if (TComponent(objval).Owner = anObject) then
|
|
SerializeObject(node, objval) // Owned sub-component
|
|
else begin
|
|
// Reference to another component
|
|
node.AddAttribute(attr_ByRef, XMLBooleans[TRUE]);
|
|
node.AddAttribute(attr_RefName, TComponent(objval).Name);
|
|
if (TComponent(objval).Owner <> nil) then node.AddAttribute(attr_Owner, TComponent(objval).Owner.Name);
|
|
end;
|
|
end
|
|
|
|
// TCollection
|
|
else if (objval is TCollection) then begin
|
|
coll := TCollection(objval);
|
|
node.AddAttribute(attr_IsCollection, XMLBooleans[TRUE]);
|
|
node.AddAttribute(attr_Count, coll.Count);
|
|
node.AddAttribute(attr_ItemClass, coll.ItemClass.ClassName);
|
|
|
|
for x := 0 to (coll.Count - 1) do begin
|
|
subnode := node.Add(attr_Item + IntToStr(x));
|
|
SerializeObject(subnode, coll.Items[x]);
|
|
end;
|
|
end
|
|
|
|
// Standard persistent class
|
|
else
|
|
SerializeObject(node, objval);
|
|
end
|
|
|
|
// NIL object
|
|
else
|
|
node.AddAttribute(attr_IsNull, XMLBooleans[TRUE]);
|
|
end
|
|
|
|
// Simple types
|
|
else begin
|
|
if (soIncludeType in fXMLStreamerOptions) then node.AddAttribute(attr_Type, props^[i]^.PropType^.Name);
|
|
SerializeSimpleType(node, anObject, props^[i]);
|
|
end;
|
|
end;
|
|
finally
|
|
FreeMem(props, cnt * SizeOf(PPropInfo));
|
|
end;
|
|
end
|
|
|
|
(* // TROArray (they don't have properties so they will not fall in the previous block)
|
|
else if (anObject is TROArray) then begin
|
|
arr := TROArray(anObject);
|
|
anObjectNode.AddAttribute(attr_IsArray, XMLBooleans[TRUE]);
|
|
anObjectNode.AddAttribute(attr_Count, arr.Count);
|
|
|
|
if (arr.GetItemType<>NIL) then begin
|
|
anObjectNode.AddAttribute(attr_ItemClass, arr.GetItemType^.Name);
|
|
for x := 0 to (arr.Count-1) do begin
|
|
subnode := anObjectNode.Add(attr_Item+IntToStr(x));
|
|
SerializeObject(subnode, TObject(arr.GetItemRef(x)));
|
|
end;
|
|
end;
|
|
end*)
|
|
end;
|
|
end
|
|
|
|
else
|
|
anObjectNode.AddAttribute(attr_IsNull, XMLBooleans[TRUE]);
|
|
end;
|
|
|
|
procedure TROXMLStreamer.DeserializeObject(const anObjectNode: IXMLNode;
|
|
anObject: TObject; IsRoot: boolean = FALSE);
|
|
var
|
|
props: PPropList;
|
|
x, cnt, i: integer;
|
|
node: IXMLNode;
|
|
coll: TCollection;
|
|
|
|
// Temporary variables
|
|
objval: TObject;
|
|
pdata: PTypeData;
|
|
collitem: TCollectionItem;
|
|
strVal: string;
|
|
lName: string;
|
|
begin
|
|
if (anObjectNode.GetAttributeValue(attr_IsNull, XMLBooleans[FALSE]) = XMLBooleans[TRUE]) then begin
|
|
//anObject := NIL;
|
|
Exit;
|
|
end;
|
|
|
|
pdata := GetTypeData(anObject.ClassInfo);
|
|
|
|
if (pdata <> nil) then begin
|
|
|
|
cnt := pdata.PropCount;
|
|
|
|
if (cnt > 0) then begin
|
|
GetMem(props, cnt * SizeOf(PPropInfo));
|
|
|
|
try
|
|
cnt := GetPropList(PTypeInfo(anObject.ClassInfo), tkProperties, props);
|
|
|
|
for i := 0 to (cnt - 1) do begin
|
|
lname:= {$IFDEF UNICODE}UTF8ToString {$ENDIF}(props^[i]^.Name);
|
|
if IsRoot and (fPropertiesToIgnore.IndexOf(lName) >= 0) then Continue;
|
|
|
|
node := anObjectNode.GetNodeByName(lName);
|
|
if (node = nil) then Continue; // Property was not streamed
|
|
|
|
with props^[i]^ do
|
|
// Class types
|
|
if (PropType^.Kind = tkClass) then begin
|
|
objval := GetObjectProp(anObject, lName);
|
|
|
|
if (objval = nil) then
|
|
Continue
|
|
|
|
else begin
|
|
// TComponent
|
|
if (objval is TStrings) then begin
|
|
TStrings(objval).Text := node.Value;
|
|
end else
|
|
if (objval is TComponent) then begin
|
|
if (TComponent(objval).Owner = anObject) then
|
|
DeserializeObject(node, objval) // Owned sub-component
|
|
else begin
|
|
// Reference to another component
|
|
{node.AddAttribute(attr_ByRef, XMLBooleans[TRUE]);
|
|
node.AddAttribute(attr_RefName, TComponent(objval).Name);
|
|
if (TComponent(objval).Owner<>NIL)
|
|
then node.AddAttribute(attr_Owner, TComponent(objval).Owner.Name);}
|
|
end;
|
|
end
|
|
|
|
// TCollection
|
|
else if (objval is TCollection) then begin
|
|
coll := TCollection(objval);
|
|
coll.Clear;
|
|
|
|
for x := 0 to (node.ChildrenCount - 1) do try
|
|
if SameText(Copy(node.Children[x].Name, 1, 4), attr_Item) then begin
|
|
collitem := coll.Add;
|
|
DeserializeObject(node.Children[x], collitem);
|
|
end;
|
|
except
|
|
raise
|
|
end;
|
|
end
|
|
|
|
// Standard persistent class
|
|
else
|
|
DeserializeObject(node, objval);
|
|
end
|
|
end
|
|
|
|
// Simple types
|
|
else begin
|
|
case PropType^.Kind of
|
|
tkEnumeration: begin
|
|
// If enumerated values are empty, it should just skip and leave the defaults.
|
|
// Not doing so generates a range check error.
|
|
strVal := VarToStr(node.Value);
|
|
if (strVal<>'')
|
|
then SetPropValue(anObject, lName, GetEnumValue(props^[i]^.PropType{$IFNDEF FPC}^{$ENDIF}, strVal));
|
|
end;
|
|
else
|
|
SetPropValue(anObject, lName, node.Value);
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
FreeMem(props, cnt * SizeOf(PPropInfo));
|
|
end;
|
|
end
|
|
|
|
// TROArray (they don't have properties so they will not fall in the previous block)
|
|
(* else if (anObject is TROArray) then begin
|
|
arr := TROArray(anObject);
|
|
arr.Resize(anObjectNode.ChildrenCount-1);
|
|
|
|
if (arr.GetItemType<>NIL) then begin
|
|
arr.GetItemClass.Create
|
|
anObjectNode.AddAttribute(attr_ItemClass, arr.GetItemType^.Name);
|
|
for x := 0 to (arr.Count-1) do begin
|
|
subnode := anObjectNode.Add(attr_Item+IntToStr(x));
|
|
SerializeObject(subnode, TObject(arr.GetItemRef(x)));
|
|
end;
|
|
end;
|
|
end*)
|
|
end;
|
|
end;
|
|
|
|
procedure TROXMLStreamer.SetPropertiesToIgnore(const Value: TStrings);
|
|
begin
|
|
fPropertiesToIgnore.Assign(Value);
|
|
end;
|
|
|
|
function TROXMLStreamer.GetPropertiesToIgnore: TStrings;
|
|
begin
|
|
result := fPropertiesToIgnore;
|
|
end;
|
|
|
|
// Dataset oriented functions
|
|
function DatasetToXML(
|
|
const aDataset : IDADataset;
|
|
const RootNodeName : string = '';
|
|
const RecordNodeName : string = 'Record';
|
|
IncludeSchema : boolean = TRUE) : IXMLDocument;
|
|
var root, node : IXMLNode;
|
|
i : integer;
|
|
begin
|
|
result := NewROXmlDocument;
|
|
|
|
if (RootNodeName<>'') then result.New(RootNodeName)
|
|
else begin
|
|
if (Trim(aDataset.Name)<>'') then result.New(aDataset.Name)
|
|
else result.New('Dataset');
|
|
end;
|
|
|
|
if not aDataset.Active then Exit;
|
|
|
|
root := result.DocumentNode;
|
|
|
|
if IncludeSchema then begin
|
|
end;
|
|
|
|
while not aDataset.EOF do try
|
|
node := root.Add(RecordNodeName);
|
|
for i := 0 to aDataset.FieldCount-1 do begin
|
|
node.Add(aDataset.Fields[i].Name).Value := aDataset.Fields[i].AsString;
|
|
end;
|
|
finally
|
|
aDataset.Next;
|
|
end;
|
|
end;
|
|
|
|
procedure XMLToCommandParams(const aCommand : IDASQLCommand; const XML : string);
|
|
var xmldoc : IXMLDocument;
|
|
i : integer;
|
|
node : IXMLNode;
|
|
param : TDAParam;
|
|
begin
|
|
xmldoc := NewROXmlDocument;
|
|
xmldoc.New('CommandParams');
|
|
xmldoc.XML := XML;
|
|
|
|
for i := 0 to (aCommand.Params.Count-1) do
|
|
aCommand.Params[i].Value := Null;
|
|
|
|
for i := 0 to (xmldoc.DocumentNode.ChildrenCount-1) do begin
|
|
node := xmldoc.DocumentNode.Children[i];
|
|
param := aCommand.Params.FindParam(node.Name);
|
|
if (param=NIL) then Continue;
|
|
|
|
param.Value := node.Value;
|
|
end;
|
|
end;
|
|
|
|
function XMLToUpdateCommand(const aConnection : IDAConnection;
|
|
const aReferencedDataset : TDADataset;
|
|
const aTargetTableName : string;
|
|
const aXML : string) : IDASQLCommand;
|
|
const CRLF = #13#10;
|
|
var fld : TDAField;
|
|
i : integer;
|
|
xmldoc : IXMLDocument;
|
|
nme, where, sql : string;
|
|
begin
|
|
xmldoc := NewROXmlDocument;
|
|
xmldoc.New;
|
|
xmldoc.XML := aXML;
|
|
|
|
result := NIL;
|
|
if (xmldoc.DocumentNode.ChildrenCount=0)
|
|
then raise Exception.Create('Invalid XML document. Cannot generate an update statement');
|
|
|
|
sql := 'UPDATE '+aTargetTableName+' SET'+CRLF;
|
|
where := '';
|
|
|
|
with xmldoc do begin
|
|
for i := 0 to (DocumentNode.ChildrenCount-1) do begin
|
|
nme := DocumentNode.Children[i].Name;
|
|
fld := aReferencedDataset.Fields.FindField(nme);
|
|
|
|
if (fld=NIL) then begin
|
|
if (Pos(old_FieldPrefix, UpperCase(nme))=1) then begin
|
|
if (where<>'') then where := where+' AND ';
|
|
nme := Copy(nme, Length(old_FieldPrefix)+1, MaxInt);
|
|
fld := aReferencedDataset.Fields.FindField(nme);
|
|
if (fld=NIL) then Continue;
|
|
if (fld.DataType in [datWideString, datString, datDateTime])
|
|
then where := where+nme+'='+''''+VarToStr(DocumentNode.Children[i].Value)+''''
|
|
else where := where+nme+'='+VarToStr(DocumentNode.Children[i].Value);
|
|
|
|
end;
|
|
Continue;
|
|
end
|
|
else begin
|
|
sql := sql+fld.Name+'=';
|
|
if (fld.DataType in [datWideString, datString, datDateTime])
|
|
then sql := sql+''''+VarToStr(DocumentNode.Children[i].Value)+''''
|
|
else sql := sql+VarToStr(DocumentNode.Children[i].Value);
|
|
sql := sql+','+CRLF;
|
|
end;
|
|
end;
|
|
end;
|
|
sql := Copy(sql, 1, Length(sql)-3)+CRLF;
|
|
|
|
if (where<>'') then sql := sql+' WHERE '+where;
|
|
|
|
result := aConnection.NewCommand(sql, stSQL, 'UPDATE_'+aTargetTableName);
|
|
end;
|
|
|
|
procedure TROXMLStreamer.Serialize(const aSource: TObject; const anObjectNode: IXMLNode; IsRoot: boolean = True);
|
|
begin
|
|
if (anObjectNode = nil) then raise Exception.Create('Invalid XMLNode.');
|
|
if (aSource <> nil) then SerializeObject(anObjectNode, aSource, IsRoot);
|
|
end;
|
|
|
|
end.
|