熱點推薦:
您现在的位置: 電腦知識網 >> 編程 >> Delphi編程 >> 正文

用Delphi編寫數據報存儲控件

2013-11-11 21:04:21  來源: Delphi編程 
概述
  
  在用Delphi編寫數據庫程序時經常涉及到數據的導入和導出操作將大型數據庫中的數據存儲為便攜文件以便於出外閱讀將存儲在文件中的數據信息導入到另外的數據庫中而且通過將數據庫中的數據存儲為數據文件更便於程序內部和程序間交換數據避免通過內存交換數據的煩瑣步驟例如在筆者編寫的通用報表程序中即以該控件作為數據信息傳遞的載體
  
  二基本思路
  
  作為數據報存儲控件應能夠存儲和讀入數據集的基本信息(如字段名字段的顯示名稱字段的數據類型記錄數字段數指定記錄指定字段的當前值等)應能夠提供較好的封裝特性以便於使用
  基於此筆者利用Delphi面向對象的特點設計開發了數據報存儲控件
  
  三實現方法
  
  編寫如下代碼單元
  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
  AStreamRead(AChar );
  Result := AChar;
  end;
  
  function ReadAStr(AStream: TStream): string;
  var
  Str: String;
  C : Char;
  begin
  Str := ;
  C := ReadAChar(AStream);
  While C <> # 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 := 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 <> # do
  begin
  Str := Str + C;
  C := ReadAChar(AStream);
  end;
  try
  Result := StrToInt(Str);
  except
  ApplicationMessageBox( 當前字符串無法轉換為整數! 錯誤
  Mb_Ok + Mb_IconError);
  end;
  end;
  
  
  procedure WriteAStr(AStream: TStream; AStr: string);
  begin
  AStreamWrite(Pointer(AStr)^ Length(AStr) + );
  end;
  
  procedure WriteBStr(AStream: TStream; AStr: string);
  begin
  AStreamWrite(Pointer(AStr)^ Length(AStr));
  end;
  
  procedure WriteAInteger(AStream: TStream; AInteger: Integer);
  var
  S : string;
  begin
  S := IntToStr(AInteger);
  WriteAstr(AStream S);
  end;
  
  Constructor TIbStorageCreate(AOwner: TComponent);
  begin
  inherited Create(AOwner);
  FOpenFlag := False; //確定流是否創建的標志
  end;
  
  Destructor TIbStorageDestroy;
  begin
  if FOpenFlag then
  begin
  FStreamFree;
  FStreamIndexFree;
  FFieldNamesFree;
  end;
  inherited Destroy;
  end;
  
  procedure TIbStorageOpen;
  begin
  FOpenFlag := True;
  FStream := TMemoryStreamCreate;
  FStreamIndex := TStringListCreate;
  FFieldNames := TStringListCreate;
  Reset;
  end;
  
  procedure TIbStorageReset; //復位
  begin
  if FOpenFlag then
  begin
  FFieldNamesClear;
  FStreamIndexClear;
  FStreamSize := ;
  FRptTitle := ;
  FPageHead := ;
  FPageFoot := ;
  FFieldCount := ;
  FRecordCount := ;
  end;
  end;
  
  //保存數據部分
  procedure TIbStorageSaveToFile(ADataSet: TDataSet; AFileName: string);
  var
  Fp: TFileStream;
  I : Integer;
  Ch: Char;
  T T: TDateTime;
  Str: string;
  begin
  if Not FOpenFlag then
  begin
  showmessage( 對象沒有打開);
  Exit;
  end;
  try
  if FileExists(AFileName) then DeleteFile(AFileName);
  Fp := TFileStreamCreate(AFileName fmCreate);
  Reset;
  SaveHead(ADataSet Fp); //保存頭部信息附加說明
  IndexFields(ADataSet); //將數據集的字段信息保存到FFieldName
  LoadTableToStream(ADataSet); //保存數據集的數據信息
  WriteAStr(Fp FFieldNamesText); //存儲字段名信息
  Ch := @;
  FpWrite(Ch );
  WriteAStr(Fp FStreamIndexText); //存儲字段索引列表
  Ch := @;
  FpWrite(Ch );
  FpCopyFrom(FStream );
  finally
  FpFree;
  end;
  end;
  
  procedure TIbStorageSaveHead(ADataSet: TDataSet; Fp: TStream);
  Var
  I : Integer;
  Ch: Char;
  begin
  if Not ADataSetActive then ADataSetActive := True;
  WriteAStr(Fp Flag);
  WriteAStr(Fp FRptTitle);
  WriteAStr(Fp FPageHead);
  WriteAStr(Fp FPag
From:http://tw.wingwit.com/Article/program/Delphi/201311/8408.html
    推薦文章
    Copyright © 2005-2013 電腦知識網 Computer Knowledge   All rights reserved.