fs_iodacrtti.pas

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

{******************************************}
{                                          }
{             FastScript v1.9              }
{        SDAC classes and functions        }
{                                          }
{          Created by: CoreLab             }
{         E-mail: [e-mail]           }
{                                          }
{******************************************}

unit fs_iodacrtti;

interface

{$i fs.inc}

uses
  SysUtils, Classes, fs_iinterpreter, fs_itools, fs_idbrtti, fs_idacrtti, DB,
  OraClasses, Ora, OraSmart;

type
  TfsODACRTTI = class(TComponent); // fake component

implementation

type
  TFunctions = class(TfsRTTIModule)
  private
    function CallMethod(Instance: TObject; ClassType: TClass;
      const MethodName: String; Caller: TfsMethodHelper): Variant;
    function GetProp(Instance: TObject; ClassType: TClass;
      const PropName: String): Variant;
    procedure SetProp(Instance: TObject; ClassType: TClass;
      const PropName: String; Value: Variant);
  public
    constructor Create(AScript: TfsScript); override;
  end;

{ TFunctions }

constructor TFunctions.Create(AScript: TfsScript);
begin
  inherited Create(AScript);
  
  with AScript do begin
    with AddClass(TOraSession, 'TCustomDAConnection') do begin
      AddMethod('procedure Savepoint(const Savepoint: string)', CallMethod);
      AddMethod('procedure RollbackToSavepoint(const Savepoint: string)', CallMethod);

      AddMethod('function ExecProc(Name: string; const Params: array of variant): variant', CallMethod);

      AddMethod('function ExecSQLEx(Text: string; const Params: array of variant): variant', CallMethod);
      AddMethod('function ExecProcEx(Name: string; const Params: array of variant): variant', CallMethod);

      AddMethod('procedure Ping', CallMethod);
      AddMethod('procedure ClearStatementCache', CallMethod);

      AddMethod('procedure ChangePassword(NewPassword: string)', CallMethod);

      AddMethod('procedure GetSequenceNames(List: TStrings)', CallMethod);

      AddProperty('OracleVersion', 'string', GetProp);
    end;

    AddEnum('TOracleHome', 'ohDefault,ohHome0,ohHome1,ohHome2,ohHome3,ohHome4,ohHome5');
    
    AddClass(TOraSessionOptions, 'TDAConnectionOptions');
    AddEnum('TOptimizerMode', 'omDefault, omFirstRows1000, omFirstRows100, omFirstRows10, omFirstRows1, omFirstRows, omAllRows, omChoose, omRule');
    AddClass(TOraPoolingOptions, 'TPoolingOptions');
    AddEnum('TOraPoolingType',  'optLocal, optOCI, optMTS');

    with AddClass(TOraDataSet, 'TCustomDADataSet') do begin
      AddMethod('procedure BreakExec', CallMethod);
      AddMethod('procedure Lock', CallMethod);
      AddMethod('procedure Unlock', CallMethod);
      AddMethod('function GetKeyList(TableName: string; List: TStrings): string', CallMethod);
    end;
    AddClass(TOraParams, 'TDAParams');
    AddEnum('TLockMode', 'lmNone, lmLockImmediate, lmLockDelayed');
    AddEnum('TCheckMode', 'cmNone, cmException, cmRefresh');
    AddEnum('TSequenceMode', 'smInsert, smPost');
    AddEnum('TRefreshMode', 'rmNone, rmAfterInsert, rmAfterUpdate, rmAlways'); // obsolete

    AddClass(TOraDataSetOptionsDS, 'TDADataSetOptions');
    AddClass(TOraDataSetOptions, 'TOraDataSetOptionsDS');

    with AddClass(TSmartQuery, 'TOraDataSet') do begin
      AddMethod('procedure View', CallMethod);
    end;
    AddClass(TSmartQueryOptions, 'TOraDataSetOptions');
    
    with AddClass(TOraTable, 'TOraDataSet') do begin
      AddMethod('procedure PrepareSQL', CallMethod);
      AddMethod('procedure EmptyTable', CallMethod);
    end;
    AddClass(TOraTableOptions, 'TSmartQueryOptions');

    with AddClass(TOraStoredProc, 'TOraDataSet') do begin
      AddMethod('procedure ExecProc', CallMethod);
      AddMethod('procedure PrepareSQL', CallMethod);

      AddProperty('StoredProcName', 'string', GetProp, SetProp);
    end;
  end;
