Componentes.Terceros.RemObj.../internal/5.0.35.741/1/Data Abstract for Delphi/Source/Drivers/uDADOADriver.pas

690 lines
18 KiB
ObjectPascal
Raw Permalink Blame History

unit uDADOADriver;
// if using DOA 4.0 or higher activate this define
{$DEFINE DOA4}
{$IFDEF MSWINDOWS}
{$I ..\DataAbstract.inc}
{$ELSE}
{$I ../DataAbstract.inc}
{$ENDIF}
interface
uses
DB,
Classes,
uROClasses,
uDAEngine,
uDAInterfaces,
uDAOracleInterfaces,
uDAUtils,
Oracle,
OracleData;
type
TDADOADriver = class(TDADriverReference)
end;
TDAEDOADriver = class(TDAOracleDriver)
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;
procedure GetAuxParams(const AuxDriver: string; out List: IROStrings); override;
end;
TDAEDOAConnection = class(TDAOracleConnection)
private
function GetOracleSession: TOracleSession;
protected
function CreateCompatibleQuery: IDADataset; override;
function CreateCustomConnection: TCustomConnection; override;
procedure DoApplyConnectionString(aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection); override;
function DoGetInTransaction: boolean; override;
function DoBeginTransaction: Integer; override;
procedure DoCommitTransaction; override;
procedure DoRollbackTransaction; override;
function GetDataSetClass: TDAEDatasetClass; override;
function GetStoredProcedureClass: TDAEStoredProcedureClass; override;
property OracleSession: TOracleSession read GetOracleSession;
end;
TDAEDOAQuery = class(TDAEDataSet, IOracleDataSet)
private
function LockModeDaToDoa(LockMode: TDAOracleLockMode): TLockingModeOptions;
function LockModeDoaToDa(LockMode: TLockingModeOptions): TDAOracleLockMode;
protected
procedure ClearParams; override;
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: TDAOracleLockMode;
function GetOptions: TDAOracleOptions;
procedure SetLockMode(Value: TDAOracleLockMode);
procedure SetOptions(Value: TDAOracleOptions);
procedure SetParamValues(Params: TDAParamCollection); override; safecall;
procedure GetParamValues(Params: TDAParamCollection); override; safecall;
end;
TDAEDOAStoredProcedure = class(TDAEStoredProcedure)
private
fProcedureName: string;
FConnection: TDAEDOAConnection;
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); override; safecall;
procedure GetParamValues(Params: TDAParamCollection); override; safecall;
procedure SetStoredProcedureName(const Name: string); override;
end;
procedure Register;
function GetDriverObject: IDADriver; stdcall;
implementation
uses
SysUtils,
uDADriverManager,
uDARes;
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;
{$IFDEF DataAbstract_SchemaModelerOnly}
{$INCLUDE ..\DataAbstract_SchemaModelerOnly.inc}
{$ENDIF DataAbstract_SchemaModelerOnly}
function GetDriverObject: IDADriver;
begin
{$IFDEF DataAbstract_SchemaModelerOnly}
if not RunningInSchemaModeler then begin
result := nil;
exit;
end;
{$ENDIF}
if (_driver = nil) then _driver := TDAEDOADriver.Create(nil);
result := _driver;
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);
datGuid, datString: Result := otString;
datDateTime: Result := otDate;
datSingleFloat, datFloat, datCurrency: Result := otFloat;
datByte,
datShortInt,
datWord,
datCardinal,
datAutoInc,
datInteger,
datLargeInt: Result := otInteger;
datBoolean: Result := otInteger; // needs a special handling
datMemo: Result := otClob;
datBlob: Result := otBlob;
datXml, datWideString: Result := otVarchar2;
datWideMemo : Result := otNCLOB;
datLargeAutoInc, datLargeUInt,datDecimal : Result := otNumber;
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;
{ 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;
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:='';
end;
function TDAEDOADriver.GetDescription: string;
begin
Result := 'Direct Oracle Access Driver'{$IFDEF DataAbstract_SchemaModelerOnly} + SchemaModelerOnly{$ENDIF};;
end;
function TDAEDOADriver.GetDriverID: string;
begin
Result := 'DOA';
end;
{
****************************** TDAEDOAConnection *******************************
}
function TDAEDOAConnection.CreateCompatibleQuery: IDADataset;
begin
Result := inherited CreateCompatibleQuery;
OracleSession.LogOn;
end;
function TDAEDOAConnection.CreateCustomConnection: TCustomConnection;
begin
Result := TDADOAInternalConnection.Create(nil);
end;
// -----------------------------------------------------------------------------
// TDAEDOAConnection.CreateMacroProcessor
//
// UKO 25.09.2003 18:43:06
//
// -----------------------------------------------------------------------------
// 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
OracleSession.LogonDatabase := Database;
OracleSession.LogonUsername := UpperCase(UserID);
OracleSession.LogonPassword := Password;
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;
function TDAEDOAConnection.DoGetInTransaction: boolean;
begin
Result := OracleSession.InTransaction;
end;
procedure TDAEDOAConnection.DoRollbackTransaction;
begin
OracleSession.Rollback;
end;
function TDAEDOAConnection.GetDataSetClass: TDAEDatasetClass;
begin
Result := TDAEDOAQuery;
end;
function TDAEDOAConnection.GetOracleSession: TOracleSession;
begin
Result := TDADOAInternalConnection(inherited ConnectionObject).Session;
end;
function TDAEDOAConnection.GetStoredProcedureClass: TDAEStoredProcedureClass;
begin
Result := TDAEDOAStoredProcedure;
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
//
{
********************************* TDAEDOAQuery *********************************
}
procedure TDAEDOAQuery.ClearParams;
begin
inherited;
TOracleDataSet(Dataset).ClearVariables;
end;
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: TDAOracleLockMode;
begin
Result := LockModeDoaToDa(TOracleDataSet(Dataset).LockingMode)
end;
function TDAEDOAQuery.GetOptions: TDAOracleOptions;
begin
// Can't be implemented
end;
procedure TDAEDOAQuery.GetParamValues(Params: TDAParamCollection);
var
i: integer;
par: TDAParam;
ds: TOracleDataSet;
begin
ds := TOracleDataSet(Dataset);
if not Assigned(ds.Variables) then Exit;
for i := 0 to (ds.VariableCount - 1) do begin
par := Params.ParamByName(copy(ds.VariableName(i),2,MaxInt));
if par.ParamType in [daptOutput, daptInputOutput, daptResult] then
par.Value := ds.GetVariable(i);
end;
end;
function TDAEDOAQuery.LockModeDaToDoa(LockMode: TDAOracleLockMode):
TLockingModeOptions;
begin
Result := lmNone;
case LockMode of
olmLockImmediate: Result := lmLockImmediate;
olmLockDelayed: Result := lmLockDelayed;
end;
end;
function TDAEDOAQuery.LockModeDoaToDa(LockMode: TLockingModeOptions):
TDAOracleLockMode;
begin
Result := olmNone;
case LockMode of
lmLockImmediate: Result := olmLockImmediate;
lmLockDelayed: Result := olmLockDelayed;
end;
end;
procedure TDAEDOAQuery.SetLockMode(Value: TDAOracleLockMode);
begin
TOracleDataSet(Dataset).LockingMode := LockModeDaToDoa(Value);
end;
procedure TDAEDOAQuery.SetOptions(Value: TDAOracleOptions);
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);
FConnection := TDAEDOAConnection(aConnection);
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' + sLineBreak +
' result boolean;' + sLineBreak +
'begin' + sLineBreak;
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: TDAParamCollection;
begin
Oracle_DoGetStoredProcedureParams(fProcedureName, FConnection.CreateCompatibleQuery,OraParams);
GetParams.AssignParamCollection(OraParams);
end;
procedure TDAEDOAStoredProcedure.GetParamValues(Params: TDAParamCollection);
var
i: integer;
par: TDAParam;
ds: TOracleDataSet;
begin
ds := TOracleDataSet(Dataset);
if not Assigned(ds.Variables) then Exit;
for i := 0 to (ds.VariableCount - 1) do begin
par := Params.ParamByName(ds.VariableName(i));
if par.ParamType in [daptOutput, daptInputOutput, daptResult] then
par.Value := ds.GetVariable(i);
end;
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.