delphi7 建立access数据库 delphi数据库控件

转载

mob6454cc773039 2024-05-09 21:10:23

文章标签 delphi7 建立access数据库存储 delphi integer string 文章分类 架构后端开发

一、概述

在用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 := true; //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 := true; //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) or (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) or (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) or (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开发环境下调试通过。

本文章为转载内容，我们尊重原作者对文章享有的著作权。如有内容错误或侵权问题，欢迎原作者联系我们进行内容更正或删除文章。

上一篇：protobuf根据字节流和类型转成java protobuf 字节数组

下一篇：基于逐坐标下降逻辑回归分类模型步骤 logistic逐步回归分析结果

提问和评论都可以，用心的回复会被更多人看到评论

发布评论

相关文章

官方博客	全部文章	热门标签	班级博客
了解我们	网站地图	意见反馈

鸿蒙开发者社区	51CTO学堂
51CTO	软考资讯

delphi7 建立access数据库 delphi数据库控件

delphi7 建立access数据库 delphi数据库控件

51CTO博客