566 lines
16 KiB
ObjectPascal
566 lines
16 KiB
ObjectPascal
unit uDASDACDriver;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ 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_SDACDriver_Glyphs.res}
|
|
|
|
interface
|
|
|
|
uses
|
|
DB, Classes, uDAEngine, uDAInterfaces, uDAADOInterfaces, uROClasses,
|
|
DBAccess, MSAccess, DASQLMonitor,
|
|
MSSQLMonitor, Variants, uDAUtils;
|
|
|
|
type { TDASDACDriver }
|
|
TDASDACDriver = class(TDADriverReference)
|
|
end;
|
|
|
|
{ TDAEADODriver }
|
|
TDAEADODriver = class(TDAMSSQLDriver)
|
|
private
|
|
fMonitor: TMSSQLMonitor;
|
|
fTraceCallBack: TDALogTraceEvent;
|
|
|
|
procedure OnSDACTrace(Sender: TObject; Text: string; Flag: TDATraceFlag);
|
|
|
|
protected
|
|
function GetConnectionClass: TDAEConnectionClass; override;
|
|
procedure DoSetTraceOptions(TraceActive: boolean; TraceOptions: TDATraceOptions; Callback: TDALogTraceEvent); override;
|
|
|
|
// IDADriver
|
|
function GetDriverID: string; override;
|
|
function GetDescription: string; override;
|
|
function GetAvailableDriverOptions: TDAAvailableDriverOptions; override; safecall;
|
|
function GetDefaultCustomParameters: String; override; safecall;
|
|
procedure GetAuxParams(const AuxDriver: string; out List: IROStrings); override;
|
|
end;
|
|
|
|
{ TDAEMSConnection }
|
|
TDAEMSConnection = class(TDAMSConnection, IDAADOConnection, IDACanQueryDatabaseNames)
|
|
private
|
|
fMSConnection: TMSConnection;
|
|
|
|
// procedure GetSysObjects(const aCondition: string; aList: TStrings);
|
|
|
|
protected
|
|
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 DoGetStoredProcedureParams(const aStoredProcedureName : string; out Params : TDAParamCollection); //override;
|
|
// IADOConnection
|
|
function GetProviderName: string; safecall;
|
|
function GetProviderType: TDAOleDBProviderType; safecall;
|
|
function GetCommandTimeout: Integer; safecall;
|
|
procedure SetCommandTimeout(const Value: Integer); safecall;
|
|
end;
|
|
|
|
{ TDAEMSQuery }
|
|
TDAEMSQuery = 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;
|
|
procedure DoPrepare(Value: boolean); override;
|
|
|
|
// IDAMustSetParams
|
|
procedure SetParamValues(Params: TDAParamCollection); safecall;
|
|
procedure GetParamValues(Params: TDAParamCollection); safecall;
|
|
|
|
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 Execute: integer; override;
|
|
|
|
// IDAMustSetParams
|
|
procedure SetParamValues(Params: TDAParamCollection); safecall;
|
|
procedure GetParamValues(Params: TDAParamCollection); safecall;
|
|
|
|
end;
|
|
|
|
procedure Register;
|
|
|
|
function GetDriverObject: IDADriver; stdcall;
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils,
|
|
uDADriverManager, uDARes, OLEDBAccess,
|
|
uROBinaryHelpers;
|
|
|
|
var
|
|
_driver: TDAEDriver = nil;
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents(DAPalettePageName, [TDASDACDriver]);
|
|
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;
|
|
|
|
{$I uDACRLabsUtils.inc}
|
|
|
|
{ TDAEMSConnection }
|
|
|
|
procedure TDAEMSConnection.DoApplyConnectionString(
|
|
aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection);
|
|
var
|
|
adoconn: string;
|
|
i: integer;
|
|
begin
|
|
inherited;
|
|
|
|
with aConnStrParser do begin
|
|
adoconn := Format(stdMSSQL_ConnectionString, [UserID, Password, Database, Server]);
|
|
adoconn := '';
|
|
if UserId <> '' then begin
|
|
if adoconn = '' then
|
|
AdoConn := 'User ID='+UserID
|
|
else
|
|
AdoConn := ADoConn + ';User ID='+UserID;
|
|
end;
|
|
if Password <> '' then begin
|
|
if adoconn = '' then
|
|
AdoConn := 'Password='+Password
|
|
else
|
|
AdoConn := ADoConn + ';Password='+Password;
|
|
end;
|
|
if DataBase <> '' then begin
|
|
if adoconn = '' then
|
|
AdoConn := 'Initial Catalog='+Database
|
|
else
|
|
AdoConn := ADoConn + ';Initial Catalog='+Database;
|
|
end;
|
|
if Server <> '' then begin
|
|
if adoconn = '' then
|
|
AdoConn := 'Data Source='+Server
|
|
else
|
|
AdoConn := ADoConn + ';Data Source='+Server;
|
|
end;
|
|
|
|
AdoConn := ADoConn + ';';
|
|
MSSQLSchemaEnabled := True; // by default
|
|
for i := 0 to AuxParamsCount -1 do
|
|
begin
|
|
if Uppercase(AuxParamNames[i]) = 'SCHEMAS' then
|
|
MSSQLSchemaEnabled := AuxParams['Schemas'] = '1'
|
|
else
|
|
adoconn := adoconn + AuxParamNames[i] + '=' + AuxParams[AuxParamNames[i]]+';';
|
|
end;
|
|
|
|
fMSConnection.ConnectString := adoconn;
|
|
|
|
if (Self.UserID <> '') then fMSConnection.Username := Self.UserID;
|
|
|
|
if (Self.Password <> '') then fMSConnection.Password := Self.Password;
|
|
end;
|
|
end;
|
|
|
|
function TDAEMSConnection.DoBeginTransaction: integer;
|
|
begin
|
|
fMSConnection.StartTransaction;
|
|
result := 0;
|
|
end;
|
|
|
|
procedure TDAEMSConnection.DoCommitTransaction;
|
|
begin
|
|
fMSConnection.Commit;
|
|
end;
|
|
|
|
function TDAEMSConnection.CreateCustomConnection: TCustomConnection;
|
|
begin
|
|
fMSConnection := TMSConnection.Create(nil);
|
|
fMSConnection.LoginPrompt := FALSE;
|
|
|
|
result := fMSConnection;
|
|
end;
|
|
|
|
function TDAEMSConnection.GetDatasetClass: TDAEDatasetClass;
|
|
begin
|
|
result := TDAEMSQuery;
|
|
end;
|
|
|
|
function TDAEMSConnection.GetStoredProcedureClass: TDAEStoredProcedureClass;
|
|
begin
|
|
result := TDAEADOStoredProcedure;
|
|
end;
|
|
|
|
(*function SqlServerToDAType(aType:integer):TDADataType;
|
|
begin
|
|
case aType of
|
|
34:result := datBlob;
|
|
35:result := datMemo;
|
|
36:result := datString; //uniqueidentifier
|
|
48:result := datInteger;
|
|
52:result := datInteger;
|
|
56:result := datInteger;
|
|
58:result := datDateTime;
|
|
59:result := datFloat;
|
|
60:result := datCurrency;
|
|
61:result := datDateTime;
|
|
62:result := datFloat;
|
|
//98 sql_variant
|
|
99:result := datMemo;// ntext
|
|
104:result := datBoolean;
|
|
106:result := datFloat;
|
|
108:result := datFloat;
|
|
122:result := datCurrency;
|
|
127:result := datInteger;
|
|
165:result := datBlob; // varbinary
|
|
167:result := datString;
|
|
173:result := datBlob; // binary
|
|
175:result := datString; // char
|
|
189:result := datBlob; // timestamp
|
|
231:result := datString; // nvarchar
|
|
239:result := datString; //nchar
|
|
240:result := datDateTime;
|
|
241:result := datBlob;// xml
|
|
else result := datUnknown;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEMSConnection.DoGetStoredProcedureParams(const aStoredProcedureName: string; out Params: TDAParamCollection);
|
|
var
|
|
ds : TMSQuery;
|
|
lID:string;
|
|
begin
|
|
ds := TMSQuery.Create(NIL);
|
|
try
|
|
|
|
ds.Connection := fMSConnection;
|
|
ds.SQL.Text := 'select * from sysobjects where xtype=''P'' and name='''+aStoredProcedureName+'''';
|
|
ds.Open;
|
|
try
|
|
if ds.EOF then RaiseError('Stored Procedure %s not found in database',[aStoredProcedureName]);
|
|
lID := ds.FieldbyName('id').AsString;
|
|
finally
|
|
ds.Close();
|
|
end;
|
|
|
|
ds.SQL.Text := 'select * from sys.parameters where object_id='''+lID+''' ORDER BY parameter_id';
|
|
ds.Open;
|
|
try
|
|
Params := TDAParamCollection.Create(nil);
|
|
while not ds.Eof do begin
|
|
with Params.Add() do begin
|
|
Name := ds.FieldByName('name').AsString;
|
|
|
|
DataType := SqlServerToDAType(ds.FieldByName('system_type_id').AsInteger);
|
|
Size := ds.FieldByName('max_length').AsInteger;
|
|
|
|
{if ds.FieldByName('has_default_value').AsBoolean then
|
|
DefaultValue := ds.FieldByName('default_Value').AsInteger;}
|
|
|
|
if ds.FieldByName('is_output').AsBoolean then
|
|
ParamType := daptOutput
|
|
else
|
|
ParamType := daptInput;
|
|
|
|
end;
|
|
ds.Next();
|
|
end;
|
|
finally
|
|
Close();
|
|
end;
|
|
|
|
finally
|
|
ds.Free;
|
|
end;
|
|
end;*)
|
|
|
|
procedure TDAEMSConnection.DoRollbackTransaction;
|
|
begin
|
|
fMSConnection.Rollback;
|
|
end;
|
|
|
|
function TDAEMSConnection.DoGetInTransaction: boolean;
|
|
begin
|
|
result := fMSConnection.InTransaction
|
|
end;
|
|
|
|
function TDAEMSConnection.GetProviderName: string;
|
|
begin
|
|
result := oledb_MSSQLId;
|
|
end;
|
|
|
|
function TDAEMSConnection.GetProviderType: TDAOleDBProviderType;
|
|
begin
|
|
result := oledb_MSSQL;
|
|
end;
|
|
|
|
function TDAEMSConnection.GetCommandTimeout: Integer;
|
|
begin
|
|
if fMSConnection <> nil then
|
|
Result := fMSConnection.ConnectionTimeout
|
|
else
|
|
Result:=0;
|
|
end;
|
|
|
|
procedure TDAEMSConnection.SetCommandTimeout(const Value: Integer);
|
|
begin
|
|
if fMSConnection <> nil then
|
|
fMSConnection.ConnectionTimeout := Value;
|
|
end;
|
|
|
|
{ TDAEADODriver }
|
|
|
|
function TDAEADODriver.GetConnectionClass: TDAEConnectionClass;
|
|
begin
|
|
result := TDAEMSConnection;
|
|
end;
|
|
|
|
function TDAEADODriver.GetDescription: string;
|
|
begin
|
|
result := 'Core Lab SDAC Driver'{$IFDEF DataAbstract_SchemaModelerOnly} + SchemaModelerOnly{$ENDIF};
|
|
end;
|
|
|
|
function TDAEADODriver.GetDriverID: string;
|
|
begin
|
|
result := 'SDAC';
|
|
end;
|
|
|
|
procedure TDAEADODriver.OnSDACTrace(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
|
|
sdacopts: TDATraceFlags;
|
|
begin
|
|
inherited;
|
|
|
|
if TraceActive then begin
|
|
if (fMonitor = nil) then fMonitor := TMSSQLMonitor.Create(Self);
|
|
|
|
fMonitor.Active := FALSE;
|
|
fMonitor.OnSQL := OnSDACTrace;
|
|
|
|
sdacopts := [];
|
|
if (toPrepare in TraceOptions) then sdacopts := sdacopts + [tfQPrepare];
|
|
if (toExecute in TraceOptions) then sdacopts := sdacopts + [tfQExecute];
|
|
if (toFetch in TraceOptions) then sdacopts := sdacopts + [tfQFetch];
|
|
if (toError in TraceOptions) then sdacopts := sdacopts + [tfError];
|
|
if (toStmt in TraceOptions) then sdacopts := sdacopts + [tfStmt];
|
|
if (toConnect in TraceOptions) then sdacopts := sdacopts + [tfConnect];
|
|
if (toTransact in TraceOptions) then sdacopts := sdacopts + [tfTransact];
|
|
if (toBlob in TraceOptions) then sdacopts := sdacopts + [tfBlob];
|
|
if (toService in TraceOptions) then sdacopts := sdacopts + [tfService];
|
|
if (toMisc in TraceOptions) then sdacopts := sdacopts + [tfMisc];
|
|
if (toParams in TraceOptions) then sdacopts := sdacopts + [tfParams];
|
|
|
|
fTraceCallBack := Callback;
|
|
|
|
fMonitor.TraceFlags := sdacopts;
|
|
fMonitor.Active := TRUE;
|
|
end
|
|
else begin
|
|
FreeAndNIL(fMonitor);
|
|
fTraceCallback := nil;
|
|
end;
|
|
end;
|
|
|
|
function TDAEADODriver.GetAvailableDriverOptions: TDAAvailableDriverOptions;
|
|
begin
|
|
result := [doServerName, doDatabaseName, doLogin, doCustom];
|
|
end;
|
|
|
|
function TDAEADODriver.GetDefaultCustomParameters: String;
|
|
begin
|
|
Result := 'Schemas=1;Integrated Security=SSPI';
|
|
end;
|
|
|
|
|
|
|
|
procedure TDAEADODriver.GetAuxParams(const AuxDriver: string;
|
|
out List: IROStrings);
|
|
begin
|
|
inherited;
|
|
MSSQL_GetAuxParams(List);
|
|
end;
|
|
|
|
{ TDAEMSQuery }
|
|
|
|
function TDAEMSQuery.CreateDataset(aConnection: TDAEConnection): TDataset;
|
|
begin
|
|
result := TMSQuery.Create(nil);
|
|
|
|
TMSQuery(result).FetchAll := True; //for preventing creating an additional session when you call StartTransaction (an known issue of OLEDB)
|
|
TMSQuery(result).Unidirectional := True;
|
|
TMSQuery(result).ReadOnly := TRUE;
|
|
TMSQuery(result).Connection := TDAEMSConnection(aConnection).fMSConnection;
|
|
// TMSQuery(result).Options.AutoPrepare:=True;
|
|
end;
|
|
|
|
function TDAEMSQuery.DoExecute: integer;
|
|
begin
|
|
inherited DoExecute;
|
|
result := TMSQuery(Dataset).RowsAffected;
|
|
end;
|
|
|
|
function TDAEMSQuery.DoGetSQL: string;
|
|
begin
|
|
result := TMSQuery(Dataset).SQL.Text;
|
|
end;
|
|
|
|
procedure TDAEMSQuery.DoPrepare(Value: boolean);
|
|
var
|
|
i: integer;
|
|
par: TMSParam;
|
|
begin
|
|
if Value and not TMSQuery(Dataset).Prepared and (TMSQuery(Dataset).ParamCount<>0) then begin
|
|
for I := 0 to GetParams.Count - 1 do begin
|
|
par:=TMSQuery(Dataset).ParamByName(GetParams[i].Name);
|
|
par.DataType:= DATypeToVCLType(GetParams[i].DataType);
|
|
if par.DataType = ftAutoInc then par.DataType:= ftInteger;
|
|
end;
|
|
end;
|
|
TMSQuery(Dataset).Prepared := Value;
|
|
end;
|
|
|
|
procedure TDAEMSQuery.DoSetSQL(const Value: string);
|
|
begin
|
|
TMSQuery(Dataset).SQL.Text := Value;
|
|
end;
|
|
|
|
procedure TDAEMSQuery.GetParamValues(Params: TDAParamCollection);
|
|
var
|
|
I: Integer;
|
|
lParam: TMSParam;
|
|
begin
|
|
for i := 0 to TMSQuery(DataSet).Params.Count - 1 do begin
|
|
lParam:=TMSQuery(DataSet).Params[i];
|
|
if (lParam.ParamType in [ptOutput, ptInputOutput, ptResult]) then
|
|
params.ParamByName(lParam.Name).Value := lParam.Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEMSQuery.SetParamValues(Params: TDAParamCollection);
|
|
begin
|
|
WriteCrLabsParamValues(Params, TMSQuery(Dataset).Params, true);
|
|
end;
|
|
|
|
{ TDAEADOStoredProcedure }
|
|
|
|
function TDAEADOStoredProcedure.CreateDataset(
|
|
aConnection: TDAEConnection): TDataset;
|
|
begin
|
|
result := TMSStoredProc.Create(nil);
|
|
TMSStoredProc(result).Connection := TDAEMSConnection(aConnection).fMSConnection;
|
|
end;
|
|
|
|
function TDAEADOStoredProcedure.Execute: integer;
|
|
var
|
|
i: integer;
|
|
_params: TDAParamCollection;
|
|
lParam: uDAInterfaces.TDAParam;
|
|
begin
|
|
_params := GetParams;
|
|
|
|
with TMSStoredProc(Dataset) do begin
|
|
for i := 0 to (Params.Count - 1) do
|
|
if (Params[i].ParamType in [ptInput, ptInputOutput]) then begin
|
|
lParam := _params.ParamByName(Params[i].Name);
|
|
if (Params[i].DataType in [ftMemo, ftBlob, ftGraphic]) and VarIsArray(lParam.Value)then
|
|
Params[i].Value := VariantBinaryToString(lParam.Value)
|
|
else
|
|
Params[i].Value := lParam.Value;
|
|
end;
|
|
|
|
ExecProc;
|
|
result := RowsAffected;
|
|
|
|
for i := 0 to (_params.Count-1) do
|
|
if (_params[i].ParamType in [daptOutput, daptInputOutput, daptResult])
|
|
then _params[i].Value := params.ParamByName(_params[i].Name).Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEADOStoredProcedure.GetParamValues(Params: TDAParamCollection);
|
|
var
|
|
i: Integer;
|
|
lParam: TMSParam;
|
|
begin
|
|
for i := 0 to TMSStoredProc(DataSet).Params.Count - 1 do begin
|
|
lParam:=TMSStoredProc(DataSet).Params[i];
|
|
if (lParam.ParamType in [ptOutput, ptInputOutput, ptResult]) then
|
|
params.ParamByName(lParam.Name).Value := lParam.Value;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TDAEADOStoredProcedure.GetStoredProcedureName: string;
|
|
begin
|
|
result := TMSStoredProc(Dataset).StoredProcName;
|
|
end;
|
|
|
|
procedure TDAEADOStoredProcedure.SetStoredProcedureName(
|
|
const Name: string);
|
|
begin
|
|
TMSStoredProc(Dataset).StoredProcName := Name;
|
|
end;
|
|
|
|
procedure TDAEADOStoredProcedure.SetParamValues(Params: TDAParamCollection);
|
|
begin
|
|
WriteCrLabsParamValues(Params, TMSStoredProc(Dataset).Params);
|
|
end;
|
|
|
|
exports
|
|
GetDriverObject name func_GetDriverObject;
|
|
|
|
initialization
|
|
_driver := nil;
|
|
RegisterDriverProc(GetDriverObject);
|
|
|
|
finalization
|
|
UnregisterDriverProc(GetDriverObject);
|
|
FreeAndNIL(_driver);
|
|
|
|
end.
|