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 47 by tony, Mon Jan 9 15:31:51 2017 UTC vs.
Revision 118 by tony, Mon Jan 22 13:58:14 2018 UTC

# Line 171 | Line 171 | type
171      FAttachment: IAttachment;
172      FCreateDatabase: boolean;
173      FCreateIfNotExists: boolean;
174    FDefaultCharSetID: integer;
175    FDefaultCharSetName: RawByteString;
176    FDefaultCodePage: TSystemCodePage;
174      FDPB: IDPB;
175      FAllowStreamedConnected: boolean;
176      FHiddenPassword: string;
# Line 199 | Line 196 | type
196      FUseDefaultSystemCodePage: boolean;
197      procedure EnsureInactive;
198      function GetDBSQLDialect: Integer;
199 +    function GetDefaultCharSetID: integer;
200 +    function GetDefaultCharSetName: AnsiString;
201 +    function GetDefaultCodePage: TSystemCodePage;
202      function GetSQLDialect: Integer;
203      procedure SetSQLDialect(const Value: Integer);
204      procedure ValidateClientSQLDialect;
# Line 263 | Line 263 | type
263      property TransactionCount: Integer read GetTransactionCount;
264      property Transactions[Index: Integer]: TIBTransaction read GetTransaction;
265      property InternalTransaction: TIBTransaction read FInternalTransaction;
266 <    property DefaultCharSetName: RawByteString read FDefaultCharSetName;
267 <    property DefaultCharSetID: integer read FDefaultCharSetID;
268 <    property DefaultCodePage: TSystemCodePage read FDefaultCodePage;
266 >    property DefaultCharSetName: AnsiString read GetDefaultCharSetName;
267 >    property DefaultCharSetID: integer read GetDefaultCharSetID;
268 >    property DefaultCodePage: TSystemCodePage read GetDefaultCodePage;
269  
270    published
271      property Connected;
# Line 597 | Line 597 | begin
597    if Connected then
598      InternalClose(False);
599    FDBSQLDialect := 1;
600  FDefaultCharSetName := '';
601  FDefaultCharSetID := 0;
602  FDefaultCodePage := CP_NONE;
600   end;
601  
602    procedure TIBDataBase.CreateDatabase;
# Line 611 | Line 608 | begin
608   end;
609  
610   procedure TIBDataBase.CreateDatabase(createDatabaseSQL: string);
614 var info: IDBInformation;
615    ConnectionType: integer;
616    SiteName: string;
611   begin
612    CheckInactive;
613    FAttachment := FirebirdAPI.CreateDatabase(createDatabaseSQL,FSQLDialect);
614 <  info := FAttachment.GetDBInformation(isc_info_db_id);
621 <  info[0].DecodeIDCluster(ConnectionType,FDBName,SiteName);
614 >  FDBName := Attachment.GetConnectString;
615    if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
616      OnCreateDatabase(self);
617   end;
# Line 654 | Line 647 | begin
647      end;
648   end;
649  
650 < function TIBDataBase.FindDefaultTransaction: TIBTransaction;
650 >  function TIBDataBase.FindDefaultTransaction(): TIBTransaction;
651   var
652    i: Integer;
653   begin
# Line 934 | Line 927 | var
927    aDBName: string;
928    Status: IStatus;
929    CharSetID: integer;
930 +  CharSetName: AnsiString;
931   begin
932    CheckInactive;
933    CheckDatabaseName;
# Line 950 | Line 944 | begin
944    TempDBParams := TStringList.Create;
945    try
946     TempDBParams.Assign(FDBParams);
947 +   {$ifdef UNIX}
948 +   {See below for WINDOWS UseDefaultSystemCodePage}
949     if UseDefaultSystemCodePage then
950 <   begin
951 <     {$ifdef WINDOWS}
956 <     if FirebirdAPI.CodePage2CharSetID(GetACP,CharSetID) then
957 <       TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID)
958 <     {$else}
959 <     if FirebirdAPI.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
960 <       TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID)
961 <     {$endif}
962 <     else
963 <       TempDBParams.Values['lc_ctype'] :='UTF8';
964 <   end;
950 >     TempDBParams.Values['lc_ctype'] :='UTF8';
951 >   {$endif}
952     {Opportunity to override defaults}
953     for i := 0 to FSQLObjects.Count - 1 do
954     begin
# Line 969 | Line 956 | begin
956           SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
957     end;
958  
959 <   FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
960 <   if FDefaultCharSetName <> '' then
961 <     FirebirdAPI.CharSetName2CharSetID(FDefaultCharSetName,FDefaultCharSetID);
962 <   FirebirdAPI.CharSetID2CodePage(FDefaultCharSetID,FDefaultCodePage);
963 <   { Generate a new DPB if necessary }
964 <   if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
965 <   begin
966 <     FDBParamsChanged := False;
967 <     if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
968 <       FDPB := GenerateDPB(TempDBParams)
959 >   repeat
960 >     { Generate a new DPB if necessary }
961 >     if (FDPB = nil) or FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text) then
962 >     begin
963 >       FDBParamsChanged := False;
964 >       if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
965 >         FDPB := GenerateDPB(TempDBParams)
966 >       else
967 >       begin
968 >          TempDBParams.Values['password'] := FHiddenPassword;
969 >          FDPB := GenerateDPB(TempDBParams);
970 >       end;
971 >     end;
972 >
973 >     if FCreateDatabase then
974 >     begin
975 >       FCreateDatabase := false;
976 >       FAttachment := FirebirdAPI.CreateDatabase(aDBName,FDPB, false);
977 >       if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
978 >         OnCreateDatabase(self);
979 >     end
980       else
981 +       FAttachment := FirebirdAPI.OpenDatabase(aDBName,FDPB,false);
982 +
983 +     if FAttachment = nil then
984       begin
985 <        TempDBParams.Add('password=' + FHiddenPassword);
986 <        FDPB := GenerateDPB(TempDBParams);
985 >       Status := FirebirdAPI.GetStatus;
986 >       {$IFDEF UNIX}
987 >       if Pos(':',aDBName) = 0 then
988 >       begin
989 >           if ((Status.GetSQLCode = -901) and (Status.GetIBErrorCode = isc_random)) {Access permissions on firebird temp}
990 >              or
991 >              ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_sys_request)) {Security DB Problem}
992 >              or
993 >              ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_psw_attach)) {Security DB Problem}
994 >              or
995 >              ((Status.GetSQLCode = -904) and (Status.GetIBErrorCode = isc_lock_dir_access)) {Lock File Problem}
996 >              then
997 >              begin
998 >                aDBName := 'localhost:' + aDBName;
999 >                Continue;
1000 >             end
1001 >       end;
1002 >       {$ENDIF}
1003 >       if ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_io_error)) {Database not found}
1004 >                        and CreateIfNotExists and not (csDesigning in ComponentState) then
1005 >         FCreateDatabase := true
1006 >       else
1007 >         raise EIBInterBaseError.Create(Status);
1008       end;
1009 <   end;
1009 >
1010 >     if UseDefaultSystemCodePage and (FAttachment <> nil) then
1011 >     {Only now can we check the codepage in use by the Attachment.
1012 >      If not that required then re-open with required LCLType.}
1013 >     begin
1014 >       {$ifdef WINDOWS}
1015 >       if Attachment.CodePage2CharSetID(GetACP,CharSetID) then
1016 >       {$else}
1017 >       if Attachment.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
1018 >       {$endif}
1019 >       begin
1020 >         CharSetName := Attachment.GetCharsetName(CharSetID);
1021 >         if CharSetName <> AnsiUpperCase(TempDBParams.Values['lc_ctype']) then
1022 >         begin
1023 >           TempDBParams.Values['lc_ctype'] := CharSetName;
1024 >           FDBParamsChanged := True;
1025 >           FAttachment := nil;
1026 >         end
1027 >       end
1028 >     end;
1029 >
1030 >   until FAttachment <> nil;
1031 >
1032    finally
1033     TempDBParams.Free;
1034    end;
1035  
992  repeat
993    if FCreateDatabase then
994    begin
995      FCreateDatabase := false;
996      FAttachment := FirebirdAPI.CreateDatabase(aDBName,FDPB, false);
997      if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
998        OnCreateDatabase(self);
999    end
1000    else
1001      FAttachment := FirebirdAPI.OpenDatabase(aDBName,FDPB,false);
1002    if FAttachment = nil then
1003    begin
1004      Status := FirebirdAPI.GetStatus;
1005      {$IFDEF UNIX}
1006      if Pos(':',aDBName) = 0 then
1007      begin
1008          if ((Status.GetSQLCode = -901) and (Status.GetIBErrorCode = isc_random)) {Access permissions on firebird temp}
1009             or
1010             ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_sys_request)) {Security DB Problem}
1011             or
1012             ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_psw_attach)) {Security DB Problem}
1013             or
1014             ((Status.GetSQLCode = -904) and (Status.GetIBErrorCode = isc_lock_dir_access)) {Lock File Problem}
1015             then
1016             begin
1017               aDBName := 'localhost:' + aDBName;
1018               Continue;
1019            end
1020      end;
1021      {$ENDIF}
1022      if ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_io_error)) {Database not found}
1023                       and CreateIfNotExists and not (csDesigning in ComponentState) then
1024        FCreateDatabase := true
1025      else
1026        raise EIBInterBaseError.Create(Status);
1027    end;
1028  until FAttachment <> nil;
1036    if not (csDesigning in ComponentState) then
1037      FDBName := aDBName; {Synchronise at run time}
1038    FDBSQLDialect := GetDBSQLDialect;
# Line 1235 | Line 1242 | begin
1242    DatabaseInfo.Free;
1243   end;
1244  
1245 + function TIBDataBase.GetDefaultCharSetID: integer;
1246 + begin
1247 +  if (Attachment <> nil) and Attachment.HasDefaultCharSet then
1248 +    Result := Attachment.GetDefaultCharSetID
1249 +  else
1250 +    Result := 0;
1251 + end;
1252 +
1253 + function TIBDataBase.GetDefaultCharSetName: AnsiString;
1254 + begin
1255 +  if Attachment <> nil then
1256 +    Result := Attachment.GetCharsetName(DefaultCharSetID)
1257 +  else
1258 +    Result := '';
1259 + end;
1260 +
1261 + function TIBDataBase.GetDefaultCodePage: TSystemCodePage;
1262 + begin
1263 +  if Attachment <> nil then
1264 +    Attachment.CharSetID2CodePage(DefaultCharSetID,Result)
1265 +  else
1266 +    Result := CP_NONE;
1267 + end;
1268 +
1269   procedure TIBDataBase.ValidateClientSQLDialect;
1270   begin
1271    if (FDBSQLDialect < FSQLDialect) then
# Line 1325 | Line 1356 | begin
1356      Query.Database := Self;
1357      Query.Transaction := FInternalTransaction;
1358      Query.SQL.Text := 'Select R.RDB$FIELD_NAME ' + {do not localize}
1359 <      'from RDB$RELATION_FIELDS R, RDB$FIELDS F ' + {do not localize}
1359 >      'from RDB$RELATION_FIELDS R ' + {do not localize}
1360        'where R.RDB$RELATION_NAME = ' + {do not localize}
1361 <      '''' +
1362 <      FormatIdentifierValue(SQLDialect, TableName) +
1332 <      ''' ' +
1333 <      'and R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME '; {do not localize}
1361 >      '''' + ExtractIdentifier(SQLDialect, TableName) +
1362 >      ''' and Exists(Select * From RDB$FIELDS F Where R.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME)' ; {do not localize}
1363      Query.Prepare;
1364      Query.ExecQuery;
1365      with List do
# Line 1574 | Line 1603 | begin
1603    case Action of
1604      TARollback, TACommit:
1605      begin
1606 <      DoBeforeTransactionEnd;
1606 >      try
1607 >        DoBeforeTransactionEnd;
1608 >      except on E: EIBInterBaseError do
1609 >        begin
1610 >          if not Force then
1611 >            raise;
1612 >        end;
1613 >      end;
1614 >
1615        for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1616 +      try
1617          SQLObjects[i].DoBeforeTransactionEnd(Action);
1618 +      except on E: EIBInterBaseError do
1619 +        begin
1620 +          if not Force then
1621 +              raise;
1622 +          end;
1623 +      end;
1624 +
1625        if InTransaction then
1626        begin
1627          if (Action = TARollback) then
# Line 1593 | Line 1638 | begin
1638            end;
1639          end;
1640  
1641 <        for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1642 <          SQLObjects[i].DoAfterTransactionEnd;
1643 <        DoAfterTransactionEnd;
1641 >          for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1642 >          try
1643 >            SQLObjects[i].DoAfterTransactionEnd;
1644 >          except on E: EIBInterBaseError do
1645 >            begin
1646 >              if not Force then
1647 >                raise;
1648 >            end;
1649 >          end;
1650 >        try
1651 >          DoAfterTransactionEnd;
1652 >        except on E: EIBInterBaseError do
1653 >          begin
1654 >            if not Force then
1655 >              raise;
1656 >          end;
1657 >        end;
1658        end;
1659      end;
1660      TACommitRetaining:

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines