nction 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); //存储字段索引列表