frxodaccomponents.pas

ODAC 6 最新版的﹐網上找了好久才找到﹐不太好找啊﹐大家一起共享

{******************************************}
{                                          }
{             FastReport  4.0              }
{         ODAC enduser components          }
{                                          }

// Created by: CoreLab
// E-mail: [e-mail]

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

unit frxODACComponents;

interface

{$I frx.inc}

uses
  Windows, Sysutils, Classes, frxClass, frxCustomDB, DB, OraSmart, Ora,
  Graphics, frxDACComponents
{$IFDEF Delphi6}
, Variants
{$ENDIF}
{$IFDEF QBUILDER}
, fqbClass
{$ENDIF};


type
  TODACTable = class(TOraTable)
  protected
    procedure InitFieldDefs; override;
  end;

  TODACSmartQuery = class(TSmartQuery)
  protected
    procedure InitFieldDefs; override;
  end;

  TfrxODACComponents = class(TfrxDACComponents)
  private
    FOldComponents: TfrxDACComponents;
    function GetDefaultDatabase: TOraSession;
    procedure SetDefaultDatabase(Value: TOraSession);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    
    function GetDescription: String; override;

    class function GetComponentsBitmap: TBitmap; override;
    class function GetComponentsName: string; override;
    class function ResourceName: string; override;
    class function GetDatabaseClass: TfrxDACDatabaseClass; override;
    class function GetTableClass: TfrxDACTableClass; override;
    class function GetQueryClass: TfrxDACQueryClass; override;
  published
    property DefaultDatabase: TOraSession read GetDefaultDatabase write SetDefaultDatabase;  
  end;

  TfrxODACDatabase = class(TfrxDACDatabase)
  protected
    function GetDatabaseName: string; override;
    procedure SetDatabaseName(const Value: string); override;
  public
    constructor Create(AOwner: TComponent); override;
    class function GetDescription: String; override;
  published
    property LoginPrompt;
    property DatabaseName;
    property Username;
    property Password;
    property Server;
    property Connected;
  end;

  TfrxODACDatabaseNet = class (TfrxODACDatabase) // obsolete
  public
    constructor Create(AOwner: TComponent); override;
    class function GetDescription: String; override;
  end;

  TfrxODACDatabaseDirect = class (TfrxODACDatabaseNet)
  end;

  TfrxODACTable = class(TfrxDACTable)
  private
    FTable: TODACTable;
  protected
    procedure SetDatabase(const Value: TfrxDACDatabase); override;
    procedure SetMaster(const Value: TDataSource); override;
    procedure SetMasterFields(const Value: String); override;
    procedure SetIndexFieldNames(const Value: String); override;
    function GetIndexFieldNames: String; override;
    function GetTableName: String; override;
    procedure SetTableName(const Value: String); override;
  public
    constructor Create(AOwner: TComponent); override;
    class function GetDescription: String; override;
    property Table: TODACTable read FTable;
  published
    property Database;
    property TableName: string read GetTableName write SetTableName;
  end;

  TfrxODACQuery = class(TfrxDACQuery)
  protected
    procedure SetDatabase(const Value: TfrxDACDatabase); override;
  public
    constructor Create(AOwner: TComponent); override;
    class function GetDescription: String; override;
{$IFDEF QBUILDER}
    function QBEngine: TfqbEngine; override;
{$ENDIF}
  published
    property Database;
    property IndexName;
    property MasterFields;
  end;

{$IFDEF QBUILDER}
  TfrxEngineODAC = class(TfrxEngineDAC)
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ReadFieldList(const ATableName: string; var AFieldList: TfqbFieldList); override;
  end;
{$ENDIF}

var
  CatBmp: TBitmap;
  ODACComponents: TfrxDACComponents;

implementation

{$R *.res}

uses
  frxODACRTTI,
{$IFNDEF NO_EDITORS}
  frxODACEditor,
{$ENDIF}
  frxDsgnIntf, frxRes;

{ TODACTable }

procedure TODACTable.InitFieldDefs;
begin
  if (TableName <> '') and (Assigned(Connection)) then
    inherited;
end;

{ TODACSmartQuery }

procedure TODACSmartQuery.InitFieldDefs;
begin
  if (SQL.Text <> '') and (Assigned(Connection)) then
    inherited;
end;

{ TfrxODACComponents }

constructor TfrxODACComponents.Create(AOwner: TComponent);
begin
  inherited;

  FOldComponents := ODACComponents;
  ODACComponents := Self;
end;

destructor TfrxODACComponents.Destroy;
begin
  if ODACComponents = Self then
    ODACComponents := FOldComponents;

  inherited;
end;

function TfrxODACComponents.GetDefaultDatabase: TOraSession;
begin
  Result := TOraSession(FDefaultDatabase);
end;

procedure TfrxODACComponents.SetDefaultDatabase(Value: TOraSession);
begin
  FDefaultDatabase := Value;
end;

class function TfrxODACComponents.GetComponentsBitmap: TBitmap;
begin
  Result := CatBmp;
end;

class function TfrxODACComponents.GetComponentsName: string;
begin
  Result := 'ODAC';
end;

class function TfrxODACComponents.ResourceName: string;
begin
  Result := 'frxODACObjects';
end;

class function TfrxODACComponents.GetDatabaseClass: TfrxDACDatabaseClass;
begin
  Result := TfrxODACDatabase;
end;

class function TfrxODACComponents.GetTableClass: TfrxDACTableClass;
begin
  Result := TfrxODACTable;
end;

class function TfrxODACComponents.GetQueryClass: TfrxDACQueryClass;
begin
  Result := TfrxODACQuery;
end;

