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.