I. Overview
When writing a database program with Delphi, the import and export operations of the data are often involved, such as: Storing the data in the large database as a portable file to facilitate reading; the data information stored in the file, imported to another database In; and, by storing data in the database as a data file, it is more convenient for internal and program-switched data to avoid cumbersome steps of memory switching data, such as in the general report program written in the author, as data information is used as data information. Passive carrier. Second, the basic idea is used as a datagram storage control, and should be able to store and read the basic information of the dataset (such as the field name, the display name of the field, the data type of the field, the number of records, the number of fields, and the current value of the specified field. Wait), it should be able to provide better package characteristics for use. Based on this, the author uses Delphi 5.0-oriented features to design the development of datagram storage controls.
Third, implement the following code unit: Unit ibdbfile; Interface Uses Windows, Sysutils, Classes, Forms, DB, DBTABLES, DIURMS, DB, DBTABLES, DIALOGS; Const Flag = 'Data News - Jiking Software Studio'; type tdsexception = Class (Exception); TibStorage = Class (Tcomponent) private frPtTitle: String; // Stores Data reports FPAGEHEAD: STRING; // Table Description FPAGEFOOT: STRING; // Falance FfieldNames: Tstrings; // Field Name FSTREAMINDEX: TSTRINGS; // field index FSTREAM: TSTREAM; // Store FfieldCount: Integer; // Field number FRECORDCOUNT: INTEGER; // Record number fopenflag: boolean; // Create a logo protected procedure reset; // Reset --- Clear flow Content Procedure Savehead (Adataset: TDataSet; // Storing report header information procedure loadtabletospostream (adtaset: tdataset); // Store recorded data procedure indexfields (adtaset: tdataset); // Save the field name of the data set to Procedure gethead (fp: tfilestream); // save the report header information Procedure getIndex (fp: tfilestream); // Establish a record stream index procedure getfieldnames (fp: tfilestream); // Read Field Name Function GetfieldName from the stream ( Aindex: integer: String; // Get field name Function getFieldDataType (aindex: integer): tfieldType; Function GetDisplayLabel (aindex: integer): string; // Get field displays the name of the procedure SaveFieldToStream (AStream: TStream; AField: TField); // the field into the stream function GetFieldValue (ARecordNo, FieldNo: Integer): string; the content of public Constructor // field Create (AOwner: TComponent ); Destructor Destroy; override; procedure Open; // create a stream of data in preparation for storing procedure SaveToFile (ADataSet: TDataSet; aFileName: string); // storage method procedure LoadFromFile (aFileName: string); // data is loaded procedure FieldStream ( ARecordNo, FieldNo: Integer; var AStream: TStream); property FieldNames [Index: Integer]: string read GetFieldName; // field name property FieldDataTypes [Index: Integer]: TFieldType read GetFieldDataType; property FieldDisplayLabels [Index: Integer]: string read GetDisplayLabel;
property Fields [RecNo, FieldIndex: Integer]: string read GetFieldValue; // property FieldStreams [RecNo, FieldIndex: Integer]: TStream read GetFieldStream; property RecordCount: Integer read FRecordCount write FRecordCount; property FieldCount: Integer read FFieldCount write FFieldCount; published property RptTitle: string read FRptTitle write FRptTitle; property PageHead: string read FPageHead write FPageHead; property PageFoot: string read FPageFoot write FPageFoot; end; function ReadAChar (AStream: TStream): Char; function ReadAStr (AStream: TStream): string; function ReadBStr (AStream: TStream; Size: Integer): string; function ReadAInteger (AStream: TStream): Integer; procedure WriteAStr (AStream: TStream; AStr: string); procedure WriteBStr (AStream: TStream; AStr: string); procedure WriteAInteger (AStream : TSTREAM; Ainteger: Integer; Procedure Register; IMPLEMENTATION Procedure Register; Begin RegisterComponents; End; Function Readachar (Astream: TSTREAM): char VAR ACHAR: CHAR; Begin Astream.read (Achar, 1); Result: = ACHAR; End; Function Readastr (ASTREAM: TSTREAM): String; Var Str: string; c: char; begin str: = '; c : = Readachar (Astream); While C <> # 0 do begin str: = Str C; c: = readachar (astream); end; result: = str; end; function readbstr (Astream: TSTREAM; SIZE: Integer) : string; var str: string; c: char; i: integer; begin str: = '; for i: = 1 to size do beg c: = readachar (astream); str: = str c; end; result : = Str; End; Function Readainteger: Integer; var str: string; c: char; begin result: = maxint; str: = '; c: = readachar (astream); while c <>
# 0 do begin str: = Str C; c: = readachar (astream); end; str); Except Application.MessageBox ('Current string can not be converted to an integer!', 'Error', Mb_Ok Mb_IconError); end; end; procedure WriteAStr (AStream: TStream; AStr: string); begin AStream.Write (Pointer (AStr) ^, Length (AStr) 1); end; procedure WriteBStr (AStream: TStream; AStr : string; begin ASTREAM.WRITE (POINTER (Astr) ^, Length (Astr)); End; Procedure Writeainteger (ASTREAM: TSTREAM; Ainteger: Integer); var s: string; begin s: = INTOSTR (ainteger); Writeastr (AStream, S); end; Constructor TIbStorage.Create (AOwner: TComponent); begin inherited create (AOwner); FOpenFlag: = False; // a flag that determines whether the end stream created; Destructor TIbStorage.Destroy; begin if FOpenFlag then begin FStream.Free; FStreamIndex.Free; FFieldNames.Free; end; inherited Destroy; end; procedure TIbStorage.Open; begin FOpenFlag: = True; fStream: = TMemoryStream.Create; FStreamIndex: = TStringList.Create; FFieldNames: = TStringList.Create Reset; End; Procedure Tibstorage.reset; // Reset Begi Nnessnames.cle; fstream.Size: = 0; frPtTitle: = '; fpagehead: ='; fpagefoot: = '; ffieldcount: = 0; FRECORDCOUNT: = 0; END; End; // ------ Save data section Procedure TibStorage.savetofile (adataset: tdataset; var fp: tfilestream; i: integer; ch: char; t1, t2: tdatetime; str: string ; begin if not FOpenFlag then begin showmessage ( 'object is not open'); Exit; end; try if FileExists (aFileName) then DeleteFile (aFileName); Fp: = TFileStream.Create (aFileName, fmCreate); Reset; SaveHead (ADataSet, FP); // Save Head Information - • Additional Description Indexfields (Adataset);
// Save the field information of the data set to the FfieldName LoadTableTroup (Adataset); // Save the data set of data set Writeastr (fp, ffieldnames.text); // Store the field name information CH: = '@'; fp.write CH, 1); WRITEASTR (FP, FSTREAMINDEX.TEXT); // Store field index list CH: = '@'; fp.write (ch, 1); fp.copyfrom (fstream, 0); finally fp.free; End; end; procedure Tibstorage.savehead (adataset: tdatan; fp: tstract; var i: integer; ch: char; begin if not adtataset.active damset.active: = true; Writeastr (FP, FLAG); Writeastr Fp, FRptTitle); WriteAStr (Fp, FPageHead); WriteAStr (Fp, FPageFoot); FFieldCount: = ADataSet.Fields.Count; FRecordCount: = ADataSet.RecordCount; WriteAStr (Fp, IntToStr (ADataSet.Fields.Count)); WriteAStr (FP, INTTOSTR (Adataset.Recordcount); CH: = '@'; fp.write (CH, 1); End; Procedure Tibstorage.indexfields (Adataset: TDataSet); VAR i: Integer; Afield: Tfield; Begin for I: = 0 to adataset.fields.count - 1 do begin afield: = adataset.fields [i]; // Do not use ffieldnames.values [Afield.fieldName]: = Afield.DisplayLabel; Consideration FfieldNames.Add (Afield. FieldName '=' a Field.DisplayLabel); FFieldNames.Add (AField.FieldName 'DataType =' IntToStr (Ord (AField.DataType))); end; end; procedure TIbStorage.LoadTableToStream (ADataSet: TDataSet); var No: Integer; I, J, Size: Integer; TMP, ID, STR: STRING; // ID = String (Recno) String (FIELDNO) LEN: INTEGER; CH: CHAR; BLOBSTREAM: TBLOBSTREAM; Begin if not fopenflag dam showMessage ('object no Open '); exit; end; try adataset.disablecontrols; adataset.first; no: = 0; fstreamINDEX.CLEAR; fstream.size: = 0; while not adtaset.eof do begin no: = no 1; for J: = 0 to adataset.fields.count - 1 do begin ID: =
INTOSTR (NO) ' INTOSTR (J); // Create the index of the stream, index pointing: size # 0content fstreamIndex.add (ID ' = ' INTOSTR (FStream.Position)); // Storage Field information to SavefieldTostReam (fstream, adataset.fields [j]); end; adataset.next; end; finally adataset.NableControls; end; end; // If a field is empty or blobsize <= 0, It is only written to the field size of 0, not writing content procedure Tibstorage.savefieldTOSTREAM (ASTREAM: TSTREAM; AFIELD: TFIELD); var size: integer; ch: char; xf: tstream; str: string; begin if afield.isblob1 Begin // How to store the contents of a TBLOBFIELD field as streams xf: = TBLOBSTREAM.CREATE (TBLOBFIELD (AFIELD), BMREAD; TRY IF XF.Size> 0 Then Begin Size: = Xf.Size; Writeainteger (Astream, Size) ASTREAM.COPYFROM (XF, XF.SIZE); ELSE WRITEAINTEGER (ASTREAM, 0); Finally Xf.free; End; End else Begin Str: = Afield.Asstring; Size: = Length (STR); Writeainteger (Astream, Size); if size <> 0 Then Astream.write (Pointer (STR) ^, size); // Writeastr (Astream, Str); end; ch: = '@'; Astream.write (CH, 1); END ; // ------------ Load Data Procedure Tibstorage.LoadFromFile (AfileName: String); var Fp: TFileStream; Check: string; begin Reset; try if Not FileExists (AFileName) then begin showmessage ( 'file does not exist:' AFileName); Exit; end; Fp: = TFileStream.Create (AFileName, fmOpenRead); Check : = Readastr (fp); if CHECK <> Flag The Begin Application.MessageBox ('illegal file format ",' error ', MB_OK MB_ICONERROR); EXIT; End; GetHead (fp); getfieldnames (fp); getIndex ); Fstream.copyfrom (fp, fp.size-fp.position); Finally fp.free; end; end; procedure TibStorage.gethead (fp: tfilestream); begin frPtTitle: = readastr (fp); fpagehead: = readastr FP); fpagefoot: = readastr (fp); ffieldcount: = readainteger (fp);
FRecordCount: = ReadAInteger (Fp); if ReadAChar (Fp) <> '@' then showmessage ( 'GetHead File Error'); end; procedure TIbStorage.GetFieldNames (Fp: TFileStream); var Ch: Char; Str: string; begin Str: = '; str: = readastr (fp); ffieldnames.commatext: = str; ch: = readachar (fp); if Ch <>' @ 'Ten ShowMessage (' When Get FieldNames Error '); End; Procedure Tibstorage.GetIndex (FP: TFileStream); Var Ch: char; str: string; begin str: = '; str: = readastr (fp); fstreamindex.commatext: = Str; ch: = readachar (fp); if ch <> @ 'Ten ShowMessage (' When get Field Position Index Error '); end; // --------- Read Field's Value Part Function Tibstorage.GetfieldValue (Arecordno, FieldNo: Integer): string; var ID, T: String; POS: Integer; Len, I: Integer; ER: Boolean; Begin Result: = '; ER: = FALSE; if all defordno> frecordcount dam: = true; // allcordno: = FRECORDCOUNT; IF Arecordno <1 Then Er: = true; // all; = = 1; iffieldno> = ffieldcount dam = true; // fieldno: = ffieldcount - 1; if Fieldno <0 th En Er: = true; // FieldNo: = 0; if Er The begin ShowMessage ('record number or field label "); exit; end; if ffieldcount = 0 dam; ID: = INTOSTR (ARECORDNO) ' ' INTOSTR (FieldNo); POS: = strt (fstreamINDEX.VALUES [ID]); fstream.position: = POS; // Take the length of the field content LEN: = readainteger (fstream); if len> 0 Then Result: = Readbstr (FSTREAM, LEN); if readachar (fstream) <> '@' Ten ShowMessage ('When Read Field, Find Save Format Error'); END;
procedure TIbStorage.FieldStream (ARecordNo, FieldNo: Integer; var AStream: TStream); var Id, T: string; Pos: Integer; Len, I: Integer; Er: Boolean; begin Er: = False; if ARecordNo> FRecordCount then Er : = true; // defordno: = FRECORDCOUNT; if defordno <1 Then Er: = True; // all = = 1; iffieldno> = ffieldcount the Er: = true; // fieldno: = ffieldcount - 1; if Fieldno <0 THEN ER: = true; // fieldno: = 0; if Er The begin tdsexception.create ('getfieldValue function index); exit; end; if ffieldcount = 0 damtr (Id: = INTOSTR (Arecordno ) IntToStr (FieldNo); Pos: = StrToInt (FStreamIndex.Values [Id]); FStream.Position: = Pos; Len: = ReadAInteger (fStream); AStream.CopyFrom (fStream, Len); end; function TIbStorage.GetFieldName (Aindex: Integer): String; // Take the field name begin // stored fields and data types each occupy half IF (Aindex <0) or (aindex> = ffieldnames.count div 2)) Then Application.MESSAGEBOX (' Take a literary name index incremental world ',' program error ', MB_OK MB_ICONERROR) Else Result: = ffieldnames.names [aindex * 2]; end; function Tibstorage.GetField DataType (Aindex: Integer): tfieldType; // Take the field name begin // stored fields and data types each occupied half IF (Aindex <0) or (aindex> = ffieldnames.count div 2)) The Application.MessageBox 'Take the Data Type Index' (Aindex: Integer): String; // Get field display name Begin if (Aindex <0) or (aindex> = ffieldnames.count) The application.MessageBox ('Take a word name index ",' program error ', MB_OK MB_ICONERROR) Else Result: = ffieldNames.Values [getfieldname (aindex)];