end;

function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
  const MethodName: String; Caller: TfsMethodHelper): Variant;
begin
  Result := 0;

  if ClassType = TOraSession then begin
    if MethodName = 'SAVEPOINT' then
      TOraSession(Instance).Savepoint(Caller.Params[0])
    else
    if MethodName = 'ROLLBACKTOSAVEPOINT' then
      TOraSession(Instance).RollbackToSavepoint(Caller.Params[0])
    else
    if MethodName = 'EXECPROC' then
      Result := TOraSession(Instance).ExecProc(Caller.Params[0], [Caller.Params[0]])
    else
    if MethodName = 'EXECSQLEX' then
      Result := TOraSession(Instance).ExecSQLEx(Caller.Params[0], [Caller.Params[0]])
    else
    if MethodName = 'EXECPROCEX' then
      Result := TOraSession(Instance).ExecProcEx(Caller.Params[0], [Caller.Params[0]])
    else
    if MethodName = 'PING' then
      TOraSession(Instance).Ping
    else
    if MethodName = 'CLEARSTATEMENTCACHE' then
      TOraSession(Instance).ClearStatementCache
    else
    if MethodName = 'CHANGEPASSWORD' then
      TOraSession(Instance).ChangePassword(Caller.Params[0])
    else
    if MethodName = 'GETSEQUENCENAMES' then
      TOraSession(Instance).GetSequenceNames(TStrings(Integer(Caller.Params[0])));
  end
  else
  if ClassType = TOraDataSet then begin
    if MethodName = 'BREAKEXEC' then
      TOraDataSet(Instance).BreakExec
    else
    if MethodName = 'LOCK' then
      TOraDataSet(Instance).Lock
    else
    if MethodName = 'UNLOCK' then
      TOraDataSet(Instance).Unlock
    else
    if MethodName = 'GETKEYLIST' then
      Result := TOraDataSet(Instance).GetKeyList(Caller.Params[1], TStrings(Integer(Caller.Params[1])));
  end
  else
  if ClassType = TSmartQuery then begin
    if MethodName = 'VIEW' then
      TSmartQuery(Instance).View;
  end
  else
  if ClassType = TOraTable then begin
    if MethodName = 'PREPARESQL' then
      TOraTable(Instance).PrepareSQL
    else
    if MethodName = 'EMPTYTABLE' then
      TOraTable(Instance).EmptyTable;
  end
  else
  if ClassType = TOraStoredProc then begin
    if MethodName = 'PREPARESQL' then
      TOraStoredProc(Instance).PrepareSQL
    else
    if MethodName = 'EXECPROC' then
      TOraStoredProc(Instance).ExecProc;
  end;
end;

function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
  const PropName: String): Variant;
begin
  Result := 0;

  if ClassType = TOraSession then begin
    if PropName = 'ORACLEVERSION' then
      Result := TOraSession(Instance).OracleVersion
  end
  else
  if ClassType = TOraStoredProc then begin
    if PropName = 'STOREDPROCNAME' then
      Result := TOraStoredProc(Instance).StoredProcName;
  end;
end;

procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
  const PropName: String; Value: Variant);
begin
  if ClassType = TOraStoredProc then begin
    if PropName = 'STOREDPROCNAME' then
      TOraStoredProc(Instance).StoredProcName := Value;
  end;
end;

initialization
  fsRTTIModules.Add(TFunctions);

finalization
  if fsRTTIModules <> nil then
    fsRTTIModules.Remove(TFunctions);

end.