ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/branches/journaling/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 120 by tony, Mon Jan 22 13:58:20 2018 UTC

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

Diff Legend

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