27 |
|
unit FBAttachment; |
28 |
|
{$IFDEF MSWINDOWS} |
29 |
|
{$DEFINE WINDOWS} |
30 |
– |
{$IF defined(CompilerVersion) and (CompilerVersion >= 28)} |
31 |
– |
{Delphi XE7 onwards}} |
32 |
– |
{$define HASREQEX} |
33 |
– |
{$IFEND} |
30 |
|
{$ENDIF} |
31 |
|
|
32 |
|
{$IFDEF FPC} |
38 |
|
interface |
39 |
|
|
40 |
|
uses |
41 |
< |
Classes, SysUtils, {$IFDEF WINDOWS} windows, {$ENDIF} IB, FBParamBlock, FBActivityMonitor; |
41 |
> |
Classes, SysUtils, {$IFDEF WINDOWS} windows, {$ENDIF} IB, FBParamBlock, |
42 |
> |
FBActivityMonitor, FBClientAPI; |
43 |
|
|
44 |
|
type |
45 |
|
TCharsetMap = record |
59 |
|
FODSMajorVersion: integer; |
60 |
|
FODSMinorVersion: integer; |
61 |
|
FUserCharSetMap: array of TCharSetMap; |
62 |
+ |
FSecDatabase: AnsiString; |
63 |
|
protected |
64 |
|
FDatabaseName: AnsiString; |
65 |
|
FRaiseExceptionOnConnectError: boolean; |
68 |
|
FCharSetID: integer; |
69 |
|
FCodePage: TSystemCodePage; |
70 |
|
FRemoteProtocol: AnsiString; |
71 |
< |
constructor Create(DatabaseName: AnsiString; DPB: IDPB; |
71 |
> |
FAuthMethod: AnsiString; |
72 |
> |
constructor Create(api: TFBClientAPI; DatabaseName: AnsiString; DPB: IDPB; |
73 |
|
RaiseExceptionOnConnectError: boolean); |
74 |
|
procedure CheckHandle; virtual; abstract; |
75 |
|
function GenerateCreateDatabaseSQL(DatabaseName: AnsiString; aDPB: IDPB): AnsiString; |
76 |
|
procedure GetODSAndConnectionInfo; |
77 |
+ |
function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation; virtual; abstract; |
78 |
|
function IsConnected: boolean; virtual; abstract; |
79 |
|
procedure EndAllTransactions; |
80 |
|
procedure DPBFromCreateSQL(CreateSQL: AnsiString); |
81 |
|
procedure SetParameters(SQLParams: ISQLParams; params: array of const); |
82 |
|
public |
83 |
|
destructor Destroy; override; |
84 |
+ |
function getFirebirdAPI: IFirebirdAPI; |
85 |
|
function getDPB: IDPB; |
86 |
|
function AllocateBPB: IBPB; |
87 |
+ |
function AllocateDIRB: IDIRB; |
88 |
|
function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract; |
89 |
|
function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract; |
90 |
|
procedure Disconnect(Force: boolean=false); virtual; abstract; |
114 |
|
function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IStatement; overload; virtual; abstract; |
115 |
|
function Prepare(transaction: ITransaction; sql: AnsiString): IStatement; overload; |
116 |
|
function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString; |
117 |
< |
aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; overload; virtual; abstract; |
117 |
> |
aSQLDialect: integer; GenerateParamNames: boolean=false; |
118 |
> |
CaseSensitiveParams: boolean = false): IStatement; overload; virtual; abstract; |
119 |
|
function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString; |
120 |
< |
GenerateParamNames: boolean=false): IStatement; overload; |
120 |
> |
GenerateParamNames: boolean=false; |
121 |
> |
CaseSensitiveParams: boolean = false): IStatement; overload; |
122 |
|
function GetEventHandler(Events: TStrings): IEvents; overload; virtual; abstract; |
123 |
|
function GetEventHandler(Event: AnsiString): IEvents; overload; |
124 |
|
|
128 |
|
property SQLDialect: integer read FSQLDialect; |
129 |
|
property DPB: IDPB read FDPB; |
130 |
|
public |
131 |
< |
function GetDBInformation(Requests: array of byte): IDBInformation; overload; virtual; abstract; |
132 |
< |
function GetDBInformation(Request: byte): IDBInformation; overload; virtual; abstract; |
131 |
> |
function GetDBInformation(Requests: array of byte): IDBInformation; overload; |
132 |
> |
function GetDBInformation(Request: byte): IDBInformation; overload; |
133 |
> |
function GetDBInformation(Requests: IDIRB): IDBInformation; overload; |
134 |
|
function GetConnectString: AnsiString; |
135 |
|
function GetRemoteProtocol: AnsiString; |
136 |
+ |
function GetAuthenticationMethod: AnsiString; |
137 |
+ |
function GetSecurityDatabase: AnsiString; |
138 |
|
function GetODSMajorVersion: integer; |
139 |
|
function GetODSMinorVersion: integer; |
140 |
|
{Character Sets} |
153 |
|
|
154 |
|
implementation |
155 |
|
|
156 |
< |
uses FBMessages, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF}; |
156 |
> |
uses FBMessages, IBUtils, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF}; |
157 |
|
|
158 |
|
const |
159 |
|
CharSetMap: array [0..69] of TCharsetMap = ( |
255 |
|
FSQLDialect := getAsInteger; |
256 |
|
end; |
257 |
|
|
258 |
< |
if (FODSMajorVersion > 11) or ((FODSMajorVersion = 11) and (FODSMinorVersion >= 1)) then |
258 |
> |
FCharSetID := 0; |
259 |
> |
FRemoteProtocol := ''; |
260 |
> |
FAuthMethod := 'Legacy_Auth'; |
261 |
> |
FSecDatabase := 'Default'; |
262 |
> |
if FODSMajorVersion > 11 then |
263 |
> |
begin |
264 |
> |
Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit), |
265 |
> |
'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL, MON$AUTH_METHOD, MON$SEC_DATABASE From MON$ATTACHMENTS, MON$DATABASE '+ |
266 |
> |
'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION'); |
267 |
> |
ResultSet := Stmt.OpenCursor; |
268 |
> |
if ResultSet.FetchNext then |
269 |
> |
begin |
270 |
> |
FCharSetID := ResultSet[0].AsInteger; |
271 |
> |
FRemoteProtocol := Trim(ResultSet[1].AsString); |
272 |
> |
FAuthMethod := Trim(ResultSet[2].AsString); |
273 |
> |
FSecDatabase := Trim(ResultSet[3].AsString); |
274 |
> |
end |
275 |
> |
end |
276 |
> |
else |
277 |
> |
if (FODSMajorVersion = 11) and (FODSMinorVersion >= 1) then |
278 |
|
begin |
279 |
|
Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit), |
280 |
|
'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL From MON$ATTACHMENTS '+ |
283 |
|
if ResultSet.FetchNext then |
284 |
|
begin |
285 |
|
FCharSetID := ResultSet[0].AsInteger; |
286 |
< |
FRemoteProtocol := ResultSet[1].AsString; |
286 |
> |
FRemoteProtocol := Trim(ResultSet[1].AsString); |
287 |
|
end |
288 |
|
end |
289 |
|
else |
292 |
|
Param := DPB.Find(isc_dpb_lc_ctype); |
293 |
|
if (Param = nil) or not CharSetName2CharSetID(Param.AsString,FCharSetID) then |
294 |
|
FCharSetID := 0; |
295 |
< |
FRemoteProtocol := ''; |
296 |
< |
end |
297 |
< |
else |
298 |
< |
begin |
299 |
< |
FCharSetID := 0; |
300 |
< |
FRemoteProtocol := ''; |
295 |
> |
case GetProtocol(FDatabaseName) of |
296 |
> |
TCP: FRemoteProtocol := 'TCPv4'; |
297 |
> |
Local: FRemoteProtocol := ''; |
298 |
> |
NamedPipe: FRemoteProtocol := 'Netbui'; |
299 |
> |
SPX: FRemoteProtocol := 'SPX' |
300 |
> |
end; |
301 |
|
end; |
302 |
|
FHasDefaultCharSet := CharSetID2CodePage(FCharSetID,FCodePage) and (FCharSetID > 1); |
303 |
|
end; |
304 |
|
|
305 |
< |
constructor TFBAttachment.Create(DatabaseName: AnsiString; DPB: IDPB; |
306 |
< |
RaiseExceptionOnConnectError: boolean); |
305 |
> |
constructor TFBAttachment.Create(api: TFBClientAPI; DatabaseName: AnsiString; |
306 |
> |
DPB: IDPB; RaiseExceptionOnConnectError: boolean); |
307 |
|
begin |
308 |
|
inherited Create; |
309 |
< |
FFirebirdAPI := FirebirdAPI; {Keep reference to interface} |
309 |
> |
FFirebirdAPI := api.GetAPI; {Keep reference to interface} |
310 |
|
FSQLDialect := 3; |
311 |
|
FDatabaseName := DatabaseName; |
312 |
|
FDPB := DPB; |
453 |
|
inherited Destroy; |
454 |
|
end; |
455 |
|
|
456 |
+ |
function TFBAttachment.getFirebirdAPI: IFirebirdAPI; |
457 |
+ |
begin |
458 |
+ |
Result := FFirebirdAPI; |
459 |
+ |
end; |
460 |
+ |
|
461 |
|
function TFBAttachment.getDPB: IDPB; |
462 |
|
begin |
463 |
|
Result := FDPB; |
465 |
|
|
466 |
|
function TFBAttachment.AllocateBPB: IBPB; |
467 |
|
begin |
468 |
< |
Result := TBPB.Create; |
468 |
> |
Result := TBPB.Create(FFirebirdAPI as TFBClientAPI); |
469 |
> |
end; |
470 |
> |
|
471 |
> |
function TFBAttachment.AllocateDIRB: IDIRB; |
472 |
> |
begin |
473 |
> |
Result := TDIRB.Create(FFirebirdAPI as TFBClientAPI); |
474 |
|
end; |
475 |
|
|
476 |
|
procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: AnsiString; |
593 |
|
end; |
594 |
|
|
595 |
|
function TFBAttachment.PrepareWithNamedParameters(transaction: ITransaction; |
596 |
< |
sql: AnsiString; GenerateParamNames: boolean): IStatement; |
596 |
> |
sql: AnsiString; GenerateParamNames: boolean; CaseSensitiveParams: boolean): IStatement; |
597 |
|
begin |
598 |
< |
Result := PrepareWithNamedParameters(transaction,sql,FSQLDialect,GenerateParamNames); |
598 |
> |
Result := PrepareWithNamedParameters(transaction,sql,FSQLDialect,GenerateParamNames,CaseSensitiveParams); |
599 |
|
end; |
600 |
|
|
601 |
|
function TFBAttachment.GetEventHandler(Event: AnsiString): IEvents; |
621 |
|
Result := OpenBlob(Transaction,Field.GetBlobMetadata, Field.AsQuad,BPB); |
622 |
|
end; |
623 |
|
|
624 |
+ |
function TFBAttachment.GetDBInformation(Requests: array of byte |
625 |
+ |
): IDBInformation; |
626 |
+ |
var ReqBuffer: PByte; |
627 |
+ |
i: integer; |
628 |
+ |
begin |
629 |
+ |
CheckHandle; |
630 |
+ |
if Length(Requests) = 1 then |
631 |
+ |
Result := GetDBInformation(Requests[0]) |
632 |
+ |
else |
633 |
+ |
begin |
634 |
+ |
GetMem(ReqBuffer,Length(Requests)); |
635 |
+ |
try |
636 |
+ |
for i := 0 to Length(Requests) - 1 do |
637 |
+ |
ReqBuffer[i] := Requests[i]; |
638 |
+ |
|
639 |
+ |
Result := GetDBInfo(ReqBuffer,Length(Requests)); |
640 |
+ |
|
641 |
+ |
finally |
642 |
+ |
FreeMem(ReqBuffer); |
643 |
+ |
end; |
644 |
+ |
end; |
645 |
+ |
end; |
646 |
+ |
|
647 |
+ |
function TFBAttachment.GetDBInformation(Request: byte): IDBInformation; |
648 |
+ |
begin |
649 |
+ |
CheckHandle; |
650 |
+ |
Result := GetDBInfo(@Request,1); |
651 |
+ |
end; |
652 |
+ |
|
653 |
+ |
function TFBAttachment.GetDBInformation(Requests: IDIRB): IDBInformation; |
654 |
+ |
begin |
655 |
+ |
CheckHandle; |
656 |
+ |
with Requests as TDIRB do |
657 |
+ |
Result := GetDBInfo(getBuffer,getDataLength); |
658 |
+ |
end; |
659 |
+ |
|
660 |
|
function TFBAttachment.GetConnectString: AnsiString; |
661 |
|
begin |
662 |
|
Result := FDatabaseName; |
667 |
|
Result := FRemoteProtocol; |
668 |
|
end; |
669 |
|
|
670 |
+ |
function TFBAttachment.GetAuthenticationMethod: AnsiString; |
671 |
+ |
begin |
672 |
+ |
Result := FAuthMethod; |
673 |
+ |
end; |
674 |
+ |
|
675 |
+ |
function TFBAttachment.GetSecurityDatabase: AnsiString; |
676 |
+ |
begin |
677 |
+ |
Result := FSecDatabase; |
678 |
+ |
end; |
679 |
+ |
|
680 |
|
function TFBAttachment.GetODSMajorVersion: integer; |
681 |
|
begin |
682 |
|
Result := FODSMajorVersion; |
766 |
|
begin |
767 |
|
Result := false; |
768 |
|
for i := Low(CharSetMap) to High(CharSetMap) do |
769 |
< |
if AnsiCompareStr(CharSetMap[i].CharSetName, CharSetName) = 0 then |
769 |
> |
if AnsiCompareText(CharSetMap[i].CharSetName, CharSetName) = 0 then |
770 |
|
begin |
771 |
|
CharSetID := CharSetMap[i].CharSetID; |
772 |
|
Result := true; |
774 |
|
end; |
775 |
|
|
776 |
|
for i := 0 to Length(FUserCharSetMap) - 1 do |
777 |
< |
if AnsiCompareStr(FUserCharSetMap[i].CharSetName, CharSetName) = 0 then |
777 |
> |
if AnsiCompareText(FUserCharSetMap[i].CharSetName, CharSetName) = 0 then |
778 |
|
begin |
779 |
|
CharSetID := FUserCharSetMap[i].CharSetID; |
780 |
|
Result := true; |