paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-24 09:29:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-db:fcl-db: base: fix streaming (restoring) of ftWideMemo fields in XMLDatapacketReader

Browse Source 
+ extend test of streaming of "FieldDataset" to test all fields (not only Blob and Memo)

git-svn-id: trunk@25538 -
This commit is contained in:
lacak 2013-09-23 11:09:07 +00:00
parent 22e9cb48dd
commit 9013ff6724
2 changed files with 29 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
packages/fcl-db/src/base/xmldatapacketreader.pp
View File

@ -341,6 +341,7 @@ var FieldNr : integer;
ABufBlobField: TBufBlobField; ABufBlobField: TBufBlobField;
AField: TField; AField: TField;
s: string; s: string;
ws: widestring;
begin begin
with ADataset do for FieldNr:=0 to FieldDefs.Count-1 do with ADataset do for FieldNr:=0 to FieldDefs.Count-1 do
begin begin
@ -348,19 +349,20 @@ begin
AFieldNode := FRecordNode.Attributes.GetNamedItem(FieldDefs[FieldNr].Name); AFieldNode := FRecordNode.Attributes.GetNamedItem(FieldDefs[FieldNr].Name);
if assigned(AFieldNode) then if assigned(AFieldNode) then
begin begin
s := AFieldNode.NodeValue; s := AFieldNode.NodeValue;
if (FieldDefs[FieldNr].DataType in [ftBlob, ftBytes, ftVarBytes]) and (s <> '') then if (FieldDefs[FieldNr].DataType in [ftBlob, ftBytes, ftVarBytes]) and (s <> '') then
s := DecodeStringBase64(s); s := DecodeStringBase64(s);
if FieldDefs[FieldNr].DataType in [ftBlob, ftMemo, ftWideMemo] then case FieldDefs[FieldNr].DataType of
begin ftBlob, ftMemo:
ABufBlobField.BlobBuffer:=ADataset.GetNewBlobBuffer; RestoreBlobField(ADataset, AField, @s[1], length(s));
ABufBlobField.BlobBuffer^.Size:=length(s); ftWideMemo:
ReAllocMem(ABufBlobField.BlobBuffer^.Buffer,ABufBlobField.BlobBuffer^.Size); begin
move(s[1],ABufBlobField.BlobBuffer^.Buffer^,ABufBlobField.BlobBuffer^.Size); ws := s;
AField.SetData(@ABufBlobField); RestoreBlobField(ADataset, AField, @ws[1], length(ws)*sizeof(WideChar));
end end
else else;
AField.AsString := s; // set it to the filterbuffer AField.AsString := s; // set it to the filterbuffer
end;
end end
else else
AField.SetData(nil); AField.SetData(nil);

24
packages/fcl-db/tests/testbufdatasetstreams.pas
View File

@ -37,7 +37,7 @@ type
procedure NullEditChange(ADataset: TCustomBufDataset); procedure NullEditChange(ADataset: TCustomBufDataset);
procedure AppendDeleteChange(ADataset: TCustomBufDataset); procedure AppendDeleteChange(ADataset: TCustomBufDataset);
procedure TestStreamingBlobFields(AFormat: TDataPacketFormat); procedure TestStreamingDataFields(AFormat: TDataPacketFormat);
procedure TestStreamingNullFields(AFormat: TDataPacketFormat); procedure TestStreamingNullFields(AFormat: TDataPacketFormat);
protected protected
procedure SetUp; override; procedure SetUp; override;
@ -72,8 +72,8 @@ type
procedure TestSeveralEditsXML; procedure TestSeveralEditsXML;
procedure TestDeleteAllXML; procedure TestDeleteAllXML;
procedure TestDeleteAllInsertXML; procedure TestDeleteAllInsertXML;
procedure TestStreamingBlobFieldsBIN; procedure TestStreamingDataFieldsBIN;
procedure TestStreamingBlobFieldsXML; procedure TestStreamingDataFieldsXML;
procedure TestStreamingBigBlobFieldsXML; procedure TestStreamingBigBlobFieldsXML;
procedure TestStreamingNullFieldsBIN; procedure TestStreamingNullFieldsBIN;
procedure TestStreamingNullFieldsXML; procedure TestStreamingNullFieldsXML;
@ -462,9 +462,10 @@ begin
TestChangesXML(@DeleteAllInsertChange); TestChangesXML(@DeleteAllInsertChange);
end; end;
procedure TTestBufDatasetStreams.TestStreamingBlobFields(AFormat: TDataPacketFormat); procedure TTestBufDatasetStreams.TestStreamingDataFields(AFormat: TDataPacketFormat);
var SaveDs: TCustomBufDataset; var SaveDs: TCustomBufDataset;
LoadDs: TCustomBufDataset; LoadDs: TCustomBufDataset;
i: integer;
begin begin
SaveDs := DBConnector.GetFieldDataset as TCustomBufDataset; SaveDs := DBConnector.GetFieldDataset as TCustomBufDataset;
SaveDs.Open; SaveDs.Open;
@ -472,13 +473,15 @@ begin
LoadDs := TCustomBufDataset.Create(nil); LoadDs := TCustomBufDataset.Create(nil);
LoadDs.LoadFromFile(TestFileNames[AFormat]); LoadDs.LoadFromFile(TestFileNames[AFormat]);
AssertEquals(SaveDs.FieldCount, LoadDs.FieldCount);
LoadDS.First; LoadDS.First;
SaveDS.First; SaveDS.First;
while not LoadDS.EOF do while not LoadDS.EOF do
begin begin
AssertEquals(SaveDS.FieldByName('FBLOB').AsString, LoadDS.FieldByName('FBLOB').AsString); for i:=0 to LoadDS.FieldCount-1 do
AssertEquals(SaveDS.FieldByName('FMEMO').AsString, LoadDS.FieldByName('FMEMO').AsString); // all FieldTypes supports GetAsString
AssertEquals(LoadDS.Fields[i].FieldName, SaveDS.Fields[i].AsString, LoadDS.Fields[i].AsString);
LoadDS.Next; LoadDS.Next;
SaveDS.Next; SaveDS.Next;
end; end;
@ -486,14 +489,14 @@ begin
LoadDs.Free; LoadDs.Free;
end; end;
procedure TTestBufDatasetStreams.TestStreamingBlobFieldsBIN; procedure TTestBufDatasetStreams.TestStreamingDataFieldsBIN;
begin begin
TestStreamingBlobFields(dfBinary); TestStreamingDataFields(dfBinary);
end; end;
procedure TTestBufDatasetStreams.TestStreamingBlobFieldsXML; procedure TTestBufDatasetStreams.TestStreamingDataFieldsXML;
begin begin
TestStreamingBlobFields(dfXML); TestStreamingDataFields(dfXML);
end; end;
procedure TTestBufDatasetStreams.TestStreamingBigBlobFieldsXML; procedure TTestBufDatasetStreams.TestStreamingBigBlobFieldsXML;
@ -588,6 +591,7 @@ begin
LoadDs := TCustomBufDataset.Create(nil); LoadDs := TCustomBufDataset.Create(nil);
try try
LoadDs.LoadFromFile(TestFileNames[AFormat]); LoadDs.LoadFromFile(TestFileNames[AFormat]);
AssertEquals(SaveDs.FieldCount, LoadDs.FieldCount);
SaveDs.First; SaveDs.First;
while not SaveDs.EOF do while not SaveDs.EOF do
begin begin