一、概述
在用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;
//-------保存資料部分
procedure TIbStorage.SaveToFile(ADataSet: TDataSet; AFileName: string);
var
Fp: TFileStream;
I : Integer;
Ch: Char;
T1, T2: TDateTime;
Str: string;
begin
if Not FOpenFlag then
begin
showmessage(' 物件沒有開啟');
Exit;
end;
try
if FileExists(AFileName) then DeleteFile(AFileName);
Fp := TFileStream.Create(AFileName, fmCreate);
Reset;
SaveHead(ADataSet, Fp); //儲存頭部資訊---附加說明
IndexFields(ADataSet); //將資料集的欄位資訊儲存到FFieldName
LoadTableToStream(ADataSet); //儲存資料集的資料資訊
WriteAStr(Fp, FFieldNames.Text); //儲存欄位名稱資訊
Ch := '@';
Fp.Write(Ch, 1);
WriteAStr(Fp, FStreamIndex.Text); //儲存欄位索引列表
Ch := '@';
Fp.Write(Ch, 1);
Fp.CopyFrom(FStream, 0);
finally
Fp.Free;
end;
end;
procedure TIbStorage.SaveHead(ADataSet: TDataSet; Fp: TStream);
Var
I : Integer;
Ch: Char;
begin
if Not ADataSet.Active then ADataSet.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];
//不用FFieldNames.Values[AField.FieldName] := AField.DisplayLabel;是考慮效率
FFieldNames.Add(AField.FieldName + '=' + AField.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 then
begin
showmessage(' 物件沒有開啟');
Exit;
end;
try
ADataSet.DisableControls;
ADataSet.First;
No := 0;
FStreamIndex.Clear;
FStream.Size := 0;
While Not ADataSet.Eof do
begin
No := No + 1;
For J := 0 to ADataSet.Fields.Count - 1 do
begin
Id := Inttostr(NO) + '_' + IntToStr(J);
//建立流的位置的索引, 索引指向: Size#0Content
FStreamIndex.Add(Id + '=' + IntToStr(FStream.Position));
//儲存欄位資訊到流中
SaveFieldToStream(FStream, ADataSet.Fields[J]);
end;
ADataSet.Next;
end;
finally
ADataSet.EnableControls;
end;
end;
//如果一個欄位的目前內容為空或BlobSize<=0,則只寫入欄位大小為0, 不寫入內容
procedure TIbStorage.SaveFieldToStream(AStream: TStream; AField: TField);
var
Size: Integer;
Ch: Char;
XF: TStream;
Str: string;
begin
if AField.IsBlob then
begin
//如何把一個TBlobField欄位的內容儲存為流
Xf := TBlobStream.Create(TBlobField(AField), bmread);
try
if Xf.Size > 0 then
begin
Size := Xf.Size;
WriteAInteger(AStream, Size);
AStream.CopyFrom(Xf, Xf.Size);
end
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(' 文件不存在:' + AFileName);
Exit;
end;
Fp := TFileStream.Create(AFileName, fmOpenRead);
Check := ReadAStr(Fp);
if Check <> Flag then
begin
Application.MessageBox(' 非法檔案格式', '錯誤', Mb_Ok + Mb_IconError);
Exit;
end;
GetHead(Fp);
GetFieldNames(Fp);
GetIndex(Fp);
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 <> '@' then 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 <> '@' then 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 ARecordNo > FRecordCount then
Er := 真; //ARecordNo := FRecordCount;
if ARecordNo < 1 then
Er := True; // ARecordNo := 1;
if FieldNo >= FFieldCount then
Er := True; // FieldNo := FFieldCount - 1;
if FieldNo < 0 then
Er := True; //FieldNo := 0;
if Er then
begin
Showmessage('記錄號碼或字段標號越界');
Exit;
end;
if FFieldCount = 0 then Exit;
Id := Inttostr(ARecordNO) + '_' + IntToStr(FieldNo);
Pos := StrToInt(FStreamIndex.Values[Id]);
FStream.Position := Pos;
//取得欄位內容的長度
Len := ReadAInteger(FStream);
if Len > 0 then
Result := ReadBStr(FStream, Len);
if ReadAChar(FStream) <> '@' then
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 := 真; //ARecordNo := FRecordCount;
if ARecordNo < 1 then
Er := True; // ARecordNo := 1;
if FieldNo >= FFieldCount then
Er := True; // FieldNo := FFieldCount - 1;
if FieldNo < 0 then
Er := True; //FieldNo := 0;
if Er then
begin
TDsException.Create('GetFieldValue函數索引下標越界');
Exit;
end;
if FFieldCount = 0 then Exit;
Id := Inttostr(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; //取得欄位名稱
begin
//儲存的欄位和資料型別各佔一半
if ((AIndex < 0) 或 (AIndex >= FFieldNames.Count div 2)) then
Application.MessageBox(' 取字段名索引越界', '程式錯誤',
Mb_Ok + Mb_IconError)
else
Result := FFieldNames.Names[AIndex*2];
end;
function TIbStorage.GetFieldDataType(AIndex: Integer): TFieldType; //取得欄位名稱
begin
//儲存的欄位和資料型別各佔一半
if ((AIndex < 0) 或 (AIndex >= FFieldNames.Count div 2)) then
Application.MessageBox(' 取字段資料型別索引越界', '程式錯誤',
Mb_Ok + Mb_IconError)
else
Result := TFieldType(StrToInt(FFieldNames.Values[FFieldNames.Names[AIndex*2+1]]));
end;
function TIbStorage.GetDisplayLabel(AIndex: Integer): string; //取得欄位顯示名稱
begin
if ((AIndex < 0) 或 (AIndex >= FFieldNames.Count)) then
Application.MessageBox(' 取字段名索引越界', '程式錯誤',
Mb_Ok + Mb_IconError)
else
Result := FFieldNames.Values[GetFieldName(AIndex)];
end;
end.
透過測試，該控制項對Ttable,Tquery, TaodTable, TadoQuery, TibTable, TibQuery等常用的資料集控制項等都能較好的支持，並且具有較好的效率（測試：1100條人事記錄，23個欄位儲存為文件約用時2秒鐘）。
四、控制項的基本使用方法
1．儲存資料集中的資料到文件
IbStorage1.Open; //建立儲存流
IbStorage1.SaveToFile(AdataSet, Afilename);
2．從文件中讀出數據訊息
IbStorage1.Open;
IbStorage1.LoadFromFile(AfileName);
3．對資料封包儲存控制項中資料的存取
Value := IbStorage1.Fields[ArecNo, AfieldNo]; //字串型
其它略。
五、結束語
透過編寫此資料封包儲存控件，較好地解決了資料庫程式中資料的儲存和交換問題，為資料庫程式的開發提供了一個實用的控件。
此控制項在Windows98，Delphi5開發環境下除錯通過。