778 lines
28 KiB
ObjectPascal
778 lines
28 KiB
ObjectPascal
/// UniDAC-based classes for SynDB units
|
|
// - this unit is a part of the freeware Synopse framework,
|
|
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
|
|
unit SynDBUniDAC;
|
|
|
|
{
|
|
This file is part of Synopse framework.
|
|
|
|
Synopse framework. Copyright (C) 2022 Arnaud Bouchez
|
|
Synopse Informatique - https://synopse.info
|
|
|
|
*** BEGIN LICENSE BLOCK *****
|
|
Version: MPL 1.1/GPL 2.0/LGPL 2.1
|
|
|
|
The contents of this file are subject to the Mozilla Public License Version
|
|
1.1 (the "License"); you may not use this file except in compliance with
|
|
the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
|
for the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is Synopse mORMot framework.
|
|
|
|
The Initial Developer of the Original Code is Arnaud Bouchez.
|
|
|
|
Portions created by the Initial Developer are Copyright (C) 2022
|
|
the Initial Developer. All Rights Reserved.
|
|
|
|
Contributor(s):
|
|
- alexpirate
|
|
- delphinium (louisyeow)
|
|
- itSDS
|
|
- milesyou
|
|
|
|
Alternatively, the contents of this file may be used under the terms of
|
|
either the GNU General Public License Version 2 or later (the "GPL"), or
|
|
the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
|
|
in which case the provisions of the GPL or the LGPL are applicable instead
|
|
of those above. If you wish to allow use of your version of this file only
|
|
under the terms of either the GPL or the LGPL, and not to allow others to
|
|
use your version of this file under the terms of the MPL, indicate your
|
|
decision by deleting the provisions above and replace them with the notice
|
|
and other provisions required by the GPL or the LGPL. If you do not delete
|
|
the provisions above, a recipient may use your version of this file under
|
|
the terms of any one of the MPL, the GPL or the LGPL.
|
|
|
|
***** END LICENSE BLOCK *****
|
|
|
|
}
|
|
|
|
{$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows,
|
|
SysUtils,
|
|
{$IFNDEF DELPHI5OROLDER}
|
|
Variants,
|
|
{$ENDIF}
|
|
Classes,
|
|
Contnrs,
|
|
SynCommons,
|
|
SynTable,
|
|
SynLog,
|
|
SynDB,
|
|
SynDBDataset,
|
|
SynOleDB, // for CoInit/CoUnInit
|
|
Uni,
|
|
UniProvider,
|
|
UniScript;
|
|
|
|
|
|
{ -------------- UniDAC database access }
|
|
|
|
const
|
|
cMSSQLProvider = 'prDirect';
|
|
|
|
type
|
|
/// Exception type associated to UniDAC database access
|
|
ESQLDBUniDAC = class(ESQLDBDataset);
|
|
|
|
|
|
/// connection properties definition using UniDAC database access
|
|
TSQLDBUniDACConnectionProperties = class(TSQLDBDatasetConnectionProperties)
|
|
protected
|
|
fSpecificOptions: TStringList;
|
|
/// initialize fForeignKeys content with all foreign keys of this DB
|
|
// - do nothing by now (UniDAC metadata may be used in the future)
|
|
procedure GetForeignKeys; override;
|
|
public
|
|
/// initialize the properties to connect via UniDAC database access
|
|
// - aServerName shall contain the UniDAC provider name, e.g. 'Oracle' - you
|
|
// can use the TSQLDBUniDACConnectionProperties.URI() to retrieve the
|
|
// provider name from its SynDB.TSQLDBDefinition enumeration, and optionally
|
|
// set some options, which will be added to the internal SpecificOptions[]:
|
|
// ! 'Oracle?ClientLibrary=oci64\oci.dll'
|
|
// ! 'MySQL?Server=192.168.2.60;Port=3306', 'world', 'root', 'dev'
|
|
// - aDatabaseName shall contain the database server name
|
|
constructor Create(const aServerName, aDatabaseName, aUserID, aPassWord: RawUTF8); override;
|
|
/// release internal structures
|
|
destructor Destroy; override;
|
|
/// create a new connection
|
|
// - caller is responsible of freeing this instance
|
|
// - this overridden method will create an TSQLDBUniDACConnection instance
|
|
function NewConnection: TSQLDBConnection; override;
|
|
|
|
/// compute the UniDAC URI from a given database engine and server name
|
|
// - the optional server name can contain a port number, specified after ':'
|
|
// - you can set an optional full path to the client library name,
|
|
// to be completed on the left side with the executable path
|
|
// - possible use may be:
|
|
// ! PropsOracle := TSQLDBUniDACConnectionProperties.Create(
|
|
// ! TSQLDBUniDACConnectionProperties.URI(dOracle,'','oci64\oci.dll'),
|
|
// ! 'tnsname','user',pass');
|
|
// ! PropsFirebird := TSQLDBUniDACConnectionProperties.Create(
|
|
// ! TSQLDBUniDACConnectionProperties.URI(dFirebird,'',
|
|
// ! 'Firebird\fbembed.dll'),'databasefilename','','');
|
|
// ! PropsMySQL := TSQLDBUniDACConnectionProperties.Create(
|
|
// ! TSQLDBUniDACConnectionProperties.URI(dMySQL,'192.168.2.60:3306'),
|
|
// ! 'world', 'root', 'dev');
|
|
class function URI(aServer: TSQLDBDefinition; const aServerName: RawUTF8;
|
|
const aLibraryLocation: TFileName='';
|
|
aLibraryLocationAppendExePath: boolean=true): RawUTF8;
|
|
|
|
/// retrieve the column/field layout of a specified table
|
|
// - this overridden method will use UniDAC metadata to retrieve the information
|
|
procedure GetFields(const aTableName: RawUTF8; out Fields: TSQLDBColumnDefineDynArray); override;
|
|
/// get all table names
|
|
// - this overridden method will use UniDAC metadata to retrieve the information
|
|
procedure GetTableNames(out Tables: TRawUTF8DynArray); override;
|
|
/// retrieve the advanced indexed information of a specified Table
|
|
// - this overridden method will use UniDAC metadata to retrieve the information
|
|
procedure GetIndexes(const aTableName: RawUTF8; out Indexes: TSQLDBIndexDefineDynArray); override;
|
|
/// allow to set the options specific to a UniDAC driver
|
|
// - for instance, you can set for both SQLite3 and Firebird/Interbase:
|
|
// ! Props.SpecificOptions.Values['ClientLibrary'] := ClientDllName;
|
|
property SpecificOptions: TStringList read fSpecificOptions;
|
|
end;
|
|
|
|
|
|
/// implements a direct connection via UniDAC database access
|
|
TSQLDBUniDACConnection = class(TSQLDBConnectionThreadSafe)
|
|
protected
|
|
fDatabase: TUniConnection;
|
|
public
|
|
/// prepare a connection for a specified UniDAC database access
|
|
constructor Create(aProperties: TSQLDBConnectionProperties); override;
|
|
/// release memory and connection
|
|
destructor Destroy; override;
|
|
/// connect to the specified database server using UniDAC
|
|
// - should raise an ESQLDBUniDAC on error
|
|
procedure Connect; override;
|
|
/// stop connection to the specified database server using UniDAC
|
|
// - should raise an ESQLDBUniDAC on error
|
|
procedure Disconnect; override;
|
|
/// return TRUE if Connect has been already successfully called
|
|
function IsConnected: boolean; override;
|
|
/// create a new statement instance
|
|
function NewStatement: TSQLDBStatement; override;
|
|
/// begin a Transaction for this connection
|
|
procedure StartTransaction; override;
|
|
/// commit changes of a Transaction for this connection
|
|
// - StartTransaction method must have been called before
|
|
procedure Commit; override;
|
|
/// discard changes of a Transaction for this connection
|
|
// - StartTransaction method must have been called before
|
|
procedure Rollback; override;
|
|
/// access to the associated UniDAC connection instance
|
|
property Database: TUniConnection read fDatabase;
|
|
end;
|
|
|
|
/// implements a statement via a UniDAC connection
|
|
TSQLDBUniDACStatement = class(TSQLDBDatasetStatement)
|
|
protected
|
|
fBatchExecute: Boolean;
|
|
/// initialize and set fQuery: TUniQuery internal field as expected
|
|
procedure DatasetCreate; override;
|
|
/// set fQueryParams internal field as expected
|
|
function DatasetPrepare(const aSQL: string): boolean; override;
|
|
/// execute underlying TUniQuery.ExecSQL
|
|
procedure DatasetExecSQL; override;
|
|
/// overriden by itSDS to properly handle UniDAC parameters
|
|
procedure DataSetBindSQLParam(const aArrayIndex, aParamIndex: integer; const aParam: TSQLDBParam); override;
|
|
public
|
|
end;
|
|
|
|
|
|
const
|
|
/// UniDAC provider names corresponding to SynDB recognized SQL engines
|
|
UNIDAC_PROVIDER: array[dOracle..high(TSQLDBDefinition)] of RawUTF8 = (
|
|
'Oracle','SQL Server','Access','MySQL','SQLite','InterBase',
|
|
'NexusDB','PostgreSQL','DB2','');
|
|
|
|
implementation
|
|
|
|
uses
|
|
DAScript, CRDataTypeMap, DBAccess;
|
|
|
|
|
|
{ TSQLDBUniDACConnectionProperties }
|
|
|
|
constructor TSQLDBUniDACConnectionProperties.Create(const aServerName, aDatabaseName, aUserID, aPassWord: RawUTF8);
|
|
var p: TSQLDBDefinition;
|
|
provider,options,namevalue: RawUTF8;
|
|
opt: PUTF8Char;
|
|
begin
|
|
Split(aServerName,'?',provider,options);
|
|
for p := Low(UNIDAC_PROVIDER) to high(UNIDAC_PROVIDER) do
|
|
if SameTextU(UNIDAC_PROVIDER[p],provider) then begin
|
|
fDBMS := p;
|
|
break;
|
|
end;
|
|
inherited Create(provider,aDatabaseName,aUserID,aPassWord);
|
|
fOnBatchInsert := nil; // MultipleValuesInsert is slower
|
|
fSpecificOptions := TStringList.Create;
|
|
opt := pointer(options);
|
|
while opt<>nil do begin
|
|
GetNextItem(opt,';',namevalue);
|
|
if namevalue<>'' then
|
|
fSpecificOptions.Add(UTF8ToString(namevalue));
|
|
end;
|
|
case fDBMS of
|
|
dSQLite: begin // UniDAC support of SQLite3 is just buggy
|
|
{$ifdef FPC}
|
|
fSpecificOptions.Values['UseUnicode'] := 'true'; // FPC strings do like UTF8
|
|
{$else}
|
|
{$ifndef UNICODE}
|
|
fForceUseWideString := true; // for non-unicode Delphi
|
|
{$endif}
|
|
{$endif}
|
|
fSpecificOptions.Values['ForceCreateDatabase'] := 'true';
|
|
fSQLCreateField[ftInt64] := ' BIGINT'; // SQLite3 INTEGER = 32bit for UniDAC
|
|
end;
|
|
dFirebird: begin
|
|
{$ifdef FPC}
|
|
fSpecificOptions.Values['UseUnicode'] := 'true'; // FPC strings do like UTF8
|
|
{$else}
|
|
{$ifndef UNICODE}
|
|
fForceUseWideString := true; // for non-unicode Delphi
|
|
{$endif}
|
|
{$endif}
|
|
fSpecificOptions.Values['CharSet'] := 'UTF8';
|
|
fSpecificOptions.Values['CharLength'] := '2';
|
|
fSpecificOptions.Values['DescribeParams'] := 'true';
|
|
end; // http://www.devart.com/unidac/docs/index.html?ibprov_article.htm
|
|
dOracle: begin
|
|
{$ifdef FPC}
|
|
fSpecificOptions.Values['UseUnicode'] := 'true'; // FPC strings do like UTF8
|
|
{$else}
|
|
{$ifndef UNICODE}
|
|
fForceUseWideString := true; // for non-unicode Delphi
|
|
{$endif}
|
|
{$endif}
|
|
fSpecificOptions.Values['Direct'] := 'true';
|
|
fSpecificOptions.Values['HOMENAME'] := '';
|
|
end;
|
|
dMySQL: begin
|
|
{$ifdef FPC}
|
|
fSpecificOptions.Values['UseUnicode'] := 'true'; // FPC strings do like UTF8
|
|
{$else}
|
|
{$ifndef UNICODE}
|
|
fForceUseWideString := true; // for non-unicode Delphi
|
|
{$endif}
|
|
{$endif}
|
|
// s.d. 30.11.19 Damit der Connect schneller geht ! CRVioTCP.pas WaitForConnect
|
|
fSpecificOptions.Values['MySQL.ConnectionTimeout'] := '0';
|
|
end;
|
|
dMSSQL: begin
|
|
{$ifndef UNICODE}
|
|
{$ifndef FPC}
|
|
fForceUseWideString := true; // for non-unicode Delphi
|
|
{$endif}
|
|
{$endif}
|
|
if aUserID='' then
|
|
fSpecificOptions.Values['Authentication'] := 'auWindows';
|
|
fSpecificOptions.Values['SQL Server.Provider'] := cMSSQLProvider;
|
|
// s.d. 30.11.19 Damit der Connect im Direct Mode so Schnell ist wie mit prAuto/OleDB
|
|
fSpecificOptions.Values['SQL Server.ConnectionTimeout'] := '0';
|
|
end; // http://www.devart.com/unidac/docs/index.html?sqlprov_article.htm
|
|
dPostgreSQL: begin // thanks delphinium for the trick!
|
|
{$ifdef FPC}
|
|
fSpecificOptions.Values['UseUnicode'] := 'true'; // FPC strings do like UTF8
|
|
{$else}
|
|
{$ifndef UNICODE}
|
|
fForceUseWideString := true; // for non-unicode Delphi
|
|
{$endif}
|
|
{$endif}
|
|
fSpecificOptions.Values['CharSet'] := 'UTF8';
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
destructor TSQLDBUniDACConnectionProperties.Destroy;
|
|
begin
|
|
fSpecificOptions.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TSQLDBUniDACConnectionProperties.GetFields(
|
|
const aTableName: RawUTF8; out Fields: TSQLDBColumnDefineDynArray);
|
|
var meta: TDAMetaData;
|
|
n: integer;
|
|
F: TSQLDBColumnDefine;
|
|
FA: TDynArray;
|
|
hasSubType: boolean;
|
|
Owner,Table: RawUTF8;
|
|
begin
|
|
meta := (MainConnection as TSQLDBUniDACConnection).fDatabase.CreateMetaData;
|
|
try
|
|
FA.Init(TypeInfo(TSQLDBColumnDefineDynArray),Fields,@n);
|
|
FA.Compare := SortDynArrayAnsiStringI; // FA.Find() case insensitive
|
|
FillChar(F,sizeof(F),0);
|
|
meta.MetaDataKind := 'Columns';
|
|
Split(aTableName,'.',Owner,Table);
|
|
if Table='' then begin
|
|
Table := Owner;
|
|
Owner := '';
|
|
end;
|
|
if (Owner='') and (fDBMS<>dOracle) then
|
|
Owner := MainConnection.Properties.DatabaseName; // itSDS
|
|
if Owner<>'' then
|
|
meta.Restrictions.Values['TABLE_SCHEMA'] := UTF8ToString(UpperCase(Owner)) else
|
|
meta.Restrictions.Values['SCOPE'] := 'LOCAL';
|
|
meta.Restrictions.Values['TABLE_NAME'] := UTF8ToString(UpperCase(Table));
|
|
meta.Open;
|
|
hasSubType := meta.FindField('DATA_SUBTYPE')<>nil;
|
|
while not meta.Eof do begin
|
|
F.ColumnName := StringToUTF8(meta.FieldByName('COLUMN_NAME').AsString);
|
|
F.ColumnTypeNative := StringToUTF8(meta.FieldByName('DATA_TYPE').AsString);
|
|
if hasSubType then
|
|
F.ColumnTypeNative := F.ColumnTypeNative+
|
|
StringToUTF8(meta.FieldByName('DATA_SUBTYPE').AsString);
|
|
F.ColumnLength := meta.FieldByName('DATA_LENGTH').AsInteger;
|
|
F.ColumnScale := meta.FieldByName('DATA_SCALE').AsInteger;
|
|
F.ColumnPrecision := meta.FieldByName('DATA_PRECISION').AsInteger;
|
|
F.ColumnType := ColumnTypeNativeToDB(F.ColumnTypeNative,F.ColumnScale);
|
|
if F.ColumnType=ftUnknown then begin // UniDAC metadata failed -> use SQL
|
|
Fields := nil;
|
|
inherited GetFields(aTableName,Fields);
|
|
exit;
|
|
end;
|
|
FA.Add(F);
|
|
meta.Next;
|
|
end;
|
|
Setlength(Fields,n);
|
|
GetIndexesAndSetFieldsColumnIndexed(aTableName,Fields);
|
|
finally
|
|
meta.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TSQLDBUniDACConnectionProperties.GetIndexes(
|
|
const aTableName: RawUTF8; out Indexes: TSQLDBIndexDefineDynArray);
|
|
var meta, indexs: TDAMetaData;
|
|
F: TSQLDBIndexDefine;
|
|
FA: TDynArray;
|
|
n: integer;
|
|
ColName: RawUTF8;
|
|
ndxName: string;
|
|
Owner,Table: RawUTF8;
|
|
begin
|
|
SetLength(Indexes,0);
|
|
FA.Init(TypeInfo(TSQLDBIndexDefineDynArray),Indexes,@n);
|
|
fillchar(F,sizeof(F),0);
|
|
meta := (MainConnection as TSQLDBUniDACConnection).fDatabase.CreateMetaData;
|
|
indexs := (MainConnection as TSQLDBUniDACConnection).fDatabase.CreateMetaData;
|
|
try
|
|
meta.MetaDataKind := 'Indexes';
|
|
Split(aTableName,'.',Owner,Table);
|
|
if Table='' then begin
|
|
Table := Owner;
|
|
Owner := '';
|
|
end;
|
|
if (Owner='') and (fDBMS<>dOracle) then
|
|
Owner := MainConnection.Properties.DatabaseName; // itSDS
|
|
if Owner<>'' then
|
|
meta.Restrictions.Values['TABLE_SCHEMA'] := UTF8ToString(UpperCase(Owner)) else
|
|
meta.Restrictions.Values['SCOPE'] := 'LOCAL';
|
|
meta.Restrictions.Values['TABLE_NAME'] := UTF8ToString(UpperCase(Table));
|
|
meta.Open;
|
|
while not meta.Eof do begin
|
|
ndxName := meta.FieldByName('INDEX_NAME').AsString;
|
|
F.IndexName := StringToUTF8(ndxName);
|
|
F.KeyColumns := '';
|
|
indexs.MetaDataKind := 'indexcolumns';
|
|
if Owner<>'' then
|
|
indexs.Restrictions.Values['TABLE_SCHEMA'] := UTF8ToString(UpperCase(Owner)) else
|
|
indexs.Restrictions.Values['SCOPE'] := 'LOCAL';
|
|
indexs.Restrictions.Values['TABLE_NAME'] := UTF8ToString(UpperCase(Table));
|
|
indexs.Restrictions.Values['INDEX_NAME'] := ndxName;
|
|
indexs.Open;
|
|
while not indexs.Eof do begin
|
|
ColName := StringToUTF8(indexs.FieldByName('COLUMN_NAME').AsString);
|
|
if F.KeyColumns='' then
|
|
F.KeyColumns := ColName else
|
|
F.KeyColumns := F.KeyColumns+','+ColName;
|
|
indexs.Next;
|
|
end;
|
|
FA.Add(f);
|
|
indexs.Close;
|
|
meta.Next;
|
|
end;
|
|
SetLength(Indexes,n);
|
|
finally
|
|
indexs.Free;
|
|
meta.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TSQLDBUniDACConnectionProperties.GetForeignKeys;
|
|
var conn: TUniConnection;
|
|
begin
|
|
conn := (MainConnection as TSQLDBUniDACConnection).Database;
|
|
if conn=nil then
|
|
exit;
|
|
{ TODO : get FOREIGN KEYS from UniDAC metadata ? }
|
|
end;
|
|
|
|
procedure TSQLDBUniDACConnectionProperties.GetTableNames(out Tables: TRawUTF8DynArray);
|
|
var List: TStringList;
|
|
begin
|
|
List := TStringList.Create;
|
|
try
|
|
(MainConnection as TSQLDBUniDACConnection).fDatabase.GetTableNames(List);
|
|
StringListToRawUTF8DynArray(List,Tables);
|
|
exit;
|
|
finally
|
|
List.Free;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
function TSQLDBUniDACConnectionProperties.NewConnection: TSQLDBConnection;
|
|
begin
|
|
result := TSQLDBUniDACConnection.Create(self);
|
|
end;
|
|
|
|
class function TSQLDBUniDACConnectionProperties.URI(aServer: TSQLDBDefinition;
|
|
const aServerName: RawUTF8; const aLibraryLocation: TFileName;
|
|
aLibraryLocationAppendExePath: boolean): RawUTF8;
|
|
var Server,Port: RawUTF8;
|
|
begin
|
|
if aServer<low(UNIDAC_PROVIDER) then
|
|
result := '' else
|
|
result := UNIDAC_PROVIDER[aServer];
|
|
if result='' then
|
|
exit;
|
|
if aLibraryLocation<>'' then begin
|
|
result := result+'?ClientLibrary=';
|
|
if aLibraryLocationAppendExePath then
|
|
result := result+StringToUTF8(ExeVersion.ProgramFilePath);
|
|
result := result+StringToUTF8(aLibraryLocation);
|
|
end;
|
|
if aServerName<>'' then begin
|
|
Split(aServerName,':',Server,Port);
|
|
if aLibraryLocation='' then
|
|
result := result+'?' else
|
|
result := result+';';
|
|
result := result+'Server='+Server;
|
|
if Port<>'' then
|
|
result := result+';Port='+Port;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TSQLDBUniDACConnection }
|
|
|
|
procedure TSQLDBUniDACConnection.Commit;
|
|
begin
|
|
inherited Commit;
|
|
try
|
|
fDatabase.Commit;
|
|
except
|
|
inc(fTransactionCount); // the transaction is still active
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
constructor TSQLDBUniDACConnection.Create(aProperties: TSQLDBConnectionProperties);
|
|
var options: TStrings;
|
|
PortNumber, i: Integer;
|
|
begin
|
|
inherited Create(aProperties);
|
|
if (aProperties.DBMS = dMSSQL) and (not SameText(cMSSQLProvider, 'prDirect')) then
|
|
CoInit;
|
|
fDatabase := TUniConnection.Create(nil);
|
|
fDatabase.LoginPrompt := false;
|
|
fDatabase.ProviderName := UTF8ToString(fProperties.ServerName);
|
|
case aProperties.DBMS of
|
|
dSQLite, dFirebird, dPostgreSQL, dMySQL, dDB2, dMSSQL:
|
|
fDatabase.Database := UTF8ToString(fProperties.DatabaseName);
|
|
else
|
|
fDatabase.Server := UTF8ToString(fProperties.DatabaseName);
|
|
end;
|
|
fDatabase.Username := UTF8ToString(fProperties.UserID);
|
|
fDatabase.Password := UTF8ToString(fProperties.PassWord);
|
|
if aProperties.DBMS = dMySQL then
|
|
// s.d. 30.11.19 Damit der Connect schneller geht
|
|
fDatabase.SpecificOptions.Add('MySQL.ConnectionTimeout=0');
|
|
if aProperties.DBMS = dMSSQL then begin
|
|
fDatabase.SpecificOptions.Add('SQL Server.Provider='+cMSSQLProvider);
|
|
// s.d. 30.11.19 Damit der Connect im Direct Mode so Schnell ist wie mit prAuto/OleDB
|
|
fDatabase.SpecificOptions.Add('SQL Server.ConnectionTimeout=0');
|
|
end;
|
|
// handle the options set by TSQLDBUniDACConnectionProperties.URI()
|
|
options := (fProperties as TSQLDBUniDACConnectionProperties).fSpecificOptions;
|
|
if fDatabase.Server='' then
|
|
fDatabase.Server := options.Values['Server'];
|
|
if fDatabase.Database='' then
|
|
fDatabase.Database := options.Values['Database'];
|
|
if (fDatabase.Port=0) and TryStrToInt(options.Values['Port'],PortNumber) then
|
|
fDatabase.Port := PortNumber;
|
|
for i := 0 to options.Count-1 do
|
|
if FindRawUTF8(['Server','Database','Port'],
|
|
StringToUTF8(options.Names[i]),false)<0 then
|
|
fDatabase.SpecificOptions.Add(options[i]);
|
|
end;
|
|
|
|
procedure TSQLDBUniDACConnection.Connect;
|
|
var Log: ISynLog;
|
|
begin
|
|
if fDatabase=nil then
|
|
raise ESQLDBUniDAC.CreateUTF8('%.Connect(%): Database=nil',
|
|
[self,fProperties.ServerName]);
|
|
Log := SynDBLog.Enter('Connect to ProviderName=% Database=% on Server=%',
|
|
[fDatabase.ProviderName,fDatabase.Database,fDatabase.Server],self);
|
|
try
|
|
case fProperties.DBMS of
|
|
dFirebird:
|
|
if (fDatabase.Server= '') and not FileExists(fDatabase.Database) then
|
|
with TUniScript.Create(nil) do // always create database for embedded Firebird
|
|
try
|
|
NoPreconnect := true;
|
|
SQL.Text := UTF8ToString(fProperties.SQLCreateDatabase(fProperties.DatabaseName));
|
|
Connection := fDatabase;
|
|
Execute;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
fDatabase.Open;
|
|
inherited Connect; // notify any re-connection
|
|
Log.Log(sllDB,'Connected to % (%)',
|
|
[fDatabase.ProviderName,fDatabase.ServerVersionFull]);
|
|
except
|
|
on E: Exception do begin
|
|
Log.Log(sllError,E);
|
|
Disconnect; // clean up on fail
|
|
raise;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TSQLDBUniDACConnection.Disconnect;
|
|
begin
|
|
try
|
|
inherited Disconnect; // flush any cached statement
|
|
finally
|
|
if fDatabase<>nil then
|
|
fDatabase.Close;
|
|
end;
|
|
end;
|
|
|
|
destructor TSQLDBUniDACConnection.Destroy;
|
|
begin
|
|
try
|
|
Disconnect;
|
|
if (fProperties.DBMS = dMSSQL) and (not SameText(cMSSQLProvider, 'prDirect')) then
|
|
CoUnInit;
|
|
except
|
|
on Exception do
|
|
end;
|
|
inherited;
|
|
FreeAndNil(fDatabase);
|
|
end;
|
|
|
|
function TSQLDBUniDACConnection.IsConnected: boolean;
|
|
begin
|
|
result := Assigned(fDatabase) and fDatabase.Connected;
|
|
end;
|
|
|
|
function TSQLDBUniDACConnection.NewStatement: TSQLDBStatement;
|
|
begin
|
|
result := TSQLDBUniDACStatement.Create(self);
|
|
end;
|
|
|
|
procedure TSQLDBUniDACConnection.Rollback;
|
|
begin
|
|
inherited Rollback;
|
|
fDatabase.Rollback;
|
|
end;
|
|
|
|
procedure TSQLDBUniDACConnection.StartTransaction;
|
|
begin
|
|
inherited StartTransaction;
|
|
fDatabase.StartTransaction;
|
|
end;
|
|
|
|
|
|
{ TSQLDBUniDACStatement }
|
|
|
|
procedure TSQLDBUniDACStatement.DataSetBindSQLParam(const aArrayIndex,
|
|
aParamIndex: integer; const aParam: TSQLDBParam);
|
|
var P: TDAParam;
|
|
i: Integer;
|
|
tmp: RawUTF8;
|
|
StoreVoidStringAsNull: boolean;
|
|
begin
|
|
P := TDAParam(fQueryParams[aParamIndex]);
|
|
if not P.InheritsFrom(TDAParam) then begin
|
|
inherited DataSetBindSQLParam(aArrayIndex, aParamIndex, aParam);
|
|
Exit;
|
|
end;
|
|
if fDatasetSupportBatchBinding then
|
|
fBatchExecute := (aArrayIndex<0) and (fParamsArrayCount>0) else
|
|
fBatchExecute := false;
|
|
if fBatchExecute then
|
|
P.ValueCount := fParamsArrayCount else
|
|
P.ValueCount := 1;
|
|
with aParam do begin
|
|
P.ParamType := SQLParamTypeToDBParamType(VInOut);
|
|
if VinOut <> paramInOut then
|
|
case VType of
|
|
SynTable.ftNull:
|
|
if fBatchExecute then
|
|
for i := 0 to fParamsArrayCount-1 do
|
|
P.Values[i].Clear else
|
|
P.Clear;
|
|
SynTable.ftInt64: begin
|
|
if fBatchExecute then
|
|
for i := 0 to fParamsArrayCount-1 do
|
|
if VArray[i]='null' then
|
|
P.Values[i].Clear else
|
|
P.Values[i].AsLargeInt := GetInt64(pointer(VArray[i])) else
|
|
if aArrayIndex>=0 then
|
|
if VArray[aArrayIndex]='null' then
|
|
P.Clear else
|
|
P.AsLargeInt := GetInt64(pointer(VArray[aArrayIndex])) else
|
|
P.AsLargeInt := VInt64;
|
|
end;
|
|
SynTable.ftDouble:
|
|
if fBatchExecute then
|
|
for i := 0 to fParamsArrayCount-1 do
|
|
if VArray[i]='null' then
|
|
P.Values[i].Clear else
|
|
P.Values[i].AsFloat := GetExtended(pointer(VArray[i])) else
|
|
if aArrayIndex>=0 then
|
|
if VArray[aArrayIndex]='null' then
|
|
P.Clear else
|
|
P.AsFloat := GetExtended(pointer(VArray[aArrayIndex])) else
|
|
P.AsFloat := PDouble(@VInt64)^;
|
|
SynTable.ftCurrency:
|
|
if fBatchExecute then
|
|
for i := 0 to fParamsArrayCount-1 do
|
|
if VArray[i]='null' then
|
|
P.Values[i].Clear else
|
|
P.Values[i].AsCurrency := StrToCurrency(pointer(VArray[i])) else
|
|
if aArrayIndex>=0 then
|
|
if VArray[aArrayIndex]='null' then
|
|
P.Clear else
|
|
P.AsCurrency := StrToCurrency(pointer(VArray[aArrayIndex])) else
|
|
P.AsCurrency := PCurrency(@VInt64)^;
|
|
SynTable.ftDate:
|
|
if fBatchExecute then
|
|
for i := 0 to fParamsArrayCount-1 do
|
|
if VArray[i]='null' then
|
|
P.Values[i].Clear else begin
|
|
UnQuoteSQLStringVar(pointer(VArray[i]),tmp);
|
|
P.Values[i].AsDateTime := Iso8601ToDateTime(tmp);
|
|
end else
|
|
if aArrayIndex>=0 then
|
|
if VArray[aArrayIndex]='null' then
|
|
P.Clear else begin
|
|
UnQuoteSQLStringVar(pointer(VArray[aArrayIndex]),tmp);
|
|
P.AsDateTime := Iso8601ToDateTime(tmp);
|
|
end else
|
|
P.AsDateTime := PDateTime(@VInt64)^;
|
|
SynTable.ftUTF8:
|
|
if fBatchExecute then begin
|
|
StoreVoidStringAsNull := fConnection.Properties.StoreVoidStringAsNull;
|
|
for i := 0 to fParamsArrayCount-1 do
|
|
if (VArray[i]='null') or
|
|
(StoreVoidStringAsNull and (VArray[i]=#39#39)) then
|
|
P.Values[i].Clear else begin
|
|
UnQuoteSQLStringVar(pointer(VArray[i]),tmp);
|
|
{$ifdef UNICODE}
|
|
P.Values[i].AsWideString := UTF8ToString(tmp);
|
|
{$else}
|
|
if fForceUseWideString then
|
|
P.Values[i].AsWideString := UTF8ToWideString(tmp) else
|
|
P.Values[i].AsString := UTF8ToString(tmp);
|
|
{$endif}
|
|
end
|
|
end else
|
|
if aArrayIndex>=0 then
|
|
if (VArray[aArrayIndex]='null') or
|
|
(fConnection.Properties.StoreVoidStringAsNull and
|
|
(VArray[aArrayIndex]=#39#39)) then
|
|
P.Clear else begin
|
|
UnQuoteSQLStringVar(pointer(VArray[aArrayIndex]),tmp);
|
|
{$ifdef UNICODE}
|
|
P.AsWideString := UTF8ToString(tmp);
|
|
{$else}
|
|
if fForceUseWideString then
|
|
P.AsWideString := UTF8ToWideString(tmp) else
|
|
P.AsString := UTF8ToString(tmp);
|
|
{$endif}
|
|
end else
|
|
if (VData='') and fConnection.Properties.StoreVoidStringAsNull then
|
|
P.Clear else
|
|
{$ifdef UNICODE}
|
|
P.AsWideString := UTF8ToString(VData);
|
|
{$else}
|
|
if not fForceUseWideString then
|
|
P.AsString := UTF8ToString(VData) else
|
|
P.AsWideString := UTF8ToWideString(VData);
|
|
{$endif}
|
|
SynTable.ftBlob:
|
|
if fBatchExecute then
|
|
for i := 0 to fParamsArrayCount-1 do
|
|
if VArray[i]='null' then
|
|
P.Values[i].Clear else begin
|
|
{$ifdef UNICODE}
|
|
P.Values[i].AsBlobRef.Clear;
|
|
P.Values[i].AsBlobRef.Write(0, Length(VArray[aArrayIndex]), Pointer(VArray[aArrayIndex])); end else
|
|
{$else}
|
|
P.Values[i].AsString := VArray[aArrayIndex]; end else
|
|
{$endif}
|
|
if aArrayIndex>=0 then
|
|
if VArray[aArrayIndex]='null' then
|
|
P.Clear else begin
|
|
{$ifdef UNICODE}
|
|
P.AsBlobRef.Clear;
|
|
P.AsBlobRef.Write(0, Length(VArray[aArrayIndex]), Pointer(VArray[aArrayIndex])); end else begin
|
|
P.AsBlobRef.Clear;
|
|
P.AsBlobRef.Write(0, Length(VData), Pointer(VData)); end;
|
|
{$else}
|
|
P.AsString := VArray[aArrayIndex] end else
|
|
P.AsString := VData;
|
|
{$endif}
|
|
else
|
|
raise ESQLDBUniDAC.CreateUTF8(
|
|
'%.DataSetBindSQLParam: invalid type % on bound parameter #%',
|
|
[Self,ord(VType),aParamIndex+1]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TSQLDBUniDACStatement.DatasetCreate;
|
|
begin
|
|
fQuery := TUniQuery.Create(nil);
|
|
TUniQuery(fQuery).Connection := (fConnection as TSQLDBUniDACConnection).Database;
|
|
fDatasetSupportBatchBinding := true;
|
|
end;
|
|
|
|
function TSQLDBUniDACStatement.DatasetPrepare(const aSQL: string): boolean;
|
|
begin
|
|
(fQuery as TUniQuery).SQL.Text := aSQL;
|
|
TUniQuery(fQuery).Prepare;
|
|
fQueryParams := TUniQuery(fQuery).Params;
|
|
result := fQueryParams<>nil;
|
|
end;
|
|
|
|
procedure TSQLDBUniDACStatement.DatasetExecSQL;
|
|
begin
|
|
if fBatchExecute then
|
|
(fQuery as TUniQuery).Execute(fParamsArrayCount) else
|
|
(fQuery as TUniQuery).Execute;
|
|
end;
|
|
|
|
|
|
initialization
|
|
TSQLDBUniDACConnectionProperties.RegisterClassNameForDefinition;
|
|
end.
|