接上文
//-------保存数据部分
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
      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]; //字符串类型
其它略。


五、结束语

通过编写此数据报存储控件，较好地解决了数据库程序中数据的存储和交换问题，为数据库程序的开发提供了一种实用的控件。
　

标签：