From 4151e3f2c1b854573e594a28945e1358df1ed9cb Mon Sep 17 00:00:00 2001 From: joost Date: Fri, 29 Jun 2012 16:04:55 +0000 Subject: [PATCH] * Stream TBufdataset fmtBcd fields (xml) * Stream TBufdataset blob and memo-fields (xml) * Refactored code to recognize xml-fieldtypes * ftVarBytes fields do not have the 'Binary' subtype (delphi compat) * Use fielddefs instead of fields to stream dataset (fixes problems with calculated fields) * Added basic blob-tests git-svn-id: trunk@21735 - --- packages/fcl-db/src/base/bufdataset.pas | 2 +- .../fcl-db/src/base/xmldatapacketreader.pp | 89 +++++++++++------- .../fcl-db/tests/testbufdatasetstreams.pas | 91 +++++++++++++++++++ packages/fcl-db/tests/testdbbasics.pas | 33 +++++++ packages/fcl-db/tests/toolsunit.pas | 2 + 5 files changed, 181 insertions(+), 36 deletions(-) diff --git a/packages/fcl-db/src/base/bufdataset.pas b/packages/fcl-db/src/base/bufdataset.pas index 752bdf40f5..e38b5f2ff6 100644 --- a/packages/fcl-db/src/base/bufdataset.pas +++ b/packages/fcl-db/src/base/bufdataset.pas @@ -457,7 +457,6 @@ type procedure InitDefaultIndexes; protected procedure UpdateIndexDefs; override; - function GetNewBlobBuffer : PBlobBuffer; function GetNewWriteBlobBuffer : PBlobBuffer; procedure FreeBlobBuffer(var ABlobBuffer: PBlobBuffer); procedure SetRecNo(Value: Longint); override; @@ -523,6 +522,7 @@ type function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override; procedure AddIndex(const AName, AFields : string; AOptions : TIndexOptions; const ADescFields: string = ''; const ACaseInsFields: string = ''); virtual; + function GetNewBlobBuffer : PBlobBuffer; procedure SetDatasetPacket(AReader : TDataPacketReader); procedure GetDatasetPacket(AWriter : TDataPacketReader); diff --git a/packages/fcl-db/src/base/xmldatapacketreader.pp b/packages/fcl-db/src/base/xmldatapacketreader.pp index 94ea8b7c13..7dcd5e58a7 100644 --- a/packages/fcl-db/src/base/xmldatapacketreader.pp +++ b/packages/fcl-db/src/base/xmldatapacketreader.pp @@ -62,7 +62,7 @@ type implementation -uses xmlwrite, xmlread; +uses xmlwrite, xmlread, base64; const XMLFieldtypenames : Array [TFieldType] of String[15] = @@ -74,21 +74,21 @@ const 'i4', 'boolean', 'r8', - 'r8', + 'r8:Money', 'fixed', 'date', 'time', 'datetime', 'bin.hex', 'bin.hex', - 'i4', - 'bin.hex', - 'bin.hex', - 'bin.hex', - 'bin.hex', - 'bin.hex', - 'bin.hex', - 'bin.hex', + 'i4:Autoinc', + 'bin.hex:Binary', + 'bin.hex:Text', + 'bin.hex:Graphics', + 'bin.hex:Formatted', + 'bin.hex:Ole', + 'bin.hex:Ole', + 'bin.hex:Graphics', '', 'string', 'string', @@ -104,7 +104,7 @@ const '', '', '', - '', + 'fixedFMT', '', '' ); @@ -137,6 +137,7 @@ var i : integer; AFieldDef : TFieldDef; iFieldType : TFieldType; FTString : string; + SubFTString : string; AFieldNode : TDOMNode; begin @@ -160,6 +161,9 @@ begin AFieldDef.Name:=GetNodeAttribute(AFieldNode,'attrname'); AFieldDef.Size:=StrToIntDef(GetNodeAttribute(AFieldNode,'width'),0); FTString:=GetNodeAttribute(AFieldNode,'fieldtype'); + SubFTString:=GetNodeAttribute(AFieldNode,'subtype'); + if SubFTString<>'' then + FTString:=FTString+':'+SubFTString; AFieldDef.DataType:=ftUnknown; for iFieldType:=low(TFieldType) to high(TFieldType) do @@ -181,8 +185,9 @@ end; procedure TXMLDatapacketReader.StoreFieldDefs(AFieldDefs: TFieldDefs); -var i : integer; +var i,p : integer; AFieldNode : TDOMElement; + AStringFT : string; begin XMLDocument := TXMLDocument.Create; @@ -198,22 +203,15 @@ begin if Name <> '' then AFieldNode.SetAttribute('fieldname',Name); AFieldNode.SetAttribute('attrname',DisplayName); if size <> 0 then AFieldNode.SetAttribute('width',IntToStr(Size)); - AFieldNode.SetAttribute('fieldtype',XMLFieldtypenames[DataType]); - case DataType of - ftAutoInc : begin - AFieldNode.SetAttribute('readonly','true'); - AFieldNode.SetAttribute('subtype','Autoinc'); - end; - ftCurrency: AFieldNode.SetAttribute('subtype','Money'); - ftVarBytes, - ftBlob : AFieldNode.SetAttribute('subtype','Binary'); - ftMemo : AFieldNode.SetAttribute('subtype','Text'); - ftTypedBinary, - ftGraphic: AFieldNode.SetAttribute('subtype','Graphics'); - ftFmtMemo : AFieldNode.SetAttribute('subtype','Formatted'); - ftParadoxOle, - ftDBaseOle : AFieldNode.SetAttribute('subtype','Ole'); - end; {case} + AStringFT:=XMLFieldtypenames[DataType]; + p := pos(':',AStringFT); + if p > 1 then + begin + AFieldNode.SetAttribute('fieldtype',copy(AStringFT,1,p-1)); + AFieldNode.SetAttribute('subtype',copy(AStringFT,p+1,25)); + end + else + AFieldNode.SetAttribute('fieldtype',AStringFT); if faReadonly in Attributes then AFieldNode.SetAttribute('readonly','true'); FieldsNode.AppendChild(AFieldNode); @@ -329,28 +327,49 @@ begin end; procedure TXMLDatapacketReader.RestoreRecord(ADataset : TCustomBufDataset); -var FieldNr : integer; - AFieldNode : TDomNode; +var FieldNr : integer; + AFieldNode : TDomNode; + ABufBlobField: TBufBlobField; + AField: TField; + s: string; begin - with ADataset do for FieldNr:=0 to FieldCount-1 do + with ADataset do for FieldNr:=0 to FieldDefs.Count-1 do begin - AFieldNode := FRecordNode.Attributes.GetNamedItem(Fields[FieldNr].FieldName); + AFieldNode := FRecordNode.Attributes.GetNamedItem(FieldDefs[FieldNr].Name); if assigned(AFieldNode) then begin - Fields[FieldNr].AsString := AFieldNode.NodeValue; // set it to the filterbuffer + if FieldDefs[FieldNr].DataType in [ftMemo,ftBlob] then + begin + ABufBlobField.BlobBuffer:=ADataset.GetNewBlobBuffer; + afield := Fields.FieldByNumber(FieldDefs[FieldNr].FieldNo); + AField.SetData(@ABufBlobField); + s := AFieldNode.NodeValue; + if (FieldDefs[FieldNr].DataType = ftBlob) and (s<>'') then + s := DecodeStringBase64(s); + ABufBlobField.BlobBuffer^.Size:=length(s); + ReAllocMem(ABufBlobField.BlobBuffer^.Buffer,ABufBlobField.BlobBuffer^.Size); + move(s[1],ABufBlobField.BlobBuffer^.Buffer^,ABufBlobField.BlobBuffer^.Size); + end + else + Fields.FieldByNumber(FieldDefs[FieldNr].FieldNo).AsString := AFieldNode.NodeValue; // set it to the filterbuffer end end; end; procedure TXMLDatapacketReader.StoreRecord(ADataset : TCustomBufDataset; ARowState : TRowState; AUpdOrder : integer = 0); var FieldNr : Integer; + AField: TField; ARecordNode : TDOMElement; begin inc(FEntryNr); ARecordNode := XMLDocument.CreateElement('ROW'); - for FieldNr := 0 to ADataset.Fields.Count-1 do + for FieldNr := 0 to ADataset.FieldDefs.Count-1 do begin - ARecordNode.SetAttribute(ADataset.fields[FieldNr].FieldName,ADataset.fields[FieldNr].AsString); + AField := ADataset.Fields.FieldByNumber(ADataset.FieldDefs[FieldNr].FieldNo); + if AField.DataType=ftBlob then + ARecordNode.SetAttribute(AField.FieldName,EncodeStringBase64(AField.AsString)) + else + ARecordNode.SetAttribute(AField.FieldName,AField.AsString); end; if ARowState<>[] then begin diff --git a/packages/fcl-db/tests/testbufdatasetstreams.pas b/packages/fcl-db/tests/testbufdatasetstreams.pas index 93ef270648..a510fd8f35 100644 --- a/packages/fcl-db/tests/testbufdatasetstreams.pas +++ b/packages/fcl-db/tests/testbufdatasetstreams.pas @@ -69,6 +69,8 @@ type procedure TestSeveralEditsXML; procedure TestDeleteAllXML; procedure TestDeleteAllInsertXML; + procedure TestStreamingBlobFieldsXML; + procedure TestStreamingBigBlobFieldsXML; procedure TestAppendDeleteBIN; @@ -452,6 +454,95 @@ begin TestChangesXML(@DeleteAllInsertChange); end; +procedure TTestBufDatasetStreams.TestStreamingBlobFieldsXML; +var SaveDs: TCustomBufDataset; + LoadDs: TCustomBufDataset; +begin + SaveDs := DBConnector.GetFieldDataset as TCustomBufDataset; + SaveDs.Open; + SaveDs.SaveToFile('FieldsDS.xml',dfXML); + + LoadDs := TCustomBufDataset.Create(nil); + LoadDs.LoadFromFile('FieldsDS.xml'); + + LoadDS.First; + SaveDS.First; + while not LoadDS.EOF do + begin + AssertEquals(LoadDS.FieldByName('FBLOB').AsString,SaveDS.FieldByName('FBLOB').AsString); + AssertEquals(LoadDS.FieldByName('FMEMO').AsString,SaveDS.FieldByName('FMEMO').AsString); + LoadDS.Next; + SaveDS.Next; + end; + + LoadDs.Free; +end; + +procedure TTestBufDatasetStreams.TestStreamingBigBlobFieldsXML; +var + SaveDs: TCustomBufDataset; + LoadDs: TCustomBufDataset; + j: integer; + i: byte; + s: string; + f: file of byte; + fn: string; + fs: TMemoryStream; +begin + // Create a temp. file with blob-data. + fn := GetTempFileName; + assign(f,fn); + Rewrite(f); + s := 'This is a blob-field test file.'; + for j := 0 to 250 do + begin + for i := 1 to length(s) do + write(f,ord(s[i])); + for i := 0 to 255 do + write(f,i); + end; + close(f); + + try + // Open dataset and set blob-field-data to content of blob-file. + SaveDs := DBConnector.GetFieldDataset(true) as TCustomBufDataset; + SaveDs.Open; + SaveDs.Edit; + TBlobField(SaveDs.FieldByName('FBLOB')).LoadFromFile(fn); + SaveDs.Post; + + // Save this dataset to file. + SaveDs.SaveToFile('FieldsDS.xml',dfXML); + + // Load this file in another dataset + LoadDs := TCustomBufDataset.Create(nil); + try + LoadDs.LoadFromFile('FieldsDS.xml'); + LoadDS.First; + + // Compare the content of the blob-field with the file on disc + fs := TMemoryStream.Create; + try + TBlobField(SaveDs.FieldByName('FBLOB')).SaveToStream(fs); + fs.Seek(0,soBeginning); + assign(f,fn); + reset(f); + for j := 0 to fs.Size-1 do + begin + read(f,i); + CheckEquals(i,fs.ReadByte); + end; + finally + fs.free; + end; + finally + LoadDs.Free; + end; + finally + DeleteFile(fn); + end; +end; + procedure TTestBufDatasetStreams.TestAppendDeleteBIN; begin TestChanges(@AppendDeleteChange); diff --git a/packages/fcl-db/tests/testdbbasics.pas b/packages/fcl-db/tests/testdbbasics.pas index 4fa80f6410..dedc12e737 100644 --- a/packages/fcl-db/tests/testdbbasics.pas +++ b/packages/fcl-db/tests/testdbbasics.pas @@ -42,6 +42,8 @@ type procedure TestSupportBCDFields; procedure TestSupportfmtBCDFields; procedure TestSupportFixedStringFields; + procedure TestSupportBlobFields; + procedure TestSupportMemoFields; procedure TestDoubleClose; procedure TestCalculatedField; @@ -2387,6 +2389,37 @@ begin ds.close; end; +procedure TTestDBBasics.TestSupportBlobFields; + +var i : byte; + ds : TDataset; + Fld : TField; +begin + TestfieldDefinition(ftBlob,0,ds,Fld); + + for i := 0 to testValuesCount-1 do + begin + CheckEquals(testValues[ftBlob,i],Fld.AsString); + ds.Next; + end; + ds.close; +end; + +procedure TTestDBBasics.TestSupportMemoFields; +var i : byte; + ds : TDataset; + Fld : TField; +begin + TestfieldDefinition(ftMemo,0,ds,Fld); + + for i := 0 to testValuesCount-1 do + begin + CheckEquals(testValues[ftMemo,i],Fld.AsString); + ds.Next; + end; + ds.close; +end; + procedure TTestDBBasics.TestDoubleClose; begin with DBConnector.GetNDataset(1) do diff --git a/packages/fcl-db/tests/toolsunit.pas b/packages/fcl-db/tests/toolsunit.pas index 548c857c2c..bdbb494573 100644 --- a/packages/fcl-db/tests/toolsunit.pas +++ b/packages/fcl-db/tests/toolsunit.pas @@ -311,6 +311,8 @@ begin testValues[ftFixedChar] := testStringValues; testValues[ftTime] := testTimeValues; testValues[ftDate] := testDateValues; + testValues[ftBlob] := testStringValues; + testValues[ftMemo] := testStringValues; testValues[ftFMTBcd] := testFmtBCDValues; for i := 0 to testValuesCount-1 do begin