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 49 by tony, Thu Feb 2 16:20:12 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 476 | Line 476 | function GenerateTPB(sl: TStrings): ITPB
476   implementation
477  
478   uses  IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
479 <     typInfo, FBMessages, IBErrorCodes, RegExpr;
479 >     typInfo, FBMessages, IBErrorCodes;
480  
481   { TIBDatabase }
482  
# 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 RegexObj: TRegExpr;
611   begin
612    CheckInactive;
613    FAttachment := FirebirdAPI.CreateDatabase(createDatabaseSQL,FSQLDialect);
614 <  RegexObj := TRegExpr.Create;
619 <  try
620 <    {extact database file spec}
621 <    RegexObj.ModifierG := false; {turn off greedy matches}
622 <    RegexObj.Expression := '^ *CREATE +(DATABASE|SCHEMA) +''(.*)''';
623 <    if RegexObj.Exec(AnsiUpperCase(createDatabaseSQL)) then
624 <      FDBName := system.copy(createDatabaseSQL,RegexObj.MatchPos[2],RegexObj.MatchLen[2]);
625 <  finally
626 <    RegexObj.Free;
627 <  end;
614 >  FDBName := Attachment.GetConnectString;
615    if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
616      OnCreateDatabase(self);
617   end;
# Line 660 | 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 940 | Line 927 | var
927    aDBName: string;
928    Status: IStatus;
929    CharSetID: integer;
930 +  CharSetName: AnsiString;
931   begin
932    CheckInactive;
933    CheckDatabaseName;
# Line 956 | 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}
962 <     if FirebirdAPI.CodePage2CharSetID(GetACP,CharSetID) then
963 <       TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID)
964 <     {$else}
965 <     if FirebirdAPI.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
966 <       TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID)
967 <     {$endif}
968 <     else
969 <       TempDBParams.Values['lc_ctype'] :='UTF8';
970 <   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 975 | 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  
998  repeat
999    if FCreateDatabase then
1000    begin
1001      FCreateDatabase := false;
1002      FAttachment := FirebirdAPI.CreateDatabase(aDBName,FDPB, false);
1003      if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
1004        OnCreateDatabase(self);
1005    end
1006    else
1007      FAttachment := FirebirdAPI.OpenDatabase(aDBName,FDPB,false);
1008    if FAttachment = nil then
1009    begin
1010      Status := FirebirdAPI.GetStatus;
1011      {$IFDEF UNIX}
1012      if Pos(':',aDBName) = 0 then
1013      begin
1014          if ((Status.GetSQLCode = -901) and (Status.GetIBErrorCode = isc_random)) {Access permissions on firebird temp}
1015             or
1016             ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_sys_request)) {Security DB Problem}
1017             or
1018             ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_psw_attach)) {Security DB Problem}
1019             or
1020             ((Status.GetSQLCode = -904) and (Status.GetIBErrorCode = isc_lock_dir_access)) {Lock File Problem}
1021             then
1022             begin
1023               aDBName := 'localhost:' + aDBName;
1024               Continue;
1025            end
1026      end;
1027      {$ENDIF}
1028      if ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_io_error)) {Database not found}
1029                       and CreateIfNotExists and not (csDesigning in ComponentState) then
1030        FCreateDatabase := true
1031      else
1032        raise EIBInterBaseError.Create(Status);
1033    end;
1034  until FAttachment <> nil;
1036    if not (csDesigning in ComponentState) then
1037      FDBName := aDBName; {Synchronise at run time}
1038    FDBSQLDialect := GetDBSQLDialect;
# Line 1241 | 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 1331 | 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) +
1338 <      ''' ' +
1339 <      '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 1580 | 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 1599 | 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