ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/client/FBAttachment.pas
(Generate patch)

Comparing ibx/trunk/fbintf/client/FBAttachment.pas (file contents):
Revision 120 by tony, Mon Jan 22 13:58:20 2018 UTC vs.
Revision 263 by tony, Thu Dec 6 15:55:01 2018 UTC

# Line 38 | Line 38 | unit FBAttachment;
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
# Line 58 | Line 59 | type
59      FODSMajorVersion: integer;
60      FODSMinorVersion: integer;
61      FUserCharSetMap: array of TCharSetMap;
62 +    FSecDatabase: AnsiString;
63    protected
64      FDatabaseName: AnsiString;
65      FRaiseExceptionOnConnectError: boolean;
# Line 66 | Line 68 | type
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;
# Line 120 | Line 126 | type
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}
# Line 142 | Line 151 | public
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 = (
# Line 244 | Line 253 | begin
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 '+
# Line 253 | Line 281 | begin
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
# Line 262 | Line 290 | begin
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;
# Line 423 | Line 451 | begin
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;
# Line 430 | Line 463 | end;
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;
# Line 581 | Line 619 | begin
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;
# Line 591 | Line 665 | begin
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;
# Line 680 | Line 764 | var i: integer;
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;
# Line 688 | Line 772 | begin
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;

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines