david
e4d0fcb01d
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@46 b6239004-a887-0f4b-9937-50029ccdca16
1737 lines
59 KiB
ObjectPascal
1737 lines
59 KiB
ObjectPascal
unit uDAADODriver;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ 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.
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
{$I ..\DataAbstract.inc}
|
|
{$ELSE}
|
|
{$I ../DataAbstract.inc}
|
|
{$ENDIF}
|
|
|
|
{$R DataAbstract_ADODriver_Glyphs.res}
|
|
|
|
// with included option, you can receive errors like
|
|
// Access violation at address 6BD7297F in module 'msado15.dll'. Read of address 00000068.
|
|
{.$DEFINE ADOMONITOR_SHOWPARAMVALUES}
|
|
|
|
interface
|
|
|
|
uses Windows, Classes, DB, uDAEngine, uDAInterfaces, uDAADOInterfaces, uROClasses, ADODB,
|
|
uDAInterfacesEx, uDAUtils, uDAOracleInterfaces;
|
|
|
|
type { TDAADODriver }
|
|
TDAADODriver = class(TDADriverReference)
|
|
end;
|
|
TDAEADODriver = class;
|
|
|
|
TDAADOMonitor = class
|
|
private
|
|
FDriver: TDAEADODriver;
|
|
FEnabled: Boolean;
|
|
FOnCallback: TDALogTraceEvent;
|
|
FTraceFlags: TDATraceOptions;
|
|
procedure SetEnabled(const Value: Boolean);
|
|
procedure SetTraceFlags(const Value: TDATraceOptions);
|
|
procedure SetOnCallback(const Value: TDALogTraceEvent);
|
|
procedure ADOConnectionBeginTransComplete(Connection: TADOConnection;
|
|
TransactionLevel: Integer; const Error: Error;
|
|
var EventStatus: TEventStatus);
|
|
procedure ADOConnectionCommitTransComplete(Connection: TADOConnection;
|
|
const Error: Error; var EventStatus: TEventStatus);
|
|
procedure ADOConnectionConnectComplete(Connection: TADOConnection;
|
|
const Error: Error; var EventStatus: TEventStatus);
|
|
procedure ADOConnectionExecuteComplete(Connection: TADOConnection;
|
|
RecordsAffected: Integer; const Error: Error;
|
|
var EventStatus: TEventStatus; const Command: _Command;
|
|
const Recordset: _Recordset);
|
|
procedure ADOConnectionInfoMessage(Connection: TADOConnection;
|
|
const Error: Error; var EventStatus: TEventStatus);
|
|
procedure ADOConnectionRollbackTransComplete(
|
|
Connection: TADOConnection; const Error: Error;
|
|
var EventStatus: TEventStatus);
|
|
procedure ADOConnectionDisconnect(Connection: TADOConnection;
|
|
var EventStatus: TEventStatus);
|
|
procedure ADOConnectionWillConnect(Connection: TADOConnection;
|
|
var ConnectionString, UserID, Password: WideString;
|
|
var ConnectOptions: TConnectOption; var EventStatus: TEventStatus);
|
|
procedure ADOConnectionWillExecute(Connection: TADOConnection;
|
|
var CommandText: WideString; var CursorType: TCursorType;
|
|
var LockType: TADOLockType; var CommandType: TCommandType;
|
|
var ExecuteOptions: TExecuteOptions; var EventStatus: TEventStatus;
|
|
const Command: _Command; const Recordset: _Recordset);
|
|
public
|
|
constructor Create(ADriver: TDAEADODriver);
|
|
procedure ReAssignEvents;
|
|
procedure AssignEvents(AConnection:TADOConnection);
|
|
procedure UnAssignEvents(AConnection:TADOConnection);
|
|
property Enabled : Boolean read FEnabled write SetEnabled;
|
|
property TraceFlags: TDATraceOptions read FTraceFlags write SetTraceFlags;
|
|
property OnCallback: TDALogTraceEvent read FOnCallback write SetOnCallback;
|
|
end;
|
|
|
|
{ TDAEADODriver }
|
|
TDAEADODriver = class(TDAEDriver, IDADriver40)
|
|
private
|
|
FConnectionList: TThreadList;
|
|
FMonitor: TDAADOMonitor;
|
|
protected
|
|
procedure DoSetTraceOptions(TraceActive: boolean; TraceFlags: TDATraceOptions; Callback: TDALogTraceEvent); override;
|
|
procedure RegisterConnection(AConnection: TADOConnection);
|
|
procedure UnregisterConnection(AConnection: TADOConnection);
|
|
protected
|
|
function GetConnectionClass: TDAEConnectionClass; override;
|
|
procedure CustomizeConnectionObject(aConnection: TDAEConnection); override;
|
|
// IDADriver
|
|
function GetDriverID: string; override;
|
|
function GetDescription: string; override;
|
|
procedure GetAuxDrivers(out List: IROStrings); override;
|
|
procedure GetAuxParams(const AuxDriver: string; out List: IROStrings); override;
|
|
function GetAvailableDriverOptions: TDAAvailableDriverOptions; override;
|
|
function GetProviderDefaultCustomParameters(Provider: string): string; safecall;
|
|
function GetDefaultConnectionType(const AuxDriver: string): string;override; safecall;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
{ TDAEADOConnection }
|
|
TDAEADOConnection = class(TDAEConnection, IDAADOConnection, IDAConnectionModelling, IDACanQueryDatabaseNames,IDAFileBasedDatabase,IDAUseGenerators,IDAOracleConnection)
|
|
private
|
|
fProviderName: string;
|
|
fSchemaEnabled: Boolean;
|
|
fProviderType: TDAOleDBProviderType;
|
|
fADOConnection: TADOConnection;
|
|
fQuery_CursorType: TCursorType;
|
|
fQuery_CursorLocation: TCursorLocation;
|
|
fQuery_ADOLockType: TADOLockType;
|
|
procedure GetViewOrTableNames(const aType: string; const aSystemTables: boolean; List: IROStrings);
|
|
function CreateCompatibleQuery: IDADataset;
|
|
|
|
protected
|
|
function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
|
|
function CreateCustomConnection: TCustomConnection; override;
|
|
function CreateMacroProcessor: TDASQLMacroProcessor; 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;
|
|
|
|
procedure DoGetTableNames(out List: IROStrings); override;
|
|
procedure DoGetTableFields(const aTableName: string; out Fields: TDAFieldCollection); override;
|
|
|
|
procedure DoGetViewNames(out List: IROStrings); override;
|
|
procedure DoGetStoredProcedureNames(out List: IROStrings); override;
|
|
procedure DoGetStoredProcedureParams(const aStoredProcedureName: string; out Params: TDAParamCollection); override;
|
|
procedure DoGetForeignKeys(out ForeignKeys: TDADriverForeignKeyCollection); override;
|
|
|
|
function DoGetLastAutoInc(const GeneratorName: string): integer; override;
|
|
|
|
function GetQuoteChars: TDAQuoteCharArray; override;
|
|
function isAlive: Boolean; override; safecall;
|
|
|
|
// IADOConnection
|
|
function GetProviderName: string; safecall;
|
|
function GetProviderType: TDAOleDBProviderType; safecall;
|
|
function GetCommandTimeout: Integer; safecall;
|
|
procedure SetCommandTimeout(const Value: Integer); safecall;
|
|
|
|
// IDAConnectionModelling
|
|
function BuildCreateTableSQL(aDataSet: TDADataSet; const aOverrideName: string = ''): string; safecall;
|
|
procedure CreateTable(aDataSet: TDADataSet; const aOverrideName: string = ''); safecall;
|
|
function FieldToDeclaration(aField: TDAField): string; safecall;
|
|
|
|
// IDACanQueryDatabaseNames
|
|
function GetDatabaseNames: IROStrings;
|
|
function GetSPSelectSyntax(HasArguments: Boolean): String; override; safecall;
|
|
// IDAFileBasedDatabase
|
|
function GetFileExtensions: IROStrings;
|
|
function IdentifierNeedsQuoting(const iIdentifier: string): boolean; override; safecall;
|
|
{ IDAUseGenerators }
|
|
function GetNextAutoinc(const GeneratorName: string): integer; safecall;
|
|
public
|
|
constructor Create(aDriver: TDAEDriver; aName: string = ''); override;
|
|
destructor Destroy; override;
|
|
property SchemaEnabled: Boolean read fSchemaEnabled write fSchemaEnabled;
|
|
end;
|
|
|
|
{ TDAEADOQuery }
|
|
TDAEADOQuery = class(TDAEDataset, IDAMustSetParams)
|
|
private
|
|
|
|
protected
|
|
procedure ClearParams; override;
|
|
function CreateDataset(aConnection: TDAEConnection): TDataset; override;
|
|
|
|
function DoExecute: integer; override;
|
|
function DoGetSQL: string; override;
|
|
procedure DoSetSQL(const Value: string); override;
|
|
|
|
|
|
// IDAMustSetParams
|
|
procedure SetParamValues(Params: TDAParamCollection); override;safecall;
|
|
procedure RefreshParams; override; safecall;
|
|
procedure GetParamValues(Params: TDAParamCollection); override;safecall;
|
|
|
|
public
|
|
end;
|
|
|
|
{ TDAEADOStoredProcedure }
|
|
TDAEADOStoredProcedure = class(TDAEStoredProcedure, IDAMustSetParams)
|
|
protected
|
|
function CreateDataset(aConnection: TDAEConnection): TDataset; override;
|
|
|
|
procedure RefreshParams; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function GetStoredProcedureName: string; override;
|
|
procedure SetStoredProcedureName(const Name: string); override;
|
|
function DoExecute: integer; override;
|
|
function Execute: integer; override;
|
|
|
|
// IDAMustSetParams
|
|
procedure SetParamValues(Params: TDAParamCollection); override;safecall;
|
|
procedure GetParamValues(Params: TDAParamCollection); override;safecall;
|
|
end;
|
|
|
|
procedure Register;
|
|
|
|
function GetDriverObject: IDADriver; stdcall;
|
|
|
|
implementation
|
|
|
|
uses SysUtils, uDADriverManager, uDARes, Variants, ADOInt, uDAMacroProcessors,
|
|
Math, uDAHelpers, uROBinaryHelpers, uDAPostgresInterfaces;
|
|
|
|
const
|
|
Default_CursorType = ctOpenForwardOnly;
|
|
Default_CursorLocation = clUseServer;
|
|
Default_ADOLockType = ltReadOnly;
|
|
|
|
const
|
|
TConnectOptionStr: array[TConnectOption] of string = ('coConnectUnspecified', 'coAsyncConnect');
|
|
TCursorLocationStr: array[TCursorLocation] of string = ('clUseServer', 'clUseClient');
|
|
TCursorTypeStr: array[TCursorType] of string = ('ctUnspecified', 'ctOpenForwardOnly', 'ctKeyset', 'ctDynamic','ctStatic');
|
|
TEventStatusStr: array[TEventStatus] of string = ('esOK', 'esErrorsOccured', 'esCantDeny', 'esCancel', 'esUnwantedEvent');
|
|
TADOLockTypeStr: array[TADOLockType] of string = ('ltUnspecified', 'ltReadOnly', 'ltPessimistic', 'ltOptimistic', 'ltBatchOptimistic');
|
|
TCommandTypeStr: array[TCommandType] of string = ('cmdUnknown', 'cmdText', 'cmdTable', 'cmdStoredProc', 'cmdFile', 'cmdTableDirect');
|
|
TExecuteOptionStr: array[TExecuteOption] of string = ('eoAsyncExecute', 'eoAsyncFetch', 'eoAsyncFetchNonBlocking','eoExecuteNoRecords');
|
|
|
|
var
|
|
_driver: TDAEDriver = nil;
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents(DAPalettePageName, [TDAADODriver]);
|
|
end;
|
|
|
|
function GetDriverObject: IDADriver;
|
|
begin
|
|
if (_driver = nil) then _driver := TDAEADODriver.Create(nil);
|
|
result := _driver;
|
|
end;
|
|
|
|
type
|
|
TDecimalVariant = packed record
|
|
VarType: TVarType;
|
|
scale: Byte;
|
|
sign: Byte;
|
|
Hi32: Cardinal;
|
|
Lo32: Cardinal;
|
|
Mid32: Cardinal;
|
|
Dummy: Cardinal;
|
|
end;
|
|
|
|
function DecimalToInt64(const V: Variant): Int64;
|
|
var
|
|
vData: TDecimalVariant absolute V;
|
|
begin
|
|
if (vData.VarType = 14) and (vData.scale = 0) and (vData.Hi32 = 0) then begin
|
|
Result := Int64(vData.Lo32) or (Int64(vData.Mid32) shl 32);
|
|
if vData.sign <> 0 then result := -Result;
|
|
end else result := v;
|
|
end;
|
|
|
|
function Int64ToDecimal(Data: Int64): Variant;
|
|
var
|
|
vd: TDecimalVariant absolute Result;
|
|
begin
|
|
VarClear(Result);
|
|
vd.scale := 0;
|
|
if data < 0 then begin
|
|
vd.Sign := 128;
|
|
data := -data;
|
|
end else
|
|
vd.sign := 0;
|
|
vd.Hi32 := 0;
|
|
vd.Mid32 := int64(data shr 32);
|
|
vd.Lo32 := data;
|
|
vd.VarType := 14;
|
|
end;
|
|
|
|
|
|
{ TDAEADOConnection }
|
|
|
|
procedure TDAEADOConnection.DoApplyConnectionString(aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection);
|
|
var
|
|
lConnectionString: string;
|
|
i: Integer;
|
|
sName,sValue: string;
|
|
begin
|
|
inherited;
|
|
|
|
with aConnStrParser do begin
|
|
lConnectionString := '';
|
|
if AuxDriver <> '' then lConnectionString := lConnectionString + 'Provider=' + AuxDriver + ';' else
|
|
raise EDADriverException.Create('No aux driver specified for ADO connection');
|
|
|
|
fProviderName := AuxDriver;
|
|
fProviderType := OleDBDriverIdToOleDBProviderType(fProviderName);
|
|
|
|
if (Self.UserID <> '') then
|
|
lConnectionString := lConnectionString + 'User ID=' + Self.UserID + ';'
|
|
else if (UserID <> '') then
|
|
lConnectionString := lConnectionString + 'User ID=' + UserID + ';';
|
|
|
|
if (Self.Password <> '') then
|
|
lConnectionString := lConnectionString + 'Password=' + Self.Password + ';'
|
|
else if (Password <> '') then
|
|
lConnectionString := lConnectionString + 'Password=' + Password + ';';
|
|
|
|
if fProviderType = oledb_Jet then begin
|
|
lConnectionString := lConnectionString + 'Data Source=' + Database+';';
|
|
end else begin
|
|
if Database <> '' then begin
|
|
if fProviderType = oledb_Postgresql then
|
|
lConnectionString := lConnectionString + 'Location=' + Database + ';'
|
|
else
|
|
lConnectionString := lConnectionString + 'Initial Catalog=' + Database + ';';
|
|
end;
|
|
if Server <> '' then lConnectionString := lConnectionString + 'Data Source=' + Server + ';';
|
|
|
|
if fProviderType <> oledb_Postgresql then
|
|
lConnectionString := lConnectionString + 'OLE DB SERVICES=-2;';
|
|
end;
|
|
fSchemaEnabled := false;
|
|
for i := 0 to AuxParamsCount -1 do
|
|
begin
|
|
sName := AuxParamNames[i];
|
|
if sName = '' then Continue;
|
|
sValue := AuxParams[AuxParamNames[i]];
|
|
if AnsiSameText('SCHEMAS',sName) then
|
|
fSchemaEnabled := sValue = '1'
|
|
else if AnsiSameText(sName, 'CursorLocation') then begin
|
|
if AnsiSameText('clUseServer',sValue) then
|
|
fQuery_CursorLocation:= clUseServer
|
|
else if AnsiSameText('clUseClient',sValue) then
|
|
fQuery_CursorLocation:= clUseClient;
|
|
end else if AnsiSameText(sName,'CursorType') then begin
|
|
if AnsiSameText('ctUnspecified',sValue) then
|
|
fQuery_CursorType:=ctUnspecified
|
|
else if AnsiSameText('ctOpenForwardOnly',sValue) then
|
|
fQuery_CursorType:=ctOpenForwardOnly
|
|
else if AnsiSameText('ctKeyset',sValue) then
|
|
fQuery_CursorType:=ctKeyset
|
|
else if AnsiSameText('ctDynamic',sValue) then
|
|
fQuery_CursorType:=ctDynamic
|
|
else if AnsiSameText('ctStatic',sValue) then
|
|
fQuery_CursorType:=ctStatic;
|
|
end else if AnsiSameText(sName, 'LockType') then begin
|
|
if AnsiSameText('ltUnspecified',sValue) then
|
|
fQuery_ADOLockType:= ltUnspecified
|
|
else if AnsiSameText('ltReadOnly',sValue) then
|
|
fQuery_ADOLockType:= ltReadOnly
|
|
else if AnsiSameText('ltPessimistic',sValue) then
|
|
fQuery_ADOLockType:= ltPessimistic
|
|
else if AnsiSameText('ltOptimistic',sValue) then
|
|
fQuery_ADOLockType:= ltOptimistic
|
|
else if AnsiSameText('ltBatchOptimistic',sValue) then
|
|
fQuery_ADOLockType:= ltBatchOptimistic;
|
|
end else begin
|
|
if sName[1] = '@' then sName:= Pchar(sName)+1;
|
|
lConnectionString := lConnectionString + sName + '=' + sValue +';';
|
|
end;
|
|
end;
|
|
fADOConnection.ConnectionString := lConnectionString;
|
|
end;
|
|
SchemaEnabled := fSchemaEnabled or ((UpperCase(GetProviderName) = 'SQLNCLI') or (UpperCase(GetProviderName) ='SQLNCLI.1'));
|
|
if fProviderType = oledb_Postgresql then fQuery_CursorLocation:=clUseClient; // ADOQuery can't process correctly "name" datatype of Postgres
|
|
if fProviderType = oledb_Oracle then fQuery_CursorLocation:=clUseClient; // Oracle don't work correctly without clUseClient
|
|
end;
|
|
|
|
function TDAEADOConnection.DoBeginTransaction: integer;
|
|
begin
|
|
result := fADOConnection.BeginTrans
|
|
end;
|
|
|
|
procedure TDAEADOConnection.DoCommitTransaction;
|
|
begin
|
|
fADOConnection.CommitTrans
|
|
end;
|
|
|
|
function TDAEADOConnection.CreateCustomConnection: TCustomConnection;
|
|
begin
|
|
fSchemaEnabled := true;
|
|
fADOConnection := TADOConnection.Create(nil);
|
|
fADOConnection.LoginPrompt := FALSE;
|
|
if Assigned(fADOConnection) then TDAEADODriver(Driver).RegisterConnection(fADOConnection);
|
|
result := fADOConnection;
|
|
end;
|
|
|
|
function TDAEADOConnection.GetDatasetClass: TDAEDatasetClass;
|
|
begin
|
|
result := TDAEADOQuery;
|
|
end;
|
|
|
|
function TDAEADOConnection.GetStoredProcedureClass: TDAEStoredProcedureClass;
|
|
begin
|
|
result := TDAEADOStoredProcedure;
|
|
end;
|
|
|
|
procedure TDAEADOConnection.DoGetStoredProcedureNames(out List: IROStrings);
|
|
var
|
|
Schema, NameField: TField;
|
|
DataSet: TADODataSet;
|
|
lName: string;
|
|
p: integer;
|
|
begin
|
|
inherited;
|
|
case fProviderType of
|
|
oledb_MSSQL, oledb_MSSQL2005, oledb_MSSQL2008: MSSQL_DoGetNames(CreateCompatibleQuery,List,dotProcedure,SchemaEnabled);
|
|
oledb_Postgresql: Postgres_DoGetNames(CreateCompatibleQuery,List,dotProcedure);
|
|
oledb_Oracle: Oracle_DoGetNames(CreateCompatibleQuery,List,dotProcedure);
|
|
else
|
|
fADOConnection.Open();
|
|
DataSet := TADODataSet.Create(nil);
|
|
try
|
|
fADOConnection.OpenSchema(siProcedures, EmptyParam, EmptyParam, DataSet);
|
|
NameField := DataSet.FieldByName('PROCEDURE_NAME');
|
|
Schema := DataSet.Findfield('PROCEDURE_SCHEMA');
|
|
while not DataSet.EOF do begin
|
|
lName := NameField.AsString;
|
|
if (Schema <> nil) and (Schema.Value = 'sys') then begin dataset.Next; continue; end;
|
|
p := Pos(';', lName);
|
|
if p > 1 then begin
|
|
if P+1 >= length(lName) then begin
|
|
if lName[p+1] = '0' then // function
|
|
begin
|
|
Dataset.Next;
|
|
continue;
|
|
end;
|
|
end;
|
|
SetLength(lName, p-1);
|
|
end;
|
|
if fSchemaEnabled and (Schema <> nil) and not (VarIsNull(Schema.Value)) then
|
|
List.Add(Schema.AsString + '.' + lName)
|
|
else
|
|
List.Add(lName);
|
|
DataSet.Next;
|
|
end;
|
|
finally
|
|
DataSet.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ADOTypeToFieldType(const ADOType: DataTypeEnum; EnableBCD: Boolean = False): TFieldType;
|
|
begin
|
|
case ADOType of
|
|
adEmpty: Result := ftUnknown;
|
|
adTinyInt, adSmallInt: Result := ftSmallint;
|
|
adError, adInteger, adUnsignedInt: Result := ftInteger;
|
|
adBigInt, adUnsignedBigInt: Result := ftLargeInt;
|
|
adUnsignedTinyInt, adUnsignedSmallInt: Result := ftWord;
|
|
adSingle, adDouble: Result := ftFloat;
|
|
adCurrency: Result := ftCurrency;
|
|
adBoolean: Result := ftBoolean;
|
|
adDBDate: Result := ftDate;
|
|
adDBTime: Result := ftTime;
|
|
adDate, adDBTimeStamp, adFileTime, adDBFileTime: Result := ftDateTime;
|
|
adChar: Result := ftFixedChar;
|
|
adVarChar: Result := ftString;
|
|
adBSTR, adWChar, adVarWChar: Result := ftWideString;
|
|
adLongVarChar, adLongVarWChar: Result := ftMemo;
|
|
adLongVarBinary: Result := ftBlob;
|
|
adBinary: Result := ftBytes;
|
|
adVarBinary: Result := ftVarBytes;
|
|
adChapter: Result := ftDataSet;
|
|
adPropVariant, adVariant: Result := ftVariant;
|
|
adIUnknown: Result := ftInterface;
|
|
adIDispatch: Result := ftIDispatch;
|
|
adGUID: Result := ftGUID;
|
|
adDecimal, adNumeric, adVarNumeric:
|
|
if EnableBCD then
|
|
Result := ftBCD
|
|
else
|
|
Result := ftFloat;
|
|
else
|
|
Result := ftUnknown;
|
|
end;
|
|
end;
|
|
|
|
(*procedure TDAEADOConnection.DoGetStoredProcedureParams(const aStoredProcedureName: string; out Params: TDAParamCollection);
|
|
var
|
|
DataSet: TADODataSet;
|
|
begin
|
|
fADOConnection.Open();
|
|
DataSet := TADODataSet.Create(nil);
|
|
try
|
|
fADOConnection.OpenSchema(siProcedureParameters, VarArrayOf([Null, Null, aStoredProcedureName]), EmptyParam, DataSet);
|
|
//NameField := DataSet.FieldByName('PROCEDURE_NAME'); { do not localize }
|
|
Params := TDAParamCollection.Create(NIL);
|
|
while not DataSet.EOF do begin
|
|
with Params.Add() do begin
|
|
Name := DataSet.FieldByName('PARAMETER_NAME').AsString;
|
|
ParamType := TDAParamType(DataSet.FieldByName('PARAMETER_TYPE').AsInteger);
|
|
//DataType := TDADataType(DataSet.FieldByName('DATA_TYPE').AsInteger);
|
|
DataType := VCLTypeToDAType(ADOTypeToFieldType(DataSet.FieldByName('DATA_TYPE').AsInteger));
|
|
Size := DataSet.FieldByName('CHARACTER_MAXIMUM_LENGTH').AsInteger
|
|
//more info available:
|
|
//'PARAMETER_HASDEFAULT'
|
|
//'PARAMETER_DEFAULT'
|
|
//'IS_NULLABLE'
|
|
//'DATA_TYPE'
|
|
//'CHARACTER_MAXIMUM_LENGTH'
|
|
//'CHARACTER_OCTET_LENGTH'
|
|
//'DESCRIPTION'
|
|
//'TYPE_NAME'
|
|
//'LOCAL_TYPE_NAME'
|
|
end;
|
|
//List.Add(NameField.AsString);
|
|
DataSet.Next;
|
|
end;
|
|
finally
|
|
DataSet.Free;
|
|
end;
|
|
end;*)
|
|
|
|
procedure TDAEADOConnection.DoGetTableFields(const aTableName: string; out Fields: TDAFieldCollection);
|
|
var
|
|
lField: TDAField;
|
|
//i: Integer;
|
|
DataSet: TADODataSet;
|
|
begin
|
|
case fProviderType of
|
|
oledb_MSSQL, oledb_MSSQL2005, oledb_MSSQL2008: MSSQL_DoGetTableFields(QuoteIdentifierIfNeeded(aTableName),CreateCompatibleQuery,Fields);
|
|
oledb_Postgresql: Postgres_DoGetTableFields(QuoteIdentifierIfNeeded(aTableName),CreateCompatibleQuery,Fields);
|
|
oledb_Oracle: Oracle_DoGetTableFields(QuoteIdentifierIfNeeded(aTableName),CreateCompatibleQuery,Fields);
|
|
else
|
|
fADOConnection.Open();
|
|
DataSet := TADODataSet.Create(nil);
|
|
try
|
|
if (pos('.', aTableName) > 0) and (SchemaEnabled) then
|
|
fADOConnection.OpenSchema(siColumns, VarArrayOf([Unassigned, Copy(aTableName, 1, Pos('.', aTableName)-1), Copy(aTableName, Pos('.', aTableName)+1, MaxInt)]), EmptyParam, DataSet)
|
|
else
|
|
fADOConnection.OpenSchema(siColumns, VarArrayOf([Unassigned, Unassigned, aTableName]), EmptyParam, DataSet);
|
|
//NameField := DataSet.FieldByName('PROCEDURE_NAME'); { do not localize }
|
|
if DataSet.EOF then begin
|
|
inherited DoGetTableFields(QuoteIdentifierIfNeeded(aTableName), Fields);
|
|
exit ;
|
|
end;
|
|
|
|
Fields := TDAFieldCollection.Create(nil);
|
|
|
|
{for i := 0 to DataSet.FieldCount-1 do begin
|
|
DebugServer.Wre(DataSet.Fields[i].FieldName);
|
|
end; { for }
|
|
|
|
while not DataSet.EOF do begin
|
|
with Fields.Add() do begin
|
|
Name := DataSet.FieldByName('COLUMN_NAME').AsString;
|
|
DataType := VCLTypeToDAType(ADOTypeToFieldType(DataSet.FieldByName('DATA_TYPE').AsInteger));
|
|
Size := DataSet.FieldByName('CHARACTER_MAXIMUM_LENGTH').AsInteger;
|
|
Description := DataSet.FieldByName('DESCRIPTION').AsString;
|
|
// NotNull := DataSet.FieldByName('IS_NULLABLE').AsBoolean;
|
|
Required := not DataSet.FieldByName('IS_NULLABLE').AsBoolean;
|
|
|
|
{ Hack: for Memo fields ADO seems to return datString, with a lenght of $7fffffff }
|
|
//if (DataType = datString) and (Size = $7FFFFFFF) then
|
|
if (DataType = datString) and (Size > $100000) then
|
|
DataType := datMemo;
|
|
if (DAtaType = datWideString) and (Size > $100000) then
|
|
DataType := datWideMemo;
|
|
|
|
if DataSet.FieldByName('COLUMN_HASDEFAULT').AsBoolean then
|
|
begin
|
|
DefaultValue := DataSet.FieldByName('COLUMN_DEFAULT').AsString;
|
|
if not TestDefaultValue(DefaultValue, DataType) then
|
|
DefaultValue := '';
|
|
end;
|
|
|
|
if ADOTypeToFieldType(DataSet.FieldByName('DATA_TYPE').AsInteger) = ftGUID then begin
|
|
Size := 38; { Quickhack, until we have proper GUID support in 3.0 }
|
|
if DefaultValue = 'newid()' then DefaultValue := Unassigned;
|
|
end;
|
|
|
|
|
|
//more info available:
|
|
//'COLUMN_HASDEFAULT'
|
|
//'COLUMN_DEFAULT'
|
|
//'IS_NULLABLE'
|
|
//'DATA_TYPE'
|
|
//'CHARACTER_MAXIMUM_LENGTH'
|
|
end;
|
|
//List.Add(NameField.AsString);
|
|
DataSet.Next;
|
|
end;
|
|
|
|
if (pos('.', aTableName) > 0) and (SchemaEnabled) then
|
|
fADOConnection.OpenSchema(siPrimaryKeys, VarArrayOf([Unassigned, Copy(aTableName, 1, Pos('.', aTableName)-1), Copy(aTableName, Pos('.', aTableName)+1, MaxInt)]), EmptyParam, DataSet)
|
|
else
|
|
fADOConnection.OpenSchema(siPrimaryKeys, VarArrayOf([Unassigned, Unassigned, aTableName]), EmptyParam, DataSet);
|
|
{for i := 0 to DataSet.FieldCount-1 do begin
|
|
DebugServer.Write(DataSet.Fields[i].FieldName);
|
|
end; { for }
|
|
while not DataSet.EOF do begin
|
|
lField := Fields.FieldByName(DataSet.FieldByName('COLUMN_NAME').AsString);
|
|
if Assigned(lField) then
|
|
lField.InPrimaryKey := true;
|
|
|
|
DataSet.Next();
|
|
end;
|
|
finally
|
|
DataSet.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEADOConnection.DoGetForeignKeys(out ForeignKeys: TDADriverForeignKeyCollection);
|
|
var
|
|
//i: Integer;
|
|
DataSet: TADODataSet;
|
|
s: string;
|
|
PKSchema,FKSchema: TField;
|
|
begin
|
|
inherited;
|
|
case fProviderType of
|
|
oledb_MSSQL, oledb_MSSQL2005, oledb_MSSQL2008: MSSQL_DoGetForeignKeys(CreateCompatibleQuery, ForeignKeys, SchemaEnabled);
|
|
oledb_Postgresql: Postgres_DoGetForeignKeys(CreateCompatibleQuery, ForeignKeys);
|
|
oledb_Oracle: Oracle_DoGetForeignKeys(CreateCompatibleQuery, ForeignKeys);
|
|
else
|
|
s := UpperCase(GetProviderName);
|
|
fADOConnection.Open();
|
|
DataSet := TADODataSet.Create(nil);
|
|
try
|
|
fADOConnection.OpenSchema(siForeignKeys, EmptyParam, EmptyParam, DataSet);
|
|
{for i := 0 to DataSet.FieldCount-1 do begin
|
|
DebugServer.Write(DataSet.Fields[i].FieldName);
|
|
end; { for }
|
|
PKSchema := DataSet.FindField('PK_TABLE_SCHEMA');
|
|
FKSchema := DataSet.FindField('FK_TABLE_SCHEMA');
|
|
while not DataSet.EOF do begin
|
|
{lField := Fields.FieldByName(DataSet.FieldByName('COLUMN_NAME').AsString);
|
|
if Assigned(lField) then
|
|
lField.InPrimaryKey := true;}
|
|
with ForeignKeys.Add() do begin
|
|
FKField := DataSet.FieldByName('FK_COLUMN_NAME').AsString;
|
|
PKField := DataSet.FieldByName('PK_COLUMN_NAME').AsString;
|
|
//FKTable := DataSet.FieldByName('FK_TABLE_NAME').AsString;
|
|
//PKTable := DataSet.FieldByName('PK_TABLE_NAME').AsString;
|
|
if fSchemaEnabled and (PKSchema <> nil) and not (VarIsNull(PKSchema.Value)) then
|
|
PKTable := PKSchema.AsString + '.' + DataSet.FieldByName('PK_TABLE_NAME').AsString
|
|
else
|
|
PKTable := DataSet.FieldByName('PK_TABLE_NAME').AsString;
|
|
if fSchemaEnabled and (FKSchema <> nil) and not (VarIsNull(FKSchema.Value)) then
|
|
FKTable := FKSchema.AsString + '.' + DataSet.FieldByName('FK_TABLE_NAME').AsString
|
|
else
|
|
FKTable := DataSet.FieldByName('FK_TABLE_NAME').AsString;
|
|
|
|
end;
|
|
{DebugServer.Write(DataSet.FieldByName('FK_TABLE_NAME').AsString+'.'+DataSet.FieldByName('FK_COLUMN_NAME').AsString+' => '+
|
|
DataSet.FieldByName('PK_COLUMN_NAME').AsString);}
|
|
|
|
DataSet.Next();
|
|
end;
|
|
|
|
|
|
finally
|
|
DataSet.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEADOConnection.GetViewOrTableNames(const aType: string; const aSystemTables: boolean; List: IROStrings);
|
|
var
|
|
SchemaField,
|
|
TypeField,
|
|
NameField: TField;
|
|
TableType: string;
|
|
DataSet: TADODataSet;
|
|
begin
|
|
fADOConnection.Open();
|
|
|
|
DataSet := TADODataSet.Create(nil);
|
|
try
|
|
fADOConnection.OpenSchema(siTables, EmptyParam, EmptyParam, DataSet);
|
|
|
|
TypeField := DataSet.FieldByName('TABLE_TYPE'); { do not localize }
|
|
NameField := DataSet.FieldByName('TABLE_NAME'); { do not localize }
|
|
SchemaField := DataSet.FindField('TABLE_SCHEMA');
|
|
while not DataSet.EOF do begin
|
|
TableType := TypeField.AsString;
|
|
if (TableType = aType) or ((aType = 'TABLE') and (TableType ='ACCESS TABLE')) or (aSystemTables and (TableType = 'SYSTEM TABLE')) then
|
|
begin
|
|
if fSchemaEnabled and (SchemaField <> nil) and not (VarIsNull(SchemaField.Value)) then
|
|
List.Add(SchemaField.AsString + '.' + NameField.AsString)
|
|
else
|
|
List.Add(NameField.AsString);
|
|
end;
|
|
DataSet.Next;
|
|
end;
|
|
finally
|
|
DataSet.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEADOConnection.DoGetViewNames(out List: IROStrings);
|
|
var
|
|
Schema,NameField: TField;
|
|
DataSet: TADODataSet;
|
|
lName: string;
|
|
p: integer;
|
|
begin
|
|
inherited;
|
|
case fProviderType of
|
|
oledb_MSSQL, oledb_MSSQL2005, oledb_MSSQL2008: MSSQL_DoGetNames(CreateCompatibleQuery,List,dotView,SchemaEnabled);
|
|
oledb_Postgresql: Postgres_DoGetNames(CreateCompatibleQuery,List,dotView);
|
|
oledb_Oracle: Oracle_DoGetNames(CreateCompatibleQuery,List,dotView);
|
|
else
|
|
GetViewOrTableNames('VIEW', false, List);
|
|
fADOConnection.Open();
|
|
DataSet := TADODataSet.Create(nil);
|
|
try
|
|
fADOConnection.OpenSchema(siProcedures, EmptyParam, EmptyParam, DataSet);
|
|
NameField := DataSet.FieldByName('PROCEDURE_NAME'); { do not localize }
|
|
Schema := DataSet.Findfield('PROCEDURE_SCHEMA');
|
|
if List = nil then
|
|
List := NewROStrings();
|
|
while not DataSet.EOF do begin
|
|
lName := NameField.AsString;
|
|
if (Schema <> nil) and (Schema.Value = 'sys') then begin dataset.Next; continue; end;
|
|
p := Pos(';', lName);
|
|
if p > 1 then begin
|
|
if P+1 >= length(lName) then begin
|
|
if lName[p+1] = '1' then // procedure
|
|
begin
|
|
Dataset.Next;
|
|
continue;
|
|
end;
|
|
end;
|
|
SetLength(lName, p-1);
|
|
end;
|
|
if fSchemaEnabled and (Schema <> nil) and not (VarIsNull(Schema.Value)) then
|
|
List.Add(Schema.AsString + '.' + lName)
|
|
else
|
|
List.Add(lName);
|
|
DataSet.Next;
|
|
end;
|
|
finally
|
|
DataSet.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEADOConnection.DoGetTableNames(out List: IROStrings);
|
|
begin
|
|
inherited;
|
|
case fProviderType of
|
|
oledb_MSSQL, oledb_MSSQL2005, oledb_MSSQL2008: MSSQL_DoGetNames(CreateCompatibleQuery,List,dotTable,SchemaEnabled);
|
|
oledb_Postgresql: Postgres_DoGetNames(CreateCompatibleQuery,List,dotTable);
|
|
oledb_Oracle: Oracle_DoGetNames(CreateCompatibleQuery,List,dotTable);
|
|
else
|
|
GetViewOrTableNames('TABLE', false, List);
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEADOConnection.DoRollbackTransaction;
|
|
begin
|
|
fADOConnection.RollbackTrans
|
|
end;
|
|
|
|
function TDAEADOConnection.GetQuoteChars: TDAQuoteCharArray;
|
|
begin
|
|
case fProviderType of
|
|
oledb_Oracle: Result:= Oracle_GetQuoteChars;
|
|
else
|
|
result:=MSSQL_GetQuoteChars;
|
|
end;
|
|
end;
|
|
|
|
function TDAEADOConnection.DoGetInTransaction: boolean;
|
|
begin
|
|
result := fADOConnection.InTransaction
|
|
end;
|
|
|
|
function TDAEADOConnection.DoGetLastAutoInc(
|
|
const GeneratorName: string): integer;
|
|
var
|
|
ds: IDADataset;
|
|
begin
|
|
case fProviderType of
|
|
oledb_MSSQL, oledb_MSSQL2005, oledb_MSSQL2008: begin
|
|
Result := MSSQL_DoGetLastAutoInc(GeneratorName,CreateCompatibleQuery);
|
|
end;
|
|
oledb_Jet: begin
|
|
ds := NewDataset('SELECT @@Identity', ''); // Returns 0 by default
|
|
ds.Open;
|
|
result := ds.Fields[0].Value;
|
|
end;
|
|
oledb_Postgresql: Result := Postgres_DoGetLastAutoInc(GeneratorName,CreateCompatibleQuery);
|
|
oledb_Oracle: Result := Oracle_DoGetLastAutoInc(GeneratorName,CreateCompatibleQuery);
|
|
else
|
|
result := inherited DoGetLastAutoInc(GeneratorName);
|
|
end;
|
|
end;
|
|
|
|
function TDAEADOConnection.GetProviderName: string;
|
|
begin
|
|
result := fProviderName;
|
|
end;
|
|
|
|
function TDAEADOConnection.GetProviderType: TDAOleDBProviderType;
|
|
begin
|
|
result := fProviderType;
|
|
end;
|
|
|
|
function TDAEADOConnection.CreateMacroProcessor: TDASQLMacroProcessor;
|
|
begin
|
|
case fProviderType of
|
|
oledb_MSSQL, oledb_MSSQL2005, oledb_MSSQL2008: Result := MSSQL_CreateMacroProcessor;
|
|
oledb_Jet: result := MSSQL_CreateMacroProcessor;
|
|
oledb_Oracle: Result := Oracle_CreateMacroProcessor;
|
|
else
|
|
Result:= inherited CreateMacroProcessor;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEADOConnection.CreateTable(aDataSet: TDADataSet; const aOverrideName: string);
|
|
var
|
|
lSQL: string;
|
|
begin
|
|
lSQL := BuildCreateTableSQL(aDataSet, aOverrideName);
|
|
with NewCommand(lSQL, stSQL) do begin
|
|
Execute();
|
|
end; { with }
|
|
end;
|
|
|
|
function TDAEADOConnection.BuildCreateTableSQL(aDataSet: TDADataSet; const aOverrideName: string): string;
|
|
var
|
|
lName: string;
|
|
begin
|
|
lName := aOverrideName;
|
|
if lName = '' then lName := aDataSet.Name;
|
|
result := uDAHelpers.BuildCreateStatementForTable(aDataSet, lName, self);
|
|
end;
|
|
|
|
function TDAEADOConnection.FieldToDeclaration(aField: TDAField): string;
|
|
begin
|
|
case aField.DataType of
|
|
datUnknown: result := 'unknown';
|
|
datString: result := Format('varchar(%d)', [aField.Size]);
|
|
datDateTime: result := 'datetime';
|
|
datFloat: result := 'float';
|
|
datCurrency: result := 'money';
|
|
datAutoInc: result := 'int IDENTITY(1,1)';
|
|
datInteger: result := 'int';
|
|
datLargeInt: result := 'largeint';
|
|
datBoolean: result := 'bit';
|
|
datMemo: result := 'text';
|
|
datBlob: result := 'image';
|
|
//datGuid:result := 'uniqueidentifier';
|
|
end; { case }
|
|
end;
|
|
|
|
function TDAEADOConnection.GetDatabaseNames: IROStrings;
|
|
begin
|
|
case fProviderType of
|
|
oledb_Jet: Result := NewROStrings;
|
|
oledb_Postgresql: Result:= Postgres_GetDatabaseNames(Self);
|
|
else
|
|
Result := MSSQL_GetDatabaseNames(Self);
|
|
end;
|
|
end;
|
|
|
|
function TDAEADOConnection.GetSPSelectSyntax(
|
|
HasArguments: Boolean): String;
|
|
begin
|
|
case fProviderType of
|
|
oledb_MSSQL, oledb_MSSQL2005, oledb_MSSQL2008: Result := MSSQL_GetSPSelectSyntax(HasArguments);
|
|
oledb_Oracle: Result := Oracle_GetSPSelectSyntax(HasArguments);
|
|
oledb_Postgresql: Result:= Postgres_GetSPSelectSyntax(HasArguments);
|
|
else
|
|
Result := inherited GetSPSelectSyntax(HasArguments);
|
|
end;
|
|
end;
|
|
|
|
function TDAEADOConnection.GetCommandTimeout: Integer;
|
|
begin
|
|
if fADOConnection <> nil then
|
|
Result:= fADOConnection.CommandTimeout
|
|
else
|
|
Result:=0;
|
|
end;
|
|
|
|
procedure TDAEADOConnection.SetCommandTimeout(const Value: Integer);
|
|
begin
|
|
if fADOConnection <> nil then
|
|
fADOConnection.CommandTimeout:= Value;
|
|
end;
|
|
|
|
function TDAEADOConnection.IdentifierNeedsQuoting(
|
|
const iIdentifier: string): boolean;
|
|
begin
|
|
Result := inherited IdentifierNeedsQuoting(iIdentifier);
|
|
if not Result then
|
|
case fProviderType of
|
|
oledb_Oracle: Result:= Oracle_IdentifierNeedsQuoting(iIdentifier);
|
|
oledb_Postgresql: Result:= Postgres_IdentifierNeedsQuoting(iIdentifier);
|
|
else
|
|
Result:= MSSQL_IdentifierNeedsQuoting(iIdentifier);
|
|
end;
|
|
end;
|
|
|
|
function TDAEADOConnection.GetFileExtensions: IROStrings;
|
|
begin
|
|
case fProviderType of
|
|
oledb_Jet: Result:=MSACCESS_GetFileExtensions;
|
|
else
|
|
result := NewROStrings;
|
|
end;
|
|
end;
|
|
|
|
function TDAEADOConnection.QueryInterface(const IID: TGUID;
|
|
out Obj): HResult;
|
|
begin
|
|
Result := E_NOINTERFACE;
|
|
if IsEqualGUID(IID, IDAFileBasedDatabase) then begin
|
|
if not (fProviderType in [oledb_Jet]) then Exit;
|
|
end
|
|
else if IsEqualGUID(IID, IDACanQueryDatabaseNames) then begin
|
|
if (fProviderType in [oledb_Jet]) then Exit;
|
|
end
|
|
else if IsEqualGUID(IID, IDAUseGenerators) then begin
|
|
if not (fProviderType in [oledb_Oracle, oledb_Postgresql]) then Exit;
|
|
end
|
|
else if IsEqualGUID(IID, IDAOracleConnection) then begin
|
|
if (fProviderType <> oledb_Oracle) then Exit;
|
|
end;
|
|
|
|
Result := inherited QueryInterface(IID, Obj);
|
|
end;
|
|
|
|
function TDAEADOConnection.isAlive: Boolean;
|
|
begin
|
|
Result:=(ConnectionObject <> nil) and not (stClosed in fADOConnection.State);
|
|
end;
|
|
|
|
constructor TDAEADOConnection.Create(aDriver: TDAEDriver; aName: string);
|
|
begin
|
|
inherited Create(aDriver, aName);
|
|
fQuery_CursorType := Default_CursorType;
|
|
fQuery_CursorLocation := Default_CursorLocation;
|
|
fQuery_ADOLockType := Default_ADOLockType;
|
|
end;
|
|
|
|
function TDAEADOConnection.GetNextAutoinc(const GeneratorName: string): integer;
|
|
begin
|
|
case fProviderType of
|
|
oledb_Oracle: Result:=Oracle_GetNextAutoinc(GeneratorName,CreateCompatibleQuery);
|
|
oledb_Postgresql: Result := Postgres_GetNextAutoInc(GeneratorName,CreateCompatibleQuery);
|
|
else
|
|
Result:=-1;
|
|
end;
|
|
end;
|
|
|
|
function TDAEADOConnection.CreateCompatibleQuery: IDADataset;
|
|
begin
|
|
Result := GetDatasetClass.Create(Self);
|
|
TADOQuery(Result.Dataset).CursorLocation:=clUseClient;
|
|
end;
|
|
|
|
procedure TDAEADOConnection.DoGetStoredProcedureParams(
|
|
const aStoredProcedureName: string; out Params: TDAParamCollection);
|
|
begin
|
|
case fProviderType of
|
|
oledb_Postgresql: Postgres_DoGetStoredProcedureParams(aStoredProcedureName, CreateCompatibleQuery, Params);
|
|
oledb_Oracle: Oracle_DoGetStoredProcedureParams(aStoredProcedureName, CreateCompatibleQuery, Params);
|
|
oledb_MSSQL, oledb_MSSQL2005, oledb_MSSQL2008: MSSQL_DoGetStoredProcedureParams(aStoredProcedureName, CreateCompatibleQuery, Params);
|
|
else
|
|
inherited;
|
|
end;
|
|
end;
|
|
|
|
destructor TDAEADOConnection.Destroy;
|
|
begin
|
|
if Assigned(fADOConnection) then TDAEADODriver(Driver).UnregisterConnection(fADOConnection);
|
|
inherited;
|
|
end;
|
|
|
|
{ TDAEADODriver }
|
|
|
|
function TDAEADODriver.GetAvailableDriverOptions: TDAAvailableDriverOptions;
|
|
begin
|
|
result := [doAuxDriver, doServerName, doDatabaseName, doLogin, doCustom];
|
|
end;
|
|
|
|
function TDAEADODriver.GetConnectionClass: TDAEConnectionClass;
|
|
begin
|
|
result := TDAEADOConnection;
|
|
end;
|
|
|
|
function TDAEADODriver.GetDefaultConnectionType(
|
|
const AuxDriver: string): string;
|
|
begin
|
|
case OleDBDriverIdToOleDBProviderType(AuxDriver) of
|
|
oledb_MSSQL,
|
|
oledb_MSSQL2005,
|
|
oledb_MSSQL2008 :Result:=MSSQL_DriverType;
|
|
oledb_Jet: Result := Access_DriverType;
|
|
oledb_Oracle: Result := Oracle_DriverType;
|
|
oledb_ODBC: Result := ODBC_DriverType;
|
|
oledb_Postgresql : Result := PostgreSQL_DriverType;
|
|
oleDb_VisualFoxPro: Result := FoxPro_DriverType;
|
|
else
|
|
Result:= inherited GetDefaultConnectionType(AuxDriver);
|
|
end;
|
|
end;
|
|
|
|
function TDAEADODriver.GetDescription: string;
|
|
begin
|
|
result := 'Borland ADOExpress Driver';
|
|
end;
|
|
|
|
function TDAEADODriver.GetDriverID: string;
|
|
begin
|
|
result := 'ADO';
|
|
end;
|
|
|
|
procedure TDAEADODriver.GetAuxDrivers(out List: IROStrings);
|
|
var
|
|
i: TDAOleDBProviderType;
|
|
begin
|
|
inherited;
|
|
for i := Low(TDAOleDBProviderType) to High(TDAOleDBProviderType) do
|
|
if (i <> oledb_Unknown) {// Redundant but safe if I change the enum later...} then List.Add(OleDBProviders[i]);
|
|
end;
|
|
|
|
function TDAEADODriver.GetProviderDefaultCustomParameters(
|
|
Provider: string): string;
|
|
begin
|
|
if Sametext(Trim(Provider), oledb_MSSQL2005id) or
|
|
Sametext(Trim(Provider), oledb_MSSQL2008id) then Result := 'Schemas=1;Integrated Security=SSPI;' else
|
|
if SameText(Trim(Provider), oledb_MSSQLId) then Result := 'Integrated Security=SSPI;';
|
|
end;
|
|
|
|
procedure TDAEADODriver.GetAuxParams(const AuxDriver: string;
|
|
out List: IROStrings);
|
|
begin
|
|
inherited;
|
|
if Sametext(Trim(AuxDriver), oledb_MSSQL2005id) or
|
|
SameText(Trim(AuxDriver), oledb_MSSQLId) or
|
|
Sametext(Trim(AuxDriver), oledb_MSSQL2008id) then
|
|
MSSQL_GetAuxParams(List);
|
|
List.Add('CursorLocation=(clUseServer,clUseClient)');
|
|
List.Add('CursorType=(ctUnspecified,ctOpenForwardOnly,ctKeyset,ctDynamic,ctStatic)');
|
|
List.Add('LockType=(ltUnspecified,ltReadOnly,ltPessimistic,ltOptimistic,ltBatchOptimistic)');
|
|
List.Add('');
|
|
List.Add('You can pass any parameters directly to driver. Use the prefix ''@'' for this, e.g.:');
|
|
List.Add('CursorLocation=clUseServer;@Mode=Read');
|
|
end;
|
|
|
|
procedure TDAEADODriver.CustomizeConnectionObject(
|
|
aConnection: TDAEConnection);
|
|
begin
|
|
inherited;
|
|
if Assigned(FMonitor) then fMonitor.AssignEvents(TDAEADOConnection(aConnection).fADOConnection);
|
|
end;
|
|
|
|
constructor TDAEADODriver.Create(AOwner: TComponent);
|
|
begin
|
|
FConnectionList:= TThreadList.Create;
|
|
inherited;
|
|
end;
|
|
|
|
destructor TDAEADODriver.Destroy;
|
|
begin
|
|
inherited;
|
|
FConnectionList.Free;
|
|
end;
|
|
|
|
procedure TDAEADODriver.DoSetTraceOptions(TraceActive: boolean;
|
|
TraceFlags: TDATraceOptions; Callback: TDALogTraceEvent);
|
|
begin
|
|
inherited;
|
|
if TraceActive then begin
|
|
if (FMonitor = nil) then fMonitor := TDAADOMonitor.Create(Self);
|
|
fMonitor.Enabled := FALSE;
|
|
fMonitor.TraceFlags := TraceFlags;
|
|
FMonitor.OnCallback := Callback;
|
|
fMonitor.Enabled := TRUE;
|
|
end
|
|
else begin
|
|
if (FMonitor <> nil) then begin
|
|
fMonitor.Enabled:=False;
|
|
FreeAndNIL(fMonitor);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEADODriver.RegisterConnection(AConnection: TADOConnection);
|
|
begin
|
|
FConnectionList.Add(AConnection);
|
|
if FMonitor <> nil then FMonitor.AssignEvents(AConnection);
|
|
end;
|
|
|
|
procedure TDAEADODriver.UnregisterConnection(AConnection: TADOConnection);
|
|
begin
|
|
FConnectionList.Remove(AConnection);
|
|
if FMonitor <> nil then FMonitor.UnAssignEvents(AConnection);
|
|
end;
|
|
|
|
{ TDAEADOQuery }
|
|
|
|
procedure TDAEADOQuery.ClearParams;
|
|
begin
|
|
inherited;
|
|
TADOQuery(Dataset).Parameters.Clear;
|
|
end;
|
|
|
|
function TDAEADOQuery.CreateDataset(aConnection: TDAEConnection): TDataset;
|
|
begin
|
|
result := TADOQuery.Create(nil);
|
|
|
|
TADOQuery(result).LockType := TDAEADOConnection(aConnection).fQuery_ADOLockType;// ltReadOnly;
|
|
TADOQuery(result).CursorLocation :=TDAEADOConnection(aConnection).fQuery_CursorLocation; // clUseClient;
|
|
TADOQuery(result).CursorType := TDAEADOConnection(aConnection).fQuery_CursorType; //ctOpenForwardOnly;
|
|
TADOQuery(result).Connection := TDAEADOConnection(aConnection).fADOConnection;
|
|
TADOQuery(result).EnableBCD := False;
|
|
TADOQuery(result).CacheSize := 25;
|
|
// TADOQuery(result).Prepared := TRUE;
|
|
if TADOQuery(result).Connection <> nil then
|
|
TADOQuery(result).CommandTimeout := TADOQuery(result).Connection.CommandTimeout;
|
|
end;
|
|
|
|
function TDAEADOQuery.DoExecute: integer;
|
|
begin
|
|
result := TADOQuery(Dataset).ExecSQL;
|
|
if TADOQuery(Dataset).Connection.Errors.Count>0 then
|
|
raise Exception.Create(TADOQuery(Dataset).Connection.Errors.Item[0].Description);
|
|
end;
|
|
|
|
function TDAEADOQuery.DoGetSQL: string;
|
|
begin
|
|
result := TADOQuery(Dataset).SQL.Text;
|
|
end;
|
|
|
|
procedure TDAEADOQuery.DoSetSQL(const Value: string);
|
|
begin
|
|
TADOQuery(Dataset).SQL.Text := Value;
|
|
end;
|
|
|
|
procedure TDAEADOQuery.GetParamValues(Params: TDAParamCollection);
|
|
var
|
|
i: integer;
|
|
par: TDAParam;
|
|
inpar: TParameter;
|
|
ds: TADOQuery;
|
|
begin
|
|
ds := TADOQuery(Dataset);
|
|
if not Assigned(ds.Parameters) then
|
|
Exit;
|
|
|
|
for i := 0 to (ds.Parameters.Count - 1) do begin
|
|
inpar := ds.Parameters[i];
|
|
|
|
par := Params.ParamByName(inpar.Name);
|
|
if par.ParamType in [daptOutput, daptInputOutput, daptResult] then begin
|
|
if inpar.DataType = ftLargeint then
|
|
par.Value := DecimalToInt64(inpar.Value)
|
|
else
|
|
par.Value := inpar.Value;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEADOQuery.RefreshParams;
|
|
var
|
|
i: Integer;
|
|
par: TDAParam;
|
|
outpar: TParameter;
|
|
ds: TADOQuery;
|
|
begin
|
|
inherited;
|
|
ds := TADOQuery(Dataset);
|
|
if not Assigned(ds.Parameters) then
|
|
Exit;
|
|
for i := 0 to ds.Parameters.Count -1 do begin
|
|
outpar := ds.Parameters[i];
|
|
|
|
par := self.ParamByName(outpar.Name);
|
|
|
|
if outpar.DataType <> ftUnknown then begin
|
|
par.DataType := VCLTypeToDAType(outpar.DataType);
|
|
par.Size := outpar.Size;
|
|
par.DecimalPrecision := outpar.Precision;
|
|
par.DecimalScale := outpar.NumericScale;
|
|
case outpar.Direction of
|
|
pdInput: par.ParamType := daptInput;
|
|
pdOutput: par.ParamType := daptOutput;
|
|
pdInputOutput: par.ParamType := daptInputOutput;
|
|
pdReturnValue: par.ParamType := daptResult;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEADOQuery.SetParamValues(Params: TDAParamCollection);
|
|
var
|
|
i: integer;
|
|
par: TDAParam;
|
|
outpar: TParameter;
|
|
ds: TADOQuery;
|
|
ft: TFieldType;
|
|
begin
|
|
ds := TADOQuery(Dataset);
|
|
if not Assigned(ds.Parameters) then
|
|
Exit;
|
|
|
|
for i := 0 to (ds.Parameters.Count - 1) do begin
|
|
outpar := ds.Parameters[i];
|
|
|
|
par := Params.ParamByName(outpar.Name);
|
|
ft := DATypeToVCLType(par.DataType);
|
|
case par.ParamType of
|
|
daptInput: outpar.Direction := pdInput;
|
|
daptOutput: outpar.Direction := pdOutput;
|
|
daptInputOutput: outpar.Direction := pdInputOutput;
|
|
daptResult: outpar.Direction := pdReturnValue;
|
|
end;
|
|
|
|
if par.DataType = datBlob then begin
|
|
outpar.DataType := ftBlob;
|
|
if not (par.ParamType in [daptOutput, daptResult]) then begin
|
|
if VarIsEmpty(par.Value) or VarIsNull(par.Value)
|
|
then outpar.Value := NULL
|
|
else outpar.Value := VariantBinaryToString(par.Value);
|
|
end;
|
|
end
|
|
else begin
|
|
if (outpar.DataType <> ft) and (ft <> ftUnknown) then
|
|
outpar.DataType := ft;
|
|
if not (par.ParamType in [daptOutput, daptResult]) then begin
|
|
if outpar.DataType = ftLargeint then
|
|
Outpar.Value := Int64ToDecimal(par.Value)
|
|
else
|
|
outpar.Value := par.Value;
|
|
end;
|
|
end;
|
|
if (VarIsEmpty(par.Value) or VarIsNull(par.Value)) and
|
|
(par.DataType <> datUnknown) then begin
|
|
if (outpar.DataType <> ft) and (ft <> ftUnknown) then
|
|
outpar.DataType := ft;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TDAEADOStoredProcedure }
|
|
|
|
function TDAEADOStoredProcedure.CreateDataset(aConnection: TDAEConnection): TDataset;
|
|
begin
|
|
result := TADOStoredProc.Create(nil);
|
|
TADOStoredProc(result).Connection := TDAEADOConnection(aConnection).fADOConnection;
|
|
if TADOStoredProc(result).Connection <> nil then
|
|
TADOStoredProc(result).CommandTimeout := TADOStoredProc(result).Connection.CommandTimeout;
|
|
end;
|
|
|
|
procedure TDAEADOStoredProcedure.SetParamValues(Params: TDAParamCollection);
|
|
var
|
|
i: integer;
|
|
par: TDAParam;
|
|
outpar: TParameter;
|
|
ds: TADOStoredProc;
|
|
ft: TFieldType;
|
|
begin
|
|
ds := TADOStoredProc(Dataset);
|
|
if not Assigned(ds.Parameters) then
|
|
Exit;
|
|
|
|
for i := 0 to (ds.Parameters.Count - 1) do begin
|
|
outpar := ds.Parameters[i];
|
|
|
|
par := Params.ParamByName(outpar.Name);
|
|
ft := DATypeToVCLType(par.DataType);
|
|
case par.ParamType of
|
|
daptInput: outpar.Direction := pdInput;
|
|
daptOutput: outpar.Direction := pdOutput;
|
|
daptInputOutput: outpar.Direction := pdInputOutput;
|
|
daptResult: outpar.Direction := pdReturnValue;
|
|
end;
|
|
|
|
if par.DataType = datBlob then begin
|
|
outpar.DataType := ftBlob;
|
|
if not (par.ParamType in [daptOutput, daptResult]) then begin
|
|
if VarIsEmpty(par.Value) or VarIsNull(par.Value)
|
|
then outpar.Value := NULL
|
|
else outpar.Value := VariantBinaryToString(par.Value);
|
|
end;
|
|
end
|
|
else begin
|
|
if (outpar.DataType <> ft) and (ft <> ftUnknown) then
|
|
outpar.DataType := ft;
|
|
if not (par.ParamType in [daptOutput, daptResult]) then begin
|
|
if outpar.DataType = ftLargeint then
|
|
Outpar.Value := Int64ToDecimal(par.Value)
|
|
else
|
|
outpar.Value := par.Value;
|
|
end;
|
|
end;
|
|
if (VarIsEmpty(par.Value) or VarIsNull(par.Value)) and
|
|
(par.DataType <> datUnknown) then begin
|
|
if (outpar.DataType <> ft) and (ft <> ftUnknown) then
|
|
outpar.DataType := ft;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEADOStoredProcedure.GetParamValues(Params: TDAParamCollection);
|
|
var
|
|
i: integer;
|
|
par: TDAParam;
|
|
inpar: TParameter;
|
|
ds: TADOQuery;
|
|
begin
|
|
ds := TADOQuery(Dataset);
|
|
if not Assigned(ds.Parameters) then
|
|
Exit;
|
|
|
|
for i := 0 to (ds.Parameters.Count - 1) do begin
|
|
inpar := ds.Parameters[i];
|
|
|
|
par := Params.ParamByName(inpar.Name);
|
|
if par.ParamType in [daptOutput, daptInputOutput, daptResult] then begin
|
|
if inpar.DataType = ftLargeint then
|
|
par.Value := DecimalToInt64(inpar.Value)
|
|
else
|
|
par.Value := inpar.Value;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
type
|
|
TADOStoredProcHack = class(TADOStoredProc);
|
|
|
|
function TDAEADOStoredProcedure.Execute: integer;
|
|
var
|
|
i: integer;
|
|
pstr: string;
|
|
params: TDAParamCollection;
|
|
ds: TADOStoredProc;
|
|
lParam: TParameter;
|
|
begin
|
|
params := GetParams;
|
|
if (Connection as TDAEADOConnection).fProviderType = oledb_Oracle then pstr := '' else pstr := '@';
|
|
|
|
ds := TADOStoredProc(Dataset);
|
|
|
|
for i := ds.Parameters.Count -1 downto 0 do
|
|
begin
|
|
if (ds.Parameters[i].DataType = ftInterface) and (ds.Parameters[i].Direction in [pdOutput, pdInputOutput, pdReturnValue]) then
|
|
ds.Parameters.Delete(i);
|
|
end;
|
|
|
|
if (ds.Parameters.Count<>Params.Count) then begin
|
|
ds.Parameters.Refresh;
|
|
end;
|
|
|
|
{for i := 0 to (Parameters.Count - 1) do
|
|
if (Parameters[i].Direction in [pdInput, pdInputOutput])
|
|
then Parameters.ParamByName('@'+params[i].Name) [i].Value := params[i].Value;}
|
|
|
|
for i := 0 to (params.Count-1) do
|
|
begin
|
|
lParam:= ds.Parameters.ParamByName(pstr+params[i].Name);
|
|
if (params[i].ParamType = daptOutput) and (lParam.Direction <> pdOutput) then
|
|
lParam.Direction := pdOutput // ado sometimes doesn't set the direction properly
|
|
else if (params[i].ParamType in [daptInput, daptInputOutput]) then
|
|
lParam.Value := params[i].Value;
|
|
end;
|
|
|
|
Result := DoExecute;
|
|
|
|
{TADOStoredProcHack(Dataset).InitializeMasterFields(Self);
|
|
Command.Execute;}
|
|
|
|
{for i := 0 to (Parameters.Count - 1) do
|
|
if (Parameters[i].Direction in [pdOutput, pdInputOutput, pdReturnValue])
|
|
then params[i].Value := Parameters[i].Value;}
|
|
|
|
for i := 0 to (params.Count-1) do
|
|
if (params[i].ParamType in [daptOutput, daptInputOutput, daptResult])
|
|
then params[i].Value := ds.Parameters.ParamByName(pstr+params[i].Name).Value;
|
|
end;
|
|
|
|
function TDAEADOStoredProcedure.GetStoredProcedureName: string;
|
|
begin
|
|
result := TADOStoredProc(Dataset).ProcedureName;
|
|
end;
|
|
|
|
procedure TDAEADOStoredProcedure.SetStoredProcedureName(
|
|
const Name: string);
|
|
begin
|
|
TADOStoredProc(Dataset).ProcedureName := Name;
|
|
end;
|
|
|
|
procedure TDAEADOStoredProcedure.RefreshParams;
|
|
var
|
|
dsparams: TParameters;
|
|
dPar: TParameter;
|
|
i: integer;
|
|
par: TDAParam;
|
|
params: TDAParamCollection;
|
|
nme: string;
|
|
begin
|
|
dsparams := TADOStoredProc(Dataset).Parameters;
|
|
|
|
dsparams.Refresh;
|
|
params := GetParams;
|
|
params.Clear;
|
|
|
|
for i := 0 to (dsparams.Count - 1) do begin
|
|
par := params.Add;
|
|
dPar:=dsparams[i];
|
|
nme := dPar.Name;
|
|
if Pos('@', nme) > 0 then
|
|
System.Delete(nme, Pos('@', nme), 1);
|
|
par.Name := nme;
|
|
|
|
if (dPar.DataType = ftInterface) then
|
|
par.DataType := datUnknown
|
|
else
|
|
par.DataType := VCLTypeToDAType(dPar.DataType);
|
|
par.ParamType := TDAParamType(dPar.Direction);
|
|
par.Size := dPar.Size;
|
|
end;
|
|
end;
|
|
|
|
exports
|
|
GetDriverObject name func_GetDriverObject;
|
|
|
|
|
|
function TDAEADOStoredProcedure.DoExecute: integer;
|
|
begin
|
|
TADOStoredProcHack(TADOStoredProc(Dataset)).Command.Execute(result, EmptyParam);
|
|
|
|
if TADOStoredProc(Dataset).Connection.Errors.Count >0 then
|
|
raise Exception.Create(TADOStoredProc(Dataset).Connection.Errors.Item[0].Description);
|
|
end;
|
|
|
|
{ TDAADOMonitor }
|
|
|
|
function ParseError(const AError: Error):string;
|
|
begin
|
|
if aError = nil then begin
|
|
Result:=''
|
|
end
|
|
else begin
|
|
Result:=
|
|
'Error.Number: ' + IntToStr(AError.Number) + sLineBreak +
|
|
'Error.NativeError: ' + IntToStr(AError.NativeError) + sLineBreak +
|
|
'Error.Source: ' + AError.Source+sLineBreak +
|
|
'Error.Description: ' + AError.Description + sLineBreak +
|
|
'Error.SQLState: ' + AError.SQLState + sLineBreak;
|
|
end;
|
|
end;
|
|
|
|
function ParseCommand(Const Command: _Command): string;
|
|
var
|
|
i: integer;
|
|
{$IFDEF ADOMONITOR_SHOWPARAMVALUES}
|
|
v: Variant;
|
|
{$ENDIF}
|
|
lItem: _Parameter;
|
|
s: String;
|
|
begin
|
|
if Command = nil then begin
|
|
Result:=sLineBreak;
|
|
end
|
|
else begin
|
|
s:= PWideChar(Command.CommandText);
|
|
Result:=
|
|
'Command.CommandText: ' + StringReplace(s, sLineBreak,' ',[rfReplaceAll]) + sLineBreak +
|
|
'Command.Parameters.Count: ' + IntToStr(Command.Parameters.Count) + sLineBreak;
|
|
for i:= 0 to Command.Parameters.Count-1 do begin
|
|
lItem:=Command.Parameters.Item[i];
|
|
Result := Result + 'Command.Parameters['+intToStr(i)+ ']: '+ lItem.Name;
|
|
{$IFDEF ADOMONITOR_SHOWPARAMVALUES}
|
|
Result:= Result + ' = ';
|
|
v:=lItem.Value;
|
|
if VarIsNull(v) then Result := Result+ '<Null>'
|
|
else if VarIsEmpty(v) then Result := Result+ '<empty>'
|
|
else if lItem.Type_ in [adBinary, adVarBinary, adLongVarBinary, adLongVarChar] then Result:= Result + '<blob>'
|
|
else Result:= Result + VarToStr(v);
|
|
{$ENDIF}
|
|
Result:=Result+sLineBreak;
|
|
end;
|
|
Result:=Result+sLineBreak;
|
|
end;
|
|
end;
|
|
|
|
function ParseEventStatus(const EventStatus: TEventStatus): string;
|
|
begin
|
|
Result := 'EventStatus: ' + TEventStatusStr[EventStatus]+sLineBreak;
|
|
end;
|
|
|
|
procedure TDAADOMonitor.ADOConnectionBeginTransComplete(
|
|
Connection: TADOConnection; TransactionLevel: Integer;
|
|
const Error: Error; var EventStatus: TEventStatus);
|
|
begin
|
|
if Assigned(FOnCallback) then FOnCallback(Self,
|
|
'Begin transaction'+sLineBreak+
|
|
'-----------------'+sLineBreak+
|
|
'TransactionLevel: ' +IntToStr(TransactionLevel)+sLineBreak+
|
|
ParseError(Error)+
|
|
ParseEventStatus(EventStatus),
|
|
0);
|
|
end;
|
|
|
|
procedure TDAADOMonitor.ADOConnectionCommitTransComplete(
|
|
Connection: TADOConnection; const Error: Error;
|
|
var EventStatus: TEventStatus);
|
|
begin
|
|
if Assigned(FOnCallback) then FOnCallback(Self,
|
|
'Commit transaction'+sLineBreak+
|
|
'------------------'+sLineBreak+
|
|
ParseError(Error)+
|
|
ParseEventStatus(EventStatus),
|
|
0);
|
|
end;
|
|
|
|
procedure TDAADOMonitor.ADOConnectionConnectComplete(
|
|
Connection: TADOConnection; const Error: Error;
|
|
var EventStatus: TEventStatus);
|
|
begin
|
|
if Assigned(FOnCallback) then FOnCallback(Self,
|
|
'Connect'+sLineBreak+
|
|
'-------'+sLineBreak+
|
|
ParseError(Error)+
|
|
ParseEventStatus(EventStatus),
|
|
0);
|
|
end;
|
|
|
|
procedure TDAADOMonitor.ADOConnectionDisconnect(Connection: TADOConnection;
|
|
var EventStatus: TEventStatus);
|
|
begin
|
|
if Assigned(FOnCallback) then FOnCallback(Self,
|
|
'Disconnect'+sLineBreak+
|
|
'----------'+sLineBreak+
|
|
ParseEventStatus(EventStatus),
|
|
0);
|
|
end;
|
|
|
|
procedure TDAADOMonitor.ADOConnectionExecuteComplete(
|
|
Connection: TADOConnection; RecordsAffected: Integer; const Error: Error;
|
|
var EventStatus: TEventStatus; const Command: _Command;
|
|
const Recordset: _Recordset);
|
|
begin
|
|
if Assigned(FOnCallback) then FOnCallback(Self,
|
|
'Execute'+sLineBreak+
|
|
'-------'+sLineBreak+
|
|
'RecordsAffected: ' +IntToStr(RecordsAffected)+sLineBreak+
|
|
ParseError(Error)+
|
|
ParseEventStatus(EventStatus)+
|
|
ParseCommand(Command),
|
|
0);
|
|
end;
|
|
|
|
procedure TDAADOMonitor.ADOConnectionInfoMessage(
|
|
Connection: TADOConnection; const Error: Error;
|
|
var EventStatus: TEventStatus);
|
|
begin
|
|
if Assigned(FOnCallback) then FOnCallback(Self,
|
|
'Info message'+sLineBreak+
|
|
'------------'+sLineBreak+
|
|
ParseError(Error)+
|
|
ParseEventStatus(EventStatus),
|
|
0);
|
|
end;
|
|
|
|
procedure TDAADOMonitor.ADOConnectionRollbackTransComplete(
|
|
Connection: TADOConnection; const Error: Error;
|
|
var EventStatus: TEventStatus);
|
|
begin
|
|
if Assigned(FOnCallback) then FOnCallback(Self,
|
|
'Rollback transaction'+sLineBreak+
|
|
'-------------------'+sLineBreak+
|
|
ParseError(Error)+
|
|
ParseEventStatus(EventStatus),
|
|
0);
|
|
end;
|
|
|
|
procedure TDAADOMonitor.ADOConnectionWillConnect(
|
|
Connection: TADOConnection; var ConnectionString, UserID,
|
|
Password: WideString; var ConnectOptions: TConnectOption;
|
|
var EventStatus: TEventStatus);
|
|
begin
|
|
if Assigned(FOnCallback) then FOnCallback(Self,
|
|
'Will connect'+sLineBreak+
|
|
'------------'+sLineBreak+
|
|
'Connection string: ' + ConnectionString +sLineBreak+
|
|
'UserID: ' + UserID +sLineBreak+
|
|
'Password: ' + Password +sLineBreak+
|
|
'ConnectOptions: ' + TConnectOptionStr[ConnectOptions]+sLineBreak+
|
|
ParseEventStatus(EventStatus),
|
|
0);
|
|
end;
|
|
|
|
function getExecuteOptionStr(const ExecuteOptions: TExecuteOptions): string;
|
|
var
|
|
i: TExecuteOption;
|
|
begin
|
|
Result:='';
|
|
for i:= low(TExecuteOption) to High(TExecuteOption) do
|
|
if i in ExecuteOptions then Result:= Result + TExecuteOptionStr[i]+',';
|
|
if Length(Result) > 0 then SetLength(Result, Length(Result)-1);
|
|
end;
|
|
|
|
procedure TDAADOMonitor.ADOConnectionWillExecute(
|
|
Connection: TADOConnection; var CommandText: WideString;
|
|
var CursorType: TCursorType; var LockType: TADOLockType;
|
|
var CommandType: TCommandType; var ExecuteOptions: TExecuteOptions;
|
|
var EventStatus: TEventStatus; const Command: _Command;
|
|
const Recordset: _Recordset);
|
|
begin
|
|
if Assigned(FOnCallback) then FOnCallback(Self,
|
|
'Will execute' + sLineBreak+
|
|
'------------' + sLineBreak+
|
|
'CommandText: ' + CommandText + sLineBreak+
|
|
'CursorType: ' + TCursorTypeStr[CursorType] + sLineBreak +
|
|
'LockType: ' + TADOLockTypeStr[LockType] + sLineBreak +
|
|
'CommandType: ' + TCommandTypeStr[CommandType] + sLineBreak +
|
|
'ExecuteOptions: ' + getExecuteOptionStr(ExecuteOptions) + sLineBreak +
|
|
ParseEventStatus(EventStatus)+
|
|
ParseCommand(Command),
|
|
0);
|
|
end;
|
|
|
|
procedure TDAADOMonitor.AssignEvents(AConnection: TADOConnection);
|
|
begin
|
|
if (AConnection <> nil) and FEnabled and Assigned(FOnCallback) then begin
|
|
// if toPrepare in FTraceFlags then AConnection.
|
|
if toExecute in FTraceFlags then begin
|
|
AConnection.OnExecuteComplete := ADOConnectionExecuteComplete;
|
|
AConnection.OnWillExecute := ADOConnectionWillExecute;
|
|
end;
|
|
// if toFetch in FTraceFlags then AConnection.
|
|
if toError in FTraceFlags then begin
|
|
AConnection.OnInfoMessage := ADOConnectionInfoMessage;
|
|
end;
|
|
// if toStmt in FTraceFlags then AConnection.
|
|
if toConnect in FTraceFlags then begin
|
|
AConnection.OnConnectComplete := ADOConnectionConnectComplete;
|
|
AConnection.OnWillConnect := ADOConnectionWillConnect;
|
|
AConnection.OnDisconnect := ADOConnectionDisconnect;
|
|
end;
|
|
if toTransact in FTraceFlags then begin
|
|
AConnection.OnBeginTransComplete := ADOConnectionBeginTransComplete;
|
|
AConnection.OnCommitTransComplete := ADOConnectionCommitTransComplete;
|
|
AConnection.OnRollbackTransComplete := ADOConnectionRollbackTransComplete;
|
|
end;
|
|
// if toBlob in FTraceFlags then AConnection.
|
|
// if toService in FTraceFlags then AConnection.
|
|
// if toMisc in FTraceFlags then AConnection.
|
|
// if toParams in FTraceFlags then AConnection.
|
|
end;
|
|
end;
|
|
|
|
constructor TDAADOMonitor.Create(ADriver: TDAEADODriver);
|
|
begin
|
|
inherited Create;
|
|
FDriver := ADriver;
|
|
FEnabled := False;
|
|
end;
|
|
|
|
procedure TDAADOMonitor.ReAssignEvents;
|
|
var
|
|
i: integer;
|
|
lmode: boolean;
|
|
begin
|
|
lMode:=FEnabled and (fTraceFlags <> []) and Assigned(FOnCallback);
|
|
with FDriver.FConnectionList.LockList do try
|
|
for i:= 0 to Count-1 do
|
|
if lMode then
|
|
AssignEvents(TADOConnection(Items[i]))
|
|
else
|
|
UnAssignEvents(TADOConnection(Items[i]));
|
|
finally
|
|
FDriver.FConnectionList.UnLockList;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAADOMonitor.SetEnabled(const Value: Boolean);
|
|
begin
|
|
if FEnabled <> Value then begin
|
|
FEnabled := Value;
|
|
if FEnabled and (fTraceFlags <> []) and Assigned(FOnCallback) then ReAssignEvents;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAADOMonitor.SetOnCallback(const Value: TDALogTraceEvent);
|
|
begin
|
|
if @fOnCallback <> @Value then begin
|
|
FOnCallback := Value;
|
|
if FEnabled and (fTraceFlags <> []) and Assigned(FOnCallback) then ReAssignEvents;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAADOMonitor.SetTraceFlags(const Value: TDATraceOptions);
|
|
begin
|
|
if FTraceFlags <> Value then begin
|
|
FTraceFlags := Value;
|
|
if FEnabled and (fTraceFlags <> []) and Assigned(FOnCallback) then ReAssignEvents;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAADOMonitor.UnAssignEvents(AConnection: TADOConnection);
|
|
begin
|
|
if AConnection <> nil then begin
|
|
// toTransact
|
|
AConnection.OnBeginTransComplete := nil;
|
|
AConnection.OnCommitTransComplete := nil;
|
|
AConnection.OnRollbackTransComplete := nil;
|
|
|
|
//toConnect
|
|
AConnection.OnConnectComplete := nil;
|
|
AConnection.OnWillConnect := nil;
|
|
AConnection.OnDisconnect := nil;
|
|
|
|
//toExecute
|
|
AConnection.OnExecuteComplete := nil;
|
|
AConnection.OnWillExecute := nil;
|
|
|
|
//toError
|
|
AConnection.OnInfoMessage := nil;
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
_driver := nil;
|
|
RegisterDriverProc(GetDriverObject);
|
|
finalization
|
|
UnregisterDriverProc(GetDriverObject);
|
|
FreeAndNIL(_driver);
|
|
end.
|