1175 lines
33 KiB
ObjectPascal
1175 lines
33 KiB
ObjectPascal
|
unit uDADOADriver;
|
|||
|
|
|
|||
|
|
interface
|
|||
|
|
|
|||
|
|
uses
|
|||
|
|
DB,
|
|||
|
|
Classes,
|
|||
|
|
uROClasses,
|
|||
|
|
uDAEngine,
|
|||
|
|
uDAInterfaces,
|
|||
|
|
uDAOracleInterfaces,
|
|||
|
|
uDAUtils,
|
|||
|
|
Oracle,
|
|||
|
|
OracleData;
|
|||
|
|
|
|||
|
|
type
|
|||
|
|
|
|||
|
|
TDADOADriver = class(TDADriverReference)
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TDAEDOADriver = class(TDAEDriver)
|
|||
|
|
private
|
|||
|
|
fTraceCallBack: TDALogTraceEvent; // UKO 26.09.2003
|
|||
|
|
protected
|
|||
|
|
procedure DoSetTraceOptions(TraceActive: Boolean; TraceOptions:
|
|||
|
|
TDATraceOptions; Callback: TDALogTraceEvent); override;
|
|||
|
|
function GetAvailableDriverOptions: TDAAvailableDriverOptions; override;
|
|||
|
|
function GetConnectionClass: TDAEConnectionClass; override;
|
|||
|
|
function GetDefaultCustomParameters: string; override;
|
|||
|
|
function GetDescription: string; override;
|
|||
|
|
function GetDriverID: string; override;
|
|||
|
|
function GetMajVersion: byte; override;
|
|||
|
|
function GetMinVersion: byte; override;
|
|||
|
|
|
|||
|
|
procedure GetAuxParams(const AuxDriver: string; out List: IROStrings); override;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TDAEDOAConnection = class(TDAECOnnection, IOracleConnection)
|
|||
|
|
private
|
|||
|
|
fSysObjects: Boolean;
|
|||
|
|
fSchema: string;
|
|||
|
|
fUsername: string;
|
|||
|
|
function GetObjects(Schema, WhereClause: string): IROStrings;
|
|||
|
|
function GetEncodedObjects(WhereClause: string): IROStrings;
|
|||
|
|
function GetOracleSession: TOracleSession;
|
|||
|
|
function GetStoredProcsInPackages(Schema: string): IROStrings;
|
|||
|
|
function EncodeSchema(const Username, Schema: string; Contents: IROStrings): IROStrings;
|
|||
|
|
function GetPrimaryKeys(const Schema, TableName: string): IROStrings;
|
|||
|
|
function GetConstraintColumnsAsString(const AOwner, AConstraintName: string; out AColumns: string): string;
|
|||
|
|
protected
|
|||
|
|
function CreateCustomConnection: TCustomConnection; override;
|
|||
|
|
function CreateMacroProcessor: TDASQLMacroProcessor; override;
|
|||
|
|
|
|||
|
|
procedure DoApplyConnectionString(aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection); override;
|
|||
|
|
|
|||
|
|
function DoBeginTransaction: Integer; override;
|
|||
|
|
procedure DoCommitTransaction; override;
|
|||
|
|
procedure DoGetStoredProcedureNames(out List: IROStrings); override;
|
|||
|
|
procedure DoGetStoredProcedureParams(const aStoredProcedureName: string;
|
|||
|
|
out Params: TDAParamCollection); override;
|
|||
|
|
procedure DoGetTableFields(const aTableName: string; out Fields:
|
|||
|
|
TDAFieldCollection); override;
|
|||
|
|
procedure DoGetTableNames(out List: IROStrings); override;
|
|||
|
|
procedure DoGetViewFields(const aViewName: string; out Fields:
|
|||
|
|
TDAFieldCollection); override;
|
|||
|
|
procedure DoGetViewNames(out List: IROStrings); override;
|
|||
|
|
procedure DoGetForeignKeys(out ForeignKeys: TDADriverForeignKeyCollection); override;
|
|||
|
|
procedure DoRollbackTransaction; override;
|
|||
|
|
function GetDataSetClass: TDAEDatasetClass; override;
|
|||
|
|
function GetStoredProcedureClass: TDAEStoredProcedureClass; override;
|
|||
|
|
property OracleSession: TOracleSession read GetOracleSession;
|
|||
|
|
|
|||
|
|
function IdentifierNeedsQuoting(const iIdentifier: string): boolean; override;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TDAEDOAQuery = class(TDAEDataSet, IDAMustSetParams, IOracleDataSet)
|
|||
|
|
private
|
|||
|
|
function LockModeDaToDoa(LockMode: TOracleLockMode): TLockingModeOptions;
|
|||
|
|
function LockModeDoaToDa(LockMode: TLockingModeOptions): TOracleLockMode;
|
|||
|
|
protected
|
|||
|
|
function CreateDataset(aConnection: TDAEConnection): TDataset; override;
|
|||
|
|
function DoExecute: Integer; override;
|
|||
|
|
function DoGetSQL: string; override;
|
|||
|
|
procedure DoPrepare(Value: Boolean); override;
|
|||
|
|
procedure DoSetSQL(const Value: string); override;
|
|||
|
|
function GetLockMode: TOracleLockMode;
|
|||
|
|
function GetOptions: TOracleOptions;
|
|||
|
|
procedure SetLockMode(Value: TOracleLockMode);
|
|||
|
|
procedure SetOptions(Value: TOracleOptions);
|
|||
|
|
procedure SetParamValues(Params: TDAParamCollection); safecall;
|
|||
|
|
procedure GetParamValues(Params: TDAParamCollection); safecall;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TDAEDOAStoredProcedure = class(TDAEStoredProcedure, IDAMustSetParams)
|
|||
|
|
private
|
|||
|
|
fProcedureName: string;
|
|||
|
|
procedure DoGetParams;
|
|||
|
|
function DoGetParamsResult: TDAParam;
|
|||
|
|
procedure DoSetSource;
|
|||
|
|
protected
|
|||
|
|
function CreateDataset(aConnection: TDAEConnection): TDataset; override;
|
|||
|
|
function Execute: Integer; override;
|
|||
|
|
function GetStoredProcedureName: string; override;
|
|||
|
|
procedure RefreshParams; override;
|
|||
|
|
procedure SetParamValues(Params: TDAParamCollection); safecall;
|
|||
|
|
procedure SetStoredProcedureName(const Name: string); override;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure Register;
|
|||
|
|
|
|||
|
|
function GetDriverObject: IDADriver; stdcall;
|
|||
|
|
|
|||
|
|
implementation
|
|||
|
|
|
|||
|
|
{$INCLUDE DOA.INC}
|
|||
|
|
|
|||
|
|
uses
|
|||
|
|
SysUtils,
|
|||
|
|
uDADriverManager,
|
|||
|
|
uDARes,
|
|||
|
|
{$IFDEF DOA4}
|
|||
|
|
OracleMonitor,
|
|||
|
|
{$ENDIF}
|
|||
|
|
uDAMacroProcessors;
|
|||
|
|
|
|||
|
|
const
|
|||
|
|
NL = #13#10;
|
|||
|
|
|
|||
|
|
type
|
|||
|
|
TDADOAInternalConnection = class(TCustomConnection)
|
|||
|
|
private
|
|||
|
|
fOracleSession: TOracleSession;
|
|||
|
|
protected
|
|||
|
|
procedure DoConnect; override;
|
|||
|
|
procedure DoDisconnect; override;
|
|||
|
|
function GetConnected: Boolean; override;
|
|||
|
|
public
|
|||
|
|
constructor Create(AOwner: TComponent); override;
|
|||
|
|
destructor Destroy; override;
|
|||
|
|
property Session: TOracleSession read fOracleSession;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
TOraPath = record
|
|||
|
|
aScheme: string;
|
|||
|
|
aPackage: string;
|
|||
|
|
aObject: string;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
var
|
|||
|
|
_Driver: TDAEDriver = nil;
|
|||
|
|
|
|||
|
|
procedure Register;
|
|||
|
|
begin
|
|||
|
|
RegisterComponents(DAPalettePageName, [TDADOADriver]);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function GetDriverObject: IDADriver;
|
|||
|
|
begin
|
|||
|
|
if (_Driver = nil) then
|
|||
|
|
_Driver := TDAEDOADriver.Create(nil);
|
|||
|
|
Result := _Driver;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{ HELPERS ******************************************************************** }
|
|||
|
|
|
|||
|
|
function CaseStringOf(const Value: string; const Args: array of string):
|
|||
|
|
Integer;
|
|||
|
|
begin
|
|||
|
|
for Result := High(Args) downto 0 do
|
|||
|
|
if AnsiSameStr(Value, Args[Result]) then
|
|||
|
|
Break;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function ParamTypeOraToDa(const AName, AType: string): TDAParamType;
|
|||
|
|
begin
|
|||
|
|
Result := daptUnknown;
|
|||
|
|
if AnsiSameStr(AType, 'IN') then
|
|||
|
|
Result := daptInput;
|
|||
|
|
if AnsiSameStr(AType, 'OUT') then
|
|||
|
|
begin
|
|||
|
|
if Length(AName) = 0 then
|
|||
|
|
Result := daptResult
|
|||
|
|
else
|
|||
|
|
Result := daptOutput;
|
|||
|
|
end;
|
|||
|
|
if AnsiSameStr(AType, 'IN/OUT') then
|
|||
|
|
Result := daptInputOutput;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function DataTypeOraToVcl(const AName: string; AScale: Integer): TFieldType;
|
|||
|
|
begin
|
|||
|
|
Result := ftUnknown;
|
|||
|
|
case CaseStringOf(AName, ['BINARY_INTEGER', 'NUMBER', 'CHAR', 'NCHAR',
|
|||
|
|
'VARCHAR2', 'NVARCHAR2', 'DATE', 'BLOB', 'CLOB', 'NCLOB', 'PL/SQL BOOLEAN',
|
|||
|
|
'FLOAT']) of
|
|||
|
|
0, 1:
|
|||
|
|
if AScale = 0 then
|
|||
|
|
Result := ftInteger
|
|||
|
|
else
|
|||
|
|
Result := ftFloat;
|
|||
|
|
2, 3, 4, 5: Result := ftString;
|
|||
|
|
6: Result := ftDate;
|
|||
|
|
7: Result := ftBlob;
|
|||
|
|
8, 9: Result := ftMemo;
|
|||
|
|
10: Result := ftBoolean;
|
|||
|
|
11: Result := ftFloat;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// 1) extended with DefaultScheme
|
|||
|
|
// 2) if Scheme is not the Default and not SYS or SYSTEM then handle it as Packagename
|
|||
|
|
// UKO 25.09.2003
|
|||
|
|
|
|||
|
|
function ExtractOraPath(AOraPath: string; ADefaultScheme: string): TOraPath;
|
|||
|
|
var
|
|||
|
|
PathList: TStringList;
|
|||
|
|
Count: Integer;
|
|||
|
|
begin
|
|||
|
|
Result.aScheme := '';
|
|||
|
|
Result.aPackage := '';
|
|||
|
|
Result.aObject := '';
|
|||
|
|
PathList := TStringList.Create;
|
|||
|
|
try
|
|||
|
|
Count := ExtractStrings(['.'], [' '], PAnsiChar(AOraPath), PathList);
|
|||
|
|
case Count of
|
|||
|
|
0: ;
|
|||
|
|
1:
|
|||
|
|
begin
|
|||
|
|
Result.aObject := AOraPath;
|
|||
|
|
Result.aScheme := ADefaultScheme;
|
|||
|
|
end;
|
|||
|
|
2:
|
|||
|
|
begin
|
|||
|
|
Result.aObject := PathList[1];
|
|||
|
|
Result.aScheme := PathList[0];
|
|||
|
|
|
|||
|
|
// The case of packages must be handled seperatly :
|
|||
|
|
// UKO 25.09.2003
|
|||
|
|
if (AnsiCompareText(Result.aScheme, ADefaultScheme) <> 0) and
|
|||
|
|
(AnsiCompareText(Result.aScheme, 'SYS') <> 0) and
|
|||
|
|
(AnsiCompareText(Result.aScheme, 'SYSTEM') <> 0) then
|
|||
|
|
begin
|
|||
|
|
Result.aScheme := ADefaultScheme;
|
|||
|
|
Result.aPackage := PathList[0];
|
|||
|
|
Result.aObject := PathList[1];
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
else
|
|||
|
|
begin
|
|||
|
|
Result.aObject := PathList[PathList.Count - 1];
|
|||
|
|
Result.aPackage := PathList[PathList.Count - 2];
|
|||
|
|
Result.aScheme := PathList[PathList.Count - 3];
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
UpperCase(Result.aScheme);
|
|||
|
|
UpperCase(Result.aPackage);
|
|||
|
|
UpperCase(Result.aObject);
|
|||
|
|
finally
|
|||
|
|
PathList.Free;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function ProcessWhereExp(AName, AValue: string): string;
|
|||
|
|
begin
|
|||
|
|
Result := Format('%s =''%s''', [AName, AValue]);
|
|||
|
|
if AValue = '' then
|
|||
|
|
Result := Format('%s is null', [AName]);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function HandleSqlName(AParamName: string; AParamType: TDAParamType): string;
|
|||
|
|
begin
|
|||
|
|
Result := AParamName;
|
|||
|
|
if AParamType = daptResult then
|
|||
|
|
Result := 'result';
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function DataTypeDaToOra(AType: TDADataType): Integer;
|
|||
|
|
const
|
|||
|
|
Error = 'INTERNAL: not supported by DOA';
|
|||
|
|
begin
|
|||
|
|
Result := otString;
|
|||
|
|
case AType of
|
|||
|
|
datUnknown: raise Exception.Create(Error);
|
|||
|
|
datString: Result := otString;
|
|||
|
|
datDateTime: Result := otDate;
|
|||
|
|
datFloat: Result := otFloat;
|
|||
|
|
datCurrency: Result := otFloat;
|
|||
|
|
datAutoInc: raise Exception.Create(Error);
|
|||
|
|
datInteger: Result := otInteger;
|
|||
|
|
datLargeInt: Result := otInteger;
|
|||
|
|
datBoolean: Result := otInteger; // needs a special handling
|
|||
|
|
datMemo: Result := otClob;
|
|||
|
|
datBlob: Result := otBlob;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure SetDataSetParams(Params: TDAParamCollection; DataSet: TDataSet);
|
|||
|
|
var
|
|||
|
|
I: Integer;
|
|||
|
|
Ds: TOracleDataSet;
|
|||
|
|
ParamIndex, OraType: Integer;
|
|||
|
|
Name: string;
|
|||
|
|
begin
|
|||
|
|
Ds := TOracleDataSet(DataSet);
|
|||
|
|
if Ds.Variables.Count > Params.Count then
|
|||
|
|
for I := Ds.VariableCount - 1 downto 0 do
|
|||
|
|
if Params.ParamByName(Ds.VariableName(I)) = nil then
|
|||
|
|
Ds.DeleteVariable(Ds.VariableName(I));
|
|||
|
|
|
|||
|
|
for I := 0 to Params.Count - 1 do
|
|||
|
|
begin
|
|||
|
|
ParamIndex := Ds.VariableIndex(Params[I].Name);
|
|||
|
|
Name := HandleSqlName(Params[I].Name, Params[I].ParamType);
|
|||
|
|
OraType := DataTypeDaToOra(Params[I].DataType);
|
|||
|
|
// New Param
|
|||
|
|
if ParamIndex = -1 then
|
|||
|
|
Ds.DeclareVariable(Name, OraType);
|
|||
|
|
// Changed Param
|
|||
|
|
if (ParamIndex > -1) and (Ds.VariableType(ParamIndex) <> DataTypeDaToOra(
|
|||
|
|
Params[I].DataType)) then
|
|||
|
|
begin
|
|||
|
|
Ds.DeleteVariable(Params[I].Name);
|
|||
|
|
Ds.DeclareVariable(Name, OraType);
|
|||
|
|
end;
|
|||
|
|
// Set value
|
|||
|
|
if Params[I].DataType = datBoolean then
|
|||
|
|
Ds.SetVariable(Name, Integer(Params[I].Value))
|
|||
|
|
else
|
|||
|
|
Ds.SetVariable(Name, Params[I].Value);
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure GetStoredProcParams(
|
|||
|
|
OracleSession: TOracleSession;
|
|||
|
|
const aStoredProcedureName: string;
|
|||
|
|
out Params: TDAParamCollection);
|
|||
|
|
var
|
|||
|
|
Query: TOracleQuery;
|
|||
|
|
OraPath: TOraPath;
|
|||
|
|
const
|
|||
|
|
SQL = 'select ' + NL +
|
|||
|
|
' argument_name, data_type, in_out, data_length, data_precision, data_scale ' + NL +
|
|||
|
|
'from all_arguments' + NL +
|
|||
|
|
'where' + NL +
|
|||
|
|
' ((in_out = ''IN'' and argument_name IS NOT NULL) or in_out = ''OUT'' or in_out = ''IN/OUT'') ' + NL +
|
|||
|
|
' and %s' + NL +
|
|||
|
|
' and %s' + NL +
|
|||
|
|
' and %s';
|
|||
|
|
begin
|
|||
|
|
Params := TDAParamCollection.Create(nil);
|
|||
|
|
Query := TOracleQuery.Create(nil);
|
|||
|
|
try
|
|||
|
|
OraPath := ExtractOraPath(aStoredProcedureName, OracleSession.LogonUsername);
|
|||
|
|
Query.Session := OracleSession;
|
|||
|
|
Query.SQL.Text := Format(SQL, [ProcessWhereExp('owner', OraPath.aScheme),
|
|||
|
|
ProcessWhereExp('package_name', OraPath.aPackage),
|
|||
|
|
ProcessWhereExp('object_name', OraPath.aObject)]);
|
|||
|
|
Query.Execute;
|
|||
|
|
while not (Query.Eof) do
|
|||
|
|
begin
|
|||
|
|
with Params.Add() do
|
|||
|
|
begin
|
|||
|
|
ParamType := ParamTypeOraToDa(Query.Field(0), Query.Field(2));
|
|||
|
|
Name := HandleSqlName(Query.Field(0), ParamType);
|
|||
|
|
DataType := VCLTypeToDAType(DataTypeOraToVcl(Query.Field(1),
|
|||
|
|
Query.Field(5)));
|
|||
|
|
Size := Query.Field(4);
|
|||
|
|
end;
|
|||
|
|
Query.Next;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
Query.Close;
|
|||
|
|
Query.Free;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure AddStrings(Base, Addition: IROStrings);
|
|||
|
|
var
|
|||
|
|
I: Integer;
|
|||
|
|
begin
|
|||
|
|
for I := 0 to Addition.Count - 1 do
|
|||
|
|
Base.Add(Addition[I]);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{ INTERNAL CLASSES *********************************************************** }
|
|||
|
|
{
|
|||
|
|
*************************** TDADOAInternalConnection ***************************
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
constructor TDADOAInternalConnection.Create(AOwner: TComponent);
|
|||
|
|
begin
|
|||
|
|
inherited;
|
|||
|
|
fOracleSession := TOracleSession.Create(nil);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
destructor TDADOAInternalConnection.Destroy;
|
|||
|
|
begin
|
|||
|
|
fOracleSession.Free;
|
|||
|
|
inherited;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TDADOAInternalConnection.DoConnect;
|
|||
|
|
begin
|
|||
|
|
fOracleSession.LogOn;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TDADOAInternalConnection.DoDisconnect;
|
|||
|
|
begin
|
|||
|
|
fOracleSession.LogOff;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TDADOAInternalConnection.GetConnected: Boolean;
|
|||
|
|
begin
|
|||
|
|
Result := fOracleSession.Connected;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{ PUBLIC CLASSES ************************************************************* }
|
|||
|
|
{
|
|||
|
|
******************************** TDAEDOADriver *********************************
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
// -----------------------------------------------------------------------------
|
|||
|
|
// TDAEDOADriver.DoSetTraceOptions
|
|||
|
|
//
|
|||
|
|
// Tracing can only be enabled when DOA Version 4.0 or higher is used.
|
|||
|
|
// UKO 26.09.2003 21:14:47
|
|||
|
|
//
|
|||
|
|
|
|||
|
|
procedure TDAEDOADriver.DoSetTraceOptions(TraceActive: Boolean; TraceOptions:
|
|||
|
|
TDATraceOptions; Callback: TDALogTraceEvent);
|
|||
|
|
begin
|
|||
|
|
inherited;
|
|||
|
|
|
|||
|
|
if TraceActive then
|
|||
|
|
begin
|
|||
|
|
fTraceCallBack := Callback;
|
|||
|
|
|
|||
|
|
{$IFDEF DOA4}
|
|||
|
|
EnableMonitor;
|
|||
|
|
{$ENDIF}
|
|||
|
|
end
|
|||
|
|
else
|
|||
|
|
begin
|
|||
|
|
fTraceCallBack := nil;
|
|||
|
|
|
|||
|
|
{$IFDEF DOA4}
|
|||
|
|
DisableMonitor;
|
|||
|
|
{$ENDIF}
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TDAEDOADriver.GetAuxParams(const AuxDriver: string;
|
|||
|
|
out List: IROStrings);
|
|||
|
|
begin
|
|||
|
|
inherited;
|
|||
|
|
List.Add('SysObjects=0,1');
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// -----------------------------------------------------------------------------
|
|||
|
|
// TDAEDOADriver.GetAvailableDriverOptions
|
|||
|
|
//
|
|||
|
|
// Only Database, Login and Custom needed. doServerName is not needed !
|
|||
|
|
//
|
|||
|
|
// UKO 25.09.2003 17:51:31
|
|||
|
|
//
|
|||
|
|
|
|||
|
|
function TDAEDOADriver.GetAvailableDriverOptions: TDAAvailableDriverOptions;
|
|||
|
|
begin
|
|||
|
|
Result := [doDatabaseName, doLogin, doCustom];
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TDAEDOADriver.GetConnectionClass: TDAEConnectionClass;
|
|||
|
|
begin
|
|||
|
|
Result := TDAEDOAConnection;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TDAEDOADriver.GetDefaultCustomParameters: string;
|
|||
|
|
begin
|
|||
|
|
Result := 'SysObjects=0';
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TDAEDOADriver.GetDescription: string;
|
|||
|
|
begin
|
|||
|
|
Result := 'Direct Oracle Access Driver';
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TDAEDOADriver.GetDriverID: string;
|
|||
|
|
begin
|
|||
|
|
Result := 'DOA';
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// -----------------------------------------------------------------------------
|
|||
|
|
// TDAEDOADriver.GetMajVersion
|
|||
|
|
//
|
|||
|
|
// UKO 25.09.2003 17:45:47
|
|||
|
|
//
|
|||
|
|
|
|||
|
|
function TDAEDOADriver.GetMajVersion: byte;
|
|||
|
|
begin
|
|||
|
|
Result := 1;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// -----------------------------------------------------------------------------
|
|||
|
|
// TDAEDOADriver.GetMinVersion
|
|||
|
|
//
|
|||
|
|
// UKO 25.09.2003 17:45:49
|
|||
|
|
//
|
|||
|
|
|
|||
|
|
function TDAEDOADriver.GetMinVersion: byte;
|
|||
|
|
begin
|
|||
|
|
Result := 1;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{
|
|||
|
|
****************************** TDAEDOAConnection *******************************
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
function TDAEDOAConnection.CreateCustomConnection: TCustomConnection;
|
|||
|
|
begin
|
|||
|
|
Result := TDADOAInternalConnection.Create(nil);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// -----------------------------------------------------------------------------
|
|||
|
|
// TDAEDOAConnection.CreateMacroProcessor
|
|||
|
|
//
|
|||
|
|
// UKO 25.09.2003 18:43:06
|
|||
|
|
//
|
|||
|
|
|
|||
|
|
function TDAEDOAConnection.CreateMacroProcessor: TDASQLMacroProcessor;
|
|||
|
|
begin
|
|||
|
|
result := TOracleMacroProcessor.Create;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// -----------------------------------------------------------------------------
|
|||
|
|
// TDAEDOAConnection.DoApplyConnectionString
|
|||
|
|
//
|
|||
|
|
// Use Database instead of Server. Server has no meaning in Oracle
|
|||
|
|
// UKO 25.09.2003 17:54:25
|
|||
|
|
//
|
|||
|
|
|
|||
|
|
procedure TDAEDOAConnection.DoApplyConnectionString(aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection);
|
|||
|
|
begin
|
|||
|
|
inherited;
|
|||
|
|
|
|||
|
|
with aConnStrParser do begin
|
|||
|
|
fUserName := UpperCase(UserID);
|
|||
|
|
OracleSession.LogonDatabase := Database;
|
|||
|
|
OracleSession.LogonUsername := fUserName;
|
|||
|
|
OracleSession.LogonPassword := Password;
|
|||
|
|
|
|||
|
|
fSchema := fUserName;
|
|||
|
|
fSysObjects := AuxParams['SysObjects'] = '1';
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TDAEDOAConnection.DoBeginTransaction: Integer;
|
|||
|
|
begin
|
|||
|
|
// DOA doesn't have any special transaction starting routines
|
|||
|
|
Result := 0;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TDAEDOAConnection.DoCommitTransaction;
|
|||
|
|
begin
|
|||
|
|
OracleSession.Commit;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TDAEDOAConnection.DoGetForeignKeys(
|
|||
|
|
out ForeignKeys: TDADriverForeignKeyCollection);
|
|||
|
|
type
|
|||
|
|
TFKRec =
|
|||
|
|
record
|
|||
|
|
TableName: string;
|
|||
|
|
ConstraintName: string;
|
|||
|
|
ReferenzContraintName: string;
|
|||
|
|
ReferenzOwner: string;
|
|||
|
|
end;
|
|||
|
|
var
|
|||
|
|
lReferenzTable: string;
|
|||
|
|
lQuery: TOracleQuery;
|
|||
|
|
lColumns: string;
|
|||
|
|
lFKArray: array of TFKRec;
|
|||
|
|
lIndex: integer;
|
|||
|
|
lfv: integer;
|
|||
|
|
const
|
|||
|
|
SQL =
|
|||
|
|
'SELECT constraint_name, table_name, r_owner, r_constraint_name FROM all_constraints' + #13#10 +
|
|||
|
|
'WHERE owner = ''%s''' + #13#10 +
|
|||
|
|
'AND constraint_type = ''R''';
|
|||
|
|
begin
|
|||
|
|
inherited; // creates an empty collection
|
|||
|
|
|
|||
|
|
OracleSession.LogOn;
|
|||
|
|
lQuery := TOracleQuery.Create(nil);
|
|||
|
|
try
|
|||
|
|
lQuery.Session := OracleSession;
|
|||
|
|
lQuery.SQL.Text := Format(SQL, [Uppercase(OracleSession.LogonUsername)]);
|
|||
|
|
lQuery.Execute;
|
|||
|
|
lIndex := 0;
|
|||
|
|
|
|||
|
|
while not (lQuery.Eof) do
|
|||
|
|
begin
|
|||
|
|
SetLength(lFKArray, lIndex+1);
|
|||
|
|
lFKArray[lIndex].ConstraintName := lQuery.FieldAsString('CONSTRAINT_NAME');
|
|||
|
|
lFKArray[lIndex].TableName := lQuery.FieldAsString('TABLE_NAME');
|
|||
|
|
lFKArray[lIndex].ReferenzOwner := lQuery.FieldAsString('R_OWNER');
|
|||
|
|
lFKArray[lIndex].ReferenzContraintName := lQuery.FieldAsString('R_CONSTRAINT_NAME');
|
|||
|
|
inc(lIndex);
|
|||
|
|
lQuery.Next;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
lQuery.Free;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
if lIndex > 0 then
|
|||
|
|
begin
|
|||
|
|
for lfv := 0 to Length(lFKArray)-1 do
|
|||
|
|
begin
|
|||
|
|
with ForeignKeys.Add() do
|
|||
|
|
begin
|
|||
|
|
GetConstraintColumnsAsString(Uppercase(OracleSession.LogonUsername), lFKArray[lfv].ConstraintName, lColumns);
|
|||
|
|
FKTable := lFKArray[lfv].TableName;
|
|||
|
|
FKField := lColumns;
|
|||
|
|
|
|||
|
|
lReferenzTable := GetConstraintColumnsAsString(lFKArray[lfv].ReferenzOwner, lFKArray[lfv].ReferenzContraintName, lColumns);
|
|||
|
|
PKTable := lReferenzTable;
|
|||
|
|
PKField := lColumns;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TDAEDOAConnection.DoGetStoredProcedureNames(out List: IROStrings);
|
|||
|
|
begin
|
|||
|
|
List := EncodeSchema(fUserName, fSchema, GetStoredProcsInPackages(fSchema));
|
|||
|
|
if fSysObjects then
|
|||
|
|
begin
|
|||
|
|
AddStrings(List, EncodeSchema(fUserName, 'SYS', GetStoredProcsInPackages('SYS')));
|
|||
|
|
AddStrings(List, EncodeSchema(fUserName, 'SYSTEM', GetStoredProcsInPackages('SYSTEM')));
|
|||
|
|
end;
|
|||
|
|
AddStrings(List, GetEncodedObjects(' (object_type = ''FUNCTION'' or object_type = ''PROCEDURE'')'));
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TDAEDOAConnection.DoGetStoredProcedureParams(const
|
|||
|
|
aStoredProcedureName: string; out Params: TDAParamCollection);
|
|||
|
|
begin
|
|||
|
|
OracleSession.LogOn;
|
|||
|
|
GetStoredProcParams(OracleSession, aStoredProcedureName, Params);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TDAEDOAConnection.DoGetTableFields(const aTableName: string; out
|
|||
|
|
Fields: TDAFieldCollection);
|
|||
|
|
var
|
|||
|
|
Query: TOracleQuery;
|
|||
|
|
OraPath: TOraPath;
|
|||
|
|
PrimaryKey: IROStrings;
|
|||
|
|
const
|
|||
|
|
SQL = 'SELECT atc.column_name, atc.data_type, atc.data_length, atc.data_scale, atc.nullable, acc.comments' + #13#10 +
|
|||
|
|
'FROM all_tab_columns atc, all_col_comments acc' + #13#10 +
|
|||
|
|
'WHERE atc.owner = ''%s''' + #13#10 +
|
|||
|
|
'AND atc.table_name = ''%s''' + #13#10 +
|
|||
|
|
'AND acc.owner= atc.OWNER' + #13#10 +
|
|||
|
|
'AND acc.table_name=atc.TABLE_NAME' + #13#10 +
|
|||
|
|
'AND acc.column_name=atc.COLUMN_NAME';
|
|||
|
|
|
|||
|
|
begin
|
|||
|
|
OracleSession.LogOn;
|
|||
|
|
Fields := TDAFieldCollection.Create(nil);
|
|||
|
|
Query := TOracleQuery.Create(nil);
|
|||
|
|
try
|
|||
|
|
OraPath := ExtractOraPath(aTableName, OracleSession.LogonUsername);
|
|||
|
|
PrimaryKey := GetPrimaryKeys(OraPath.aScheme, OraPath.aObject);
|
|||
|
|
Query.Session := OracleSession;
|
|||
|
|
Query.SQL.Text := Format(SQL, [OraPath.aScheme, OraPath.aObject]);
|
|||
|
|
Query.Execute;
|
|||
|
|
// if Query.Eof then ????? UKO 10.09.2003
|
|||
|
|
while not Query.Eof do
|
|||
|
|
begin
|
|||
|
|
with Fields.Add() do
|
|||
|
|
begin
|
|||
|
|
Name := Query.Field(0);
|
|||
|
|
InPrimaryKey := (PrimaryKey.IndexOf(Name) > -1);
|
|||
|
|
DataType := VCLTypeToDAType(DataTypeOraToVcl(Query.Field(1),
|
|||
|
|
Query.Field(3)));
|
|||
|
|
Size := Query.Field(2);
|
|||
|
|
|
|||
|
|
// UKO 17.09.2004 get additional information
|
|||
|
|
Required := (Query.FieldAsString(4) = 'N');
|
|||
|
|
Description := Query.FieldAsString(5);
|
|||
|
|
// TODO: Defaultvalue
|
|||
|
|
end;
|
|||
|
|
Query.Next;
|
|||
|
|
end;
|
|||
|
|
Query.Close;
|
|||
|
|
finally
|
|||
|
|
Query.Free;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TDAEDOAConnection.DoGetTableNames(out List: IROStrings);
|
|||
|
|
begin
|
|||
|
|
List := GetEncodedObjects(' (object_type = ''TABLE'')');
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TDAEDOAConnection.DoGetViewFields(const aViewName: string; out
|
|||
|
|
Fields: TDAFieldCollection);
|
|||
|
|
begin
|
|||
|
|
DoGetTableFields(aViewName, Fields);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TDAEDOAConnection.DoGetViewNames(out List: IROStrings);
|
|||
|
|
begin
|
|||
|
|
List := GetEncodedObjects(' (object_type = ''VIEW'')');
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TDAEDOAConnection.DoRollbackTransaction;
|
|||
|
|
begin
|
|||
|
|
TOracleSession(inherited ConnectionObject).Rollback;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TDAEDOAConnection.EncodeSchema(const Username, Schema: string;
|
|||
|
|
Contents: IROStrings): IROStrings;
|
|||
|
|
var
|
|||
|
|
I: Integer;
|
|||
|
|
begin
|
|||
|
|
Result := Contents;
|
|||
|
|
if Username <> Schema then // scheme only when different then user UKO 25.09.2003
|
|||
|
|
for I := 0 to Result.Count - 1 do
|
|||
|
|
Result[I] := Schema + '.' + Result[I];
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TDAEDOAConnection.GetConstraintColumnsAsString(const AOwner,
|
|||
|
|
AConstraintName: string; out AColumns: string): string;
|
|||
|
|
var
|
|||
|
|
Query: TOracleQuery;
|
|||
|
|
const
|
|||
|
|
SQL =
|
|||
|
|
'SELECT Table_name, Column_Name FROM All_Cons_Columns' + #13#10 +
|
|||
|
|
'WHERE owner = ''%s''' + #13#10 +
|
|||
|
|
'AND constraint_name = ''%s''' + #13#10 +
|
|||
|
|
'ORDER BY position';
|
|||
|
|
begin
|
|||
|
|
Result := '';
|
|||
|
|
AColumns := '';
|
|||
|
|
OracleSession.LogOn;
|
|||
|
|
Query := TOracleQuery.Create(nil);
|
|||
|
|
try
|
|||
|
|
Query.Session := OracleSession;
|
|||
|
|
Query.SQL.Text := Format(SQL, [AOwner, AConstraintName]);
|
|||
|
|
Query.Execute;
|
|||
|
|
|
|||
|
|
while not (Query.Eof) do
|
|||
|
|
begin
|
|||
|
|
Result := Query.FieldAsString('TABLE_NAME');
|
|||
|
|
AColumns := AColumns + Query.FieldAsString('COLUMN_NAME');
|
|||
|
|
Query.Next;
|
|||
|
|
if not Query.Eof then
|
|||
|
|
AColumns := AColumns + ',';
|
|||
|
|
end;
|
|||
|
|
Query.Close;
|
|||
|
|
finally
|
|||
|
|
Query.Free;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TDAEDOAConnection.GetDataSetClass: TDAEDatasetClass;
|
|||
|
|
begin
|
|||
|
|
Result := TDAEDOAQuery;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TDAEDOAConnection.GetEncodedObjects(
|
|||
|
|
WhereClause: string): IROStrings;
|
|||
|
|
begin
|
|||
|
|
Result := TROStrings.Create;
|
|||
|
|
AddStrings(Result, EncodeSchema(fUserName, fSchema, GetObjects(fSchema, WhereClause)));
|
|||
|
|
if fSysObjects then
|
|||
|
|
begin
|
|||
|
|
AddStrings(Result, EncodeSchema(fUserName, 'SYS', GetObjects('SYS', WhereClause)));
|
|||
|
|
AddStrings(Result, EncodeSchema(fUserName, 'SYSTEM', GetObjects('SYSTEM', WhereClause)));
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TDAEDOAConnection.GetObjects(Schema, WhereClause: string): IROStrings;
|
|||
|
|
var
|
|||
|
|
Query: TOracleQuery;
|
|||
|
|
const
|
|||
|
|
SQL = 'select object_name as object' + NL +
|
|||
|
|
'from all_objects where owner = ''%s'' and %s';
|
|||
|
|
|
|||
|
|
begin
|
|||
|
|
Result := TROStrings.Create;
|
|||
|
|
OracleSession.LogOn;
|
|||
|
|
Query := TOracleQuery.Create(nil);
|
|||
|
|
try
|
|||
|
|
Query.Session := OracleSession;
|
|||
|
|
Query.SQL.Text := Format(SQL, [Schema, WhereClause]);
|
|||
|
|
Query.Execute;
|
|||
|
|
|
|||
|
|
while not (Query.Eof) do
|
|||
|
|
begin
|
|||
|
|
Result.Add(Query.Field(0));
|
|||
|
|
Query.Next;
|
|||
|
|
end;
|
|||
|
|
Query.Close;
|
|||
|
|
finally
|
|||
|
|
Query.Free;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TDAEDOAConnection.GetOracleSession: TOracleSession;
|
|||
|
|
begin
|
|||
|
|
Result := TDADOAInternalConnection(inherited ConnectionObject).Session;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TDAEDOAConnection.GetPrimaryKeys(const Schema,
|
|||
|
|
TableName: string): IROStrings;
|
|||
|
|
var
|
|||
|
|
Query: TOracleQuery;
|
|||
|
|
const
|
|||
|
|
// this statement doesn<73>t work properly if the table is in more then one
|
|||
|
|
// database users available (e.g. two different versions of the database user)
|
|||
|
|
// In this case duplicated results are generated and performance decreases cause
|
|||
|
|
// of a full table scan on obj$
|
|||
|
|
// Solution: link also owner and tablename !
|
|||
|
|
// UKO 23.09.2003
|
|||
|
|
|
|||
|
|
//
|
|||
|
|
// SQL = 'select' + NL +
|
|||
|
|
// ' a.column_name' + NL +
|
|||
|
|
// 'from' + NL +
|
|||
|
|
// ' all_cons_columns a, all_constraints b' + NL +
|
|||
|
|
// 'where a.constraint_name = b.constraint_name' + NL +
|
|||
|
|
// ' and b.constraint_type = ''P''' + NL +
|
|||
|
|
// ' and b.owner = ''%s''' + NL +
|
|||
|
|
// ' and b.table_name = ''%s''';
|
|||
|
|
|
|||
|
|
SQL = 'select' + NL +
|
|||
|
|
' a.column_name' + NL +
|
|||
|
|
'from' + NL +
|
|||
|
|
' all_cons_columns a, all_constraints b' + NL +
|
|||
|
|
'where a.owner = b.owner' + NL +
|
|||
|
|
' and a.table_name = b.table_name' + NL +
|
|||
|
|
' and a.constraint_name = b.constraint_name' + NL +
|
|||
|
|
' and b.constraint_type = ''P''' + NL +
|
|||
|
|
' and b.owner = ''%s''' + NL +
|
|||
|
|
' and b.table_name = ''%s''';
|
|||
|
|
begin
|
|||
|
|
Result := TROStrings.Create;
|
|||
|
|
Query := TOracleQuery.Create(nil);
|
|||
|
|
try
|
|||
|
|
Query.Session := OracleSession;
|
|||
|
|
Query.SQL.Text := Format(SQL, [UpperCase(Schema), UpperCase(TableName)]);
|
|||
|
|
Query.Execute;
|
|||
|
|
while not (Query.Eof) do
|
|||
|
|
begin
|
|||
|
|
Result.Add(Query.Field(0));
|
|||
|
|
Query.Next;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
Query.Free;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TDAEDOAConnection.GetStoredProcedureClass: TDAEStoredProcedureClass;
|
|||
|
|
begin
|
|||
|
|
Result := TDAEDOAStoredProcedure;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// -----------------------------------------------------------------------------
|
|||
|
|
// TDAEDOAConnection.GetStoredProcsInPackages
|
|||
|
|
//
|
|||
|
|
// UKO 25.09.2003 11:48:08
|
|||
|
|
//
|
|||
|
|
|
|||
|
|
function TDAEDOAConnection.GetStoredProcsInPackages(Schema: string): IROStrings;
|
|||
|
|
var
|
|||
|
|
Query: TOracleQuery;
|
|||
|
|
const
|
|||
|
|
SQL = 'select distinct package_name || ''.'' || object_name as proc ' + NL +
|
|||
|
|
'from all_arguments' + NL +
|
|||
|
|
'where package_name is not null and owner = ''%s''';
|
|||
|
|
|
|||
|
|
begin
|
|||
|
|
Result := TROStrings.Create;
|
|||
|
|
OracleSession.LogOn;
|
|||
|
|
Query := TOracleQuery.Create(nil);
|
|||
|
|
try
|
|||
|
|
Query.Session := OracleSession;
|
|||
|
|
Query.SQL.Text := Format(SQL, [Schema]);
|
|||
|
|
Query.Execute;
|
|||
|
|
while not (Query.Eof) do
|
|||
|
|
begin
|
|||
|
|
Result.Add(Query.Field(0));
|
|||
|
|
Query.Next;
|
|||
|
|
end;
|
|||
|
|
finally
|
|||
|
|
Query.Close;
|
|||
|
|
Query.Free;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// -----------------------------------------------------------------------------
|
|||
|
|
// TDAEDOAConnection.IdentifierNeedsQuoting
|
|||
|
|
//
|
|||
|
|
// Default behavior not enough, as '$' and '.' are also a valid character which doesn<73>t need quoting
|
|||
|
|
//
|
|||
|
|
// UKO 25.09.2003 11:48:13
|
|||
|
|
//
|
|||
|
|
|
|||
|
|
function TDAEDOAConnection.IdentifierNeedsQuoting(const iIdentifier: string): boolean;
|
|||
|
|
var
|
|||
|
|
i: integer;
|
|||
|
|
begin
|
|||
|
|
result := false;
|
|||
|
|
if IdentifierIsQuoted(iIdentifier) then
|
|||
|
|
exit;
|
|||
|
|
for i := 1 to Length(iIdentifier) do
|
|||
|
|
begin
|
|||
|
|
if not (iIdentifier[i] in ['a'..'z', 'A'..'Z', '0'..'9', '_', '$', '.']) then
|
|||
|
|
begin
|
|||
|
|
result := true;
|
|||
|
|
exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{
|
|||
|
|
********************************* TDAEDOAQuery *********************************
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
function TDAEDOAQuery.CreateDataset(aConnection: TDAEConnection): TDataset;
|
|||
|
|
begin
|
|||
|
|
Result := TOracleDataSet.Create(nil);
|
|||
|
|
TOracleDataSet(Result).ReadOnly := True;
|
|||
|
|
TOracleDataSet(Result).Session := TDAEDOAConnection(
|
|||
|
|
aConnection).OracleSession;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TDAEDOAQuery.DoExecute: Integer;
|
|||
|
|
begin
|
|||
|
|
TOracleDataSet(DataSet).ExecSQL;
|
|||
|
|
Result := -1;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TDAEDOAQuery.DoGetSQL: string;
|
|||
|
|
begin
|
|||
|
|
Result := TOracleDataSet(Dataset).SQL.Text;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TDAEDOAQuery.DoPrepare(Value: Boolean);
|
|||
|
|
begin
|
|||
|
|
TOracleDataSet(DataSet).Optimize := Value;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TDAEDOAQuery.DoSetSQL(const Value: string);
|
|||
|
|
begin
|
|||
|
|
TOracleDataSet(Dataset).SQL.Text := Value;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TDAEDOAQuery.GetLockMode: TOracleLockMode;
|
|||
|
|
begin
|
|||
|
|
Result := LockModeDoaToDa(TOracleDataSet(Dataset).LockingMode)
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TDAEDOAQuery.GetOptions: TOracleOptions;
|
|||
|
|
begin
|
|||
|
|
// Can't be implemented
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TDAEDOAQuery.GetParamValues(Params: TDAParamCollection);
|
|||
|
|
begin
|
|||
|
|
//
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TDAEDOAQuery.LockModeDaToDoa(LockMode: TOracleLockMode):
|
|||
|
|
TLockingModeOptions;
|
|||
|
|
begin
|
|||
|
|
Result := lmNone;
|
|||
|
|
case LockMode of
|
|||
|
|
olmLockImmediate: Result := lmLockImmediate;
|
|||
|
|
olmLockDelayed: Result := lmLockDelayed;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TDAEDOAQuery.LockModeDoaToDa(LockMode: TLockingModeOptions):
|
|||
|
|
TOracleLockMode;
|
|||
|
|
begin
|
|||
|
|
Result := olmNone;
|
|||
|
|
case LockMode of
|
|||
|
|
lmLockImmediate: Result := olmLockImmediate;
|
|||
|
|
lmLockDelayed: Result := olmLockDelayed;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TDAEDOAQuery.SetLockMode(Value: TOracleLockMode);
|
|||
|
|
begin
|
|||
|
|
TOracleDataSet(Dataset).LockingMode := LockModeDaToDoa(Value);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TDAEDOAQuery.SetOptions(Value: TOracleOptions);
|
|||
|
|
begin
|
|||
|
|
// Can't be implemented
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TDAEDOAQuery.SetParamValues(Params: TDAParamCollection);
|
|||
|
|
begin
|
|||
|
|
SetDataSetParams(Params, DataSet);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{
|
|||
|
|
**************************** TDAEDOAStoredProcedure ****************************
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
function TDAEDOAStoredProcedure.CreateDataset(aConnection: TDAEConnection):
|
|||
|
|
TDataset;
|
|||
|
|
begin
|
|||
|
|
Result := TOracleDataSet.Create(nil);
|
|||
|
|
TOracleDataSet(Result).Session := TDAEDOAConnection(
|
|||
|
|
aConnection).OracleSession;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TDAEDOAStoredProcedure.DoGetParams;
|
|||
|
|
var
|
|||
|
|
Ds: TOracleDataSet;
|
|||
|
|
I: Integer;
|
|||
|
|
Params: TDAParamCollection;
|
|||
|
|
begin
|
|||
|
|
Params := GetParams;
|
|||
|
|
Ds := TOracleDataSet(DataSet);
|
|||
|
|
for I := 0 to Params.Count - 1 do
|
|||
|
|
if Params[I].ParamType in [daptOutput, daptInputOutput, daptResult] then
|
|||
|
|
Params[I].Value := Ds.GetVariable(HandleSqlName(Params[I].Name,
|
|||
|
|
Params[I].ParamType));
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TDAEDOAStoredProcedure.DoGetParamsResult: TDAParam;
|
|||
|
|
var
|
|||
|
|
I: Integer;
|
|||
|
|
Params: TDAParamCollection;
|
|||
|
|
begin
|
|||
|
|
Result := nil;
|
|||
|
|
Params := GetParams;
|
|||
|
|
for I := 0 to Params.Count - 1 do
|
|||
|
|
if Params[I].ParamType = daptResult then
|
|||
|
|
begin
|
|||
|
|
Result := Params[I];
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TDAEDOAStoredProcedure.DoSetSource;
|
|||
|
|
var
|
|||
|
|
Ds: TOracleDataSet;
|
|||
|
|
I: Integer;
|
|||
|
|
Params: TDaParamCollection;
|
|||
|
|
ParamResult: TDAParam;
|
|||
|
|
ParamsExist: Boolean;
|
|||
|
|
|
|||
|
|
const
|
|||
|
|
SQLHeader = 'declare' + NL +
|
|||
|
|
' result boolean;' + NL +
|
|||
|
|
'begin' + NL;
|
|||
|
|
SQLHandleBoolean = ':result := sys.diutil.bool_to_int(function_result);';
|
|||
|
|
SQLFooter = 'end;';
|
|||
|
|
|
|||
|
|
function CaseOfParam(const AParamResult: TDAParam): Integer;
|
|||
|
|
begin
|
|||
|
|
Result := 0;
|
|||
|
|
if AParamResult <> nil then
|
|||
|
|
if AParamResult.DataType = datBoolean then
|
|||
|
|
Result := 1
|
|||
|
|
else
|
|||
|
|
Result := 2;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function ConvertParam(const AName: string; const ADataType: TDADataType):
|
|||
|
|
string;
|
|||
|
|
begin
|
|||
|
|
if ADataType = datBoolean then
|
|||
|
|
begin
|
|||
|
|
Result := Format('%s => sys.diutil.int_to_bool(:%s), ', [AName, AName]);
|
|||
|
|
Exit;
|
|||
|
|
end;
|
|||
|
|
Result := Format('%s => :%s, ', [AName, AName]);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TrimSqlParams(const SQL: string): string;
|
|||
|
|
var
|
|||
|
|
S: string;
|
|||
|
|
begin
|
|||
|
|
S := SQL;
|
|||
|
|
Delete(S, Length(S) - 3, 4);
|
|||
|
|
Result := S;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
begin
|
|||
|
|
Ds := TOracleDataSet(DataSet);
|
|||
|
|
Params := GetParams;
|
|||
|
|
ParamResult := DoGetParamsResult;
|
|||
|
|
// PL/SQL Block - header + stored proc name
|
|||
|
|
Ds.SQL.Text := SQLHeader;
|
|||
|
|
case CaseOfParam(ParamResult) of // 0 = no result, 1 = boolean, 2 = misc
|
|||
|
|
0: Ds.SQL.Add(Format(' %s(', [fProcedureName]));
|
|||
|
|
1: Ds.SQL.Add(Format(' result := %s(', [fProcedureName]));
|
|||
|
|
2: Ds.SQL.Add(Format(' :result := %s(', [fProcedureName]));
|
|||
|
|
end;
|
|||
|
|
// PL/SQL Block - params if any;
|
|||
|
|
ParamsExist := False;
|
|||
|
|
for I := 0 to Params.Count - 1 do
|
|||
|
|
if (Params.Items[I] <> ParamResult) then
|
|||
|
|
begin
|
|||
|
|
ParamsExist := True;
|
|||
|
|
Ds.SQL.Add(ConvertParam(Params[I].Name, Params[I].DataType));
|
|||
|
|
end;
|
|||
|
|
// PL/SQL Block - params - remove the last half-stop
|
|||
|
|
if ParamsExist then
|
|||
|
|
Ds.SQL.Text := TrimSQLParams(Ds.SQL.Text);
|
|||
|
|
Ds.SQL.Add(');');
|
|||
|
|
// PL/SQL Block - special treatment for functions with boolean results
|
|||
|
|
if ParamResult.DataType = datBoolean then
|
|||
|
|
Ds.SQL.Add(SQLHandleBoolean);
|
|||
|
|
Ds.SQL.Add(SQLFooter);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TDAEDOAStoredProcedure.Execute: Integer;
|
|||
|
|
var
|
|||
|
|
Params: TDAParamCollection;
|
|||
|
|
begin
|
|||
|
|
Params := GetParams;
|
|||
|
|
SetDataSetParams(Params, DataSet);
|
|||
|
|
DoSetSource;
|
|||
|
|
TOracleDataSet(DataSet).ExecSQL;
|
|||
|
|
DoGetParams;
|
|||
|
|
Result := -1;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
function TDAEDOAStoredProcedure.GetStoredProcedureName: string;
|
|||
|
|
begin
|
|||
|
|
Result := fProcedureName;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TDAEDOAStoredProcedure.RefreshParams;
|
|||
|
|
var
|
|||
|
|
OraParams, DaParams: TDAParamCollection;
|
|||
|
|
begin
|
|||
|
|
GetStoredProcParams(TOracleDataSet(DataSet).Session, fProcedureName,
|
|||
|
|
OraParams);
|
|||
|
|
DaParams := GetParams;
|
|||
|
|
DaParams.AssignParamCollection(OraParams);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TDAEDOAStoredProcedure.SetParamValues(Params: TDAParamCollection);
|
|||
|
|
begin
|
|||
|
|
SetDataSetParams(Params, DataSet);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure TDAEDOAStoredProcedure.SetStoredProcedureName(const Name: string);
|
|||
|
|
begin
|
|||
|
|
fProcedureName := Name;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
exports
|
|||
|
|
GetDriverObject name func_GetDriverObject;
|
|||
|
|
|
|||
|
|
initialization
|
|||
|
|
_Driver := nil;
|
|||
|
|
RegisterDriverProc(GetDriverObject);
|
|||
|
|
|
|||
|
|
finalization
|
|||
|
|
UnregisterDriverProc(GetDriverObject);
|
|||
|
|
FreeAndNil(_Driver);
|
|||
|
|
|
|||
|
|
end.
|
|||
|
|
|