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; |
126 |
|
property SQLDialect: integer read FSQLDialect; |
127 |
|
property DPB: IDPB read FDPB; |
128 |
|
public |
129 |
< |
function GetDBInformation(Requests: array of byte): IDBInformation; overload; virtual; abstract; |
130 |
< |
function GetDBInformation(Request: byte): IDBInformation; overload; virtual; abstract; |
129 |
> |
function GetDBInformation(Requests: array of byte): IDBInformation; overload; |
130 |
> |
function GetDBInformation(Request: byte): IDBInformation; overload; |
131 |
> |
function GetDBInformation(Requests: IDIRB): IDBInformation; overload; |
132 |
|
function GetConnectString: AnsiString; |
133 |
|
function GetRemoteProtocol: AnsiString; |
134 |
+ |
function GetAuthenticationMethod: AnsiString; |
135 |
+ |
function GetSecurityDatabase: AnsiString; |
136 |
|
function GetODSMajorVersion: integer; |
137 |
|
function GetODSMinorVersion: integer; |
138 |
|
{Character Sets} |
151 |
|
|
152 |
|
implementation |
153 |
|
|
154 |
< |
uses FBMessages, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF}; |
154 |
> |
uses FBMessages, IBUtils, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF}; |
155 |
|
|
156 |
|
const |
157 |
|
CharSetMap: array [0..69] of TCharsetMap = ( |
253 |
|
FSQLDialect := getAsInteger; |
254 |
|
end; |
255 |
|
|
256 |
< |
if (FODSMajorVersion > 11) or ((FODSMajorVersion = 11) and (FODSMinorVersion >= 1)) then |
256 |
> |
FCharSetID := 0; |
257 |
> |
FRemoteProtocol := ''; |
258 |
> |
FAuthMethod := 'Legacy_Auth'; |
259 |
> |
FSecDatabase := 'Default'; |
260 |
> |
if FODSMajorVersion > 11 then |
261 |
> |
begin |
262 |
> |
Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit), |
263 |
> |
'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL, MON$AUTH_METHOD, MON$SEC_DATABASE From MON$ATTACHMENTS, MON$DATABASE '+ |
264 |
> |
'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION'); |
265 |
> |
ResultSet := Stmt.OpenCursor; |
266 |
> |
if ResultSet.FetchNext then |
267 |
> |
begin |
268 |
> |
FCharSetID := ResultSet[0].AsInteger; |
269 |
> |
FRemoteProtocol := Trim(ResultSet[1].AsString); |
270 |
> |
FAuthMethod := Trim(ResultSet[2].AsString); |
271 |
> |
FSecDatabase := Trim(ResultSet[3].AsString); |
272 |
> |
end |
273 |
> |
end |
274 |
> |
else |
275 |
> |
if (FODSMajorVersion = 11) and (FODSMinorVersion >= 1) then |
276 |
|
begin |
277 |
|
Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit), |
278 |
|
'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL From MON$ATTACHMENTS '+ |
281 |
|
if ResultSet.FetchNext then |
282 |
|
begin |
283 |
|
FCharSetID := ResultSet[0].AsInteger; |
284 |
< |
FRemoteProtocol := ResultSet[1].AsString; |
284 |
> |
FRemoteProtocol := Trim(ResultSet[1].AsString); |
285 |
|
end |
286 |
|
end |
287 |
|
else |
290 |
|
Param := DPB.Find(isc_dpb_lc_ctype); |
291 |
|
if (Param = nil) or not CharSetName2CharSetID(Param.AsString,FCharSetID) then |
292 |
|
FCharSetID := 0; |
293 |
< |
FRemoteProtocol := ''; |
294 |
< |
end |
295 |
< |
else |
296 |
< |
begin |
297 |
< |
FCharSetID := 0; |
298 |
< |
FRemoteProtocol := ''; |
293 |
> |
case GetProtocol(FDatabaseName) of |
294 |
> |
TCP: FRemoteProtocol := 'TCPv4'; |
295 |
> |
Local: FRemoteProtocol := ''; |
296 |
> |
NamedPipe: FRemoteProtocol := 'Netbui'; |
297 |
> |
SPX: FRemoteProtocol := 'SPX' |
298 |
> |
end; |
299 |
|
end; |
300 |
|
FHasDefaultCharSet := CharSetID2CodePage(FCharSetID,FCodePage) and (FCharSetID > 1); |
301 |
|
end; |
302 |
|
|
303 |
< |
constructor TFBAttachment.Create(DatabaseName: AnsiString; DPB: IDPB; |
304 |
< |
RaiseExceptionOnConnectError: boolean); |
303 |
> |
constructor TFBAttachment.Create(api: TFBClientAPI; DatabaseName: AnsiString; |
304 |
> |
DPB: IDPB; RaiseExceptionOnConnectError: boolean); |
305 |
|
begin |
306 |
|
inherited Create; |
307 |
< |
FFirebirdAPI := FirebirdAPI; {Keep reference to interface} |
307 |
> |
FFirebirdAPI := api.GetAPI; {Keep reference to interface} |
308 |
|
FSQLDialect := 3; |
309 |
|
FDatabaseName := DatabaseName; |
310 |
|
FDPB := DPB; |
451 |
|
inherited Destroy; |
452 |
|
end; |
453 |
|
|
454 |
+ |
function TFBAttachment.getFirebirdAPI: IFirebirdAPI; |
455 |
+ |
begin |
456 |
+ |
Result := FFirebirdAPI; |
457 |
+ |
end; |
458 |
+ |
|
459 |
|
function TFBAttachment.getDPB: IDPB; |
460 |
|
begin |
461 |
|
Result := FDPB; |
463 |
|
|
464 |
|
function TFBAttachment.AllocateBPB: IBPB; |
465 |
|
begin |
466 |
< |
Result := TBPB.Create; |
466 |
> |
Result := TBPB.Create(FFirebirdAPI as TFBClientAPI); |
467 |
> |
end; |
468 |
> |
|
469 |
> |
function TFBAttachment.AllocateDIRB: IDIRB; |
470 |
> |
begin |
471 |
> |
Result := TDIRB.Create(FFirebirdAPI as TFBClientAPI); |
472 |
|
end; |
473 |
|
|
474 |
|
procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: AnsiString; |
619 |
|
Result := OpenBlob(Transaction,Field.GetBlobMetadata, Field.AsQuad,BPB); |
620 |
|
end; |
621 |
|
|
622 |
+ |
function TFBAttachment.GetDBInformation(Requests: array of byte |
623 |
+ |
): IDBInformation; |
624 |
+ |
var ReqBuffer: PByte; |
625 |
+ |
i: integer; |
626 |
+ |
begin |
627 |
+ |
CheckHandle; |
628 |
+ |
if Length(Requests) = 1 then |
629 |
+ |
Result := GetDBInformation(Requests[0]) |
630 |
+ |
else |
631 |
+ |
begin |
632 |
+ |
GetMem(ReqBuffer,Length(Requests)); |
633 |
+ |
try |
634 |
+ |
for i := 0 to Length(Requests) - 1 do |
635 |
+ |
ReqBuffer[i] := Requests[i]; |
636 |
+ |
|
637 |
+ |
Result := GetDBInfo(ReqBuffer,Length(Requests)); |
638 |
+ |
|
639 |
+ |
finally |
640 |
+ |
FreeMem(ReqBuffer); |
641 |
+ |
end; |
642 |
+ |
end; |
643 |
+ |
end; |
644 |
+ |
|
645 |
+ |
function TFBAttachment.GetDBInformation(Request: byte): IDBInformation; |
646 |
+ |
begin |
647 |
+ |
CheckHandle; |
648 |
+ |
Result := GetDBInfo(@Request,1); |
649 |
+ |
end; |
650 |
+ |
|
651 |
+ |
function TFBAttachment.GetDBInformation(Requests: IDIRB): IDBInformation; |
652 |
+ |
begin |
653 |
+ |
CheckHandle; |
654 |
+ |
with Requests as TDIRB do |
655 |
+ |
Result := GetDBInfo(getBuffer,getDataLength); |
656 |
+ |
end; |
657 |
+ |
|
658 |
|
function TFBAttachment.GetConnectString: AnsiString; |
659 |
|
begin |
660 |
|
Result := FDatabaseName; |
665 |
|
Result := FRemoteProtocol; |
666 |
|
end; |
667 |
|
|
668 |
+ |
function TFBAttachment.GetAuthenticationMethod: AnsiString; |
669 |
+ |
begin |
670 |
+ |
Result := FAuthMethod; |
671 |
+ |
end; |
672 |
+ |
|
673 |
+ |
function TFBAttachment.GetSecurityDatabase: AnsiString; |
674 |
+ |
begin |
675 |
+ |
Result := FSecDatabase; |
676 |
+ |
end; |
677 |
+ |
|
678 |
|
function TFBAttachment.GetODSMajorVersion: integer; |
679 |
|
begin |
680 |
|
Result := FODSMajorVersion; |
764 |
|
begin |
765 |
|
Result := false; |
766 |
|
for i := Low(CharSetMap) to High(CharSetMap) do |
767 |
< |
if AnsiCompareStr(CharSetMap[i].CharSetName, CharSetName) = 0 then |
767 |
> |
if AnsiCompareText(CharSetMap[i].CharSetName, CharSetName) = 0 then |
768 |
|
begin |
769 |
|
CharSetID := CharSetMap[i].CharSetID; |
770 |
|
Result := true; |
772 |
|
end; |
773 |
|
|
774 |
|
for i := 0 to Length(FUserCharSetMap) - 1 do |
775 |
< |
if AnsiCompareStr(FUserCharSetMap[i].CharSetName, CharSetName) = 0 then |
775 |
> |
if AnsiCompareText(FUserCharSetMap[i].CharSetName, CharSetName) = 0 then |
776 |
|
begin |
777 |
|
CharSetID := FUserCharSetMap[i].CharSetID; |
778 |
|
Result := true; |