frxodaccomponents.pas

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

{******************************************}
{                                          }
{             FastReport v3.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
{$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(TfrxDBComponents)
  private
    FDefaultDatabase: TOraSession;
    FOldComponents: TfrxODACComponents;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetDescription: String; override;
  published
    property DefaultDatabase: TOraSession read FDefaultDatabase write FDefaultDatabase;
  end;

  TfrxODACDatabase = class(TfrxCustomDatabase)
  private
    FDatabase: TOraSession;
  protected
    function GetLoginPrompt: Boolean; override;
    procedure SetLoginPrompt(Value: Boolean); override;
    function GetDatabaseName: string; override;
    procedure SetDatabaseName(const Value: string); override;
    function GetUsername: string;
    procedure SetUsername(const Value: string);
    function GetPassword: string;
    procedure SetPassword(const Value: string);
    function GetServer: string;
    procedure SetServer(const Value: string);
    function GetConnected: Boolean; override;
    procedure SetConnected(Value: Boolean); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    class function GetDescription: String; override;
    procedure SetLogin(const Login, Password: String); override;
    property Database: TOraSession read FDatabase;
  published
    property LoginPrompt;
    property DatabaseName;
    property Username: String read GetUsername write SetUsername;
    property Password: String read GetPassword write SetPassword;
    property Server: String read GetServer write SetServer;
    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(TfrxCustomTable)
  private
    FDatabase: TfrxODACDatabase;
    FTable: TODACTable;
    procedure SetDatabase(const Value: TfrxODACDatabase);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); 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;
    constructor DesignCreate(AOwner: TComponent; Flags: Word); override;
    class function GetDescription: String; override;
    procedure BeforeStartReport; override;
    property Table: TODACTable read FTable;
  published
    property Database: TfrxODACDatabase read FDatabase write SetDatabase;
  end;

  TfrxODACQuery = class(TfrxCustomQuery)
  private
    FDatabase: TfrxODACDatabase;
    FQuery: TODACSmartQuery;
    procedure SetDatabase(const Value: TfrxODACDatabase);
    procedure SetIndexFieldNames(const Value: String);
    function GetIndexFieldNames: String;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetMaster(const Value: TDataSource); override;
    procedure SetMasterFields(const Value: String); override;
    procedure SetSQL(Value: TStrings); override;
    function GetSQL: TStrings; override;
  public
    constructor Create(AOwner: TComponent); override;
    constructor DesignCreate(AOwner: TComponent; Flags: Word); override;
    class function GetDescription: String; override;
    procedure BeforeStartReport; override;
    procedure UpdateParams; override;
    property Query: TODACSmartQuery read FQuery;
{$IFDEF QBUILDER}
    function QBEngine: TfqbEngine; override;
{$ENDIF}
  published
    property Database: TfrxODACDatabase read FDatabase write SetDatabase;
    property IndexFieldNames: String read GetIndexFieldNames write SetIndexFieldNames;
    property MasterFields;
  end;

{$IFDEF QBUILDER}
  TfrxEngineODAC = class(TfqbEngine)
  private
    FQuery: TODACSmartQuery;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ReadTableList(ATableList: TStrings); override;
    procedure ReadFieldList(const ATableName: string; var AFieldList: TfqbFieldList); override;
    function ResultDataSet: TDataSet; override;
    procedure SetSQL(const Value: string); override;
  end;
{$ENDIF}

var
  ODACComponents: TfrxODACComponents;


implementation

{$R *.res}

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

{$IFNDEF VER6P}
procedure SetDelimitedText(Strings: TStrings; Delimiter:Char; const Value: string);
var
  P, P1: PChar;
  S: string;
begin
  with Strings do begin
    BeginUpdate;
    try
      Clear;
      P := PChar(Value);
      while P^ in [#1..' '] do
      {$IFDEF MSWINDOWS}
        P := CharNext(P);
      {$ELSE}
        Inc(P);
      {$ENDIF}
      while P^ <> #0 do begin
        if P^ = '"' then
          S := AnsiExtractQuotedStr(P, '"')
        else begin
          P1 := P;
          while (P^ > ' ') and (P^ <> Delimiter) do
          {$IFDEF MSWINDOWS}
            P := CharNext(P);
          {$ELSE}
            Inc(P);
          {$ENDIF}
          SetString(S, P1, P - P1);
        end;
        Add(S);
        while P^ in [#1..' '] do
        {$IFDEF MSWINDOWS}
          P := CharNext(P);
        {$ELSE}
          Inc(P);
        {$ENDIF}
        if P^ = Delimiter then begin
          P1 := P;
          {$IFDEF MSWINDOWS}
          if CharNext(P1)^ = #0 then
          {$ELSE}
          Inc(P1);
          if P1^ = #0 then
          {$ENDIF}
            Add('');
          repeat
            {$IFDEF MSWINDOWS}
            P := CharNext(P);
            {$ELSE}
            Inc(P);
            {$ENDIF}
          until not (P^ in [#1..' ']);
        end;
      end;
    finally
      EndUpdate;
    end;
  end;
end;
{$ENDIF}

procedure GetMasterDetailNames(const Value: String; var MasterNames: string; var DetailNames: string);
var
  List: TStringList;
  i: integer;
begin
  List := TStringList.Create;
  try
{$IFNDEF VER6P}
    SetDelimitedText(List, ';', Value);
{$ELSE}
    List.Delimiter := ';';
    List.DelimitedText := Value;
{$ENDIF}
    MasterNames := '';
    DetailNames := '';
    for i := 0 to List.Count - 1 do begin
      if MasterNames <> '' then
        MasterNames := MasterNames + ';';
      if DetailNames <> '' then
        DetailNames := DetailNames + ';';
      MasterNames := MasterNames + List.Values[List.Names[i]];
      DetailNames := DetailNames + List.Names[i];
    end;
  finally
    List.Free;
  end;
end;

{ TODACTable }

procedure TODACTable.InitFieldDefs;
begin
  if TableName <> '' then
    inherited;
end;

{ TODACSmartQuery }

procedure TODACSmartQuery.InitFieldDefs;
begin
  if SQL.Text <> '' 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.GetDescription: String;
begin
  Result := 'ODAC';
end;


{ TfrxODACDatabase }

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

destructor TfrxODACDatabase.Destroy;
begin
  inherited;
end;

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

function TfrxODACDatabase.GetConnected: Boolean;
begin
  Result := FDatabase.Connected;
end;

function TfrxODACDatabase.GetUsername: String;
begin
  Result := FDatabase.Username;
end;

function TfrxODACDatabase.GetPassword: String;
begin
  Result := FDatabase.Password;
end;

function TfrxODACDatabase.GetServer: String;
begin
  Result := FDatabase.Server;
end;