david
2824855ea7
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
826 lines
27 KiB
ObjectPascal
826 lines
27 KiB
ObjectPascal
unit uDAXMLAdapter;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ 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, SysUtils,
|
|
uROTypes, uROXMLIntf,
|
|
uDAInterfaces, uDADataStreamer, uDADelta;
|
|
|
|
const
|
|
// Data stream node names
|
|
nn_DocumentName = 'XMLData';
|
|
nn_Schema = 'Schema';
|
|
nn_Datasets = 'Datasets';
|
|
nn_Fields = 'Fields';
|
|
nn_Field = 'Field';
|
|
nn_Params = 'Params';
|
|
nn_Param = 'Param';
|
|
nn_Row = 'Row';
|
|
|
|
// Delta stream node names
|
|
nn_Deltas = 'Deltas';
|
|
|
|
attr_RecId = 'RecId';
|
|
|
|
|
|
type
|
|
TDAXMLSchemaOption = (soIncludeEmptyAttributes);
|
|
TDAXMLSchemaOptions = set of TDAXMLSchemaOption;
|
|
|
|
TDAXMLRowOption = (roCompressBlobs);
|
|
TDAXMLRowOptions = set of TDAXMLRowOption;
|
|
|
|
TDAXmlDataStreamerOption = (xaoUseDatasetXSLTs, xaoUseDeltaXSLTs);
|
|
TDAXmlDataStreamerOptions = set of TDAXmlDataStreamerOption;
|
|
|
|
{ TDAXmlDataStreamer }
|
|
TDAXmlDataStreamer = class(TDADataStreamer)
|
|
private
|
|
fWriteXSLT,
|
|
fReadXSLT{,
|
|
fWriteDeltaXSLT,
|
|
fReadDeltaXSLT} : IXMLDocument;
|
|
|
|
fXMLDocument : IXMLDocument;
|
|
fSchemaRoot,
|
|
fRootNode,
|
|
fDatasetSchemaNode,
|
|
fDeltaSchemaNode,
|
|
fDatasetNode,
|
|
fDeltaNode : IXMLNode;
|
|
|
|
fDAFieldPropInfoList : PPropList;
|
|
fDAMemPropCount,
|
|
fDAFieldPropCount : integer;
|
|
fSchemaOptions: TDAXMLSchemaOptions;
|
|
fRowOptions: TDAXMLRowOptions;
|
|
fOptions: TDAXmlDataStreamerOptions;
|
|
fDocumentName: string;
|
|
fSkipNull: boolean;
|
|
param_proplistcount: integer;
|
|
param_PropList: PPropList;
|
|
|
|
procedure WriteBlobValue(const aDestination : IXMLNode; const anAttributeName : string; const aBlobValue : Variant);
|
|
function ReadBlobValue(const aSource: IXMLNode; const anAttributeName : string) : Variant;
|
|
function GetReadXSLT: IXMLDocument;
|
|
function GetWriteXSLT: IXMLDocument;
|
|
{function GetReadDeltaXSLT: IXMLDocument;
|
|
function GetWriteDeltaXSLT: IXMLDocument;}
|
|
|
|
function GetXMLDocument(var XMLDocument: IXMLDocument): IXMLDocument;
|
|
function SaveDocumentName: Boolean;
|
|
procedure SetDocumentName(const Value: string);
|
|
procedure ClearXMLNodes;
|
|
|
|
protected
|
|
function DoCreateStream: TStream; override;
|
|
procedure DoInitialize(Mode: TDAAdapterInitialization); override;
|
|
procedure DoFinalize; override;
|
|
function DoWriteDataset(const Source: IDADataset; Options: TDAWriteOptions; MaxRows: integer;ADynFieldNames: array of string): integer; override;
|
|
procedure DoWriteDelta(const Source: IDADelta); override;
|
|
procedure DoReadDataset(const DatasetName: string; const Destination: IDADataset; ApplySchema: boolean); override;
|
|
procedure DoReadDelta(const DeltaName: string; const Destination: IDADelta); override;
|
|
|
|
public
|
|
constructor Create(aOwner : TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
function GetTargetDataType: TRODataType; override;
|
|
|
|
property ReadXSLT : IXMLDocument read GetReadXSLT write fReadXSLT;
|
|
property WriteXSLT : IXMLDocument read GetWriteXSLT write fWriteXSLT;
|
|
{property ReadDeltaXSLT : IXMLDocument read GetReadDeltaXSLT write fReadDeltaXSLT;
|
|
property WriteDeltaXSLT : IXMLDocument read GetWriteDeltaXSLT write fWriteDeltaXSLT;}
|
|
|
|
published
|
|
property SkipNull : boolean read fSkipNull write fSkipNull default true;
|
|
property SchemaOptions : TDAXMLSchemaOptions read fSchemaOptions write fSchemaOptions;
|
|
property RowOptions : TDAXMLRowOptions read fRowOptions write fRowOptions;
|
|
property Options : TDAXmlDataStreamerOptions read fOptions write fOptions;
|
|
property DocumentName : string read fDocumentName write SetDocumentName stored SaveDocumentName;
|
|
end;
|
|
|
|
TDAXMLAdapter = class(TDAXmlDataStreamer) end deprecated;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Variants, uROXMLSerializer, uROCompression, uROClasses, uROBinaryHelpers
|
|
{$IFNDEF LINUX}
|
|
,uROZLib
|
|
{$ENDIF};
|
|
|
|
const
|
|
XML_DateTimeFormat = 'yyyy-mm-dd"T"hh":"nn":"ss"."zzz';
|
|
|
|
function XMLDateTimeToDateTime(const aXMLDateTime : string) : TDateTime;
|
|
var year, month, day, hour, min, sec, msec : word;
|
|
begin {yyyy-mm-ddThh:nn:ss.zzz}
|
|
year := StrToInt(Copy(aXMLDateTime,1,4));
|
|
month := StrToInt(Copy(aXMLDateTime,6,2));
|
|
day := StrToInt(Copy(aXMLDateTime,9,2));
|
|
hour := StrToInt(Copy(aXMLDateTime,12,2));
|
|
min := StrToInt(Copy(aXMLDateTime,15,2));
|
|
sec := StrToInt(Copy(aXMLDateTime,18,2));
|
|
msec := StrToInt(Copy(aXMLDateTime,21,3));
|
|
|
|
result := EncodeDate(year, month, day);
|
|
// The code below is required! Do not adjust
|
|
if (result<0)
|
|
then result := result-EncodeTime(hour, min, sec, msec)
|
|
else result := result+EncodeTime(hour, min, sec, msec)
|
|
end;
|
|
|
|
function DateTimeToXMLDateTime(aDateTime : TDateTime) : string;
|
|
begin
|
|
Result := FormatDateTime(XML_DateTimeFormat, aDateTime);
|
|
end;
|
|
|
|
function WriteFloat(Val: Variant): String;
|
|
begin
|
|
Result := FloatToStr(Val{$IFDEF DELPHI7UP},SOAPFormatSettings{$ENDIF});
|
|
|
|
{$IFNDEF DELPHI7UP}
|
|
if DecimalSeparator <> '.' then
|
|
ReplaceChar(Result, [DecimalSeparator], '.');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
|
|
function ReadFloat(text: String): Variant;
|
|
begin
|
|
{$IFNDEF DELPHI7UP}
|
|
if DecimalSeparator <> '.' then
|
|
ReplaceChar(text, ['.'], DecimalSeparator);
|
|
{$ENDIF}
|
|
|
|
Result := SOAPStrToFloat(text);
|
|
end;
|
|
|
|
{ TDAXmlDataStreamer }
|
|
|
|
constructor TDAXmlDataStreamer.Create(aOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
|
|
fDocumentName := nn_DocumentName;
|
|
|
|
fSchemaOptions := [soIncludeEmptyAttributes];
|
|
|
|
fXMLDocument := NewROXmlDocument;
|
|
|
|
fWriteXSLT := NIL;
|
|
fReadXSLT := NIL;
|
|
{fWriteDeltaXSLT := NIL;
|
|
fReadDeltaXSLT := NIL;}
|
|
|
|
fOptions := [xaoUseDatasetXSLTs, xaoUseDeltaXSLTs];
|
|
|
|
fDAMemPropCount := GetTypeData(TDAField.ClassInfo).PropCount;
|
|
GetMem(fDAFieldPropInfoList, fDAMemPropCount*SizeOf(PPropInfo));
|
|
fDAFieldPropCount := GetPropList(TDAField.ClassInfo, tkProperties, fDAFieldPropInfoList);
|
|
|
|
GetMem(param_PropList, GetTypeData(TDAParam.ClassInfo).PropCount * SizeOf(PPropInfo));
|
|
param_proplistcount := GetPropList(TDAParam.ClassInfo, tkProperties, param_PropList);
|
|
fSkipNull := true;
|
|
end;
|
|
|
|
destructor TDAXmlDataStreamer.Destroy;
|
|
begin
|
|
fWriteXSLT := NIL;
|
|
fReadXSLT := NIL;
|
|
{fWriteDeltaXSLT := NIL;
|
|
fReadDeltaXSLT := NIL;}
|
|
|
|
FreeMem(fDAFieldPropInfoList, fDAMemPropCount*SizeOf(PPropInfo));
|
|
FreeMem(param_PropList);
|
|
|
|
ClearXMLNodes;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
function TDAXmlDataStreamer.GetTargetDataType: TRODataType;
|
|
begin
|
|
result := rtString
|
|
end;
|
|
|
|
function TDAXmlDataStreamer.DoCreateStream: TStream;
|
|
begin
|
|
result := NIL;
|
|
end;
|
|
|
|
procedure TDAXmlDataStreamer.DoInitialize(Mode: TDAAdapterInitialization);
|
|
var
|
|
i : integer;
|
|
begin
|
|
inherited;
|
|
|
|
ClearXMLNodes;
|
|
fXMLDocument.New(fDocumentName);
|
|
|
|
if (Mode in AdapterReadModes) then begin
|
|
|
|
fXMLDocument.LoadFromStream(Data);
|
|
|
|
// Applies the XSLT (if any). The resulting document MUST be a valid XML document
|
|
// that conforms to the Data Abstract XML format
|
|
if (fReadXSLT<>NIL)
|
|
then fXMLDocument.XML := fXMLDocument.Transform(fReadXSLT.XML);
|
|
|
|
// Parses the document
|
|
fRootNode := fXMLDocument.DocumentNode;
|
|
|
|
// Schema sections
|
|
fSchemaRoot := fRootNode.GetNodeByName(nn_Schema);
|
|
if (fSchemaRoot<>NIL) then begin
|
|
fDatasetSchemaNode := fSchemaRoot.GetNodeByName(nn_Datasets);
|
|
fDeltaSchemaNode := fSchemaRoot.GetNodeByName(nn_Deltas);
|
|
end;
|
|
|
|
// Data sections
|
|
fDatasetNode := fRootNode.GetNodeByName(nn_Datasets);
|
|
fDeltaNode := fRootNode.GetNodeByName(nn_Deltas);
|
|
|
|
if (fDatasetSchemaNode<>NIL) and (fDatasetSchemaNode.ChildrenCount>0) then begin
|
|
for i := 0 to (fDatasetSchemaNode.ChildrenCount-1) do
|
|
AddingDataset(fDatasetSchemaNode.Children[i].Name);
|
|
end
|
|
else if (fDatasetNode<>NIL) then begin
|
|
for i := 0 to (fDatasetNode.ChildrenCount-1) do
|
|
AddingDataset(fDatasetNode.Children[i].Name);
|
|
end;
|
|
|
|
if (fDeltaSchemaNode<>NIL) and (fDeltaSchemaNode.ChildrenCount>0) then begin
|
|
for i := 0 to (fDeltaSchemaNode.ChildrenCount-1) do
|
|
AddingDelta(fDeltaSchemaNode.Children[i].Name);
|
|
end
|
|
else if (fDeltaNode<>NIL) then begin
|
|
for i := 0 to (fDeltaNode.ChildrenCount-1) do
|
|
AddingDataset(fDeltaNode.Children[i].Name);
|
|
end;
|
|
|
|
end
|
|
else if (Mode in AdapterWriteModes) then begin
|
|
fRootNode := fXMLDocument.DocumentNode;
|
|
// Schema sections
|
|
fSchemaRoot := fRootNode.Add(nn_Schema);
|
|
fDatasetSchemaNode := fSchemaRoot.Add(nn_Datasets);
|
|
fDeltaSchemaNode := fSchemaRoot.Add(nn_Deltas);
|
|
|
|
// Data sections
|
|
fDatasetNode := fRootNode.Add(nn_Datasets);
|
|
fDeltaNode := fRootNode.Add(nn_Deltas);
|
|
end;
|
|
end;
|
|
|
|
procedure TDAXmlDataStreamer.DoFinalize;
|
|
var finaldocument : string;
|
|
begin
|
|
if (AdapterInitialization in AdapterWriteModes) then begin
|
|
// Removes the delta sections if they don't contain data
|
|
if (fDeltaSchemaNode.ChildrenCount=0) then begin
|
|
fSchemaRoot.Remove(fDeltaSchemaNode);
|
|
fDeltaSchemaNode := NIL;
|
|
end;
|
|
|
|
if (fDeltaNode.ChildrenCount=0) then begin
|
|
fRootNode.Remove(fDeltaNode);
|
|
fDeltaNode := NIL;
|
|
end;
|
|
|
|
// Removes the datasets sections if they don't contain data
|
|
if (fDatasetSchemaNode.ChildrenCount=0) then begin
|
|
fSchemaRoot.Remove(fDatasetSchemaNode);
|
|
fDatasetSchemaNode := NIL;
|
|
end;
|
|
|
|
if (fDatasetNode.ChildrenCount=0) then begin
|
|
fRootNode.Remove(fDatasetNode);
|
|
fDeltaNode := NIL;
|
|
end;
|
|
|
|
// Applies the XSLT (if any)
|
|
if (fWriteXSLT<>NIL)
|
|
then begin
|
|
// The resulting document might not be a valid XML document!!
|
|
finaldocument := fXMLDocument.Transform(fWriteXSLT.XML);
|
|
if (finaldocument<>'')
|
|
then Data.Write(finaldocument[1], Length(finaldocument));
|
|
end
|
|
else fXMLDocument.SaveToStream(Data);
|
|
end;
|
|
ClearXMLNodes;
|
|
end;
|
|
|
|
procedure TDAXmlDataStreamer.WriteBlobValue(const aDestination : IXMLNode; const anAttributeName : string; const aBlobValue : Variant);
|
|
var ss, compressedstream : TStringStream;
|
|
binstream : Binary;
|
|
begin
|
|
compressedstream := NIL;
|
|
binstream := Binary.Create;
|
|
ss := TStringStream.Create('');
|
|
|
|
try
|
|
//binstream := BinaryFromVariant(aBlobValue);//, ms.Stream);
|
|
WriteVariantToBinary(aBlobValue, binstream);
|
|
binstream.Position := 0;
|
|
|
|
if (roCompressBlobs in fRowOptions) then begin
|
|
compressedstream := TStringStream.Create('');
|
|
ZCompressStream(binstream, compressedstream);
|
|
compressedstream.Position := 0;
|
|
|
|
EncodeStream(compressedstream, ss);
|
|
end
|
|
else begin
|
|
EncodeStream(binstream, ss);
|
|
end;
|
|
|
|
aDestination.AddAttribute(anAttributeName, ss.DataString);
|
|
|
|
finally
|
|
FreeAndNIL(ss);
|
|
FreeAndNIL(compressedstream);
|
|
FreeAndNIL(binstream);
|
|
end;
|
|
end;
|
|
|
|
function TDAXmlDataStreamer.ReadBlobValue(const aSource: IXMLNode; const anAttributeName : string) : Variant;
|
|
var data, compressedstream : TStringStream;
|
|
finaldata : IROStream;
|
|
begin
|
|
compressedstream := NIL;
|
|
|
|
data := TStringStream.Create(aSource.GetAttributeValue(anAttributeName, NULL));
|
|
finaldata := NewROStream;
|
|
|
|
try
|
|
data.Position := 0;
|
|
|
|
if (roCompressBlobs in fRowOptions) then begin
|
|
compressedstream := TStringStream.Create('');
|
|
DecodeStream(data, compressedstream);
|
|
compressedstream.Position := 0;
|
|
|
|
ZDecompressStream(compressedstream, finaldata.Stream);
|
|
finaldata.Position := 0;
|
|
end
|
|
else begin
|
|
DecodeStream(data, finaldata.Stream);
|
|
end;
|
|
|
|
finaldata.Position := 0;
|
|
result := ReadVariantFromBinary(finaldata.Stream);
|
|
|
|
finally
|
|
FreeAndNIL(data);
|
|
FreeAndNIL(compressedstream);
|
|
end;
|
|
end;
|
|
|
|
procedure TDAXmlDataStreamer.DoReadDataset(const DatasetName: string;
|
|
const Destination: IDADataset; ApplySchema: boolean);
|
|
var sourcenode : IXMLNode;
|
|
i, x : integer;
|
|
attr, node, scNode : IXMLNode;
|
|
fld : TDAField;
|
|
par: TDAParam;
|
|
val: Variant;
|
|
editable : IDAEditableDataset;
|
|
begin
|
|
// Reads and applies the schema
|
|
if ApplySchema then begin
|
|
scNode := fDatasetSchemaNode.GetNodeByName(DatasetName);
|
|
if (scNode=NIL) then exit;//raise EROException.Create('Cannot find schema for dataset '+DatasetName)
|
|
sourcenode := scNode.GetNodeByName(nn_Fields); // For now we only have fields, so this is ok
|
|
if sourcenode <> nil then begin
|
|
Destination.Fields.Clear;
|
|
|
|
for i := 0 to (sourcenode.ChildrenCount-1) do begin
|
|
fld := Destination.Fields.Add;
|
|
node := sourcenode.Children[i];
|
|
|
|
for x := 0 to (fDAFieldPropCount-1) do begin
|
|
attr := node.GetAttributeByName(fDAFieldPropInfoList^[x].Name);
|
|
if (attr=NIL) then Continue;
|
|
|
|
if (fDAFieldPropInfoList^[x].PropType^.Kind<>tkClass)
|
|
then SetPropValue(fld, fDAFieldPropInfoList^[x].Name, VarToStr(attr.Value));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
sourcenode := scNode.GetNodeByName(nn_Params); // For now we only have fields, so this is ok
|
|
if sourcenode <> nil then begin
|
|
Destination.Params.Clear;
|
|
|
|
for i := 0 to (sourcenode.ChildrenCount-1) do begin
|
|
par := Destination.Params.Add;
|
|
node := sourcenode.Children[i];
|
|
|
|
for x := 0 to (param_proplistcount-1) do begin
|
|
attr := node.GetAttributeByName(param_PropList^[x].Name);
|
|
if (attr=NIL) then Continue;
|
|
|
|
if (param_PropList^[x].PropType^.Kind<>tkClass)
|
|
then SetPropValue(par, param_PropList^[x].Name, VarToStr(attr.Value));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end
|
|
else begin
|
|
editable := Destination as IDAEditableDataset;
|
|
sourcenode := fDatasetNode.GetNodeByName(DatasetName);
|
|
if (sourcenode=NIL)
|
|
then raise EROException.Create('Cannot find schema for dataset '+DatasetName);
|
|
|
|
if not Destination.Active then Destination.Open;
|
|
|
|
{$IFDEF STORERECID}
|
|
Destination.CurrentRecIdValue := 0;
|
|
{$ENDIF}
|
|
|
|
Destination.DisableConstraints;
|
|
try
|
|
for i := 0 to sourcenode.ChildrenCount-1 do begin
|
|
editable.Append;
|
|
|
|
node := sourcenode.Children[i];
|
|
|
|
{$IFDEF STORERECID}
|
|
Destination.CurrentRecIdValue := node.GetAttributeValue(attr_RecId, -1);
|
|
for x := 1 to node.AttributeCount-1 do begin
|
|
{$ELSE}
|
|
for x := 0 to node.AttributeCount-1 do begin
|
|
{$ENDIF}
|
|
attr := node.Attributes[x];
|
|
fld := Destination.Fields.FieldByName(attr.Name);
|
|
|
|
if fld.Calculated or fld.Lookup then Continue;
|
|
|
|
if (attr.Value = '') and (fld.DataType <> datBlob) then begin
|
|
val := NULL;
|
|
end else begin
|
|
case fld.DataType of
|
|
datBlob : val := ReadBlobValue(node, attr.Name); // <--- MARC!!!
|
|
datDateTime : val := XMLDateTimeToDateTime(attr.Value);
|
|
datFloat,
|
|
datCurrency: val := ReadFloat(attr.Value);
|
|
// TODO -cAleF: remember to use the proper XML conversion routines here!
|
|
else val := attr.Value;
|
|
end;
|
|
end;
|
|
|
|
if Assigned(OnReadFieldValue) then OnReadFieldValue(fld, val);
|
|
fld.Value := val;
|
|
|
|
end;
|
|
|
|
editable.Post;
|
|
end;
|
|
finally
|
|
Destination.EnableConstraints;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDAXmlDataStreamer.DoWriteDataset(const Source: IDADataset;
|
|
Options: TDAWriteOptions; MaxRows: integer; ADynFieldNames: array of string): integer;
|
|
var i, x, max, k : integer;
|
|
subnode, node, scNode : IXMLNode;
|
|
s : string;
|
|
fld : TDAField;
|
|
val: Variant;
|
|
lfields: array of integer;
|
|
begin
|
|
result := 0;
|
|
|
|
if Length(ADynFieldNames) > 0 then begin
|
|
SetLength(lfields, Length(ADynFieldNames));
|
|
For x:=0 to High(ADynFieldNames) do begin
|
|
fld:=Source.Fields.FindField(ADynFieldNames[x]);
|
|
if fld <> nil then
|
|
lfields[x]:= fld.Index
|
|
else
|
|
lfields[x]:= -1;
|
|
end;
|
|
end else begin
|
|
SetLength(lfields, Source.FieldCount);
|
|
For x:=0 to Source.FieldCount-1 do
|
|
lfields[x]:=x;
|
|
end;
|
|
|
|
// Writes the schema
|
|
if (woSchema in Options) or (Length(ADynFieldNames)>0) then begin
|
|
scNode := fDatasetSchemaNode.Add(Source.LogicalName);
|
|
node := scNode.Add(nn_Fields);
|
|
|
|
for i := 0 to high(lfields) do begin
|
|
subnode := node.Add(nn_Field);
|
|
|
|
for x := 0 to (fDAFieldPropCount-1) do begin
|
|
s := VarToStr(GetPropValue(Source.Fields[lfields[i]], fDAFieldPropInfoList^[x].Name, TRUE));
|
|
|
|
if (s<>'') or (soIncludeEmptyAttributes in SchemaOptions)
|
|
then subnode.AddAttribute(fDAFieldPropInfoList^[x].Name, s);
|
|
end;
|
|
end;
|
|
node := scNode.Add(nn_Params);
|
|
|
|
for i := 0 to (Source.Params.Count-1) do begin
|
|
subnode := node.Add(nn_Param);
|
|
|
|
for x := 0 to (param_proplistcount-1) do begin
|
|
s := VarToStr(GetPropValue(Source.Params[i], param_PropList^[x].Name, TRUE));
|
|
|
|
if (s<>'') or (soIncludeEmptyAttributes in SchemaOptions)
|
|
then subnode.AddAttribute(param_PropList^[x].Name, s);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// Writes the data
|
|
if (woRows in Options) then begin
|
|
Source.DisableControls;
|
|
try
|
|
if not Source.Active then Source.Open;
|
|
|
|
k := 0;
|
|
max := MaxRows;
|
|
node := fDatasetNode.Add(Source.LogicalName);
|
|
//if (MaxRows<0) then cnt := source.RecordCount else cnt := MaxRows;
|
|
while (k<>max) and not source.EOF do begin
|
|
result := 0;
|
|
|
|
subnode := node.Add(nn_Row);
|
|
|
|
{$IFDEF STORERECID}
|
|
subnode.AddAttribute(attr_RecId, Source.GetRowRecIdValue);
|
|
{$ENDIF}
|
|
|
|
for x := 0 to high(lfields) do begin
|
|
fld := Source.Fields[lfields[x]];
|
|
val := Source.FieldValues[lfields[x]];
|
|
if Assigned(OnBeforeFieldValueSerialization) then OnBeforeFieldValueSerialization(fld, val);
|
|
|
|
if fld.Calculated or fld.Lookup or (fld.IsNull and fSkipNull) then Continue;
|
|
|
|
if Assigned(OnWriteFieldValue) then OnWriteFieldValue(fld, val);
|
|
|
|
if (VarIsEmpty(val) or VarIsNull(val)) and (fld.DataType <> datBlob) then begin
|
|
subnode.AddAttribute(fld.Name, VarToStr(Null))
|
|
end else begin
|
|
case fld.DataType of
|
|
datBlob : WriteBlobValue(subnode, fld.Name, val);// <--- MARC!!!
|
|
datDateTime : subnode.AddAttribute(fld.Name, DateTimeToXMLDateTime(val));
|
|
datFloat,
|
|
datCurrency: subnode.AddAttribute(fld.Name, WriteFloat(val));
|
|
// TODO -cAleF: remember to use the proper XML conversion reoutines here!
|
|
else subnode.AddAttribute(fld.Name, VarToStr(val));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
Source.Next;
|
|
Inc(k);
|
|
Inc(result);
|
|
|
|
if Source.EOF then Break;
|
|
end;
|
|
finally
|
|
Source.EnableControls;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAXmlDataStreamer.DoReadDelta(const DeltaName: string;
|
|
const Destination: IDADelta);
|
|
var schema, rootnode, node, subnode : IXMLNode;
|
|
x, i : integer;
|
|
fieldname : string;
|
|
datatype : TDADataType;
|
|
changetype : TDAChangeType;
|
|
changestatus : TDAChangeStatus;
|
|
changemessage : string;
|
|
recid : integer;
|
|
change : TDADeltaChange;
|
|
val : Variant;
|
|
begin
|
|
Destination.Clear(TRUE, TRUE);
|
|
schema := fDeltaSchemaNode.GetNodeByName(DeltaName);
|
|
|
|
// Logged fields and their types
|
|
rootnode := schema.GetNodeByName('LoggedFields');
|
|
for i := 0 to (rootnode.ChildrenCount-1) do begin
|
|
fieldname := rootnode.Children[i].GetAttributeByName('Name').Value;
|
|
datatype := TDADataType(GetEnumValue(TypeInfo(TDADataType), rootnode.Children[i].GetAttributeByName('DataType').Value));
|
|
|
|
Destination.AddFieldName(fieldname);
|
|
Destination.LoggedFieldTypes[i] := datatype;
|
|
end;
|
|
|
|
// Key fields
|
|
rootnode := schema.GetNodeByName('KeyFields');
|
|
for i := 0 to (rootnode.ChildrenCount-1) do begin
|
|
fieldname := rootnode.Children[i].GetAttributeByName('Name').Value;
|
|
Destination.AddKeyFieldName(fieldname);
|
|
end;
|
|
|
|
// Actual changes
|
|
rootnode := fDeltaNode.GetNodeByName(DeltaName);
|
|
for i := 0 to (rootnode.ChildrenCount-1) do begin
|
|
node := rootnode.Children[i];
|
|
|
|
recid := node.GetNodeByName('RecID').Value;
|
|
changetype := TDAChangeType(GetEnumValue(TypeInfo(TDAChangeType), node.GetNodeByName('ChangeType').Value));
|
|
changestatus := TDAChangeStatus(GetEnumValue(TypeInfo(TDAChangeStatus), node.GetNodeByName('Status').Value));
|
|
changemessage := node.GetNodeByName('Message').Value;
|
|
|
|
change := Destination.Add(recid, changetype, changestatus, changemessage);
|
|
|
|
subnode := node.GetNodeByName('OldValues');
|
|
for x := 0 to Destination.LoggedFieldCount-1 do begin
|
|
val := subnode.GetAttributeValue(Destination.LoggedFieldNames[x], Null);
|
|
if (val = '') and (Destination.LoggedFieldTypes[x] <> datblob) then begin
|
|
change.OldValues[x] := NULL;
|
|
end else begin
|
|
case Destination.LoggedFieldTypes[x] of
|
|
datBlob : change.OldValues[x] := ReadBlobValue(subnode, Destination.LoggedFieldNames[x]);
|
|
datDateTime : change.OldValues[x] := XMLDateTimeToDateTime(val);
|
|
datFloat,
|
|
datCurrency: change.OldValues[x] := ReadFloat(val);
|
|
else
|
|
change.OldValues[x] := val;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
subnode := node.GetNodeByName('NewValues');
|
|
for x := 0 to Destination.LoggedFieldCount-1 do begin
|
|
val := subnode.GetAttributeValue(Destination.LoggedFieldNames[x], Null);
|
|
if (val = '') and (Destination.LoggedFieldTypes[x] <> datblob) then begin
|
|
change.NewValues[x] := NULL;
|
|
end else begin
|
|
case Destination.LoggedFieldTypes[x] of
|
|
datBlob : change.NewValues[x] := ReadBlobValue(subnode, Destination.LoggedFieldNames[x]);
|
|
datDateTime : change.NewValues[x] := XMLDateTimeToDateTime(val);
|
|
datFloat,
|
|
datCurrency: change.NewValues[x] := ReadFloat(val);
|
|
else
|
|
change.NewValues[x] := val;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDAXmlDataStreamer.DoWriteDelta(const Source: IDADelta);
|
|
var rootnode, node, subnode : IXMLNode;
|
|
x, i : integer;
|
|
begin
|
|
|
|
{
|
|
<XMLData>
|
|
<Schema>
|
|
<Datasets/>
|
|
<Deltas/>
|
|
</Schema>
|
|
<Datasets/>
|
|
<Deltas/>
|
|
</XMLData>
|
|
}
|
|
|
|
// Writes the schema of the delta
|
|
rootnode := fDeltaSchemaNode.Add(Source.LogicalName);
|
|
node := rootnode.Add('LoggedFields');
|
|
for i := 0 to (Source.LoggedFieldCount-1) do begin
|
|
subnode := node.Add('Field');
|
|
subnode.AddAttribute('Name', Source.LoggedFieldNames[i]);
|
|
subnode.AddAttribute('DataType', GetEnumName(TypeInfo(TDADataType), Ord(Source.LoggedFieldTypes[i])));
|
|
end;
|
|
node := rootnode.Add('KeyFields');
|
|
for i := 0 to (Source.KeyFieldCount-1) do begin
|
|
subnode := node.Add('Field');
|
|
subnode.AddAttribute('Name', Source.KeyFieldNames[i]);
|
|
end;
|
|
|
|
// Writes the actual changes
|
|
rootnode := fDeltaNode.Add(Source.LogicalName);
|
|
for i := 0 to (Source.Count-1) do begin
|
|
node := rootnode.Add(nn_Row);
|
|
|
|
node.Add('RecID').Value := Source[i].RecID;
|
|
node.Add('ChangeType').Value := GetEnumName(TypeInfo(TDAChangeType), Ord(Source[i].ChangeType));
|
|
node.Add('Status').Value := GetEnumName(TypeInfo(TDAChangeStatus), Ord(Source[i].Status));
|
|
node.Add('Message').Value := Source[i].Message;
|
|
|
|
subnode := node.Add('OldValues');
|
|
for x := 0 to Source.LoggedFieldCount-1 do begin
|
|
if VarIsNull(Source.Changes[i].OldValues[x]) and (Source.LoggedFieldTypes[x] <> datblob) then begin
|
|
subnode.AddAttribute(Source.LoggedFieldNames[x], VarToStr(Null))
|
|
end else begin
|
|
case Source.LoggedFieldTypes[x] of
|
|
datblob: WriteBlobValue(subnode, Source.LoggedFieldNames[x], Source.Changes[i].OldValues[x]);
|
|
datDateTime : subnode.AddAttribute(Source.LoggedFieldNames[x], DateTimeToXMLDateTime(Source.Changes[i].OldValues[x]));
|
|
datFloat,
|
|
datCurrency: subnode.AddAttribute(Source.LoggedFieldNames[x], WriteFloat(Source.Changes[i].OldValues[x]));
|
|
// TODO -cAleF: remember to use the proper XML conversion reoutines here!
|
|
else subnode.AddAttribute(Source.LoggedFieldNames[x], VarToStr(Source.Changes[i].OldValues[x]));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
subnode := node.Add('NewValues');
|
|
for x := 0 to Source.LoggedFieldCount-1 do begin
|
|
if VarIsNull(Source.Changes[i].NewValues[x]) and (Source.LoggedFieldTypes[x] <> datblob) then begin
|
|
subnode.AddAttribute(Source.LoggedFieldNames[x], VarToStr(Null))
|
|
end else begin
|
|
case Source.LoggedFieldTypes[x] of
|
|
datblob: WriteBlobValue(subnode, Source.LoggedFieldNames[x], Source.Changes[i].NewValues[x]);
|
|
datDateTime : subnode.AddAttribute(Source.LoggedFieldNames[x], DateTimeToXMLDateTime(Source.Changes[i].NewValues[x]));
|
|
datFloat,
|
|
datCurrency: subnode.AddAttribute(Source.LoggedFieldNames[x], WriteFloat(Source.Changes[i].NewValues[x]));
|
|
// TODO -cAleF: remember to use the proper XML conversion reoutines here!
|
|
else subnode.AddAttribute(Source.LoggedFieldNames[x], VarToStr(Source.Changes[i].NewValues[x]));
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDAXmlDataStreamer.GetXMLDocument(var XMLDocument : IXMLDocument) : IXMLDocument;
|
|
begin
|
|
if (XMLDocument=NIL) then begin
|
|
XMLDocument := NewROXmlDocument;
|
|
XMLDocument.New();
|
|
end;
|
|
|
|
result := XMLDocument;
|
|
end;
|
|
|
|
function TDAXmlDataStreamer.GetReadXSLT: IXMLDocument;
|
|
begin
|
|
result := GetXMLDocument(fReadXSLT)
|
|
end;
|
|
|
|
{function TDAXmlDataStreamer.GetReadDeltaXSLT: IXMLDocument;
|
|
begin
|
|
result := GetXMLDocument(fReadDeltaXSLT);
|
|
end;}
|
|
|
|
function TDAXmlDataStreamer.GetWriteXSLT: IXMLDocument;
|
|
begin
|
|
result := GetXMLDocument(fWriteXSLT);
|
|
end;
|
|
|
|
{function TDAXmlDataStreamer.GetWriteDeltaXSLT: IXMLDocument;
|
|
begin
|
|
result := GetXMLDocument(fWriteDeltaXSLT);
|
|
end;}
|
|
|
|
function TDAXmlDataStreamer.SaveDocumentName: Boolean;
|
|
begin
|
|
result := fDocumentName<>nn_DocumentName
|
|
end;
|
|
|
|
procedure TDAXmlDataStreamer.SetDocumentName(const Value: string);
|
|
var n : string;
|
|
begin
|
|
n := Trim(Value);
|
|
if (n<>'')
|
|
then fDocumentName := n;
|
|
end;
|
|
|
|
procedure TDAXmlDataStreamer.ClearXMLNodes;
|
|
begin
|
|
fXMLDocument := NIL;
|
|
fXMLDocument := NewROXmlDocument;
|
|
|
|
fSchemaRoot := NIL;
|
|
fRootNode := NIL;
|
|
fDatasetSchemaNode := NIL;
|
|
fDeltaSchemaNode := NIL;
|
|
fDatasetNode := NIL;
|
|
fDeltaNode := NIL;
|
|
end;
|
|
|
|
end.
|