563 lines
16 KiB
ObjectPascal
563 lines
16 KiB
ObjectPascal
unit uDAIBDACDriver;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ Data Abstract Library - Driver Library
|
|
{
|
|
{ compiler: Delphi 6 and up
|
|
{ platform: Win32
|
|
{
|
|
{ (c)opyright RemObjects Software. all rights reserved.
|
|
{
|
|
{ Using this code requires a valid license of the Data Abstract
|
|
{ which can be obtained at http://www.remobjects.com.
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$I ..\DataAbstract.inc}
|
|
|
|
{$R DataAbstract_IBDACDriver_Glyphs.res}
|
|
|
|
interface
|
|
|
|
uses
|
|
DB, Classes, uDAEngine, uDAInterfaces, uDAADOInterfaces, uROClasses,
|
|
DBAccess, IBC, DASQLMonitor,
|
|
IBCSQLMonitor, Variants, uDAUtils, uDAIBInterfaces;
|
|
|
|
type { TDAIBDACDriver }
|
|
TDAIBDACDriver = class(TDADriverReference)
|
|
end;
|
|
|
|
{ TDAEIBDACDriver }
|
|
TDAEIBDACDriver = class(TDAIBDriver)
|
|
private
|
|
fMonitor: TIBCSQLMonitor;
|
|
fTraceCallBack: TDALogTraceEvent;
|
|
procedure OnIBDACTrace(Sender: TObject; Text: string; Flag: TDATraceFlag);
|
|
protected
|
|
function GetConnectionClass: TDAEConnectionClass; override;
|
|
procedure DoSetTraceOptions(TraceActive: boolean; TraceOptions: TDATraceOptions; Callback: TDALogTraceEvent); override;
|
|
procedure CustomizeConnectionObject(aConnection: TDAEConnection); override;
|
|
// IDADriver
|
|
function GetDriverID: string; override;
|
|
function GetDescription: string; override;
|
|
end;
|
|
|
|
{ TDAEIBDACConnection }
|
|
TDAEIBDACConnection = class(TDAIBConnection, IDAInterbaseConnection, IDAIBTransactionAccess, IDAIBConnectionProperties, IDAUseGenerators, IDAFileBasedDatabase)
|
|
private
|
|
fConnection: TIBCConnection;
|
|
protected
|
|
// IIBTransactionAccess
|
|
function GetTransaction: TObject; safecall;
|
|
|
|
procedure Commit; safecall;
|
|
procedure CommitRetaining; safecall;
|
|
procedure Rollback; safecall;
|
|
procedure RollbackRetaining; safecall;
|
|
|
|
// IIBConnectionProperties
|
|
function GetRole: string; safecall;
|
|
procedure SetRole(const Value: string); safecall;
|
|
function GetSQLDialect: integer;override; safecall;
|
|
procedure SetSQLDialect(Value: integer); safecall;
|
|
function GetCharset: string; safecall;
|
|
procedure SetCharset(const Value: string); safecall;
|
|
|
|
|
|
// IDAConnection
|
|
function CreateCustomConnection: TCustomConnection; override;
|
|
|
|
function GetDatasetClass: TDAEDatasetClass; override;
|
|
function GetStoredProcedureClass: TDAEStoredProcedureClass; override;
|
|
|
|
procedure DoApplyConnectionString(aConnStrParser: TDAConnectionStringParser;
|
|
aConnectionObject: TCustomConnection); override;
|
|
|
|
function DoBeginTransaction: integer; override;
|
|
procedure DoCommitTransaction; override;
|
|
procedure DoRollbackTransaction; override;
|
|
function DoGetInTransaction: boolean; override;
|
|
end;
|
|
|
|
{ TDAEIBDACQuery }
|
|
TDAEIBDACQuery = class(TDAEDataset, IDAMustSetParams)
|
|
private
|
|
|
|
protected
|
|
function DoGetRecordCount: integer; override;
|
|
function CreateDataset(aConnection: TDAEConnection): TDataset; override;
|
|
procedure ClearParams; override;
|
|
function DoExecute: integer; override;
|
|
function DoGetSQL: string; override;
|
|
procedure DoSetSQL(const Value: string); override;
|
|
procedure DoPrepare(Value: boolean); override;
|
|
|
|
// IDAMustSetParams
|
|
procedure SetParamValues(AParams: TDAParamCollection); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure GetParamValues(AParams: TDAParamCollection); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
|
|
public
|
|
end;
|
|
|
|
{ TDAEIBDACStoredProcedure }
|
|
TDAEIBDACStoredProcedure = class(TDAEStoredProcedure, IDAMustSetParams)
|
|
protected
|
|
function CreateDataset(aConnection: TDAEConnection): TDataset; override;
|
|
|
|
function GetStoredProcedureName: string; override;
|
|
procedure SetStoredProcedureName(const Name: string); override;
|
|
function DoExecute: Integer; override;
|
|
function Execute: integer; override;
|
|
procedure RefreshParams; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
|
|
// IDAMustSetParams
|
|
procedure SetParamValues(AParams: TDAParamCollection); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure GetParamValues(AParams: TDAParamCollection); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
|
|
end;
|
|
|
|
procedure Register;
|
|
|
|
function GetDriverObject: IDADriver; stdcall;
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils,
|
|
uDADriverManager, uDARes,
|
|
uROBinaryHelpers;
|
|
|
|
var
|
|
_driver: TDAEDriver = nil;
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents(DAPalettePageName, [TDAIBDACDriver]);
|
|
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 := TDAEIBDACDriver.Create(nil);
|
|
result := _driver;
|
|
end;
|
|
|
|
{$I uDACRLabsUtils.inc}
|
|
|
|
{ TDAEIBDACConnection }
|
|
|
|
procedure TDAEIBDACConnection.DoApplyConnectionString(
|
|
aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection);
|
|
begin
|
|
inherited;
|
|
SetSQLDialect(3);
|
|
with aConnStrParser do begin
|
|
if (Self.UserID <> '') then
|
|
fConnection.Username := Self.UserID
|
|
else
|
|
fConnection.Username := UserID;
|
|
|
|
if (Self.Password <> '') then
|
|
fConnection.Password := Self.Password
|
|
else
|
|
fConnection.Password := Password;
|
|
|
|
if Server <> '' then
|
|
fConnection.Database := Server + ':' + Database
|
|
else
|
|
fConnection.Database := Database;
|
|
|
|
if AuxParams['Dialect'] <> '' then
|
|
SetSQLDialect(StrToInt(AuxParams['Dialect']))
|
|
else if AuxParams['SQLDialect'] <> '' then
|
|
SetSQLDialect(StrToInt(AuxParams['SQLDialect']));
|
|
|
|
if AuxParams['Role'] <> '' then SetRole(AuxParams['Role']);
|
|
|
|
if AuxParams['Charset'] <> '' then SetCharset(AuxParams['Charset']);
|
|
end;
|
|
end;
|
|
|
|
function TDAEIBDACConnection.DoBeginTransaction: integer;
|
|
begin
|
|
result := -1;
|
|
fConnection.StartTransaction;
|
|
end;
|
|
|
|
procedure TDAEIBDACConnection.DoCommitTransaction;
|
|
begin
|
|
fConnection.Commit;
|
|
end;
|
|
|
|
function TDAEIBDACConnection.CreateCustomConnection: TCustomConnection;
|
|
begin
|
|
fConnection := TIBCConnection.Create(nil);
|
|
fConnection.LoginPrompt := FALSE;
|
|
|
|
result := fConnection;
|
|
end;
|
|
|
|
function TDAEIBDACConnection.GetDatasetClass: TDAEDatasetClass;
|
|
begin
|
|
result := TDAEIBDACQuery;
|
|
end;
|
|
|
|
function TDAEIBDACConnection.GetStoredProcedureClass: TDAEStoredProcedureClass;
|
|
begin
|
|
result := TDAEIBDACStoredProcedure;
|
|
end;
|
|
|
|
(*function SqlServerToDAType(aType:integer):TDADataType;
|
|
begin
|
|
case aType of
|
|
34:result := datBlob;
|
|
35:result := datMemo;
|
|
36:result := datString; //uniqueidentifier
|
|
48:result := datInteger;
|
|
52:result := datInteger;
|
|
56:result := datInteger;
|
|
58:result := datDateTime;
|
|
59:result := datFloat;
|
|
60:result := datCurrency;
|
|
61:result := datDateTime;
|
|
62:result := datFloat;
|
|
//98 sql_variant
|
|
99:result := datMemo;// ntext
|
|
104:result := datBoolean;
|
|
106:result := datFloat;
|
|
108:result := datFloat;
|
|
122:result := datCurrency;
|
|
127:result := datInteger;
|
|
165:result := datBlob; // varbinary
|
|
167:result := datString;
|
|
173:result := datBlob; // binary
|
|
175:result := datString; // char
|
|
189:result := datBlob; // timestamp
|
|
231:result := datString; // nvarchar
|
|
239:result := datString; //nchar
|
|
240:result := datDateTime;
|
|
241:result := datBlob;// xml
|
|
else result := datUnknown;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEIBDACConnection.DoGetStoredProcedureParams(const aStoredProcedureName: string; out Params: TDAParamCollection);
|
|
var
|
|
ds : TIBCQuery;
|
|
lID:string;
|
|
begin
|
|
ds := TIBCQuery.Create(NIL);
|
|
try
|
|
|
|
ds.Connection := fConnection;
|
|
ds.SQL.Text := 'select * from sysobjects where xtype=''P'' and name='''+aStoredProcedureName+'''';
|
|
ds.Open;
|
|
try
|
|
if ds.EOF then RaiseError('Stored Procedure %s not found in database',[aStoredProcedureName]);
|
|
lID := ds.FieldbyName('id').AsString;
|
|
finally
|
|
ds.Close();
|
|
end;
|
|
|
|
ds.SQL.Text := 'select * from sys.parameters where object_id='''+lID+''' ORDER BY parameter_id';
|
|
ds.Open;
|
|
try
|
|
Params := TDAParamCollection.Create(nil);
|
|
while not ds.Eof do begin
|
|
with Params.Add() do begin
|
|
Name := ds.FieldByName('name').AsString;
|
|
|
|
DataType := SqlServerToDAType(ds.FieldByName('system_type_id').AsInteger);
|
|
Size := ds.FieldByName('max_length').AsInteger;
|
|
|
|
{if ds.FieldByName('has_default_value').AsBoolean then
|
|
DefaultValue := ds.FieldByName('default_Value').AsInteger;}
|
|
|
|
if ds.FieldByName('is_output').AsBoolean then
|
|
ParamType := daptOutput
|
|
else
|
|
ParamType := daptInput;
|
|
|
|
end;
|
|
ds.Next();
|
|
end;
|
|
finally
|
|
Close();
|
|
end;
|
|
|
|
finally
|
|
ds.Free;
|
|
end;
|
|
end;*)
|
|
|
|
procedure TDAEIBDACConnection.DoRollbackTransaction;
|
|
begin
|
|
fConnection.Rollback;
|
|
end;
|
|
|
|
function TDAEIBDACConnection.DoGetInTransaction: boolean;
|
|
begin
|
|
result := fConnection.InTransaction
|
|
end;
|
|
|
|
procedure TDAEIBDACConnection.Commit;
|
|
begin
|
|
fConnection.Commit;
|
|
end;
|
|
|
|
procedure TDAEIBDACConnection.CommitRetaining;
|
|
begin
|
|
fConnection.CommitRetaining;
|
|
end;
|
|
|
|
function TDAEIBDACConnection.GetCharset: string;
|
|
begin
|
|
result := fConnection.Options.Charset;
|
|
end;
|
|
|
|
function TDAEIBDACConnection.GetRole: string;
|
|
begin
|
|
Result := fConnection.Options.Role;
|
|
end;
|
|
|
|
function TDAEIBDACConnection.GetSQLDialect: integer;
|
|
begin
|
|
Result := fConnection.SQLDialect;
|
|
end;
|
|
|
|
function TDAEIBDACConnection.GetTransaction: TObject;
|
|
begin
|
|
Result := fConnection.DefaultTransaction;
|
|
end;
|
|
|
|
procedure TDAEIBDACConnection.Rollback;
|
|
begin
|
|
fConnection.Rollback;
|
|
end;
|
|
|
|
procedure TDAEIBDACConnection.RollbackRetaining;
|
|
begin
|
|
fConnection.RollbackRetaining;
|
|
end;
|
|
|
|
procedure TDAEIBDACConnection.SetCharset(const Value: string);
|
|
begin
|
|
fConnection.Options.Charset := Value;
|
|
end;
|
|
|
|
procedure TDAEIBDACConnection.SetRole(const Value: string);
|
|
begin
|
|
fConnection.Options.Role := Value;
|
|
end;
|
|
|
|
procedure TDAEIBDACConnection.SetSQLDialect(Value: integer);
|
|
begin
|
|
fConnection.SQLDialect := Value;
|
|
end;
|
|
|
|
{ TDAEIBDACDriver }
|
|
|
|
function TDAEIBDACDriver.GetConnectionClass: TDAEConnectionClass;
|
|
begin
|
|
result := TDAEIBDACConnection;
|
|
end;
|
|
|
|
function TDAEIBDACDriver.GetDescription: string;
|
|
begin
|
|
result := 'Core Lab IBDAC Driver'{$IFDEF DataAbstract_SchemaModelerOnly} + SchemaModelerOnly{$ENDIF};
|
|
end;
|
|
|
|
function TDAEIBDACDriver.GetDriverID: string;
|
|
begin
|
|
result := 'IBDAC';
|
|
end;
|
|
|
|
procedure TDAEIBDACDriver.OnIBDACTrace(Sender: TObject; Text: string; Flag: TDATraceFlag);
|
|
begin
|
|
inherited;
|
|
// if Assigned(fTraceCallback) then fTraceCallback(Sender, Text, integer(Flag));
|
|
end;
|
|
|
|
procedure TDAEIBDACDriver.DoSetTraceOptions(TraceActive: boolean; TraceOptions: TDATraceOptions; Callback: TDALogTraceEvent);
|
|
var
|
|
IBDACopts: TDATraceFlags;
|
|
begin
|
|
inherited;
|
|
exit;
|
|
if TraceActive then begin
|
|
if (fMonitor = nil) then fMonitor := TIBCSQLMonitor.Create(Self);
|
|
|
|
fMonitor.Active := FALSE;
|
|
fMonitor.OnSQL := OnIBDACTrace;
|
|
|
|
IBDACopts := [];
|
|
if (toPrepare in TraceOptions) then IBDACopts := IBDACopts + [tfQPrepare];
|
|
if (toExecute in TraceOptions) then IBDACopts := IBDACopts + [tfQExecute];
|
|
if (toFetch in TraceOptions) then IBDACopts := IBDACopts + [tfQFetch];
|
|
if (toError in TraceOptions) then IBDACopts := IBDACopts + [tfError];
|
|
if (toStmt in TraceOptions) then IBDACopts := IBDACopts + [tfStmt];
|
|
if (toConnect in TraceOptions) then IBDACopts := IBDACopts + [tfConnect];
|
|
if (toTransact in TraceOptions) then IBDACopts := IBDACopts + [tfTransact];
|
|
if (toBlob in TraceOptions) then IBDACopts := IBDACopts + [tfBlob];
|
|
if (toService in TraceOptions) then IBDACopts := IBDACopts + [tfService];
|
|
if (toMisc in TraceOptions) then IBDACopts := IBDACopts + [tfMisc];
|
|
if (toParams in TraceOptions) then IBDACopts := IBDACopts + [tfParams];
|
|
|
|
fTraceCallBack := Callback;
|
|
|
|
fMonitor.TraceFlags := IBDACopts;
|
|
fMonitor.Active := TRUE;
|
|
end
|
|
else begin
|
|
FreeAndNIL(fMonitor);
|
|
fTraceCallback := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEIBDACDriver.CustomizeConnectionObject(
|
|
aConnection: TDAEConnection);
|
|
begin
|
|
//
|
|
end;
|
|
|
|
{ TDAEIBDACQuery }
|
|
|
|
procedure TDAEIBDACQuery.ClearParams;
|
|
begin
|
|
inherited;
|
|
TIBCQuery(Dataset).Params.Clear;
|
|
end;
|
|
|
|
function TDAEIBDACQuery.CreateDataset(aConnection: TDAEConnection): TDataset;
|
|
begin
|
|
result := TIBCQuery.Create(nil);
|
|
TIBCQuery(result).FetchAll := True; //for preventing creating an additional session when you call StartTransaction (an known issue of OLEDB)
|
|
TIBCQuery(result).Unidirectional := True;
|
|
TIBCQuery(result).ReadOnly := TRUE;
|
|
TIBCQuery(result).Connection := TDAEIBDACConnection(aConnection).fConnection;
|
|
end;
|
|
|
|
function TDAEIBDACQuery.DoExecute: integer;
|
|
begin
|
|
TIBCQuery(Dataset).ExecSQL;
|
|
result := TIBCQuery(Dataset).RowsAffected;
|
|
end;
|
|
|
|
function TDAEIBDACQuery.DoGetRecordCount: integer;
|
|
begin
|
|
Result := TIBCQuery(Dataset).RecordCount;
|
|
end;
|
|
|
|
function TDAEIBDACQuery.DoGetSQL: string;
|
|
begin
|
|
result := TIBCQuery(Dataset).SQL.Text;
|
|
end;
|
|
|
|
procedure TDAEIBDACQuery.DoPrepare(Value: boolean);
|
|
begin
|
|
TIBCQuery(Dataset).Prepared := Value;
|
|
end;
|
|
|
|
procedure TDAEIBDACQuery.DoSetSQL(const Value: string);
|
|
begin
|
|
TIBCQuery(Dataset).SQL.Text := Value;
|
|
end;
|
|
|
|
procedure TDAEIBDACQuery.GetParamValues(AParams: TDAParamCollection);
|
|
var
|
|
I: Integer;
|
|
lParam: TIBCParam;
|
|
begin
|
|
for i := 0 to TIBCQuery(DataSet).Params.Count - 1 do begin
|
|
lParam:=TIBCQuery(DataSet).Params[i];
|
|
if (lParam.ParamType in [ptOutput, ptInputOutput, ptResult]) then
|
|
AParams.ParamByName(lParam.Name).Value := lParam.Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEIBDACQuery.SetParamValues(AParams: TDAParamCollection);
|
|
begin
|
|
WriteCrLabsParamValues(AParams, TIBCQuery(Dataset).Params, true);
|
|
end;
|
|
|
|
{ TDAEIBDACStoredProcedure }
|
|
|
|
function TDAEIBDACStoredProcedure.CreateDataset(
|
|
aConnection: TDAEConnection): TDataset;
|
|
begin
|
|
result := TIBCStoredProc.Create(nil);
|
|
TIBCStoredProc(result).Connection := TDAEIBDACConnection(aConnection).fConnection;
|
|
end;
|
|
|
|
function TDAEIBDACStoredProcedure.Execute: integer;
|
|
begin
|
|
TIBCStoredProc(Dataset).Prepare;
|
|
SetParamValues(GetParams);
|
|
Result:=DoExecute;
|
|
GetParamValues(GetParams);
|
|
end;
|
|
|
|
|
|
procedure TDAEIBDACStoredProcedure.GetParamValues(AParams: TDAParamCollection);
|
|
var
|
|
i: Integer;
|
|
lParam: TIBCParam;
|
|
begin
|
|
for i := 0 to TIBCStoredProc(DataSet).Params.Count - 1 do begin
|
|
lParam:=TIBCStoredProc(DataSet).Params[i];
|
|
if (lParam.ParamType in [ptOutput, ptInputOutput, ptResult]) then
|
|
AParams.ParamByName(lParam.Name).Value := lParam.Value;
|
|
end;
|
|
end;
|
|
|
|
function TDAEIBDACStoredProcedure.GetStoredProcedureName: string;
|
|
begin
|
|
result := TIBCStoredProc(Dataset).StoredProcName;
|
|
end;
|
|
|
|
procedure TDAEIBDACStoredProcedure.SetStoredProcedureName(
|
|
const Name: string);
|
|
begin
|
|
TIBCStoredProc(Dataset).StoredProcName := Name;
|
|
end;
|
|
|
|
procedure TDAEIBDACStoredProcedure.RefreshParams;
|
|
begin
|
|
TIBCStoredProc(Dataset).Prepare;
|
|
RefreshParamsStd(TIBCStoredProc(Dataset).Params);
|
|
end;
|
|
|
|
procedure TDAEIBDACStoredProcedure.SetParamValues(AParams: TDAParamCollection);
|
|
begin
|
|
WriteCrLabsParamValues(AParams, TIBCStoredProc(Dataset).Params);
|
|
end;
|
|
|
|
exports
|
|
GetDriverObject name func_GetDriverObject;
|
|
|
|
function TDAEIBDACStoredProcedure.DoExecute: Integer;
|
|
begin
|
|
TIBCStoredProc(Dataset).ExecProc;
|
|
result := TIBCStoredProc(Dataset).RowsAffected;
|
|
end;
|
|
|
|
initialization
|
|
_driver := nil;
|
|
RegisterDriverProc(GetDriverObject);
|
|
|
|
finalization
|
|
UnregisterDriverProc(GetDriverObject);
|
|
FreeAndNIL(_driver);
|
|
|
|
end.
|
|
|