544 lines
16 KiB
ObjectPascal
544 lines
16 KiB
ObjectPascal
unit uDAMyDACDriver;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ Data Abstract Library - Driver Library
|
|
{
|
|
{ compiler: Delphi 6 and up, Kylix 3 and up
|
|
{ platform: Win32, Linux
|
|
{
|
|
{ (c)opyright RemObjects Software. all rights reserved.
|
|
{
|
|
{ Using this code requires a valid license of the Data Abstract
|
|
{ which can be obtained at http://www.remobjects.com.
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
{$I ..\DataAbstract.inc}
|
|
{$ELSE}
|
|
{$I ../DataAbstract.inc}
|
|
{$ENDIF}
|
|
|
|
{$R DataAbstract_MyDACDriver_Glyphs.res}
|
|
{.$DEFINE ENABLE_SQLMonitor}
|
|
{.$DEFINE MYSQL4Compatible}
|
|
|
|
interface
|
|
|
|
uses DB, Classes, uDAEngine, uDAInterfaces, {uDAADOInterfaces,} uROClasses, DBAccess, MyAccess,
|
|
{$IFDEF ENABLE_SQLMonitor}DASQLMonitor, MySQLMonitor,{$ENDIF ENABLE_SQLMonitor} uROBinaryHelpers, uDAUtils, uDAMySQLInterfaces;
|
|
|
|
type { TDAMyDACDriver }
|
|
TDAMyDACDriver = class(TDADriverReference)
|
|
end;
|
|
|
|
{ TDAEADODriver }
|
|
TDAEADODriver = class(TDAMySQLDriver)
|
|
private
|
|
{$IFDEF ENABLE_SQLMonitor}
|
|
fMonitor: TMySQLMonitor;
|
|
fTraceCallBack: TDALogTraceEvent;
|
|
|
|
procedure OnMyDACTrace(Sender: TObject; Text: string; Flag: TDATraceFlag);
|
|
{$ENDIF ENABLE_SQLMonitor}
|
|
protected
|
|
function GetConnectionClass: TDAEConnectionClass; override;
|
|
{$IFDEF ENABLE_SQLMonitor}
|
|
procedure DoSetTraceOptions(TraceActive: boolean; TraceOptions: TDATraceOptions; Callback: TDALogTraceEvent); override;
|
|
{$ENDIF ENABLE_SQLMonitor}
|
|
// IDADriver
|
|
function GetDriverID: string; override; safecall;
|
|
function GetDescription: string; override; safecall;
|
|
function GetDefaultCustomParameters: string; override; safecall;
|
|
procedure GetAuxParams(const AuxDriver: string; out List: IROStrings); override;
|
|
end;
|
|
|
|
{ TDAEMyConnection }
|
|
TDAEMyConnection = class(TDAMySQLConnection, IDAMySQLConnection,IDACanQueryDatabaseNames)
|
|
private
|
|
function GetMyConnection: TMyConnection;
|
|
|
|
protected
|
|
function GetTableSchema: string; override;
|
|
function useUnicode:Boolean; override;
|
|
|
|
function CreateCustomConnection: TCustomConnection; override;
|
|
|
|
function GetDatasetClass: TDAEDatasetClass; override;
|
|
function GetStoredProcedureClass: TDAEStoredProcedureClass; override;
|
|
|
|
procedure DoApplyConnectionString(aConnStrParser: TDAConnectionStringParser;
|
|
aConnectionObject: TCustomConnection); override;
|
|
|
|
function DoBeginTransaction: integer; override;
|
|
procedure DoCommitTransaction; override;
|
|
procedure DoRollbackTransaction; override;
|
|
function DoGetInTransaction: boolean; override;
|
|
procedure DoGetTableNames(out List: IROStrings); override;
|
|
procedure DoGetViewNames(out List: IROStrings); override;
|
|
procedure DoGetStoredProcedureNames(out List: IROStrings); override;
|
|
procedure DoGetForeignKeys(out ForeignKeys: TDADriverForeignKeyCollection); override;
|
|
procedure DoGetStoredProcedureParams(const aStoredProcedureName: string; out Params: TDAParamCollection); override;
|
|
function GetDatabaseNames: IROStrings;
|
|
procedure DoGetTableFields(const aTableName: string; out Fields: TDAFieldCollection); override;
|
|
property MyConnection: TMyConnection read GetMyConnection;
|
|
public
|
|
end;
|
|
|
|
{ TDAEMyQuery }
|
|
TDAEMyQuery = class(TDAEDataset, IDAMustSetParams)
|
|
private
|
|
|
|
protected
|
|
function CreateDataset(aConnection: TDAEConnection): TDataset; override;
|
|
procedure ClearParams; override;
|
|
function DoExecute: integer; override;
|
|
function DoGetSQL: string; override;
|
|
procedure DoSetSQL(const Value: string); override;
|
|
procedure DoPrepare(Value: boolean); override;
|
|
|
|
// IDAMustSetParams
|
|
procedure SetParamValues(AParams: TDAParamCollection); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure GetParamValues(AParams: TDAParamCollection); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
|
|
public
|
|
end;
|
|
|
|
{ TDAEADOStoredProcedure }
|
|
TDAEADOStoredProcedure = class(TDAEStoredProcedure, IDAMustSetParams)
|
|
protected
|
|
function CreateDataset(aConnection: TDAEConnection): TDataset; override;
|
|
|
|
function GetStoredProcedureName: string; override;
|
|
procedure SetStoredProcedureName(const Name: string); override;
|
|
function DoExecute: integer; override;
|
|
function Execute: integer; override;
|
|
procedure RefreshParams; override; {$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
|
|
// IDAMustSetParams
|
|
procedure SetParamValues(AParams: TDAParamCollection); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure GetParamValues(AParams: TDAParamCollection); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
end;
|
|
|
|
procedure Register;
|
|
|
|
function GetDriverObject: IDADriver; stdcall;
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils,Variants,
|
|
uDADriverManager, uDARes;
|
|
|
|
var
|
|
_driver: TDAEDriver = nil;
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents(DAPalettePageName, [TDAMyDACDriver]);
|
|
end;
|
|
|
|
{$IFDEF DataAbstract_SchemaModelerOnly}
|
|
{$INCLUDE ..\DataAbstract_SchemaModelerOnly.inc}
|
|
{$ENDIF DataAbstract_SchemaModelerOnly}
|
|
|
|
function GetDriverObject: IDADriver;
|
|
begin
|
|
{$IFDEF DataAbstract_SchemaModelerOnly}
|
|
if not RunningInSchemaModeler then begin
|
|
result := nil;
|
|
exit;
|
|
end;
|
|
{$ENDIF}
|
|
if (_driver = nil) then _driver := TDAEADODriver.Create(nil);
|
|
result := _driver;
|
|
end;
|
|
|
|
{$IFDEF LATEST_MyDAC}
|
|
{$I uDACRLabsUtils.inc}
|
|
{$ENDIF LATEST_MyDAC}
|
|
|
|
|
|
{$I uDACRLabsUtils.inc}
|
|
{ TDAEMyConnection }
|
|
|
|
function TDAEMyConnection.DoBeginTransaction: integer;
|
|
begin
|
|
MyConnection.StartTransaction;
|
|
result := 0;
|
|
end;
|
|
|
|
procedure TDAEMyConnection.DoCommitTransaction;
|
|
begin
|
|
MyConnection.Commit;
|
|
end;
|
|
|
|
function TDAEMyConnection.GetMyConnection: TMyConnection;
|
|
begin
|
|
result := TMyConnection(inherited ConnectionObject);
|
|
end;
|
|
|
|
function TDAEMyConnection.CreateCustomConnection: TCustomConnection;
|
|
begin
|
|
result := TMyConnection.Create(nil);
|
|
TMyConnection(result).LoginPrompt := FALSE;
|
|
end;
|
|
|
|
function TDAEMyConnection.GetDatasetClass: TDAEDatasetClass;
|
|
begin
|
|
result := TDAEMyQuery;
|
|
end;
|
|
|
|
function TDAEMyConnection.GetStoredProcedureClass: TDAEStoredProcedureClass;
|
|
begin
|
|
result := TDAEADOStoredProcedure;
|
|
end;
|
|
|
|
procedure TDAEMyConnection.DoGetStoredProcedureNames(out List: IROStrings);
|
|
begin
|
|
{$IFDEF MYSQL4Compatible}
|
|
List := TROStrings.Create;
|
|
MyConnection.GetStoredProcNames(List.Strings);
|
|
{$ELSE}
|
|
inherited DoGetStoredProcedureNames(List);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TDAEMyConnection.DoGetTableNames(out List: IROStrings);
|
|
begin
|
|
{$IFDEF MYSQL4Compatible}
|
|
List := TROStrings.Create;
|
|
MyConnection.GetTableNames(List.Strings);
|
|
{$ELSE}
|
|
inherited DoGetTableNames(List);
|
|
{$ENDIF MYSQL4Compatible}
|
|
end;
|
|
|
|
procedure TDAEMyConnection.DoRollbackTransaction;
|
|
begin
|
|
MyConnection.Rollback;
|
|
end;
|
|
|
|
function TDAEMyConnection.DoGetInTransaction: boolean;
|
|
begin
|
|
result := MyConnection.InTransaction
|
|
end;
|
|
|
|
|
|
procedure TDAEMyConnection.DoApplyConnectionString(
|
|
aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection);
|
|
const
|
|
stdMSSQL_ConnectionString = 'User ID=%s;Password=%s;Initial Catalog=%s;Data Source=%s';
|
|
var
|
|
adoconn: string;
|
|
i: integer;
|
|
sName,sValue: string;
|
|
begin
|
|
inherited;
|
|
|
|
with aConnStrParser do begin
|
|
adoconn := Format(stdMSSQL_ConnectionString, [UserID, Password, Database, Server]);
|
|
|
|
MyConnection.Database := Database;
|
|
|
|
MyConnection.Server := Server;
|
|
|
|
if (Self.UserID <> '') then
|
|
MyConnection.Username := Self.UserID
|
|
else
|
|
MyConnection.Username := UserID;
|
|
|
|
if (Self.Password <> '') then
|
|
MyConnection.Password := Self.Password
|
|
else
|
|
MyConnection.Password := Password;
|
|
for i := 0 to AuxParamsCount -1 do
|
|
begin
|
|
sName := AuxParamNames[i];
|
|
sValue := AuxParams[AuxParamNames[i]];
|
|
if SameText('Port', sName) then MyConnection.Port:= StrToIntDef(sValue,3306);
|
|
if SameText('useUnicode', sName) then MyConnection.Options.UseUnicode:=StrToBoolDef(sValue,False);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDAEMyConnection.GetTableSchema: string;
|
|
begin
|
|
Result:=MyConnection.Database;
|
|
end;
|
|
|
|
function TDAEMyConnection.useUnicode: Boolean;
|
|
begin
|
|
Result:= GetMyConnection.Options.UseUnicode;
|
|
end;
|
|
|
|
function TDAEMyConnection.GetDatabaseNames: IROStrings;
|
|
begin
|
|
{$IFDEF MYSQL4Compatible}
|
|
Result := TROStrings.Create();
|
|
MyConnection.GetDatabaseNames(Result.Strings);
|
|
{$ELSE}
|
|
Result := inherited GetDatabaseNames;
|
|
{$ENDIF MYSQL4Compatible}
|
|
end;
|
|
|
|
procedure TDAEMyConnection.DoGetViewNames(out List: IROStrings);
|
|
begin
|
|
{$IFDEF MYSQL4Compatible}
|
|
List := TROStrings.Create;
|
|
GetTablesList(MyConnection, List.Strings);
|
|
{$ELSE}
|
|
inherited DoGetViewNames(List);
|
|
{$ENDIF MYSQL4Compatible}
|
|
end;
|
|
|
|
procedure TDAEMyConnection.DoGetForeignKeys(
|
|
out ForeignKeys: TDADriverForeignKeyCollection);
|
|
begin
|
|
{$IFDEF MYSQL4Compatible}
|
|
ForeignKeys := TDADriverForeignKeyCollection.Create(nil);
|
|
{$ELSE}
|
|
inherited DoGetForeignKeys(ForeignKeys);
|
|
{$ENDIF MYSQL4Compatible}
|
|
end;
|
|
|
|
procedure TDAEMyConnection.DoGetStoredProcedureParams(
|
|
const aStoredProcedureName: string; out Params: TDAParamCollection);
|
|
{$IFDEF MYSQL4Compatible}
|
|
var
|
|
cmd: IDASQLCommand;
|
|
{$ENDIF MYSQL4Compatible}
|
|
begin
|
|
{$IFDEF MYSQL4Compatible}
|
|
cmd := NewCommand(aStoredProcedureName, stStoredProcedure);
|
|
cmd.RefreshParams;
|
|
Params := TDAParamCollection.Create(nil);
|
|
Params.AssignParamCollection(cmd.Params);
|
|
{$ELSE}
|
|
inherited DoGetStoredProcedureParams(aStoredProcedureName, Params);
|
|
{$ENDIF MYSQL4Compatible}
|
|
end;
|
|
|
|
procedure TDAEMyConnection.DoGetTableFields(const aTableName: string;
|
|
out Fields: TDAFieldCollection);
|
|
{$IFDEF MYSQL4Compatible}
|
|
var
|
|
qry: IDADataset;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF MYSQL4Compatible}
|
|
Fields := TDAFieldCollection.Create(nil);
|
|
qry := GetDatasetClass.Create(Self);
|
|
try
|
|
qry.SQL := 'SELECT * FROM ' + QuoteIdentifierIfNeeded(aTableName) + ' WHERE 1=0';
|
|
qry.Open;
|
|
Fields.Assign(qry.Fields);
|
|
finally
|
|
qry := nil;
|
|
end;
|
|
{$ELSE}
|
|
inherited DoGetTableFields(aTableName, Fields);
|
|
{$ENDIF MYSQL4Compatible}
|
|
end;
|
|
|
|
{ TDAEADODriver }
|
|
|
|
procedure TDAEADODriver.GetAuxParams(const AuxDriver: string;
|
|
out List: IROStrings);
|
|
begin
|
|
inherited;
|
|
List.Add('useUnicode=(True;False)');
|
|
end;
|
|
|
|
function TDAEADODriver.GetConnectionClass: TDAEConnectionClass;
|
|
begin
|
|
result := TDAEMyConnection;
|
|
end;
|
|
|
|
function TDAEADODriver.GetDefaultCustomParameters: string;
|
|
begin
|
|
Result:= inherited GetDefaultCustomParameters + 'useUnicode=False;';
|
|
end;
|
|
|
|
function TDAEADODriver.GetDescription: string;
|
|
begin
|
|
result := 'Core Lab MyDAC Driver'{$IFDEF DataAbstract_SchemaModelerOnly} + SchemaModelerOnly{$ENDIF};
|
|
end;
|
|
|
|
function TDAEADODriver.GetDriverID: string;
|
|
begin
|
|
result := 'MyDAC';
|
|
end;
|
|
|
|
{$IFDEF ENABLE_SQLMonitor}
|
|
procedure TDAEADODriver.OnMyDACTrace(Sender: TObject; Text: string; Flag: TDATraceFlag);
|
|
begin
|
|
if Assigned(fTraceCallback) then fTraceCallback(Sender, Text, integer(Flag));
|
|
end;
|
|
|
|
procedure TDAEADODriver.DoSetTraceOptions(TraceActive: boolean; TraceOptions: TDATraceOptions; Callback: TDALogTraceEvent);
|
|
var
|
|
MyDACopts: TDATraceFlags;
|
|
begin
|
|
inherited;
|
|
|
|
if TraceActive then begin
|
|
if (fMonitor = nil) then fMonitor := TMySQLMonitor.Create(Self);
|
|
|
|
fMonitor.Active := FALSE;
|
|
fMonitor.OnSQL := OnMyDACTrace;
|
|
|
|
MyDACopts := [];
|
|
if (toPrepare in TraceOptions) then MyDACopts := MyDACopts + [tfQPrepare];
|
|
if (toExecute in TraceOptions) then MyDACopts := MyDACopts + [tfQExecute];
|
|
if (toFetch in TraceOptions) then MyDACopts := MyDACopts + [tfQFetch];
|
|
if (toError in TraceOptions) then MyDACopts := MyDACopts + [tfError];
|
|
if (toStmt in TraceOptions) then MyDACopts := MyDACopts + [tfStmt];
|
|
if (toConnect in TraceOptions) then MyDACopts := MyDACopts + [tfConnect];
|
|
if (toTransact in TraceOptions) then MyDACopts := MyDACopts + [tfTransact];
|
|
if (toBlob in TraceOptions) then MyDACopts := MyDACopts + [tfBlob];
|
|
if (toService in TraceOptions) then MyDACopts := MyDACopts + [tfService];
|
|
if (toMisc in TraceOptions) then MyDACopts := MyDACopts + [tfMisc];
|
|
if (toParams in TraceOptions) then MyDACopts := MyDACopts + [tfParams];
|
|
|
|
fTraceCallBack := Callback;
|
|
|
|
fMonitor.TraceFlags := MyDACopts;
|
|
fMonitor.Active := TRUE;
|
|
end
|
|
else begin
|
|
FreeAndNIL(fMonitor);
|
|
fTraceCallback := nil;
|
|
end;
|
|
end;
|
|
{$ENDIF ENABLE_SQLMonitor}
|
|
|
|
{ TDAEMyQuery }
|
|
|
|
function TDAEMyQuery.CreateDataset(aConnection: TDAEConnection): TDataset;
|
|
begin
|
|
result := TMyQuery.Create(nil);
|
|
TMyQuery(result).ReadOnly := TRUE;
|
|
TMyQuery(result).Connection := TDAEMyConnection(aConnection).MyConnection;
|
|
TMyQuery(result).FetchAll := True; //for preventing creating an additional session when you call StartTransaction (an known issue of OLEDB)
|
|
|
|
// GetLastAutoInc will work in case these options is commented
|
|
// TMyQuery(result).FetchAll := False;
|
|
// TMyQuery(result).Unidirectional := True;
|
|
end;
|
|
|
|
function TDAEMyQuery.DoExecute: integer;
|
|
begin
|
|
TMyQuery(Dataset).Execute;
|
|
result := TMyQuery(Dataset).RowsAffected;
|
|
end;
|
|
|
|
function TDAEMyQuery.DoGetSQL: string;
|
|
begin
|
|
result := TMyQuery(Dataset).SQL.Text;
|
|
end;
|
|
|
|
procedure TDAEMyQuery.DoPrepare(Value: boolean);
|
|
begin
|
|
// Do not do inherited DoPrepare for MySQL.
|
|
{with TMyQuery(Dataset) do begin
|
|
if not Options.Direct then Prepared := Value;
|
|
end;}
|
|
end;
|
|
|
|
procedure TDAEMyQuery.DoSetSQL(const Value: string);
|
|
begin
|
|
TMyQuery(Dataset).SQL.Text := Value;
|
|
end;
|
|
|
|
procedure TDAEMyQuery.SetParamValues(AParams: TDAParamCollection);
|
|
begin
|
|
WriteCrLabsParamValues(AParams, TMyQuery(Dataset).Params);
|
|
end;
|
|
|
|
procedure TDAEMyQuery.GetParamValues(AParams: TDAParamCollection);
|
|
var
|
|
i: integer;
|
|
par: uDAInterfaces.TDAParam;
|
|
inpar: TParam;
|
|
begin
|
|
for i := 0 to (AParams.Count - 1) do begin
|
|
par := AParams[i];
|
|
inpar := TMyQuery(Dataset).Params.ParamByName(par.Name);
|
|
par.Value := inpar.Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEMyQuery.ClearParams;
|
|
begin
|
|
inherited;
|
|
TMyQuery(Dataset).Params.Clear;
|
|
end;
|
|
|
|
{ TDAEADOStoredProcedure }
|
|
|
|
function TDAEADOStoredProcedure.CreateDataset(
|
|
aConnection: TDAEConnection): TDataset;
|
|
begin
|
|
result := TMyStoredProc.Create(nil);
|
|
TMyStoredProc(result).Connection := TDAEMyConnection(aConnection).MyConnection;
|
|
end;
|
|
|
|
function TDAEADOStoredProcedure.Execute: integer;
|
|
begin
|
|
SetParamValues(GetParams);
|
|
Result:= DoExecute;
|
|
GetParamValues(GetParams);
|
|
end;
|
|
|
|
function TDAEADOStoredProcedure.GetStoredProcedureName: string;
|
|
begin
|
|
result := TMyStoredProc(Dataset).StoredProcName;
|
|
end;
|
|
|
|
procedure TDAEADOStoredProcedure.SetStoredProcedureName(
|
|
const Name: string);
|
|
begin
|
|
TMyStoredProc(Dataset).StoredProcName := Name;
|
|
end;
|
|
|
|
procedure TDAEADOStoredProcedure.SetParamValues(AParams: TDAParamCollection);
|
|
begin
|
|
WriteCrLabsParamValues(AParams, TMyStoredProc(Dataset).Params);
|
|
end;
|
|
|
|
procedure TDAEADOStoredProcedure.GetParamValues(AParams: TDAParamCollection);
|
|
var
|
|
i: Integer;
|
|
lParam: DBAccess.TDAParam;
|
|
begin
|
|
for i := 0 to TMyStoredProc(DataSet).Params.Count - 1 do begin
|
|
lParam:=TMyStoredProc(DataSet).Params[i];
|
|
if (lParam.ParamType in [ptOutput, ptInputOutput, ptResult]) then
|
|
Aparams.ParamByName(lParam.Name).Value := lParam.Value;
|
|
end;
|
|
end;
|
|
|
|
exports
|
|
GetDriverObject name func_GetDriverObject;
|
|
|
|
procedure TDAEADOStoredProcedure.RefreshParams;
|
|
begin
|
|
RefreshParamsStd(TMyStoredProc(DataSet).Params);
|
|
end;
|
|
|
|
function TDAEADOStoredProcedure.DoExecute: integer;
|
|
begin
|
|
TMyStoredProc(Dataset).ExecProc;
|
|
Result := -1;
|
|
end;
|
|
|
|
initialization
|
|
_driver := nil;
|
|
RegisterDriverProc(GetDriverObject);
|
|
|
|
finalization
|
|
UnregisterDriverProc(GetDriverObject);
|
|
FreeAndNIL(_driver);
|
|
|
|
end.
|