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 60 by tony, Mon Mar 27 15:21:02 2017 UTC vs.
Revision 117 by tony, Mon Jan 22 13:58:11 2018 UTC

# Line 54 | Line 54 | type
54    private
55      FDPB: IDPB;
56      FFirebirdAPI: IFirebirdAPI;
57 +    FODSMajorVersion: integer;
58 +    FODSMinorVersion: integer;
59      FUserCharSetMap: array of TCharSetMap;
60    protected
61      FDatabaseName: AnsiString;
# Line 62 | Line 64 | type
64      FHasDefaultCharSet: boolean;
65      FCharSetID: integer;
66      FCodePage: TSystemCodePage;
67 +    FRemoteProtocol: AnsiString;
68      constructor Create(DatabaseName: AnsiString; DPB: IDPB;
69        RaiseExceptionOnConnectError: boolean);
70      procedure CheckHandle; virtual; abstract;
71      function GenerateCreateDatabaseSQL(DatabaseName: AnsiString; aDPB: IDPB): AnsiString;
72 +    procedure GetODSAndConnectionInfo;
73 +    function IsConnected: boolean; virtual; abstract;
74      procedure EndAllTransactions;
75 +    procedure DPBFromCreateSQL(CreateSQL: AnsiString);
76      procedure SetParameters(SQLParams: ISQLParams; params: array of const);
77    public
78      destructor Destroy; override;
# Line 113 | Line 119 | type
119      property SQLDialect: integer read FSQLDialect;
120      property DPB: IDPB read FDPB;
121   public
122 <    {Character Sets}
122 >  function GetDBInformation(Requests: array of byte): IDBInformation; overload; virtual; abstract;
123 >  function GetDBInformation(Request: byte): IDBInformation; overload; virtual; abstract;
124 >  function GetConnectString: AnsiString;
125 >  function GetRemoteProtocol: AnsiString;
126 >  function GetODSMajorVersion: integer;
127 >  function GetODSMinorVersion: integer;
128 >  {Character Sets}
129 >  function HasDefaultCharSet: boolean;
130 >  function GetDefaultCharSetID: integer;
131    function GetCharsetName(CharSetID: integer): AnsiString;
132    function CharSetID2CodePage(CharSetID: integer; var CodePage: TSystemCodePage): boolean;
133    function CodePage2CharSetID(CodePage: TSystemCodePage; var CharSetID: integer): boolean;
# Line 121 | Line 135 | public
135    function CharSetWidth(CharSetID: integer; var Width: integer): boolean;
136    procedure RegisterCharSet(CharSetName: AnsiString; CodePage: TSystemCodePage;
137      AllowReverseLookup:boolean; out CharSetID: integer);
124 –  property HasDefaultCharSet: boolean read FHasDefaultCharSet;
138    property CharSetID: integer read FCharSetID;
139    property CodePage: TSystemCodePage read FCodePage;
140    end;
141  
142   implementation
143  
144 < uses FBMessages, FBTransaction;
144 > uses FBMessages, FBTransaction, RegExpr;
145  
146   const
147    CharSetMap: array [0..69] of TCharsetMap = (
# Line 209 | Line 222 | const
222  
223   { TFBAttachment }
224  
225 + procedure TFBAttachment.GetODSAndConnectionInfo;
226 + var DBInfo: IDBInformation;
227 +    i: integer;
228 +    Stmt: IStatement;
229 +    ResultSet: IResultSet;
230 +    Param: IDPBItem;
231 + begin
232 +  if not IsConnected then Exit;
233 +  DBInfo := GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version,
234 +                               isc_info_db_SQL_Dialect]);
235 +  for i := 0 to DBInfo.GetCount - 1 do
236 +    with DBInfo[i] do
237 +      case getItemType of
238 +      isc_info_ods_minor_version:
239 +        FODSMinorVersion := getAsInteger;
240 +      isc_info_ods_version:
241 +        FODSMajorVersion := getAsInteger;
242 +      isc_info_db_SQL_Dialect:
243 +        FSQLDialect := getAsInteger;
244 +      end;
245 +
246 +  if (FODSMajorVersion > 11) or ((FODSMajorVersion = 11) and (FODSMinorVersion >= 1)) then
247 +  begin
248 +    Stmt := Prepare(StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit),
249 +                    'Select MON$CHARACTER_SET_ID, MON$REMOTE_PROTOCOL From MON$ATTACHMENTS '+
250 +                    'Where MON$ATTACHMENT_ID = CURRENT_CONNECTION');
251 +    ResultSet := Stmt.OpenCursor;
252 +    if ResultSet.FetchNext then
253 +    begin
254 +      FCharSetID := ResultSet[0].AsInteger;
255 +      FRemoteProtocol := ResultSet[1].AsString;
256 +    end
257 +  end
258 +  else
259 +  if DPB <> nil then
260 +  begin
261 +    Param :=  DPB.Find(isc_dpb_lc_ctype);
262 +    if (Param = nil) or not CharSetName2CharSetID(Param.AsString,FCharSetID) then
263 +      FCharSetID := 0;
264 +      FRemoteProtocol := '';
265 +  end
266 +  else
267 +  begin
268 +    FCharSetID := 0;
269 +    FRemoteProtocol := '';
270 +  end;
271 +  FHasDefaultCharSet := CharSetID2CodePage(FCharSetID,FCodePage) and (FCharSetID > 1);
272 + end;
273 +
274   constructor TFBAttachment.Create(DatabaseName: AnsiString; DPB: IDPB;
275    RaiseExceptionOnConnectError: boolean);
276   begin
# Line 219 | Line 281 | begin
281    FDPB := DPB;
282    SetLength(FUserCharSetMap,0);
283    FRaiseExceptionOnConnectError := RaiseExceptionOnConnectError;
284 +  FODSMajorVersion := 0;
285 +  FODSMinorVersion := 0;
286   end;
287  
288   function TFBAttachment.GenerateCreateDatabaseSQL(DatabaseName: AnsiString;  aDPB: IDPB): AnsiString;
# Line 265 | Line 329 | begin
329    end;
330   end;
331  
332 + procedure TFBAttachment.DPBFromCreateSQL(CreateSQL: AnsiString);
333 + var RegexObj: TRegExpr;
334 + begin
335 +  FDPB := FFirebirdAPI.AllocateDPB;
336 +  RegexObj := TRegExpr.Create;
337 +  try
338 +    {extact database file spec}
339 +    RegexObj.ModifierG := false; {turn off greedy matches}
340 +    RegexObj.ModifierI := true; {case insensitive match}
341 +    RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''.*'' +USER +''(.+)'' PASSWORD +''(.+)''';
342 +    if RegexObj.Exec(CreateSQL) then
343 +    begin
344 +      DPB.Add(isc_dpb_user_name).AsString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
345 +      DPB.Add(isc_dpb_password).AsString := system.copy(CreateSQL,RegexObj.MatchPos[3],RegexObj.MatchLen[3]);
346 +    end
347 +    else
348 +    begin
349 +      RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +(''.*'') +USER +''(.+)''';
350 +      if RegexObj.Exec(CreateSQL) then
351 +        DPB.Add(isc_dpb_user_name).AsString := system.copy(CreateSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
352 +    end;
353 +  finally
354 +    RegexObj.Free;
355 +  end;
356 +  if FCharSetID > 0 then
357 +    DPB.Add(isc_dpb_lc_ctype).AsString := GetCharSetName(FCharSetID);
358 +  DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(FSQLDialect);
359 + end;
360 +
361   procedure TFBAttachment.SetParameters(SQLParams: ISQLParams;
362    params: array of const);
363   var i: integer;
# Line 277 | Line 370 | begin
370      case params[i].vtype of
371        vtinteger    :
372          SQLParams[i].AsInteger := params[i].vinteger;
373 +      vtInt64:
374 +        SQLParams[i].AsInt64 := params[i].VInt64^;
375 +      {$IF declared (vtQWord)}
376 +      vtQWord:
377 +        SQLParams[i].AsInt64 := params[i].VQWord^;
378 +      {$IFEND}
379        vtboolean    :
380          SQLParams[i].AsBoolean :=  params[i].vboolean;
381        vtchar       :
# Line 286 | Line 385 | begin
385        vtCurrency:
386          SQLParams[i].AsDouble := params[i].VCurrency^;
387        vtString     :
388 <        SQLParams[i].AsString := params[i].VString^;
388 >        SQLParams[i].AsString := strpas(PChar(params[i].VString));
389        vtPChar      :
390          SQLParams[i].AsString := strpas(params[i].VPChar);
391        vtAnsiString :
392 <        SQLParams[i].AsString := AnsiString(params[i].VAnsiString^);
392 >        SQLParams[i].AsString := strpas(PAnsiChar(params[i].VAnsiString));
393        vtVariant:
394          SQLParams[i].AsVariant := params[i].VVariant^;
395 +      vtWideChar:
396 +        SQLParams[i].AsString := UTF8Encode(WideCharLenToString(@params[i].VWideChar,1));
397 +      vtPWideChar:
398 +        SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VPWideChar)));
399 +      vtWideString:
400 +        SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VWideString)));
401 +      vtUnicodeString:
402 +        SQLParams[i].AsString := UTF8Encode(strpas(PWideChar(params[i].VUnicodeString)));
403      else
404          IBError(ibxeInvalidVariantType,[nil]);
405      end;
# Line 334 | Line 441 | end;
441   function TFBAttachment.ExecuteSQL(TPB: array of byte; sql: AnsiString;
442    SQLDialect: integer; params: array of const): IResults;
443   begin
444 <  Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,FSQLDialect,params);
444 >  Result := ExecuteSQL(StartTransaction(TPB,taCommit),sql,SQLDialect,params);
445   end;
446  
447   function TFBAttachment.ExecuteSQL(transaction: ITransaction; sql: AnsiString;
# Line 463 | Line 570 | begin
570    Result := OpenBlob(Transaction,Field.GetBlobMetadata, Field.AsQuad,BPB);
571   end;
572  
573 + function TFBAttachment.GetConnectString: AnsiString;
574 + begin
575 +  Result := FDatabaseName;
576 + end;
577 +
578 + function TFBAttachment.GetRemoteProtocol: AnsiString;
579 + begin
580 +  Result := FRemoteProtocol;
581 + end;
582 +
583 + function TFBAttachment.GetODSMajorVersion: integer;
584 + begin
585 +  Result := FODSMajorVersion;
586 + end;
587 +
588 + function TFBAttachment.GetODSMinorVersion: integer;
589 + begin
590 +  Result := FODSMinorVersion;
591 + end;
592 +
593 + function TFBAttachment.HasDefaultCharSet: boolean;
594 + begin
595 +  Result := FHasDefaultCharSet
596 + end;
597 +
598 + function TFBAttachment.GetDefaultCharSetID: integer;
599 + begin
600 +  Result := FCharsetID;
601 + end;
602 +
603   function TFBAttachment.GetCharsetName(CharSetID: integer): AnsiString;
604   var i: integer;
605   begin

Diff Legend

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