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 62 by tony, Wed Apr 12 09:19:59 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 1029 | Line 1017 | begin
1017         if Attachment.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
1018         {$endif}
1019         begin
1020 <         FDefaultCharSetName := Attachment.GetCharsetName(CharSetID);
1021 <         if FDefaultCharSetName <> AnsiUpperCase(TempDBParams.Values['lc_ctype']) then
1020 >         CharSetName := Attachment.GetCharsetName(CharSetID);
1021 >         if CharSetName <> AnsiUpperCase(TempDBParams.Values['lc_ctype']) then
1022           begin
1023 <           TempDBParams.Values['lc_ctype'] := FDefaultCharSetName;
1023 >           TempDBParams.Values['lc_ctype'] := CharSetName;
1024             FDBParamsChanged := True;
1025             FAttachment := nil;
1026           end
# Line 1041 | Line 1029 | begin
1029  
1030     until FAttachment <> nil;
1031  
1044   FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
1032    finally
1033     TempDBParams.Free;
1034    end;
1048  if FDefaultCharSetName <> '' then
1049    Attachment.CharSetName2CharSetID(FDefaultCharSetName,FDefaultCharSetID);
1050  Attachment.CharSetID2CodePage(FDefaultCharSetID,FDefaultCodePage);
1035  
1036    if not (csDesigning in ComponentState) then
1037      FDBName := aDBName; {Synchronise at run time}
# Line 1258 | 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 1348 | 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) +
1355 <      ''' ' +
1356 <      '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 1597 | 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 1616 | 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