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 60 by tony, Mon Mar 27 15:21:02 2017 UTC vs.
Revision 80 by tony, Mon Jan 1 11:31:07 2018 UTC

# Line 956 | Line 956 | begin
956    TempDBParams := TStringList.Create;
957    try
958     TempDBParams.Assign(FDBParams);
959 +   {$ifdef UNIX}
960 +   {See below for WINDOWS UseDefaultSystemCodePage}
961     if UseDefaultSystemCodePage then
962 <   begin
963 <     {$ifdef WINDOWS}
962 <     if Attachment.CodePage2CharSetID(GetACP,CharSetID) then
963 <       TempDBParams.Values['lc_ctype'] := Attachment.GetCharsetName(CharSetID)
964 <     {$else}
965 <     if Attachment.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
966 <       TempDBParams.Values['lc_ctype'] := Attachment.GetCharsetName(CharSetID)
967 <     {$endif}
968 <     else
969 <       TempDBParams.Values['lc_ctype'] :='UTF8';
970 <   end;
962 >     TempDBParams.Values['lc_ctype'] :='UTF8';
963 >   {$endif}
964     {Opportunity to override defaults}
965     for i := 0 to FSQLObjects.Count - 1 do
966     begin
# Line 975 | Line 968 | begin
968           SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
969     end;
970  
971 <   FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
972 <   { Generate a new DPB if necessary }
973 <   if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
974 <   begin
975 <     FDBParamsChanged := False;
976 <     if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
977 <       FDPB := GenerateDPB(TempDBParams)
971 >   repeat
972 >     { Generate a new DPB if necessary }
973 >     if (FDPB = nil) or FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text) then
974 >     begin
975 >       FDBParamsChanged := False;
976 >       if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
977 >         FDPB := GenerateDPB(TempDBParams)
978 >       else
979 >       begin
980 >          TempDBParams.Values['password'] := FHiddenPassword;
981 >          FDPB := GenerateDPB(TempDBParams);
982 >       end;
983 >     end;
984 >
985 >     if FCreateDatabase then
986 >     begin
987 >       FCreateDatabase := false;
988 >       FAttachment := FirebirdAPI.CreateDatabase(aDBName,FDPB, false);
989 >       if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
990 >         OnCreateDatabase(self);
991 >     end
992       else
993 +       FAttachment := FirebirdAPI.OpenDatabase(aDBName,FDPB,false);
994 +
995 +     if FAttachment = nil then
996       begin
997 <        TempDBParams.Add('password=' + FHiddenPassword);
998 <        FDPB := GenerateDPB(TempDBParams);
997 >       Status := FirebirdAPI.GetStatus;
998 >       {$IFDEF UNIX}
999 >       if Pos(':',aDBName) = 0 then
1000 >       begin
1001 >           if ((Status.GetSQLCode = -901) and (Status.GetIBErrorCode = isc_random)) {Access permissions on firebird temp}
1002 >              or
1003 >              ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_sys_request)) {Security DB Problem}
1004 >              or
1005 >              ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_psw_attach)) {Security DB Problem}
1006 >              or
1007 >              ((Status.GetSQLCode = -904) and (Status.GetIBErrorCode = isc_lock_dir_access)) {Lock File Problem}
1008 >              then
1009 >              begin
1010 >                aDBName := 'localhost:' + aDBName;
1011 >                Continue;
1012 >             end
1013 >       end;
1014 >       {$ENDIF}
1015 >       if ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_io_error)) {Database not found}
1016 >                        and CreateIfNotExists and not (csDesigning in ComponentState) then
1017 >         FCreateDatabase := true
1018 >       else
1019 >         raise EIBInterBaseError.Create(Status);
1020       end;
1021 <   end;
1021 >
1022 >     if UseDefaultSystemCodePage and (FAttachment <> nil) then
1023 >     {Only now can we check the codepage in use by the Attachment.
1024 >      If not that required then re-open with required LCLType.}
1025 >     begin
1026 >       {$ifdef WINDOWS}
1027 >       if Attachment.CodePage2CharSetID(GetACP,CharSetID) then
1028 >       {$else}
1029 >       if Attachment.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
1030 >       {$endif}
1031 >       begin
1032 >         FDefaultCharSetName := Attachment.GetCharsetName(CharSetID);
1033 >         if FDefaultCharSetName <> AnsiUpperCase(TempDBParams.Values['lc_ctype']) then
1034 >         begin
1035 >           TempDBParams.Values['lc_ctype'] := FDefaultCharSetName;
1036 >           FDBParamsChanged := True;
1037 >           FAttachment := nil;
1038 >         end
1039 >       end
1040 >     end;
1041 >
1042 >   until FAttachment <> nil;
1043 >
1044 >   FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
1045    finally
1046     TempDBParams.Free;
1047    end;
994
995  repeat
996    if FCreateDatabase then
997    begin
998      FCreateDatabase := false;
999      FAttachment := FirebirdAPI.CreateDatabase(aDBName,FDPB, false);
1000      if assigned(FOnCreateDatabase) and (FAttachment <> nil) then
1001        OnCreateDatabase(self);
1002    end
1003    else
1004      FAttachment := FirebirdAPI.OpenDatabase(aDBName,FDPB,false);
1005    if FAttachment = nil then
1006    begin
1007      Status := FirebirdAPI.GetStatus;
1008      {$IFDEF UNIX}
1009      if Pos(':',aDBName) = 0 then
1010      begin
1011          if ((Status.GetSQLCode = -901) and (Status.GetIBErrorCode = isc_random)) {Access permissions on firebird temp}
1012             or
1013             ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_sys_request)) {Security DB Problem}
1014             or
1015             ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_psw_attach)) {Security DB Problem}
1016             or
1017             ((Status.GetSQLCode = -904) and (Status.GetIBErrorCode = isc_lock_dir_access)) {Lock File Problem}
1018             then
1019             begin
1020               aDBName := 'localhost:' + aDBName;
1021               Continue;
1022            end
1023      end;
1024      {$ENDIF}
1025      if ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_io_error)) {Database not found}
1026                       and CreateIfNotExists and not (csDesigning in ComponentState) then
1027        FCreateDatabase := true
1028      else
1029        raise EIBInterBaseError.Create(Status);
1030    end;
1031  until FAttachment <> nil;
1032
1048    if FDefaultCharSetName <> '' then
1049      Attachment.CharSetName2CharSetID(FDefaultCharSetName,FDefaultCharSetID);
1050    Attachment.CharSetID2CodePage(FDefaultCharSetID,FDefaultCodePage);
# Line 1582 | Line 1597 | begin
1597    case Action of
1598      TARollback, TACommit:
1599      begin
1600 <      DoBeforeTransactionEnd;
1600 >      try
1601 >        DoBeforeTransactionEnd;
1602 >      except on E: EIBInterBaseError do
1603 >        begin
1604 >          if not Force then
1605 >            raise;
1606 >        end;
1607 >      end;
1608 >
1609        for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1610 +      try
1611          SQLObjects[i].DoBeforeTransactionEnd(Action);
1612 +      except on E: EIBInterBaseError do
1613 +        begin
1614 +          if not Force then
1615 +              raise;
1616 +          end;
1617 +      end;
1618 +
1619        if InTransaction then
1620        begin
1621          if (Action = TARollback) then
# Line 1601 | Line 1632 | begin
1632            end;
1633          end;
1634  
1635 <        for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1636 <          SQLObjects[i].DoAfterTransactionEnd;
1637 <        DoAfterTransactionEnd;
1635 >          for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1636 >          try
1637 >            SQLObjects[i].DoAfterTransactionEnd;
1638 >          except on E: EIBInterBaseError do
1639 >            begin
1640 >              if not Force then
1641 >                raise;
1642 >            end;
1643 >          end;
1644 >        try
1645 >          DoAfterTransactionEnd;
1646 >        except on E: EIBInterBaseError do
1647 >          begin
1648 >            if not Force then
1649 >              raise;
1650 >          end;
1651 >        end;
1652        end;
1653      end;
1654      TACommitRetaining:

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines