david
397cad2594
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@2 b6239004-a887-0f4b-9937-50029ccdca16
1254 lines
42 KiB
ObjectPascal
1254 lines
42 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.
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$I ..\DataAbstract.inc}
|
|
|
|
{$R DataAbstract_ADODriver_Glyphs.res}
|
|
|
|
interface
|
|
|
|
uses DB, uDAEngine, uDAInterfaces, uDAADOInterfaces, uROClasses, ADODB,
|
|
uDAInterfacesEx, uDAUtils;
|
|
|
|
type { TDAADODriver }
|
|
TDAADODriver = class(TDADriverReference)
|
|
end;
|
|
|
|
{ TDAEADODriver }
|
|
TDAEADODriver = class(TDAEDriver, IDADriver40)
|
|
protected
|
|
function GetConnectionClass: TDAEConnectionClass; 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
|
|
end;
|
|
|
|
{ TDAEADOConnection }
|
|
TDAEADOConnection = class(TDAEConnection, IDAADOConnection, IDAConnectionModelling, IDACanQueryDatabaseNames,IDAFileBasedDatabase,IDAUseGenerators)
|
|
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);
|
|
|
|
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 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;
|
|
property SchemaEnabled: Boolean read fSchemaEnabled write fSchemaEnabled;
|
|
end;
|
|
|
|
{ TDAEADOQuery }
|
|
TDAEADOQuery = class(TDAEDataset, IDAMustSetParams)
|
|
private
|
|
|
|
protected
|
|
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); safecall;
|
|
procedure RefreshParams; override; safecall;
|
|
procedure GetParamValues(Params: TDAParamCollection); safecall;
|
|
|
|
public
|
|
end;
|
|
|
|
{ TDAEADOStoredProcedure }
|
|
TDAEADOStoredProcedure = class(TDAEStoredProcedure, IDAMustSetParams)
|
|
protected
|
|
function CreateDataset(aConnection: TDAEConnection): TDataset; override;
|
|
|
|
procedure RefreshParams; override;
|
|
function GetStoredProcedureName: string; override;
|
|
procedure SetStoredProcedureName(const Name: string); override;
|
|
function Execute: integer; override;
|
|
|
|
// IDAMustSetParams
|
|
procedure SetParamValues(Params: TDAParamCollection); safecall;
|
|
procedure GetParamValues(Params: TDAParamCollection); safecall;
|
|
end;
|
|
|
|
procedure Register;
|
|
|
|
function GetDriverObject: IDADriver; stdcall;
|
|
|
|
implementation
|
|
|
|
uses Classes, SysUtils, uDADriverManager, uDARes, Variants, ADOInt, uDAMacroProcessors,
|
|
Math, uDAHelpers, uROBinaryHelpers, Windows, uDAOracleInterfaces,uDAPostgresInterfaces;
|
|
|
|
const
|
|
Default_CursorType = ctOpenForwardOnly;
|
|
Default_CursorLocation = clUseServer;
|
|
Default_ADOLockType = ltReadOnly;
|
|
|
|
|
|
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'));
|
|
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;
|
|
|
|
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: MSSQL_DoGetNames(GetDatasetClass.Create(Self),List,dotProcedure,SchemaEnabled);
|
|
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: MSSQL_DoGetTableFields(QuoteIdentifierIfNeeded(aTableName),GetDatasetClass.Create(Self),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:
|
|
MSSQL_DoGetForeignKeys(GetDatasetClass.Create(Self), ForeignKeys, SchemaEnabled);
|
|
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: MSSQL_DoGetNames(GetDatasetClass.Create(Self),List,dotView,SchemaEnabled);
|
|
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: MSSQL_DoGetNames(GetDatasetClass.Create(Self),List,dotTable,SchemaEnabled);
|
|
else
|
|
GetViewOrTableNames('TABLE', false, List);
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEADOConnection.DoRollbackTransaction;
|
|
begin
|
|
fADOConnection.RollbackTrans
|
|
end;
|
|
|
|
function TDAEADOConnection.GetQuoteChars: TDAQuoteCharArray;
|
|
begin
|
|
result:=MSSQL_GetQuoteChars;
|
|
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: begin
|
|
Result := MSSQL_DoGetLastAutoInc(GeneratorName,GetDatasetClass.Create(Self));
|
|
end;
|
|
oledb_Jet: begin
|
|
ds := NewDataset('SELECT @@Identity', ''); // Returns 0 by default
|
|
ds.Open;
|
|
result := ds.Fields[0].Value;
|
|
end;
|
|
oledb_Postgresql: Result := Postgres_GetNextAutoInc(GeneratorName,GetDatasetClass.Create(Self));
|
|
oledb_Oracle: Result := Oracle_DoGetLastAutoInc(GeneratorName,GetDatasetClass.Create(Self));
|
|
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: 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;
|
|
else
|
|
Result := MSSQL_GetDatabaseNames(Self);
|
|
end;
|
|
end;
|
|
|
|
function TDAEADOConnection.GetSPSelectSyntax(
|
|
HasArguments: Boolean): String;
|
|
begin
|
|
case fProviderType of
|
|
oledb_MSSQL, oledb_MSSQL2005: Result := MSSQL_GetSPSelectSyntax(HasArguments);
|
|
oledb_Oracle: Result := Oracle_GetSPSelectSyntax(HasArguments);
|
|
oledb_Postgresql: if HasArguments then Result := 'SELECT * FROM {0}({1})' else result := 'SELECT * FROM {0}';
|
|
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) or MSSQL_IdentifierNeedsQuoting(iIdentifier);
|
|
end;
|
|
|
|
function TDAEADOConnection.GetFileExtensions: IROStrings;
|
|
begin
|
|
result := NewROStrings;
|
|
case fProviderType of
|
|
oledb_Jet: begin
|
|
result.Add('*.mdb;MSAccess files (*.mdb)');
|
|
result.Add('*.*;All files (*.*)');
|
|
end;
|
|
else
|
|
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]) 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,GetDatasetClass.Create(Self));
|
|
else
|
|
Result:=-1;
|
|
end;
|
|
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 :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) 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) 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;
|
|
|
|
{ TDAEADOQuery }
|
|
|
|
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).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;
|
|
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
|
|
if (params[i].ParamType = daptOutput) and (ds.Parameters[i].Direction <> pdOutput) then
|
|
ds.Parameters[i].Direction := pdOutput // ado sometimes doesn't set the direction properly
|
|
else
|
|
if (params[i].ParamType in [daptInput, daptInputOutput])
|
|
then ds.Parameters.ParamByName(pstr+params[i].Name).Value := params[i].Value;
|
|
end;
|
|
|
|
TADOStoredProcHack(ds).Command.Execute(result, EmptyParam);
|
|
|
|
if ds.Connection.Errors.Count>0
|
|
then raise Exception.Create(ds.Connection.Errors.Item[0].Description);
|
|
|
|
{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;
|
|
i: integer;
|
|
par: TDAParam;
|
|
params: TDAParamCollection;
|
|
nme: string;
|
|
begin
|
|
// Must override completely because the parameters' size is not reflected correctly via IProviderSupport!!
|
|
dsparams := TADOStoredProc(Dataset).Parameters;
|
|
|
|
dsparams.Refresh;
|
|
params := GetParams;
|
|
params.Clear;
|
|
|
|
for i := 0 to (dsparams.Count - 1) do begin
|
|
par := params.Add;
|
|
|
|
if (dsparams[i].DataType = ftInterface) and (dsParams[I].Direction in [pdOutput, pdInputOutput, pdReturnValue]) then
|
|
Continue;
|
|
nme := dsparams[i].Name;
|
|
if Pos('@', nme) > 0 then
|
|
System.Delete(nme, Pos('@', nme), 1);
|
|
par.Name := nme;
|
|
|
|
par.DataType := VCLTypeToDAType(dsparams[i].DataType);
|
|
par.ParamType := TDAParamType(dsparams[i].Direction);
|
|
par.Size := dsparams[i].Size;
|
|
end;
|
|
end;
|
|
|
|
exports
|
|
GetDriverObject name func_GetDriverObject;
|
|
|
|
|
|
initialization
|
|
_driver := nil;
|
|
RegisterDriverProc(GetDriverObject);
|
|
finalization
|
|
UnregisterDriverProc(GetDriverObject);
|
|
FreeAndNIL(_driver);
|
|
end.
|