How to store records to stream and retrieve them later
------------------------------------------------------
{ Stores a record to stream. Record can later be retrieved with
RecordFromStream procedure }
Procedure RecordToStream(DSet : tdataSet;{ Datset in question }
Stream : TStream; { Stream to store to }
PhysFieldsOnly: Boolean; { Do not store lookup and calculated fields }
FieldsNotStore: array of tField); { Additional fields that should not be stored }
Function DoStoreFld(aFld: tField):Boolean;
{ Checks whether the field should be stored }
var i: Integer;
begin
Result := not PhysFieldsOnly or (aFld.FieldNo > 0); { FieldNo of Lookup and calculated fields is <= 0 }
if Result then
For i := 0 to High(FieldsNotStore) do
if aFld = FieldsNotStore[i] then begin
Result := false;
break;
end;
end;
procedure WriteFldname(fldname: string);
var L: longint;
begin
L := length(fldname);
Stream.Write(L,sizeOf(L));
Stream.Write(fldname[1],L);
end;
var I,Cnt,Len: Longint;
Fld : tField;
FldBuff : Pointer;
BStream : tBlobStream;
begin
Cnt := DSet.FieldCount;
Getmem(FldBuff,256);
TRY
For i := 1 to Cnt do begin
Fld := DSet.Fields[i-1];
if not DoStoreFld(Fld) then Continue;
WriteFldname(Fld.Fieldname);
if Fld is tBlobField then begin
BStream := TBlobStream.Create(Fld as tBlobField, bmRead);
TRY
Len := BStream.Size;
Stream.Write(len,SizeOf(Len));
if Len > 0 then Stream.CopyFrom(BStream,Len);
finally
BStream.Free;
end;
end else begin
Len := Fld.dataSize;
Fld.Getdata(FldBuff);
Stream.Write(Len,SizeOf(Len));
Stream.Write(FldBuff^,Len);
End;
end; { For }
Len := 0;
Stream.Write(Len,SizeOf(Len)); { mark the end of the stream with zero }
FINALLY
Freemem(FldBuff,256);
End;
end;
{ Reads record from the stream. The record was previously stored with
RecordToStream procedure. Dset must be in edit/insert mode }
Procedure RecordFromStream(DSet : tdataSet; { Datset in question }
Stream : TStream; { Stream to retrieve from }
FieldsToIgnore: array of tField); { Fields that should not be retrieved }
Function DoReadFld(aFld: tField):Boolean;
var i: Integer;
begin
Result := (aFld <> NIL) and (aFld.FieldNo > 0); { calculated and lookup fields are allways ignored }
if Result then
For i := 0 to High(FieldsToIgnore) do
if aFld = FieldsToIgnore[i] then begin
Result := false;
break;
end;
end;
function ReadFldname: string;
var L: longint;
begin
Stream.Read(L,sizeOf(L));
if L = 0 then result := '' else begin
SetLength(Result,L);
Stream.Read(Result[1],L);
end;
end;
var Len : Longint;
Fld : tField;
Fldname: string;
FldBuff: Pointer;
begin
Getmem(FldBuff,256);
TRY
Fldname := ReadFldname;
While Fldname <> '' do begin
Fld := DSet.FindField(Fldname);
Stream.Read(Len,SizeOf(Len));
if (Len > 0) and DoReadFld(Fld) then begin
if Fld is tBlobField then begin
With TBlobStream.Create(Fld as tBlobField, bmWrite) do Try;
CopyFrom(Stream,Len);
finally
Free;
end;
end else begin
if Fld.datasize <> Len then
raise Exception.CreateFmt('Field size changed: Field: %s',[Fldname]);
Stream.Read(FldBuff^,Fld.dataSize);
Fld.Setdata(FldBuff);
end;
end else if Len > 0 then Stream.Seek(Len, soFromCurrent);
Fldname := ReadFldname;
end
FINALLY
Freemem(FldBuff,256);
End;
end;