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 109 by tony, Thu Jan 18 14:37:48 2018 UTC vs.
Revision 118 by tony, Mon Jan 22 13:58:14 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}
34   {$ENDIF}
35  
36   {$IFDEF FPC}
37   {$mode delphi}
38   {$interfaces COM}
39 + {$define HASREQEX}
40   {$ENDIF}
41  
42   interface
# Line 54 | Line 59 | type
59    private
60      FDPB: IDPB;
61      FFirebirdAPI: IFirebirdAPI;
62 +    FODSMajorVersion: integer;
63 +    FODSMinorVersion: integer;
64      FUserCharSetMap: array of TCharSetMap;
65    protected
66      FDatabaseName: AnsiString;
# Line 62 | Line 69 | type
69      FHasDefaultCharSet: boolean;
70      FCharSetID: integer;
71      FCodePage: TSystemCodePage;
72 +    FRemoteProtocol: AnsiString;
73      constructor Create(DatabaseName: AnsiString; DPB: IDPB;
74        RaiseExceptionOnConnectError: boolean);
75      procedure CheckHandle; virtual; abstract;
76      function GenerateCreateDatabaseSQL(DatabaseName: AnsiString; aDPB: IDPB): AnsiString;
77 +    procedure GetODSAndConnectionInfo;
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;
# Line 113 | Line 124 | type
124      property SQLDialect: integer read FSQLDialect;
125      property DPB: IDPB read FDPB;
126   public
127 <    {Character Sets}
127 >  function GetDBInformation(Requests: array of byte): IDBInformation; overload; virtual; abstract;
128 >  function GetDBInformation(Request: byte): IDBInformation; overload; virtual; abstract;
129 >  function GetConnectString: AnsiString;
130 >  function GetRemoteProtocol: AnsiString;
131 >  function GetODSMajorVersion: integer;
132 >  function GetODSMinorVersion: integer;
133 >  {Character Sets}
134    function HasDefaultCharSet: boolean;
135    function GetDefaultCharSetID: integer;
136    function GetCharsetName(CharSetID: integer): AnsiString;
# Line 129 | Line 146 | public
146  
147   implementation
148  
149 < uses FBMessages, FBTransaction;
149 > uses FBMessages, FBTransaction {$IFDEF HASREQEX}, RegExpr{$ENDIF};
150  
151   const
152    CharSetMap: array [0..69] of TCharsetMap = (
# Line 210 | Line 227 | const
227  
228   { TFBAttachment }
229  
230 + procedure TFBAttachment.GetODSAndConnectionInfo;
231 + var DBInfo: IDBInformation;
232 +    i: integer;
233 +    Stmt: IStatement;
234 +    ResultSet: IResultSet;
235 +    Param: IDPBItem;
236 + begin
237 +  if not IsConnected then Exit;
238 +  DBInfo := GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version,
239 +                               isc_info_db_SQL_Dialect]);
240 +  for i := 0 to DBInfo.GetCount - 1 do
241 +    with DBInfo[i] do
242 +      case getItemType of
243 +      isc_info_ods_minor_version:
244 +        FODSMinorVersion := getAsInteger;
245 +      isc_info_ods_version:
246 +        FODSMajorVersion := getAsInteger;
247 +      isc_info_db_SQL_Dialect:
248 +        FSQLDialect := getAsInteger;
249 +      end;
250 +
251 +  if (FODSMajorVersion > 11) or ((FODSMajorVersion = 11) and (FODSMinorVersion >= 1)) then
252 +  begin
253 +    Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
254 +                    'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL From MON$ATTACHMENTS '+
255 +                    'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION');
256 +    ResultSet := Stmt.OpenCursor;
257 +    if ResultSet.FetchNext then
258 +    begin
259 +      FCharSetID := ResultSet[0].AsInteger;
260 +      FRemoteProtocol := ResultSet[1].AsString;
261 +    end
262 +  end
263 +  else
264 +  if DPB <> nil then
265 +  begin
266 +    Param :=  DPB.Find(isc_dpb_lc_ctype);
267 +    if (Param = nil) or not CharSetName2CharSetID(Param.AsString,FCharSetID) then
268 +      FCharSetID := 0;
269 +      FRemoteProtocol := '';
270 +  end
271 +  else
272 +  begin
273 +    FCharSetID := 0;
274 +    FRemoteProtocol := '';
275 +  end;
276 +  FHasDefaultCharSet := CharSetID2CodePage(FCharSetID,FCodePage) and (FCharSetID > 1);
277 + end;
278 +
279   constructor TFBAttachment.Create(DatabaseName: AnsiString; DPB: IDPB;
280    RaiseExceptionOnConnectError: boolean);
281   begin
# Line 220 | Line 286 | begin
286    FDPB := DPB;
287    SetLength(FUserCharSetMap,0);
288    FRaiseExceptionOnConnectError := RaiseExceptionOnConnectError;
289 +  FODSMajorVersion := 0;
290 +  FODSMinorVersion := 0;
291   end;
292  
293   function TFBAttachment.GenerateCreateDatabaseSQL(DatabaseName: AnsiString;  aDPB: IDPB): AnsiString;
# Line 266 | Line 334 | begin
334    end;
335   end;
336  
337 + {$IFDEF HASREQEX}
338 + procedure TFBAttachment.DPBFromCreateSQL(CreateSQL: AnsiString);
339 + var RegexObj: TRegExpr;
340 + begin
341 +  FDPB := FFirebirdAPI.AllocateDPB;
342 +  RegexObj := TRegExpr.Create;
343 +  try
344 +    {extact database file spec}
345 +    RegexObj.ModifierG := false; {turn off greedy matches}
346 +    RegexObj.ModifierI := true; {case insensitive match}
347 +    RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''.*'' +USER +''(.+)'' PASSWORD +''(.+)''';
348 +    if RegexObj.Exec(CreateSQL) then
349 +    begin
350 +      DPB.Add(isc_dpb_user_name).AsString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
351 +      DPB.Add(isc_dpb_password).AsString := system.copy(CreateSQL,RegexObj.MatchPos[3],RegexObj.MatchLen[3]);
352 +    end
353 +    else
354 +    begin
355 +      RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +(''.*'') +USER +''(.+)''';
356 +      if RegexObj.Exec(CreateSQL) then
357 +        DPB.Add(isc_dpb_user_name).AsString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
358 +    end;
359 +  finally
360 +    RegexObj.Free;
361 +  end;
362 +  if FCharSetID > 0 then
363 +    DPB.Add(isc_dpb_lc_ctype).AsString := GetCharSetName(FCharSetID);
364 +  DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(FSQLDialect);
365 + end;
366 + {$ELSE}
367 + procedure TFBAttachment.DPBFromCreateSQL(CreateSQL: AnsiString);
368 + end;
369 + {$ENDIF}
370 +
371   procedure TFBAttachment.SetParameters(SQLParams: ISQLParams;
372    params: array of const);
373   var i: integer;
# Line 349 | Line 451 | end;
451   function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: AnsiString;
452    SQLDialect: integer; params: array of const): IResults;
453   begin
454 <  Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,FSQLDialect,params);
454 >  Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,SQLDialect,params);
455   end;
456  
457   function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: AnsiString;
# Line 478 | Line 580 | begin
580    Result := OpenBlob(Transaction,Field.GetBlobMetadata, Field.AsQuad,BPB);
581   end;
582  
583 + function TFBAttachment.GetConnectString: AnsiString;
584 + begin
585 +  Result := FDatabaseName;
586 + end;
587 +
588 + function TFBAttachment.GetRemoteProtocol: AnsiString;
589 + begin
590 +  Result := FRemoteProtocol;
591 + end;
592 +
593 + function TFBAttachment.GetODSMajorVersion: integer;
594 + begin
595 +  Result := FODSMajorVersion;
596 + end;
597 +
598 + function TFBAttachment.GetODSMinorVersion: integer;
599 + begin
600 +  Result := FODSMinorVersion;
601 + end;
602 +
603   function TFBAttachment.HasDefaultCharSet: boolean;
604   begin
605    Result := FHasDefaultCharSet

Diff Legend

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