david
2a98435b14
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@68 b6239004-a887-0f4b-9937-50029ccdca16
455 lines
14 KiB
ObjectPascal
455 lines
14 KiB
ObjectPascal
unit uDAPGDACDriver;
|
|
{----------------------------------------------------------------------------}
|
|
{ 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_PgDACDriver_Glyphs.res}
|
|
interface
|
|
|
|
uses
|
|
DB, Classes,
|
|
DBAccess, PgAccess, DASQLMonitor, PgSQLMonitor,
|
|
uDAEngine, uDAInterfaces, uDAADOInterfaces, uROClasses,
|
|
uROBinaryHelpers, uDAUtils, uDAPostgresInterfaces;
|
|
|
|
type
|
|
{ TDAPgDACDriver }
|
|
TDAPgDACDriver = class(TDADriverReference)
|
|
end;
|
|
|
|
{ TDAEPgDACDriver }
|
|
TDAEPgDACDriver = class(TDAPostgresDriver)
|
|
private
|
|
fMonitor: TPgSQLMonitor;
|
|
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; safecall;
|
|
function GetDescription: string; override; safecall;
|
|
procedure GetAuxParams(const AuxDriver: string; out List: IROStrings); override;
|
|
|
|
end;
|
|
|
|
{ TDAEMyConnection }
|
|
TDAEPgDACConnection = class(TDAEPostgresConnection)
|
|
private
|
|
fConnection: TPgConnection;
|
|
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;
|
|
public
|
|
end;
|
|
|
|
{ TDAEPgDACQuery }
|
|
TDAEPgDACQuery = class(TDAEDataset,IDAMustSetParams)
|
|
private
|
|
|
|
protected
|
|
function CreateDataset(aConnection: TDAEConnection): TDataset; override;
|
|
procedure ClearParams; override;
|
|
function DoExecute: integer; override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
function DoGetSQL: string; override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure DoSetSQL(const Value: string); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure DoPrepare(Value: boolean); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure SetParamValues(AParams: TDAParamCollection); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
procedure GetParamValues(AParams: TDAParamCollection); override;{$IFNDEF FPC_SAFECALL_BUG}safecall;{$ENDIF}
|
|
|
|
public
|
|
end;
|
|
|
|
{ TDAEPgDACStoredProcedure }
|
|
TDAEPgDACStoredProcedure = 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,TypInfo,
|
|
uDADriverManager, uDARes;
|
|
|
|
var
|
|
_driver: TDAEDriver = nil;
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents(DAPalettePageName, [TDAPgDACDriver]);
|
|
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 := TDAEPgDacDriver.Create(nil);
|
|
result := _driver;
|
|
end;
|
|
|
|
{$I uDACRLabsUtils.inc}
|
|
|
|
|
|
exports GetDriverObject name func_GetDriverObject;
|
|
|
|
|
|
{ TDAEPgDACDriver }
|
|
|
|
procedure TDAEPgDACDriver.DoSetTraceOptions(TraceActive: boolean;
|
|
TraceOptions: TDATraceOptions; Callback: TDALogTraceEvent);
|
|
var
|
|
sdacopts: TDATraceFlags;
|
|
begin
|
|
inherited;
|
|
if TraceActive then begin
|
|
if (fMonitor = nil) then fMonitor := TPgSQLMonitor.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;
|
|
|
|
procedure TDAEPgDACDriver.GetAuxParams(const AuxDriver: string;
|
|
out List: IROStrings);
|
|
begin
|
|
inherited;
|
|
List.Add('Options.<Param>=<Value>');
|
|
List.Add('PoolingOptions.<Param>=<Value>');
|
|
List.Add('Port=5432');
|
|
List.Add('SSLOptions.<Param>=<Value>');
|
|
List.Add('');
|
|
List.Add('Consult to PgDAC documentation about Options, PoolingOptions and SSLOptions options.');
|
|
end;
|
|
|
|
function TDAEPgDACDriver.GetConnectionClass: TDAEConnectionClass;
|
|
begin
|
|
result := TDAEPgDacConnection;
|
|
end;
|
|
|
|
function TDAEPgDACDriver.GetDescription: string;
|
|
begin
|
|
result := 'Devart''s PostgreSQL Data Access Components'{$IFDEF DataAbstract_SchemaModelerOnly} + SchemaModelerOnly{$ENDIF};
|
|
end;
|
|
|
|
function TDAEPgDACDriver.GetDriverID: string;
|
|
begin
|
|
Result := 'PgDAC';
|
|
end;
|
|
|
|
procedure TDAEPgDACDriver.OnSDACTrace(Sender: TObject; Text: string;
|
|
Flag: TDATraceFlag);
|
|
begin
|
|
if Assigned(fTraceCallback) then fTraceCallback(Sender, Text, integer(Flag));
|
|
end;
|
|
|
|
{ TDAEPgDACConnection }
|
|
|
|
function TDAEPgDACConnection.CreateCustomConnection: TCustomConnection;
|
|
begin
|
|
fConnection := TPgConnection.Create(nil);
|
|
fConnection.LoginPrompt := FALSE;
|
|
|
|
result := fConnection;
|
|
end;
|
|
|
|
procedure TDAEPgDACConnection.DoApplyConnectionString(
|
|
aConnStrParser: TDAConnectionStringParser;
|
|
aConnectionObject: TCustomConnection);
|
|
var
|
|
i: integer;
|
|
sName, sValue: string;
|
|
begin
|
|
inherited;
|
|
|
|
with aConnStrParser do begin
|
|
fConnection.Database := Database;
|
|
|
|
fConnection.Server := Server;
|
|
|
|
if (Self.UserID <> '') then
|
|
fConnection.Username := Self.UserID
|
|
else
|
|
fConnection.Username := UserID;
|
|
|
|
if (Self.Password <> '') then
|
|
fConnection.Password := Self.Password
|
|
else
|
|
fConnection.Password := Password;
|
|
|
|
for i := 0 to AuxParamsCount -1 do begin
|
|
sName := AuxParamNames[i];
|
|
sValue := AuxParams[sName];
|
|
|
|
if Pos('options.', AnsiLowerCase(sName)) = 1 then begin
|
|
sName := Copy(sName,9, Length(sName)-8);
|
|
SetPropValue(fConnection.Options, sName, sValue);
|
|
end
|
|
else if Pos('poolingoptions.', AnsiLowerCase(sName)) = 1 then begin
|
|
sName := Copy(sName,16, Length(sName)-15);
|
|
SetPropValue(fConnection.PoolingOptions, sName, sValue);
|
|
end
|
|
else if AnsiSameStr(sName, 'PORT') then begin
|
|
fConnection.Port := StrToIntDef(sValue,0);
|
|
end
|
|
else if Pos('ssloptions.', AnsiLowerCase(sName)) = 1 then begin
|
|
sName := Copy(sName,12, Length(sName)-11);
|
|
SetPropValue(fConnection.SSLOptions, sName, sValue);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDAEPgDACConnection.DoBeginTransaction: integer;
|
|
begin
|
|
fConnection.StartTransaction;
|
|
result := 0;
|
|
end;
|
|
|
|
procedure TDAEPgDACConnection.DoCommitTransaction;
|
|
begin
|
|
fConnection.Commit;
|
|
end;
|
|
|
|
function TDAEPgDACConnection.DoGetInTransaction: boolean;
|
|
begin
|
|
Result := fConnection.InTransaction;
|
|
end;
|
|
|
|
procedure TDAEPgDACConnection.DoRollbackTransaction;
|
|
begin
|
|
fConnection.Rollback;
|
|
end;
|
|
|
|
|
|
function TDAEPgDACConnection.GetDatasetClass: TDAEDatasetClass;
|
|
begin
|
|
Result := TDAEPgDACQuery;
|
|
end;
|
|
|
|
function TDAEPgDACConnection.GetStoredProcedureClass: TDAEStoredProcedureClass;
|
|
begin
|
|
Result := TDAEPgDACStoredProcedure;
|
|
end;
|
|
|
|
{ TDAEPgDACQuery }
|
|
|
|
procedure TDAEPgDACQuery.ClearParams;
|
|
begin
|
|
inherited;
|
|
TPgQuery(Dataset).Params.Clear;
|
|
end;
|
|
|
|
function TDAEPgDACQuery.CreateDataset(aConnection: TDAEConnection): TDataset;
|
|
begin
|
|
result := TPgQuery.Create(nil);
|
|
|
|
TPgQuery(result).FetchAll := True; //for preventing creating an additional session when you call StartTransaction (an known issue of OLEDB)
|
|
TPgQuery(result).Unidirectional := True;
|
|
TPgQuery(result).ReadOnly := TRUE;
|
|
TPgQuery(result).Connection := TDAEPgDACConnection(aConnection).fConnection;
|
|
end;
|
|
|
|
function TDAEPgDACQuery.DoExecute: integer;
|
|
begin
|
|
TPgQuery(Dataset).Execute;
|
|
result := TPgQuery(Dataset).RowsAffected;
|
|
end;
|
|
|
|
function TDAEPgDACQuery.DoGetSQL: string;
|
|
begin
|
|
result := TPgQuery(Dataset).SQL.Text;
|
|
end;
|
|
|
|
procedure TDAEPgDACQuery.DoPrepare(Value: boolean);
|
|
var
|
|
i: integer;
|
|
par: TPgParam;
|
|
begin
|
|
if Value and not TPgQuery(Dataset).Prepared and (TPgQuery(Dataset).ParamCount<>0) then begin
|
|
for I := 0 to GetParams.Count - 1 do begin
|
|
par:=TPgQuery(Dataset).ParamByName(GetParams[i].Name);
|
|
par.DataType:= DATypeToVCLType(GetParams[i].DataType);
|
|
if par.DataType = ftAutoInc then par.DataType:= ftInteger;
|
|
end;
|
|
end;
|
|
TPgQuery(Dataset).Prepared := Value;
|
|
end;
|
|
|
|
procedure TDAEPgDACQuery.DoSetSQL(const Value: string);
|
|
begin
|
|
TPgQuery(Dataset).SQL.Text := Value;
|
|
end;
|
|
|
|
procedure TDAEPgDACQuery.GetParamValues(AParams: TDAParamCollection);
|
|
var
|
|
I: Integer;
|
|
lParam: TPgParam;
|
|
begin
|
|
for i := 0 to TPgQuery(DataSet).Params.Count - 1 do begin
|
|
lParam:=TPgQuery(DataSet).Params[i];
|
|
if (lParam.ParamType in [ptOutput, ptInputOutput, ptResult]) then
|
|
Aparams.ParamByName(lParam.Name).Value := lParam.Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TDAEPgDACQuery.SetParamValues(AParams: TDAParamCollection);
|
|
begin
|
|
WriteCrLabsParamValues(AParams, TPgQuery(Dataset).Params, true);
|
|
end;
|
|
|
|
{ TDAEPgDACStoredProcedure }
|
|
|
|
function TDAEPgDACStoredProcedure.CreateDataset(
|
|
aConnection: TDAEConnection): TDataset;
|
|
begin
|
|
result := TPgStoredProc.Create(nil);
|
|
TPgStoredProc(result).Connection := TDAEPgDACConnection(aConnection).fConnection;
|
|
end;
|
|
|
|
function TDAEPgDACStoredProcedure.DoExecute: integer;
|
|
begin
|
|
with TPgStoredProc(Dataset) do begin
|
|
ExecProc;
|
|
result := RowsAffected;
|
|
end;
|
|
end;
|
|
|
|
function TDAEPgDACStoredProcedure.Execute: integer;
|
|
var
|
|
i: integer;
|
|
_params: TDAParamCollection;
|
|
lParam: uDAInterfaces.TDAParam;
|
|
begin
|
|
_params := GetParams;
|
|
|
|
with TPgStoredProc(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 := VariantToAnsiString(lParam.Value)
|
|
else
|
|
Params[i].Value := lParam.Value;
|
|
end;
|
|
|
|
result := DoExecute;
|
|
|
|
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 TDAEPgDACStoredProcedure.GetParamValues(AParams: TDAParamCollection);
|
|
var
|
|
i: Integer;
|
|
lParam: TPgParam;
|
|
begin
|
|
for i := 0 to TPgStoredProc(DataSet).Params.Count - 1 do begin
|
|
lParam:=TPgStoredProc(DataSet).Params[i];
|
|
if (lParam.ParamType in [ptOutput, ptInputOutput, ptResult]) then
|
|
Aparams.ParamByName(lParam.Name).Value := lParam.Value;
|
|
end;
|
|
end;
|
|
|
|
function TDAEPgDACStoredProcedure.GetStoredProcedureName: string;
|
|
begin
|
|
result := TPgStoredProc(Dataset).StoredProcName;
|
|
end;
|
|
|
|
procedure TDAEPgDACStoredProcedure.RefreshParams;
|
|
begin
|
|
TPgStoredProc(Dataset).Prepare;
|
|
RefreshParamsStd(TPgStoredProc(Dataset).Params);
|
|
end;
|
|
|
|
procedure TDAEPgDACStoredProcedure.SetParamValues(AParams: TDAParamCollection);
|
|
begin
|
|
WriteCrLabsParamValues(AParams, TPgStoredProc(Dataset).Params);
|
|
end;
|
|
|
|
procedure TDAEPgDACStoredProcedure.SetStoredProcedureName(const Name: string);
|
|
begin
|
|
TPgStoredProc(Dataset).StoredProcName := Name;
|
|
end;
|
|
|
|
initialization
|
|
_driver := nil;
|
|
RegisterDriverProc(GetDriverObject);
|
|
|
|
finalization
|
|
UnregisterDriverProc(GetDriverObject);
|
|
FreeAndNIL(_driver);
|
|
end. |