fr_odacdb.pas

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

//////////////////////////////////////////////////
//  FastReport v2.4 - ODAC components
//  Copyright (c) 2006 Core Lab. All right reserved.
//  Database component
//  Created:
//  Last modified:
//////////////////////////////////////////////////

unit FR_ODACDB;

interface

{$I FR.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, FR_Class, StdCtrls,
  Controls, Forms, Menus, Dialogs, DB, Ora, OdacVcl;

type
  TfrODACComponents = class(TComponent) // fake component
  end;

  TfrODACDatabase = class(TfrNonVisualControl)
  private
    FDatabase: TOraSession;
  protected
    procedure SetPropValue(Index: String; Value: Variant); override;
    function GetPropValue(Index: String): Variant; override;
    function DoMethod(MethodName: String; Par1, Par2, Par3: Variant): Variant; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefineProperties; override;
    property Database: TOraSession read FDatabase;
  end;


implementation

uses FR_Utils, FR_Const, FR_DBLookupCtl, OraCall, FR_ODACQuery, FR_ODACTable
{$IFDEF Delphi6}
, Variants
{$ENDIF};

{$R FR_ODAC.RES}


{ TfrODACDatabase }

constructor TfrODACDatabase.Create;
begin
  inherited Create;
  FDatabase := TOraSession.Create(frDialogForm);
  Component := FDatabase;
  BaseName := 'Session';
  Bmp.LoadFromResourceName(hInstance, 'FR_ODACDB');
  Flags := Flags or flDontUndo;
end;

destructor TfrODACDatabase.Destroy;
begin
  FDatabase.Free;
  inherited Destroy;
end;

procedure TfrODACDatabase.DefineProperties;

  function GetServerNames: String;
  var List: TStringList;
      i: integer;
  begin
    List:=TStringList.Create;
    try
      if not OCIInited then
        InitOCI;
      GetOraServerList(List, OracleHomePath, True, True, False);
      for i := 0 to List.Count - 1 do
        Result := Result + List[i] + ';';
    finally
      List.Free;
    end;

  end;

begin
  inherited DefineProperties;
  AddProperty('Connected', [frdtBoolean], nil);
  AddProperty('ConnectPrompt', [frdtBoolean], nil);
  AddEnumProperty('Server', GetServerNames, [Null]);
  AddProperty('Password', [frdtString], nil);
  AddProperty('Username', [frdtString], nil);
end;

procedure TfrODACDatabase.SetPropValue(Index: String; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'SERVER' then
    FDatabase.Server := Value
  else if Index = 'CONNECTED' then
    FDatabase.Connected := Value
  else if Index = 'CONNECTPROMPT' then
    FDatabase.ConnectPrompt := Value
  else if Index = 'PASSWORD' then
    FDatabase.Password := Value
  else if Index = 'USERNAME' then
    FDatabase.Username := Value
end;

function TfrODACDatabase.GetPropValue(Index: String): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
   if Index = 'SERVER' then
    Result := FDatabase.Server
  else if Index = 'CONNECTED' then
    Result := FDatabase.Connected
  else if Index = 'CONNECTPROMPT' then
    Result := FDatabase.ConnectPrompt
  else if Index = 'PASSWORD' then
    Result := FDatabase.Password
  else if Index = 'USERNAME' then
    Result := FDatabase.Username
end;

function TfrODACDatabase.DoMethod(MethodName: String; Par1, Par2, Par3: Variant): Variant;
begin
end;

procedure TfrODACDatabase.LoadFromStream(Stream: TStream);
var
  s: String;
begin
  inherited LoadFromStream(Stream);

  s := frReadString(Stream);
  if s <> '' then
    FDatabase.Server := s;

  FDatabase.Username:= frReadString(Stream);

  s := frReadString(Stream);
  if s <> '' then
    FDatabase.Password := s;

  FDatabase.ConnectPrompt := frReadBoolean(Stream);
  FDatabase.Connected := frReadBoolean(Stream);
end;

procedure TfrODACDatabase.SaveToStream(Stream: TStream);
begin
  inherited SaveToStream(Stream);

  frWriteString(Stream, FDatabase.Server);
  frWriteString(Stream, FDatabase.Username);
  frWriteString(Stream, FDatabase.Password);

  frWriteBoolean(Stream, FDatabase.ConnectPrompt);
  frWriteBoolean(Stream, FDatabase.Connected);
end;

var
  BmpDB, BmpQuery, BmpTable: TBitmap;

initialization
  BmpDB := TBitmap.Create;
  BmpDB.LoadFromResourceName(hInstance, 'FR_ODACDBCONTROL');
  frRegisterControl(TfrODACDatabase, BmpDB, IntToStr(SInsertDB));
  BmpQuery := TBitmap.Create;
  BmpQuery.LoadFromResourceName(hInstance, 'FR_ODACQUERYCONTROL');
  frRegisterControl(TfrODACQuery, BmpQuery, IntToStr(SInsertQuery));
  BmpTable := TBitmap.Create;
  BmpTable.LoadFromResourceName(hInstance, 'FR_ODACTABLECONTROL');
  frRegisterControl(TfrODACTable, BmpTable, IntToStr(SInsertTable));

finalization
  frUnRegisterObject(TfrODACDatabase);
  BmpDB.Free;
  frUnRegisterObject(TfrODACQuery);
  BmpQuery.Free;
  frUnRegisterObject(TfrODACTable);
  BmpTable.Free;

end.