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} |
66 |
|
FCharSetID: integer; |
67 |
|
FCodePage: TSystemCodePage; |
68 |
|
FRemoteProtocol: AnsiString; |
69 |
+ |
FAuthMethod: AnsiString; |
70 |
|
constructor Create(DatabaseName: AnsiString; DPB: IDPB; |
71 |
|
RaiseExceptionOnConnectError: boolean); |
72 |
|
procedure CheckHandle; virtual; abstract; |
73 |
|
function GenerateCreateDatabaseSQL(DatabaseName: AnsiString; aDPB: IDPB): AnsiString; |
74 |
|
procedure GetODSAndConnectionInfo; |
75 |
+ |
function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation; virtual; abstract; |
76 |
|
function IsConnected: boolean; virtual; abstract; |
77 |
|
procedure EndAllTransactions; |
78 |
|
procedure DPBFromCreateSQL(CreateSQL: AnsiString); |
81 |
|
destructor Destroy; override; |
82 |
|
function getDPB: IDPB; |
83 |
|
function AllocateBPB: IBPB; |
84 |
+ |
function AllocateDIRB: IDIRB; |
85 |
|
function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract; |
86 |
|
function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract; |
87 |
|
procedure Disconnect(Force: boolean=false); virtual; abstract; |
123 |
|
property SQLDialect: integer read FSQLDialect; |
124 |
|
property DPB: IDPB read FDPB; |
125 |
|
public |
126 |
< |
function GetDBInformation(Requests: array of byte): IDBInformation; overload; virtual; abstract; |
127 |
< |
function GetDBInformation(Request: byte): IDBInformation; overload; virtual; abstract; |
126 |
> |
function GetDBInformation(Requests: array of byte): IDBInformation; overload; |
127 |
> |
function GetDBInformation(Request: byte): IDBInformation; overload; |
128 |
> |
function GetDBInformation(Requests: IDIRB): IDBInformation; overload; |
129 |
|
function GetConnectString: AnsiString; |
130 |
|
function GetRemoteProtocol: AnsiString; |
131 |
+ |
function GetAuthenticationMethod: AnsiString; |
132 |
|
function GetODSMajorVersion: integer; |
133 |
|
function GetODSMinorVersion: integer; |
134 |
|
{Character Sets} |
147 |
|
|
148 |
|
implementation |
149 |
|
|
150 |
< |
uses FBMessages, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF}; |
150 |
> |
uses FBMessages, IBUtils, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF}; |
151 |
|
|
152 |
|
const |
153 |
|
CharSetMap: array [0..69] of TCharsetMap = ( |
249 |
|
FSQLDialect := getAsInteger; |
250 |
|
end; |
251 |
|
|
252 |
< |
if (FODSMajorVersion > 11) or ((FODSMajorVersion = 11) and (FODSMinorVersion >= 1)) then |
252 |
> |
FCharSetID := 0; |
253 |
> |
FRemoteProtocol := ''; |
254 |
> |
FAuthMethod := 'Legacy_Auth'; |
255 |
> |
if FODSMajorVersion > 11 then |
256 |
> |
begin |
257 |
> |
Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit), |
258 |
> |
'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL, MON$AUTH_METHOD From MON$ATTACHMENTS '+ |
259 |
> |
'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION'); |
260 |
> |
ResultSet := Stmt.OpenCursor; |
261 |
> |
if ResultSet.FetchNext then |
262 |
> |
begin |
263 |
> |
FCharSetID := ResultSet[0].AsInteger; |
264 |
> |
FRemoteProtocol := ResultSet[1].AsString; |
265 |
> |
FAuthMethod := ResultSet[2].AsString; |
266 |
> |
end |
267 |
> |
end |
268 |
> |
else |
269 |
> |
if (FODSMajorVersion = 11) and (FODSMinorVersion >= 1) then |
270 |
|
begin |
271 |
|
Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit), |
272 |
|
'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL From MON$ATTACHMENTS '+ |
284 |
|
Param := DPB.Find(isc_dpb_lc_ctype); |
285 |
|
if (Param = nil) or not CharSetName2CharSetID(Param.AsString,FCharSetID) then |
286 |
|
FCharSetID := 0; |
287 |
< |
FRemoteProtocol := ''; |
288 |
< |
end |
289 |
< |
else |
290 |
< |
begin |
291 |
< |
FCharSetID := 0; |
292 |
< |
FRemoteProtocol := ''; |
287 |
> |
case GetProtocol(FDatabaseName) of |
288 |
> |
TCP: FRemoteProtocol := 'TCPv4'; |
289 |
> |
Local: FRemoteProtocol := ''; |
290 |
> |
NamedPipe: FRemoteProtocol := 'Netbui'; |
291 |
> |
SPX: FRemoteProtocol := 'SPX' |
292 |
> |
end; |
293 |
|
end; |
294 |
|
FHasDefaultCharSet := CharSetID2CodePage(FCharSetID,FCodePage) and (FCharSetID > 1); |
295 |
|
end; |
455 |
|
Result := TBPB.Create; |
456 |
|
end; |
457 |
|
|
458 |
+ |
function TFBAttachment.AllocateDIRB: IDIRB; |
459 |
+ |
begin |
460 |
+ |
Result := TDIRB.Create; |
461 |
+ |
end; |
462 |
+ |
|
463 |
|
procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: AnsiString; |
464 |
|
aSQLDialect: integer); |
465 |
|
begin |
608 |
|
Result := OpenBlob(Transaction,Field.GetBlobMetadata, Field.AsQuad,BPB); |
609 |
|
end; |
610 |
|
|
611 |
+ |
function TFBAttachment.GetDBInformation(Requests: array of byte |
612 |
+ |
): IDBInformation; |
613 |
+ |
var ReqBuffer: PByte; |
614 |
+ |
i: integer; |
615 |
+ |
begin |
616 |
+ |
CheckHandle; |
617 |
+ |
if Length(Requests) = 1 then |
618 |
+ |
Result := GetDBInformation(Requests[0]) |
619 |
+ |
else |
620 |
+ |
begin |
621 |
+ |
GetMem(ReqBuffer,Length(Requests)); |
622 |
+ |
try |
623 |
+ |
for i := 0 to Length(Requests) - 1 do |
624 |
+ |
ReqBuffer[i] := Requests[i]; |
625 |
+ |
|
626 |
+ |
Result := GetDBInfo(ReqBuffer,Length(Requests)); |
627 |
+ |
|
628 |
+ |
finally |
629 |
+ |
FreeMem(ReqBuffer); |
630 |
+ |
end; |
631 |
+ |
end; |
632 |
+ |
end; |
633 |
+ |
|
634 |
+ |
function TFBAttachment.GetDBInformation(Request: byte): IDBInformation; |
635 |
+ |
begin |
636 |
+ |
CheckHandle; |
637 |
+ |
Result := GetDBInfo(@Request,1); |
638 |
+ |
end; |
639 |
+ |
|
640 |
+ |
function TFBAttachment.GetDBInformation(Requests: IDIRB): IDBInformation; |
641 |
+ |
begin |
642 |
+ |
CheckHandle; |
643 |
+ |
with Requests as TDIRB do |
644 |
+ |
Result := GetDBInfo(getBuffer,getDataLength); |
645 |
+ |
end; |
646 |
+ |
|
647 |
|
function TFBAttachment.GetConnectString: AnsiString; |
648 |
|
begin |
649 |
|
Result := FDatabaseName; |
654 |
|
Result := FRemoteProtocol; |
655 |
|
end; |
656 |
|
|
657 |
+ |
function TFBAttachment.GetAuthenticationMethod: AnsiString; |
658 |
+ |
begin |
659 |
+ |
Result := FAuthMethod; |
660 |
+ |
end; |
661 |
+ |
|
662 |
|
function TFBAttachment.GetODSMajorVersion: integer; |
663 |
|
begin |
664 |
|
Result := FODSMajorVersion; |