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

Comparing ibx/trunk/fbintf/client/FBAttachment.pas (file contents):
Revision 118 by tony, Mon Jan 22 13:58:14 2018 UTC vs.
Revision 209 by tony, Wed Mar 14 12:48:51 2018 UTC

# Line 27 | Line 27
27   unit FBAttachment;
28   {$IFDEF MSWINDOWS}
29   {$DEFINE WINDOWS}
30 {$IF CompilerVersion >= 28}
31 {Delphi XE7 onwards}}
32 {$define HASREQEX}
33 {$IFEND}
30   {$ENDIF}
31  
32   {$IFDEF FPC}
# Line 62 | Line 58 | type
58      FODSMajorVersion: integer;
59      FODSMinorVersion: integer;
60      FUserCharSetMap: array of TCharSetMap;
61 +    FSecDatabase: AnsiString;
62    protected
63      FDatabaseName: AnsiString;
64      FRaiseExceptionOnConnectError: boolean;
# Line 70 | Line 67 | type
67      FCharSetID: integer;
68      FCodePage: TSystemCodePage;
69      FRemoteProtocol: AnsiString;
70 +    FAuthMethod: AnsiString;
71      constructor Create(DatabaseName: AnsiString; DPB: IDPB;
72        RaiseExceptionOnConnectError: boolean);
73      procedure CheckHandle; virtual; abstract;
74      function GenerateCreateDatabaseSQL(DatabaseName: AnsiString; aDPB: IDPB): AnsiString;
75      procedure GetODSAndConnectionInfo;
76 +    function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation; virtual; abstract;
77      function IsConnected: boolean; virtual; abstract;
78      procedure EndAllTransactions;
79      procedure DPBFromCreateSQL(CreateSQL: AnsiString);
# Line 83 | Line 82 | type
82      destructor Destroy; override;
83      function getDPB: IDPB;
84      function AllocateBPB: IBPB;
85 +    function AllocateDIRB: IDIRB;
86      function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
87      function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; overload; virtual; abstract;
88      procedure Disconnect(Force: boolean=false); virtual; abstract;
# Line 124 | Line 124 | type
124      property SQLDialect: integer read FSQLDialect;
125      property DPB: IDPB read FDPB;
126   public
127 <  function GetDBInformation(Requests: array of byte): IDBInformation; overload; virtual; abstract;
128 <  function GetDBInformation(Request: byte): IDBInformation; overload; virtual; abstract;
127 >  function GetDBInformation(Requests: array of byte): IDBInformation; overload;
128 >  function GetDBInformation(Request: byte): IDBInformation; overload;
129 >  function GetDBInformation(Requests: IDIRB): IDBInformation; overload;
130    function GetConnectString: AnsiString;
131    function GetRemoteProtocol: AnsiString;
132 +  function GetAuthenticationMethod: AnsiString;
133 +  function GetSecurityDatabase: AnsiString;
134    function GetODSMajorVersion: integer;
135    function GetODSMinorVersion: integer;
136    {Character Sets}
# Line 146 | Line 149 | public
149  
150   implementation
151  
152 < uses FBMessages, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
152 > uses FBMessages, IBUtils, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
153  
154   const
155    CharSetMap: array [0..69] of TCharsetMap = (
# Line 248 | Line 251 | begin
251          FSQLDialect := getAsInteger;
252        end;
253  
254 <  if (FODSMajorVersion > 11) or ((FODSMajorVersion = 11) and (FODSMinorVersion >= 1)) then
254 >  FCharSetID := 0;
255 >  FRemoteProtocol := '';
256 >  FAuthMethod := 'Legacy_Auth';
257 >  FSecDatabase := 'Default';
258 >  if FODSMajorVersion > 11 then
259 >  begin
260 >    Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
261 >                    'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL, MON$AUTH_METHOD, MON$SEC_DATABASE From MON$ATTACHMENTS, MON$DATABASE '+
262 >                    'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION');
263 >    ResultSet := Stmt.OpenCursor;
264 >    if ResultSet.FetchNext then
265 >    begin
266 >      FCharSetID := ResultSet[0].AsInteger;
267 >      FRemoteProtocol := Trim(ResultSet[1].AsString);
268 >      FAuthMethod := Trim(ResultSet[2].AsString);
269 >      FSecDatabase := Trim(ResultSet[3].AsString);
270 >    end
271 >  end
272 >  else
273 >  if (FODSMajorVersion = 11) and (FODSMinorVersion >= 1) then
274    begin
275      Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
276                      'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL From MON$ATTACHMENTS '+
# Line 257 | Line 279 | begin
279      if ResultSet.FetchNext then
280      begin
281        FCharSetID := ResultSet[0].AsInteger;
282 <      FRemoteProtocol := ResultSet[1].AsString;
282 >      FRemoteProtocol := Trim(ResultSet[1].AsString);
283      end
284    end
285    else
# Line 266 | Line 288 | begin
288      Param :=  DPB.Find(isc_dpb_lc_ctype);
289      if (Param = nil) or not CharSetName2CharSetID(Param.AsString,FCharSetID) then
290        FCharSetID := 0;
291 <      FRemoteProtocol := '';
292 <  end
293 <  else
294 <  begin
295 <    FCharSetID := 0;
296 <    FRemoteProtocol := '';
291 >    case GetProtocol(FDatabaseName) of
292 >    TCP:       FRemoteProtocol := 'TCPv4';
293 >    Local:     FRemoteProtocol := '';
294 >    NamedPipe: FRemoteProtocol := 'Netbui';
295 >    SPX:       FRemoteProtocol := 'SPX'
296 >    end;
297    end;
298    FHasDefaultCharSet := CharSetID2CodePage(FCharSetID,FCodePage) and (FCharSetID > 1);
299   end;
# Line 365 | Line 387 | begin
387   end;
388   {$ELSE}
389   procedure TFBAttachment.DPBFromCreateSQL(CreateSQL: AnsiString);
390 + begin
391 +  FDPB := FFirebirdAPI.AllocateDPB;
392 +  if FCharSetID > 0 then
393 +    DPB.Add(isc_dpb_lc_ctype).AsString := GetCharSetName(FCharSetID);
394 +  DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(FSQLDialect);
395   end;
396   {$ENDIF}
397  
# Line 432 | Line 459 | begin
459    Result := TBPB.Create;
460   end;
461  
462 + function TFBAttachment.AllocateDIRB: IDIRB;
463 + begin
464 +  Result := TDIRB.Create;
465 + end;
466 +
467   procedure TFBAttachment.ExecImmediate(TPB: array of byte; sql: AnsiString;
468    aSQLDialect: integer);
469   begin
# Line 580 | Line 612 | begin
612    Result := OpenBlob(Transaction,Field.GetBlobMetadata, Field.AsQuad,BPB);
613   end;
614  
615 + function TFBAttachment.GetDBInformation(Requests: array of byte
616 +  ): IDBInformation;
617 + var ReqBuffer: PByte;
618 +    i: integer;
619 + begin
620 +  CheckHandle;
621 +  if Length(Requests) = 1 then
622 +    Result := GetDBInformation(Requests[0])
623 +  else
624 +  begin
625 +    GetMem(ReqBuffer,Length(Requests));
626 +    try
627 +      for i := 0 to Length(Requests) - 1 do
628 +        ReqBuffer[i] := Requests[i];
629 +
630 +      Result := GetDBInfo(ReqBuffer,Length(Requests));
631 +
632 +    finally
633 +      FreeMem(ReqBuffer);
634 +    end;
635 +  end;
636 + end;
637 +
638 + function TFBAttachment.GetDBInformation(Request: byte): IDBInformation;
639 + begin
640 +  CheckHandle;
641 +  Result := GetDBInfo(@Request,1);
642 + end;
643 +
644 + function TFBAttachment.GetDBInformation(Requests: IDIRB): IDBInformation;
645 + begin
646 +  CheckHandle;
647 +  with Requests as TDIRB do
648 +    Result := GetDBInfo(getBuffer,getDataLength);
649 + end;
650 +
651   function TFBAttachment.GetConnectString: AnsiString;
652   begin
653    Result := FDatabaseName;
# Line 590 | Line 658 | begin
658    Result := FRemoteProtocol;
659   end;
660  
661 + function TFBAttachment.GetAuthenticationMethod: AnsiString;
662 + begin
663 +  Result := FAuthMethod;
664 + end;
665 +
666 + function TFBAttachment.GetSecurityDatabase: AnsiString;
667 + begin
668 +  Result := FSecDatabase;
669 + end;
670 +
671   function TFBAttachment.GetODSMajorVersion: integer;
672   begin
673    Result := FODSMajorVersion;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines