dblists.pas

企业端数据申报系统：单位管理模块 单位查询. 业务申报模块 在线数据下载 在线数据上传 在线业务申核 申报业务查询 磁盘数据导出 磁盘数据导入 在线业务模块 在线业务

{*******************************************************}
{                                                       }
{         Delphi VCL Extensions (RX)                    }
{                                                       }
{         Copyright (c) 1995, 1996 AO ROSNO             }
{         Copyright (c) 1997, 1998 Master-Bank          }
{                                                       }
{*******************************************************}

unit DBLists;

{$I RX.INC}
{$N+,P+,S-}

interface

uses SysUtils, Classes, DB, DBTables, DBUtils, BdeUtils,
{$IFDEF WIN32} 
  Windows, Bde;
{$ELSE}
  WinTypes, WinProcs, DbiTypes, DbiProcs, DbiErrs;
{$ENDIF}

type

{ TBDEItems }

  TBDEItemType = (bdDatabases, bdDrivers, bdLangDrivers, bdUsers 
    {$IFDEF WIN32}, bdRepositories {$ENDIF});

  TCustomBDEItems = class(TBDEDataSet)
  private
    FItemType: TBDEItemType;
{$IFDEF WIN32}
    FSessionName: string;
    FSessionLink: TDatabase;
    function GetDBSession: TSession;
    procedure SetSessionName(const Value: string);
{$ENDIF}
    procedure SetItemType(Value: TBDEItemType);
  protected
{$IFDEF WIN32}
    function GetRecordCount: {$IFNDEF RX_D3} Longint {$ELSE}
      Integer; override {$ENDIF};
    procedure OpenCursor {$IFDEF RX_D3}(InfoQuery: Boolean){$ENDIF}; override;
    procedure CloseCursor; override;
{$ENDIF}
    function CreateHandle: HDBICur; override;
    property ItemType: TBDEItemType read FItemType write SetItemType
      default bdDatabases;
  public
{$IFDEF WIN32}
  {$IFDEF RX_D3}
    function Locate(const KeyFields: string; const KeyValues: Variant;
      Options: TLocateOptions): Boolean; override;
  {$ENDIF}
    property DBSession: TSession read GetDBSession;
  {$IFNDEF RX_D3}
    property RecordCount: Longint read GetRecordCount;
  {$ENDIF}
  published
    property SessionName: string read FSessionName write SetSessionName;
{$ENDIF WIN32}
  end;

  TBDEItems = class(TCustomBDEItems)
  published
    property ItemType;
  end;

{ TDBListDataSet }

  TDBListDataSet = class(TDBDataSet)
{$IFDEF WIN32}
  protected
    function GetRecordCount: {$IFNDEF RX_D3} Longint {$ELSE}
      Integer; override {$ENDIF};
  public
  {$IFDEF RX_D3}
    function Locate(const KeyFields: string; const KeyValues: Variant;
      Options: TLocateOptions): Boolean; override;
  {$ELSE}
    property RecordCount: Longint read GetRecordCount;
  {$ENDIF}
{$ENDIF}
  end;

{ TDatabaseItems }

  TDBItemType = (dtTables, dtStoredProcs, dtFiles {$IFDEF WIN32},
    dtFunctions {$ENDIF});

  TCustomDatabaseItems = class(TDBListDataSet)
  private
    FExtended: Boolean;
    FSystemItems: Boolean;
    FFileMask: string;
    FItemType: TDBItemType;
    procedure SetFileMask(const Value: string);
    procedure SetExtendedInfo(Value: Boolean);
    procedure SetSystemItems(Value: Boolean);
    procedure SetItemType(Value: TDBItemType);
  protected
    function CreateHandle: HDBICur; override;
    function GetItemName: string;
    property ItemType: TDBItemType read FItemType write SetItemType
      default dtTables;
    property ExtendedInfo: Boolean read FExtended write SetExtendedInfo
      default False;
    property FileMask: string read FFileMask write SetFileMask;
    property SystemItems: Boolean read FSystemItems write SetSystemItems
      default False;
  public
    property ItemName: string read GetItemName;
  end;

  TDatabaseItems = class(TCustomDatabaseItems)
  published
    property ItemType;
    property ExtendedInfo;
    property FileMask;
    property SystemItems;
  end;

