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;