david
e4d0fcb01d
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@46 b6239004-a887-0f4b-9937-50029ccdca16
985 lines
34 KiB
ObjectPascal
985 lines
34 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,
|
|
uROClasses, 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';
|
|
nn_SourceTableFieldName = '___SourceTableFieldName';
|
|
|
|
type
|
|
|
|
TDADataForAppendXML = class(TDADataForAppend)
|
|
public
|
|
Node: iXMLNode;
|
|
end;
|
|
|
|
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;
|
|
function DoBeginWriteDataset( const Source: IDADataset; const Schema: TDADataset;
|
|
Options: TDAWriteOptions; MaxRows: integer;
|
|
ADynFieldNames: array of string): TDADataForAppend; override;
|
|
function DoWriteDatasetData(const Source: IDADataset; var aDataForAppend: TDADataForAppend; aDataIndex: Integer = -1): Integer; override;
|
|
function DoEndWriteDataset(aDataForAppend: TDADataForAppend): Integer; 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, uROBinaryHelpers
|
|
,uDAClasses, uDAEngine
|
|
{$IFDEF MSWINDOWS}
|
|
,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
|
|
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)*SizeOf(char));
|
|
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 : TROBinaryMemoryStream;
|
|
begin
|
|
compressedstream := NIL;
|
|
binstream := TROBinaryMemoryStream.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;
|
|
lName: string;
|
|
lProgress: Boolean;
|
|
lTotal: integer;
|
|
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
|
|
lName:= {$IFDEF UNICODE}UTF8ToString{$ENDIF}(fDAFieldPropInfoList^[x].Name);
|
|
attr := node.GetAttributeByName(lName);
|
|
if (attr=NIL) then Continue;
|
|
|
|
if (fDAFieldPropInfoList^[x].PropType^.Kind<>tkClass) then SetPropValue(fld, lName, 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
|
|
lName := {$IFDEF UNICODE}UTF8ToString{$ENDIF}(param_PropList^[x].Name);
|
|
attr := node.GetAttributeByName(lName);
|
|
if (attr=NIL) then Continue;
|
|
|
|
if (param_PropList^[x].PropType^.Kind<>tkClass) then SetPropValue(par, lName, 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}
|
|
|
|
lProgress := Assigned(OnReadDatasetProgress);
|
|
lTotal := sourcenode.ChildrenCount;
|
|
|
|
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];
|
|
if attr.Name = nn_SourceTableFieldName then
|
|
fld := Destination.Fields.FieldByName(def_SourceTableFieldName)
|
|
else
|
|
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;
|
|
if lProgress then OnReadDatasetProgress(Self, Destination, i, lTotal);
|
|
end;
|
|
finally
|
|
Destination.EnableConstraints;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDAXmlDataStreamer.DoWriteDataset(const Source: IDADataset;
|
|
Options: TDAWriteOptions; MaxRows: integer; ADynFieldNames: array of string): integer;
|
|
var
|
|
lDataForAppend: TDADataForAppend;
|
|
begin
|
|
lDataForAppend := DoBeginWriteDataset(Source, {schema}nil, Options, MaxRows, ADynFieldNames);
|
|
if woRows in Options then begin
|
|
DoWriteDatasetData(Source, lDataForAppend);
|
|
result := DoEndWriteDataset(lDataForAppend);
|
|
end
|
|
else begin
|
|
result := -1;
|
|
end;
|
|
end;
|
|
|
|
function TDAXmlDataStreamer.DoBeginWriteDataset( const Source: IDADataset; const Schema: TDADataset;
|
|
Options: TDAWriteOptions; MaxRows: integer;
|
|
ADynFieldNames: array of string): TDADataForAppend;
|
|
var
|
|
i: integer;
|
|
fld: TDAField;
|
|
lfields: array of integer;
|
|
lDataForAppend : TDADataForAppendXML;
|
|
lSchemaFields: TDAFieldCollection;
|
|
lSchemaParams: TDAParamCollection;
|
|
lLogicalName: String;
|
|
x : integer;
|
|
subnode, node, scNode : IXMLNode;
|
|
s : string;
|
|
lName: string;
|
|
|
|
begin
|
|
lDataForAppend := TDADataForAppendXML.Create();
|
|
result := lDataForAppend;
|
|
|
|
if Assigned(Schema) then begin
|
|
lDataForAppend.TableSchema := Schema;
|
|
if Schema is TDAUnionDataTable then begin
|
|
fld := Schema.FindField(def_SourceTableFieldName);
|
|
if not Assigned(fld) then begin
|
|
fld := Schema.Fields.Add();
|
|
fld.Name := def_SourceTableFieldName;
|
|
fld.DataType := datInteger;
|
|
fld.InPrimaryKey := true;
|
|
fld.ServerAutoRefresh := true;
|
|
end;
|
|
end;
|
|
lSchemaFields := Schema.Fields;
|
|
lSchemaParams := Schema.Params;
|
|
lLogicalName := Schema.Name;
|
|
end else begin
|
|
if Assigned(Source) then begin
|
|
lSchemaFields := Source.Fields;
|
|
lSchemaParams := Source.Params;
|
|
lLogicalName := Source.LogicalName;
|
|
end else begin
|
|
raise EDAException.Create('Schema or source should be assigned.');
|
|
end;
|
|
end;
|
|
|
|
|
|
if Length(ADynFieldNames) > 0 then begin
|
|
SetLength(lfields, Length(ADynFieldNames));
|
|
For i:=0 to High(ADynFieldNames) do begin
|
|
fld:=lSchemaFields.FindField(ADynFieldNames[i]);
|
|
if fld <> nil then
|
|
lfields[i]:= fld.Index
|
|
else
|
|
lfields[i]:= -1;
|
|
end;
|
|
end else begin
|
|
SetLength(lfields, lSchemaFields.Count);
|
|
For i:=0 to lSchemaFields.Count-1 do
|
|
lfields[i]:=i;
|
|
end;
|
|
|
|
// Writes the schema
|
|
if (woSchema in Options) or (Length(ADynFieldNames)>0) then begin
|
|
scNode := fDatasetSchemaNode.Add(lLogicalName);
|
|
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
|
|
lName := {$IFDEF UNICODE}UTF8ToString{$ENDIF}(fDAFieldPropInfoList^[x].Name);
|
|
s := VarToStr(GetPropValue(lSchemaFields[lfields[i]], lName, TRUE));
|
|
|
|
if (s<>'') or (soIncludeEmptyAttributes in SchemaOptions) then subnode.AddAttribute(lName, s);
|
|
end;
|
|
end;
|
|
node := scNode.Add(nn_Params);
|
|
|
|
for i := 0 to (lSchemaParams.Count-1) do begin
|
|
subnode := node.Add(nn_Param);
|
|
|
|
for x := 0 to (param_proplistcount-1) do begin
|
|
lName := {$IFDEF UNICODE}UTF8ToString{$ENDIF}(param_PropList^[x].Name);
|
|
s := VarToStr(GetPropValue(lSchemaParams.Params[i], lName, TRUE));
|
|
|
|
if (s<>'') or (soIncludeEmptyAttributes in SchemaOptions) then subnode.AddAttribute(lName, s);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
SetLength(lDataForAppend.RealFields, Length(lFields));
|
|
for i:= 0 to Length(lFields) -1 do
|
|
lDataForAppend.RealFields[i] := lFields[i];
|
|
|
|
lDataForAppend.node := fDatasetNode.Add(lLogicalName);
|
|
lDataForAppend.MaxRowCount := MaxRows;
|
|
lDataForAppend.RecordCount := 0;
|
|
end;
|
|
|
|
function TDAXmlDataStreamer.DoWriteDatasetData(const Source: IDADataset; var aDataForAppend: TDADataForAppend; aDataIndex: Integer = -1): Integer;
|
|
var
|
|
i, max, k : integer;
|
|
subnode, node : IXMLNode;
|
|
val: Variant;
|
|
lfields: array of integer;
|
|
flds: array of TDAField;
|
|
flds_names: array of string;
|
|
lProgress: Boolean;
|
|
f,ev, ev1: boolean;
|
|
NativeDataset: IDASQLCommandNativeObject;
|
|
lColumnMappings: TDAColumnMappingCollection;
|
|
lColumnMapping: TDAColumnMapping;
|
|
lFieldName: string;
|
|
lDataForAppend: TDADataForAppendXML;
|
|
lMapToFieldName: String;
|
|
begin
|
|
f:=(Source.QueryInterface(IDASQLCommandNativeObject, NativeDataset) = 0) and not NativeDataset.IsTDatasetCompatible;
|
|
lDataForAppend := TDADataForAppendXML(aDataForAppend);
|
|
|
|
SetLength(lfields, Length(lDataForAppend.RealFields));
|
|
SetLength(flds, Length(lDataForAppend.RealFields));
|
|
SetLength(flds_names, Length(lDataForAppend.RealFields));
|
|
for i:= 0 to Length(lDataForAppend.RealFields) -1 do
|
|
lFields[i] := lDataForAppend.RealFields[i];
|
|
|
|
|
|
k := lDataForAppend.RecordCount;
|
|
max := lDataForAppend.MaxRowCount;
|
|
|
|
// Mapping fields of Source table to the streamed dataset
|
|
if Assigned(lDataForAppend.TableSchema) and (lDataForAppend.TableSchema is TDAUnionDataTable) then begin
|
|
lColumnMappings := TDAUnionSourceTable(TDAUnionDataTable(lDataForAppend.TableSchema).SourceTables.ItemByName(Source.Name)).ColumnMappings;
|
|
for i := 0 to lDataForAppend.TableSchema.Fields.Count - 1 do begin
|
|
lFieldName := lDataForAppend.TableSchema.Fields[lFields[i]].Name;
|
|
if lFieldName = def_SourceTableFieldName then begin
|
|
lFields[i] := -10;
|
|
flds_names[i] := nn_SourceTableFieldName;
|
|
continue;
|
|
end;
|
|
flds_names[i] := lFieldName;
|
|
lMapToFieldName := lFieldName;
|
|
if Assigned(lColumnMappings) then begin
|
|
lColumnMapping := lColumnMappings.MappingByDatasetField(lFieldName);
|
|
if Assigned(lColumnMapping) and (lColumnMapping.TableField <> '') then
|
|
lMapToFieldName := lColumnMapping.TableField;
|
|
end;
|
|
lFields[i] := Source.FieldByName(lMapToFieldName).Index;
|
|
end;
|
|
end
|
|
else begin
|
|
for i := 0 to Length(lfields) -1 do
|
|
flds_names[i] := Source.Fields[lfields[i]].Name;
|
|
end;
|
|
|
|
Source.DisableControls;
|
|
try
|
|
if not Source.Active then Source.Open;
|
|
for i:= 0 to Length(lfields) -1 do begin
|
|
if lfields[i] = -10 then
|
|
flds[i] := lDataForAppend.TableSchema.FieldByName(def_SourceTableFieldName)
|
|
else
|
|
flds[i] := Source.Fields[lfields[i]];
|
|
end;
|
|
|
|
|
|
ev1 := Assigned(OnBeforeFieldValueSerialization);
|
|
ev := Assigned(OnWriteFieldValue);
|
|
f := f or ev or ev1;
|
|
lProgress := Assigned(onWriteDatasetProgress);
|
|
node := lDataForAppend.Node;
|
|
// Writes the actual records
|
|
while (k<>max) and not source.EOF do begin
|
|
|
|
subnode := node.Add(nn_Row);
|
|
|
|
{$IFDEF STORERECID}
|
|
subnode.AddAttribute(attr_RecId, Source.GetRowRecIdValue);
|
|
{$ENDIF}
|
|
|
|
for i := 0 to Length(lfields) - 1 do begin
|
|
//RealFields[i] = -10 then this is @SourceTable field
|
|
if lfields[i] = -10 then
|
|
val := aDataIndex
|
|
else
|
|
val := Source.FieldValues[lfields[i]];
|
|
if ev1 then OnBeforeFieldValueSerialization(flds[i], val);
|
|
if flds[i].Calculated or flds[i].Lookup then Continue;
|
|
if fSkipNull and
|
|
(lfields[i] <> -10) and
|
|
((f and VarIsNull(Val)) or (flds[i].IsNull)) then continue;
|
|
if ev then OnWriteFieldValue(flds[i], val);
|
|
if (VarIsEmpty(val) or VarIsNull(val)) and (flds[i].DataType <> datBlob) then begin
|
|
subnode.AddAttribute(flds_names[i], VarToStr(Null))
|
|
end else begin
|
|
case flds[i].DataType of
|
|
datBlob : WriteBlobValue(subnode, flds_names[i], val);// <--- MARC!!!
|
|
datDateTime : subnode.AddAttribute(flds_names[i], DateTimeToXMLDateTime(val));
|
|
datFloat,
|
|
datCurrency: subnode.AddAttribute(flds_names[i], WriteFloat(val));
|
|
else
|
|
// TODO -cAleF: remember to use the proper XML conversion reoutines here!
|
|
subnode.AddAttribute(flds_names[i], VarToStr(val));
|
|
end;
|
|
end;
|
|
end;
|
|
Inc(k);
|
|
if lProgress then OnWriteDatasetProgress(Self, Source, k, max);
|
|
Source.Next;
|
|
if Source.EOF then Break;
|
|
end;
|
|
aDataForAppend.RecordCount := k;
|
|
Result := k;
|
|
finally
|
|
Source.EnableControls;
|
|
end;
|
|
end;
|
|
|
|
function TDAXmlDataStreamer.DoEndWriteDataset(aDataForAppend: TDADataForAppend): Integer;
|
|
begin
|
|
result := aDataForAppend.RecordCount;
|
|
TDADataForAppendXML(aDataForAppend).Node := nil;
|
|
aDataForAppend.Free();
|
|
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;
|
|
lProgress: Boolean;
|
|
lTotal : integer;
|
|
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);
|
|
lProgress := Assigned(OnReadDeltaProgress);
|
|
lTotal := rootnode.ChildrenCount;
|
|
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;
|
|
if lProgress then OnReadDeltaProgress(Self, Destination, i, lTotal);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDAXmlDataStreamer.DoWriteDelta(const Source: IDADelta);
|
|
var
|
|
rootnode, node, subnode : IXMLNode;
|
|
x, i : integer;
|
|
lProgress: Boolean;
|
|
lTotal : 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;
|
|
|
|
lProgress := Assigned(OnWriteDeltaProgress);
|
|
lTotal := Source.Count;
|
|
// Writes the actual changes
|
|
rootnode := fDeltaNode.Add(Source.LogicalName);
|
|
Source.RemoveUnchangedChanges;
|
|
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;
|
|
if lProgress then OnWriteDeltaProgress(Self, Source, i+1, lTotal);
|
|
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.
|