function TfrxODACComponents.GetDescription: String;
begin
  Result := 'ODAC';
end;

{ TfrxODACDatabase }

constructor TfrxODACDatabase.Create(AOwner: TComponent);
begin
  inherited;
  
  FDatabase := TOraSession.Create(nil);
  Component := FDatabase;
end;

class function TfrxODACDatabase.GetDescription: String;
begin
  Result := 'ODAC Database';
end;

function TfrxODACDatabase.GetDatabaseName: string;
begin
  Result := TOraSession(FDatabase).Schema;
end;

procedure TfrxODACDatabase.SetDatabaseName(const Value: string);
begin
  TOraSession(FDatabase).Schema := Value;
end;

{ TfrxODACDatabaseNet }

constructor TfrxODACDatabaseNet.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  
  TOraSession(FDatabase).Options.Direct := True;
end;

class function TfrxODACDatabaseNet.GetDescription: String;
begin
  Result := 'ODAC Database Direct';
end;

{ TfrxODACTable }

constructor TfrxODACTable.Create(AOwner: TComponent);
begin
  FTable := TODACTable.Create(nil);
  DataSet := FTable;
  
  inherited;
end;

class function TfrxODACTable.GetDescription: String;
begin
  Result := 'ODAC Table';
end;

procedure TfrxODACTable.SetDatabase(const Value: TfrxDACDatabase);
begin
  inherited;
  
  if Value <> nil then
    FTable.Session := TOraSession(Value.Database)
  else
    if ODACComponents <> nil then
      FTable.Session := TOraSession(ODACComponents.DefaultDatabase)
    else
      FTable.Session := nil;
end;

function TfrxODACTable.GetIndexFieldNames: String;
begin
  Result := FTable.IndexFieldNames;
end;

function TfrxODACTable.GetTableName: String;
begin
  Result := FTable.TableName;
end;

procedure TfrxODACTable.SetIndexFieldNames(const Value: String);
begin
  FTable.IndexFieldNames := Value;
end;

procedure TfrxODACTable.SetTableName(const Value: String);
begin
  FTable.TableName := Value;
  if Assigned(FTable.Connection) then
    FTable.InitFieldDefs;
end;

procedure TfrxODACTable.SetMaster(const Value: TDataSource);
begin
  FTable.MasterSource := Value;
end;

procedure TfrxODACTable.SetMasterFields(const Value: String);
var
  MasterNames: string;
  DetailNames: string;
begin
  GetMasterDetailNames(MasterFields, MasterNames, DetailNames);
  FTable.MasterFields := MasterNames;
  FTable.DetailFields := DetailNames;
end;

{ TfrxODACQuery }

constructor TfrxODACQuery.Create(AOwner: TComponent);
begin
  FQuery := TODACSmartQuery.Create(nil);
  
  inherited;
end;

class function TfrxODACQuery.GetDescription: String;
begin
  Result := 'ODAC Query';
end;

procedure TfrxODACQuery.SetDatabase(const Value: TfrxDACDatabase);
begin
  inherited;
  
  if Value <> nil then
    FQuery.Connection := Value.Database
  else
    if ODACComponents <> nil then
      FQuery.Connection := TOraSession(ODACComponents.DefaultDatabase)
    else
      FQuery.Connection := nil;
end;

{$IFDEF QBUILDER}
function TfrxODACQuery.QBEngine: TfqbEngine;
begin
  Result := TfrxEngineODAC.Create(nil);
  TfrxEngineODAC(Result).FQuery.Connection := FQuery.Connection;
end;
{$ENDIF}

{ TfrxEngineODAC }

{$IFDEF QBUILDER}
constructor TfrxEngineODAC.Create(AOwner: TComponent);
begin
  inherited;
  
  FQuery := TODACSmartQuery.Create(Self);
end;

destructor TfrxEngineODAC.Destroy;
begin
  FQuery.Free;
  
  inherited;
end;

procedure TfrxEngineODAC.ReadFieldList(const ATableName: string;
  var AFieldList: TfqbFieldList);
var
  TempTable: TODACTable;
  Fields: TFieldDefs;
  i: Integer;
  tmpField: TfqbField;
begin
  AFieldList.Clear;
  TempTable := TODACTable.Create(Self);
  TempTable.Connection := FQuery.Connection;
  TempTable.TableName := ATableName;
  Fields := TempTable.FieldDefs;
  try
    try
      TempTable.Active := True;
      tmpField:= TfqbField(AFieldList.Add);
      tmpField.FieldName := '*';
      for i := 0 to Fields.Count - 1 do
      begin
        tmpField := TfqbField(AFieldList.Add);
        tmpField.FieldName := Fields.Items[i].Name;
        tmpField.FieldType := Ord(Fields.Items[i].DataType)
      end;
    except
    end;
  finally
    TempTable.Free;
  end;
end;
{$ENDIF}

initialization
  CatBmp := TBitmap.Create;
  CatBmp.LoadFromResourceName(hInstance, TfrxODACComponents.ResourceName);
  RegisterDacComponents(TfrxODACComponents);
  frxObjects.RegisterObject1(TfrxODACDataBaseDirect, nil, '', TfrxODACComponents.GetComponentsName, 0, 37);
  frxObjects.RegisterObject1(TfrxODACDataBaseNet, nil, 'ODAC Database Net (deprecated)', TfrxODACComponents.GetComponentsName, 0, 37);

finalization
  UnRegisterDacComponents(TfrxODACComponents);
  frxObjects.UnRegister(TfrxODACDataBaseDirect);
  frxObjects.UnRegister(TfrxODACDataBaseNet);
  CatBmp.Free;

end.