ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBDatabase.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBDatabase.pas (file contents):
Revision 142 by tony, Mon Jan 22 13:58:14 2018 UTC vs.
Revision 143 by tony, Fri Feb 23 12:11:21 2018 UTC

# Line 27 | Line 27
27   {    IBX For Lazarus (Firebird Express)                                  }
28   {    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29   {    Portions created by MWA Software are copyright McCallum Whyman      }
30 < {    Associates Ltd 2011                                                 }
30 > {    Associates Ltd 2011 - 2018                                               }
31   {                                                                        }
32   {************************************************************************}
33  
# Line 127 | Line 127 | const
127      'trusted_role',
128      'org_filename',
129      'utf8_ilename',
130 <    'ext_call_depth'
131 <  );
130 >    'ext_call_depth',
131 >    'auth_block',
132 >    'client_version',
133 >    'remote_protocol',
134 >    'host_name',
135 >    'os_user',
136 >    'specific_auth_data',
137 >    'auth_plugin_list',
138 >    'auth_plugin_name',
139 >    'config',
140 >    'nolinger',
141 >    'reset_icu',
142 >    'map_attach'
143 >    );
144  
145    TPBPrefix = 'isc_tpb_';
146    TPBConstantNames: array[1..isc_tpb_last_tpb_constant] of string = (
# Line 171 | Line 183 | type
183      FAttachment: IAttachment;
184      FCreateDatabase: boolean;
185      FCreateIfNotExists: boolean;
174    FDPB: IDPB;
186      FAllowStreamedConnected: boolean;
187      FHiddenPassword: string;
188      FOnCreateDatabase: TNotifyEvent;
189      FOnLogin: TIBDatabaseLoginEvent;
190      FSQLHourGlass: Boolean;
191      FTraceFlags: TTraceFlags;
181    FDBSQLDialect: Integer;
192      FSQLDialect: Integer;
193      FOnDialectDowngradeWarning: TNotifyEvent;
194      FSQLObjects: TList;
# Line 195 | Line 205 | type
205      FLoginCalled: boolean;
206      FUseDefaultSystemCodePage: boolean;
207      procedure EnsureInactive;
208 +    function GetAuthenticationMethod: string;
209      function GetDBSQLDialect: Integer;
210      function GetDefaultCharSetID: integer;
211      function GetDefaultCharSetName: AnsiString;
212      function GetDefaultCodePage: TSystemCodePage;
213 <    function GetSQLDialect: Integer;
213 >    function GetRemoteProtocol: string;
214      procedure SetSQLDialect(const Value: Integer);
215      procedure ValidateClientSQLDialect;
216      procedure DBParamsChange(Sender: TObject);
# Line 256 | Line 267 | type
267      procedure RemoveTransactions;
268  
269      property Attachment: IAttachment read FAttachment;
270 <    property DBSQLDialect : Integer read FDBSQLDialect;
270 >    property DBSQLDialect : Integer read GetDBSQLDialect;
271      property IsReadOnly: Boolean read GetIsReadOnly;
272      property SQLObjectCount: Integer read GetSQLObjectCount;
273      property SQLObjects[Index: Integer]: TIBBase read GetSQLObject;
# Line 266 | Line 277 | type
277      property DefaultCharSetName: AnsiString read GetDefaultCharSetName;
278      property DefaultCharSetID: integer read GetDefaultCharSetID;
279      property DefaultCodePage: TSystemCodePage read GetDefaultCodePage;
280 +    property AuthenticationMethod: string read GetAuthenticationMethod;
281 +    property RemoteProtocol: string read GetRemoteProtocol;
282  
283    published
284      property Connected;
# Line 278 | Line 291 | type
291      property DefaultTransaction: TIBTransaction read FDefaultTransaction
292                                                   write SetDefaultTransaction;
293      property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
294 <    property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
294 >    property SQLDialect : Integer read FSQLDialect write SetSQLDialect default 3;
295      property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
296      property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
297      property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage
# Line 476 | Line 489 | function GenerateTPB(sl: TStrings): ITPB
489   implementation
490  
491   uses  IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
492 <     typInfo, FBMessages, IBErrorCodes;
492 >     typInfo, FBMessages, IBErrorCodes {$IFDEF WINDOWS}, Windirs {$ENDIF};
493  
494   { TIBDatabase }
495  
# Line 496 | Line 509 | begin
509    FDBParamsChanged := True;
510    TStringList(FDBParams).OnChange := DBParamsChange;
511    TStringList(FDBParams).OnChanging := DBParamsChanging;
499  FDPB := nil;
512    FUserNames := nil;
513    FInternalTransaction := TIBTransaction.Create(self);
514    FInternalTransaction.DefaultDatabase := Self;
# Line 504 | Line 516 | begin
516    FTimer.Enabled := False;
517    FTimer.Interval := 0;
518    FTimer.OnTimer := TimeoutConnection;
507  FDBSQLDialect := 1;
519    FSQLDialect := 3;
520    FTraceFlags := [];
521    FDataSets := TList.Create;
# Line 524 | Line 535 | begin
535    RemoveSQLObjects;
536    RemoveTransactions;
537    FInternalTransaction.Free;
527  FDPB := nil;
538    FDBParams.Free;
539    FSQLObjects.Free;
540    FUserNames.Free;
# Line 550 | Line 560 | begin
560    end
561   end;
562  
563 + function TIBDataBase.GetAuthenticationMethod: string;
564 + begin
565 +  CheckActive;
566 +  Result := Attachment.GetAuthenticationMethod;
567 + end;
568 +
569   procedure TIBDataBase.CheckInactive;
570   begin
571    if FAttachment <> nil then
# Line 596 | Line 612 | end;
612   begin
613    if Connected then
614      InternalClose(False);
599  FDBSQLDialect := 1;
615   end;
616  
617    procedure TIBDataBase.CreateDatabase;
# Line 610 | Line 625 | end;
625   procedure TIBDataBase.CreateDatabase(createDatabaseSQL: string);
626   begin
627    CheckInactive;
628 <  FAttachment := FirebirdAPI.CreateDatabase(createDatabaseSQL,FSQLDialect);
628 >  FAttachment := FirebirdAPI.CreateDatabase(createDatabaseSQL,SQLDialect);
629    FDBName := Attachment.GetConnectString;
630    if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
631      OnCreateDatabase(self);
# Line 920 | Line 935 | begin
935    end;
936   end;
937  
938 < procedure TIBDataBase.DoConnect;
938 > procedure TIBDataBase.DoConnect;
939 >
940 >  function ExpandDBName(aDBName: string): string;
941 >  const
942 >    TmpPrefix = '$TEMP$';
943 >    DataPrefix = '$DATADIR$';
944 >  var
945 >    LocalDirName: string;
946 >  begin
947 >    if Pos(TmpPrefix,aDBName) = 1 then
948 >    begin
949 >      system.Delete(aDBName,1,Length(TmpPrefix));
950 >      Result := GetTempDir + aDBName
951 >    end
952 >    else
953 >    if Pos(DataPrefix,aDBName) = 1 then
954 >    begin
955 >      system.Delete(aDBName,1,Length(DataPrefix));
956 >      if Sysutils.VendorName <> '' then
957 >        LocalDirName :=  Sysutils.VendorName
958 >      else
959 >        LocalDirName :=  'IBX';
960 >      {$IFDEF UNIX}
961 >      LocalDirName := GetUserDir + '.' + LocalDirName;
962 >      {$ENDIF}
963 >      {$IFDEF WINDOWS}
964 >      LocalDirName := GetWindowsSpecialDir(CSIDL_LOCAL_APPDATA) + LocalDirName;
965 >      {$ENDIF}
966 >      CreateDir(LocalDirName);
967 >      Result := LocalDirName + DirectorySeparator + aDBName;
968 >    end
969 >    else
970 >      Result := aDBName;
971 >  end;
972 >
973   var
974    TempDBParams: TStrings;
975    I: integer;
# Line 928 | Line 977 | var
977    Status: IStatus;
978    CharSetID: integer;
979    CharSetName: AnsiString;
980 +  DPB: IDPB;
981 +  PW: IDPBItem;
982   begin
983 +  DPB := nil;
984    CheckInactive;
985    CheckDatabaseName;
986    if (not LoginPrompt) and (FHiddenPassword <> '') then
# Line 937 | Line 989 | begin
989      FDBParamsChanged := True;
990    end;
991    { Use builtin login prompt if requested }
992 <  aDBName := FDBName;
992 >  aDBName := ExpandDBName(FDBName);
993 >
994    if (LoginPrompt or (csDesigning in ComponentState)) and not Login(aDBName) then
995      IBError(ibxeOperationCancelled, [nil]);
996  
# Line 958 | Line 1011 | begin
1011  
1012     repeat
1013       { Generate a new DPB if necessary }
1014 <     if (FDPB = nil) or FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text) then
1014 >     if (DPB = nil) or FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text) then
1015       begin
1016         FDBParamsChanged := False;
1017         if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
1018 <         FDPB := GenerateDPB(TempDBParams)
1018 >         DPB := GenerateDPB(TempDBParams)
1019         else
1020         begin
1021            TempDBParams.Values['password'] := FHiddenPassword;
1022 <          FDPB := GenerateDPB(TempDBParams);
1022 >          DPB := GenerateDPB(TempDBParams);
1023         end;
1024       end;
1025  
1026       if FCreateDatabase then
1027       begin
1028         FCreateDatabase := false;
1029 <       FAttachment := FirebirdAPI.CreateDatabase(aDBName,FDPB, false);
1029 >       DPB.Add(isc_dpb_set_db_SQL_dialect).AsByte := SQLDialect; {create with this SQL Dialect}
1030 >       FAttachment := FirebirdAPI.CreateDatabase(aDBName,DPB, false);
1031 >       if FAttachment = nil then
1032 >         DPB := nil;
1033         if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
1034           OnCreateDatabase(self);
1035       end
1036       else
1037 <       FAttachment := FirebirdAPI.OpenDatabase(aDBName,FDPB,false);
1037 >       FAttachment := FirebirdAPI.OpenDatabase(aDBName,DPB,false);
1038  
1039       if FAttachment = nil then
1040       begin
1041         Status := FirebirdAPI.GetStatus;
1042         {$IFDEF UNIX}
1043 <       if Pos(':',aDBName) = 0 then
1043 >       if GetProtocol(aDBName) = Local then
1044         begin
1045             if ((Status.GetSQLCode = -901) and (Status.GetIBErrorCode = isc_random)) {Access permissions on firebird temp}
1046                or
# Line 1032 | Line 1088 | begin
1088    finally
1089     TempDBParams.Free;
1090    end;
1091 +  PW := Attachment.getDPB.Find(isc_dpb_password);
1092 +  if PW <> nil then PW.AsString := 'xxxxxxxx'; {Hide password}
1093  
1094    if not (csDesigning in ComponentState) then
1095      FDBName := aDBName; {Synchronise at run time}
1038  FDBSQLDialect := GetDBSQLDialect;
1096    ValidateClientSQLDialect;
1097    for i := 0 to FSQLObjects.Count - 1 do
1098    begin
# Line 1217 | Line 1274 | begin
1274    DatabaseInfo.Free;
1275   end;
1276  
1220 function TIBDataBase.GetSQLDialect: Integer;
1221 begin
1222  Result := FSQLDialect;
1223 end;
1224
1277  
1278   procedure TIBDataBase.SetSQLDialect( const Value: Integer);
1279   begin
1280    if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
1281 <  if ((FAttachment = nil) or (Value <= FDBSQLDialect))  then
1281 >  if (Attachment = nil) or (Value <= DBSQLDialect)  then
1282      FSQLDialect := Value
1283    else
1284      IBError(ibxeSQLDialectInvalid, [nil]);
1285   end;
1286  
1287   function TIBDataBase.GetDBSQLDialect: Integer;
1236 var
1237  DatabaseInfo: TIBDatabaseInfo;
1288   begin
1289 <  DatabaseInfo := TIBDatabaseInfo.Create(self);
1290 <  DatabaseInfo.Database := self;
1241 <  result := DatabaseInfo.DBSQLDialect;
1242 <  DatabaseInfo.Free;
1289 >  CheckActive;
1290 >  Result := Attachment.GetSQLDialect;
1291   end;
1292  
1293   function TIBDataBase.GetDefaultCharSetID: integer;
# Line 1266 | Line 1314 | begin
1314      Result := CP_NONE;
1315   end;
1316  
1317 + function TIBDataBase.GetRemoteProtocol: string;
1318 + begin
1319 +  CheckActive;
1320 +  Result := Attachment.GetRemoteProtocol;
1321 + end;
1322 +
1323   procedure TIBDataBase.ValidateClientSQLDialect;
1324   begin
1325 <  if (FDBSQLDialect < FSQLDialect) then
1325 >  if (DBSQLDialect < FSQLDialect) then
1326    begin
1327 <    FSQLDialect := FDBSQLDialect;
1327 >    FSQLDialect := DBSQLDialect;
1328      if Assigned (FOnDialectDowngradeWarning) then
1329        FOnDialectDowngradeWarning(self);
1330    end;
# Line 1358 | Line 1412 | begin
1412      Query.SQL.Text := 'Select R.RDB$FIELD_NAME ' + {do not localize}
1413        'from RDB$RELATION_FIELDS R ' + {do not localize}
1414        'where R.RDB$RELATION_NAME = ' + {do not localize}
1415 <      '''' + ExtractIdentifier(SQLDialect, TableName) +
1415 >      '''' + ExtractIdentifier(DBSQLDialect, TableName) +
1416        ''' and Exists(Select * From RDB$FIELDS F Where R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME)' ; {do not localize}
1417      Query.Prepare;
1418      Query.ExecQuery;
# Line 2189 | Line 2243 | begin
2243      case DPBVal of
2244        isc_dpb_user_name, isc_dpb_password, isc_dpb_password_enc,
2245        isc_dpb_sys_user_name, isc_dpb_license, isc_dpb_encrypt_key,
2246 <      isc_dpb_lc_messages, isc_dpb_lc_ctype,
2246 >      isc_dpb_lc_messages, isc_dpb_lc_ctype, isc_dpb_page_size,
2247        isc_dpb_sql_role_name, isc_dpb_sql_dialect:
2248        begin
2249          if DPBVal = isc_dpb_sql_dialect then
# Line 2208 | Line 2262 | begin
2262          Result.Add(DPBVal).SetAsInteger(StrToInt(ParamValue));
2263  
2264        isc_dpb_activate_shadow, isc_dpb_delete_shadow, isc_dpb_begin_log,
2265 <      isc_dpb_quit_log:
2265 >      isc_dpb_map_attach, isc_dpb_quit_log:
2266          Result.Add(DPBVal).SetAsByte(0);
2267        else
2268        begin

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines