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.
|
||
|