用Delphi编写数据报存储控件

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

二基本思路

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

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

三实现方法

编写如下代码单元

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

AStreamRead(AChar );

Result := AChar;

end;

function ReadAStr(AStream: TStream): string;

var

Str: String;

C : Char;

begin

Str := ;

C := ReadAChar(AStream);

While C <> # 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 := 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 <> # do

begin

Str := Str + C;

C := ReadAChar(AStream);

end;

try

Result := StrToInt(Str);

except

ApplicationMessageBox( 当前字符串无法转换为整数! 错误

Mb_Ok + Mb_IconError);

end;

end;

procedure WriteAStr(AStream: TStream; AStr: string);

begin

AStreamWrite(Pointer(AStr)^ Length(AStr) + );

end;

procedure WriteBStr(AStream: TStream; AStr: string);

begin

AStreamWrite(Pointer(AStr)^ Length(AStr));

end;

procedure WriteAInteger(AStream: TStream; AInteger: Integer);

var

S : string;

begin

S := IntToStr(AInteger);

WriteAstr(AStream S);

end;

Constructor TIbStorageCreate(AOwner: TComponent);

begin

inherited Create(AOwner);

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

end;

Destructor TIbStorageDestroy;

begin

if FOpenFlag then

begin

FStreamFree;

FStreamIndexFree;

FFieldNamesFree;

end;

inherited Destroy;

end;

procedure TIbStorageOpen;

begin

FOpenFlag := True;

FStream := TMemoryStreamCreate;

FStreamIndex := TStringListCreate;

FFieldNames := TStringListCreate;

Reset;

end;

procedure TIbStorageReset; //复位

begin

if FOpenFlag then

begin

FFieldNamesClear;

FStreamIndexClear;

FStreamSize := ;

FRptTitle := ;

FPageHead := ;

FPageFoot := ;

FFieldCount := ;

FRecordCount := ;

end;

end;

//保存数据部分

procedure TIbStorageSaveToFile(ADataSet: TDataSet; AFileName: string);

var

Fp: TFileStream;

I : Integer;

Ch: Char;

T T: TDateTime;

Str: string;

begin

if Not FOpenFlag then

begin

showmessage( 对象没有打开);

Exit;

end;

try

if FileExists(AFileName) then DeleteFile(AFileName);

Fp := TFileStreamCreate(AFileName fmCreate);

Reset;

SaveHead(ADataSet Fp); //保存头部信息附加说明

IndexFields(ADataSet); //将数据集的字段信息保存到FFieldName

LoadTableToStream(ADataSet); //保存数据集的数据信息

WriteAStr(Fp FFieldNamesText); //存储字段名信息

Ch := @;

FpWrite(Ch );

WriteAStr(Fp FStreamIndexText); //存储字段索引列表

Ch := @;

FpWrite(Ch );

FpCopyFrom(FStream );

finally

FpFree;

end;

end;

procedure TIbStorageSaveHead(ADataSet: TDataSet; Fp: TStream);

Var

I : Integer;

Ch: Char;

begin

if Not ADataSetActive then ADataSetActive := True;

WriteAStr(Fp Flag);

WriteAStr(Fp FRptTitle);

WriteAStr(Fp FPageHead);

WriteAStr(Fp FPag