{ TTableItems }

  TTabItemType = (dtFields, dtIndices, dtValChecks, dtRefInt,
    dtSecurity, dtFamily);

  TCustomTableItems = class(TDBListDataSet)
  private
    FTableName: TFileName;
    FItemType: TTabItemType;
    FPhysTypes: Boolean;
    procedure SetTableName(const Value: TFileName);
    procedure SetItemType(Value: TTabItemType);
    procedure SetPhysTypes(Value: Boolean);
  protected
    function CreateHandle: HDBICur; override;
    property ItemType: TTabItemType read FItemType write SetItemType
      default dtFields;
    property PhysTypes: Boolean read FPhysTypes write SetPhysTypes
      default False; { for dtFields only }
  published
    property TableName: TFileName read FTableName write SetTableName;
  end;

  TTableItems = class(TCustomTableItems)
  published
    property ItemType;
    property PhysTypes;
  end;

{ TDatabaseDesc }

  TDatabaseDesc = class(TObject)
  private
    FDescription: DBDesc;
  public
    constructor Create(const DatabaseName: string);
    property Description: DBDesc read FDescription;
  end;

{ TDriverDesc }

  TDriverDesc = class(TObject)
  private
    FDescription: DRVType;
  public
    constructor Create(const DriverType: string);
    property Description: DRVType read FDescription;
  end;

{*************************************************************************}

{$IFNDEF CBUILDER}
{ Obsolete classes, for backward compatibility only }

type

  TDatabaseList = class(TCustomBDEItems);

  TLangDrivList = class(TCustomBDEItems)
    constructor Create(AOwner: TComponent); override;
  end;

  TTableList = class(TCustomDatabaseItems)
  public
    function GetTableName: string;
  published
    property ExtendedInfo;
    property FileMask;
    property SystemItems;
  end;

  TStoredProcList = class(TCustomDatabaseItems)
  public
    constructor Create(AOwner: TComponent); override;
  published
    property ExtendedInfo;
    property SystemItems;
  end;

  TFieldList = class(TCustomTableItems);

  TIndexList = class(TCustomTableItems)
    constructor Create(AOwner: TComponent); override;
  end;

{$ENDIF CBUILDER}

implementation

uses DBConsts, {$IFDEF RX_D3} BDEConst, {$ENDIF} RxDConst;

{ Utility routines }

function dsGetRecordCount(DataSet: TBDEDataSet): Longint;
begin
  if DataSet.State = dsInactive then _DBError(SDataSetClosed);
  Check(DbiGetRecordCount(DataSet.Handle, Result));
end;

{$IFDEF WIN32}
type
  TSessionLink = class(TDatabase)
  private
    FList: TCustomBDEItems;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

constructor TSessionLink.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if (AOwner <> nil) and (AOwner is TSession) then
    SessionName := TSession(AOwner).SessionName;
  Temporary := True;
  KeepConnection := False;
end;

destructor TSessionLink.Destroy;
begin
  if FList <> nil then begin
    FList.FSessionLink := nil;
    FList.Close;
  end;
  inherited Destroy;
end;
{$ENDIF}

{ TCustomBDEItems }

procedure TCustomBDEItems.SetItemType(Value: TBDEItemType);
begin
  if ItemType <> Value then begin
    CheckInactive;
    FItemType := Value;
  end;
end;

function TCustomBDEItems.CreateHandle: HDBICur;
begin
  case FItemType of
    bdDatabases: Check(DbiOpenDatabaseList(Result));
    bdDrivers: Check(DbiOpenDriverList(Result));
    bdLangDrivers: Check(DbiOpenLdList(Result));
    bdUsers: Check(DbiOpenUserList(Result));
{$IFDEF WIN32}
    bdRepositories: Check(DbiOpenRepositoryList(Result));
{$ENDIF}
  end;
end;

{$IFDEF WIN32}
function TCustomBDEItems.GetDBSession: TSession;
begin
  Result := Sessions.FindSession(SessionName);
  if Result = nil then
{$IFDEF RX_D3}
    Result := DBTables.Session;
{$ELSE}
    Result := DB.Session;
{$ENDIF}
end;

procedure TCustomBDEItems.SetSessionName(const Value: string);
begin
  CheckInactive;
  FSessionName := Value;
  DataEvent(dePropertyChange, 0);
end;

procedure TCustomBDEItems.OpenCursor;
var
  S: TSession;
begin
  S := Sessions.List[SessionName];
  S.Open;
  Sessions.CurrentSession := S;
  FSessionLink := TSessionLink.Create(S);
  try
    TSessionLink(FSessionLink).FList := Self;
    inherited OpenCursor{$IFDEF RX_D3}(InfoQuery){$ENDIF};
  except
    FSessionLink.Free;
    FSessionLink := nil;
    raise;