t := 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开发环境下调试通过。
上一页 [1] [2] |
