一、概述

在用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;

标签：