用Delphi编写数据报存储控件(1)

一、概述

在用Delphi编写数据库程序时，经常涉及到数据的导入和导出操作，如：将大型数据库中的数据存储为便携文件，以便于出外阅读；将存储在文件中的数据信息，导入到另外的数据库中；而且，通过将数据库中的数据存储为数据文件，更便于程序内部和程序间交换数据，避免通过内存交换数据的烦琐步骤，例如在笔者编写的通用报表程序中即以该控件作为数据信息传递的载体。

二、基本思路

作为数据报存储控件，应能够存储和读入数据集的基本信息（如：字段名，字段的显示名称，字段的数据类型，记录数，字段数，指定记录指定字段的当前值等），应能够提供较好的封装特性，以便于使用。

基于此，笔者利用Delphi5.0面向对象的特点，设计开发了数据报存储控件。

三、实现方法

编写如下代码单元：

unit IbDbFile;

interface

Uses Windows, SysUtils, Classes, Forms, Db, DbTables, Dialogs;

Const

Flag = '数据报-吉星软件工作室';

Type

TDsException = Class(Exception);

TIbStorage = class(TComponent)

private

FRptTitle: string; //存储数据报说明

FPageHead: string; //页头说明

FPageFoot: string; //爷脚说明

FFieldNames: TStrings; //字段名表

FStreamIndex: TStrings; //字段索引

FStream: TStream; //存储字段内容的流

FFieldCount: Integer; //字段数

FRecordCount: Integer; //记录数

FOpenFlag: Boolean; //流是否创建标志

protected

procedure Reset; //复位---清空流的内容

procedure SaveHead(ADataSet: TDataSet; Fp: TStream); //存储报表头信息

procedure LoadTableToStream(ADataSet: TDataSet); //存储记录数据

procedure IndexFields(ADataSet: TDataSet); //将数据集的字段名保存到列表中

procedure GetHead(Fp: TFileStream); //保存报表头信息

procedure GetIndex(Fp: TFileStream); //建立记录流索引

procedure GetFieldNames(Fp: TFileStream); //从流中读入字段名表

function GetFieldName(AIndex: Integer): string; //取得字段名称

function GetFieldDataType(AIndex: Integer): TFieldType;

function GetDisplayLabel(AIndex: Integer): string; //取得字段显示名称

procedure SaveFieldToStream(AStream: TStream; AField: TField); //将字段存入流中

function GetFieldValue(ARecordNo, FieldNo: Integer): string; //字段的内容

public

Constructor Create(AOwner: TComponent);

Destructor Destroy; override;

procedure Open; //创建流以准备存储数据

procedure SaveToFile(ADataSet: TDataSet; AFileName: string); //存储方法

procedure LoadFromFile(AFileName: string); //装入数据

procedure FieldStream(ARecordNo, FieldNo: Integer; var AStream: TStream);

property FieldNames[Index: Integer]: string read GetFieldName; //字段名

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('Data Access', [TIbStorage]);

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

begin

C := ReadAChar(AStream);

Str := Str + C;

end;

Result := Str;

end;

function ReadAInteger(AStream: TStream): 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;

try

Result := StrToInt(Str);

except

Application.MessageBox(' 当前字符串无法转换为整数!', '错误',

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 := IntToStr(AInteger);

WriteAstr(AStream, S);

end;

Constructor TIbStorage.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

FOpenFlag := False; //确定流是否创建的标志

end;

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; //复位

begin

if FOpenFlag then

begin

FFieldNames.Clear;

FStreamIndex.Clear;

FStream.Size := 0;

FRptTitle := '';

FPageHead := '';

FPageFoot := '';

FFieldCount := 0;

FRecordCount := 0;

end;

end;

/