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 270 by tony, Fri Jan 18 11:10:37 2019 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 108 | Line 114 | type
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  
# Line 120 | Line 128 | type
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}
# Line 142 | Line 153 | public
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 = (
# Line 244 | Line 255 | begin
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 '+
# Line 253 | Line 283 | begin
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
# Line 262 | Line 292 | begin
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;
# Line 423 | Line 453 | begin
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;
# Line 430 | Line 465 | end;
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;
# Line 553 | Line 593 | begin
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;
# Line 581 | Line 621 | begin
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;
# Line 591 | Line 667 | begin
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;
# Line 680 | Line 766 | var i: integer;
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;
# Line 688 | Line 774 | begin
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;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines