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 19 by tony, Mon Jul 7 13:00:15 2014 UTC vs.
Revision 27 by tony, Tue Apr 14 13:10:23 2015 UTC

# Line 159 | Line 159 | type
159      FHiddenPassword: string;
160      FIBLoaded: Boolean;
161      FOnLogin: TIBDatabaseLoginEvent;
162 +    FSQLHourGlass: Boolean;
163      FTraceFlags: TTraceFlags;
164      FDBSQLDialect: Integer;
165      FSQLDialect: Integer;
# Line 181 | Line 182 | type
182      FUserNames: TStringList;
183      FDataSets: TList;
184      FLoginCalled: boolean;
185 +    FCharSetSizes: array of integer;
186      procedure EnsureInactive;
187      function GetDBSQLDialect: Integer;
188      function GetSQLDialect: Integer;
# Line 195 | Line 197 | type
197      function GetTransaction(Index: Integer): TIBTransaction;
198      function GetTransactionCount: Integer;
199      function Login: Boolean;
200 +    procedure LoadCharSetInfo;
201      procedure SetDatabaseName(const Value: TIBFileName);
202      procedure SetDBParamByDPB(const Idx: Integer; Value: String);
203      procedure SetDBParams(Value: TStrings);
# Line 262 | Line 265 | type
265                                                   write SetDefaultTransaction;
266      property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
267      property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
268 +    property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
269      property DBSQLDialect : Integer read FDBSQLDialect;
270      property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
271      property AfterConnect;
# Line 279 | Line 283 | type
283  
284    TIBTransaction = class(TComponent)
285    private
286 +    FAfterDelete: TNotifyEvent;
287 +    FAfterEdit: TNotifyEvent;
288 +    FAfterExecQuery: TNotifyEvent;
289 +    FAfterInsert: TNotifyEvent;
290 +    FAfterPost: TNotifyEvent;
291 +    FAfterTransactionEnd: TNotifyEvent;
292 +    FBeforeTransactionEnd: TNotifyEvent;
293      FIBLoaded: Boolean;
294      FCanTimeout         : Boolean;
295      FDatabases          : TList;
296 +    FOnStartTransaction: TNotifyEvent;
297      FSQLObjects         : TList;
298      FDefaultDatabase    : TIBDatabase;
299      FHandle             : TISC_TR_HANDLE;
# Line 295 | Line 307 | type
307      FTRParams           : TStrings;
308      FTRParamsChanged    : Boolean;
309      FInEndTransaction   : boolean;
310 +    FEndAction          : TTransactionAction;
311 +    procedure DoBeforeTransactionEnd;
312 +    procedure DoAfterTransactionEnd;
313 +    procedure DoOnStartTransaction;
314 +    procedure DoAfterExecQuery(Sender: TObject);
315 +    procedure DoAfterEdit(Sender: TObject);
316 +    procedure DoAfterDelete(Sender: TObject);
317 +    procedure DoAfterInsert(Sender: TObject);
318 +    procedure DoAfterPost(Sender: TObject);
319      procedure EnsureNotInTransaction;
320      procedure EndTransaction(Action: TTransactionAction; Force: Boolean);
321      function GetDatabase(Index: Integer): TIBDatabase;
# Line 336 | Line 357 | type
357      function AddDatabase(db: TIBDatabase): Integer;
358      function FindDatabase(db: TIBDatabase): Integer;
359      function FindDefaultDatabase: TIBDatabase;
360 +    function GetEndAction: TTransactionAction;
361      procedure RemoveDatabase(Idx: Integer);
362      procedure RemoveDatabases;
363      procedure CheckDatabasesInList;
# Line 357 | Line 379 | type
379      property DefaultAction: TTransactionAction read FDefaultAction write SetDefaultAction default taCommit;
380      property Params: TStrings read FTRParams write SetTRParams;
381      property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
382 +    property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
383 +                                             write FBeforeTransactionEnd;
384 +    property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd
385 +                                            write FAfterTransactionEnd;
386 +    property OnStartTransaction: TNotifyEvent read FOnStartTransaction
387 +                                              write FOnStartTransaction;
388 +    property AfterExecQuery: TNotifyEvent read FAfterExecQuery
389 +                                              write FAfterExecQuery;
390 +    property AfterEdit: TNotifyEvent read FAfterEdit write FAfterEdit;
391 +    property AfterDelete: TNotifyEvent read FAfterDelete write FAfterDelete;
392 +    property AfterInsert: TNotifyEvent read FAfterInsert write FAfterInsert;
393 +    property AfterPost: TNotifyEvent read FAfterPost write FAfterPost;
394    end;
395  
396 +  TTransactionEndEvent = procedure(Sender:TObject; Action: TTransactionAction) of object;
397 +
398    { TIBBase }
399  
400    { Virtually all components in IB are "descendents" of TIBBase.
# Line 375 | Line 411 | type
411      FAfterDatabaseDisconnect: TNotifyEvent;
412      FAfterDatabaseConnect: TNotifyEvent;
413      FOnDatabaseFree: TNotifyEvent;
414 <    FBeforeTransactionEnd: TNotifyEvent;
414 >    FBeforeTransactionEnd: TTransactionEndEvent;
415      FAfterTransactionEnd: TNotifyEvent;
416      FOnTransactionFree: TNotifyEvent;
417  
# Line 383 | Line 419 | type
419      procedure DoBeforeDatabaseDisconnect; virtual;
420      procedure DoAfterDatabaseDisconnect; virtual;
421      procedure DoDatabaseFree; virtual;
422 <    procedure DoBeforeTransactionEnd; virtual;
422 >    procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual;
423      procedure DoAfterTransactionEnd; virtual;
424      procedure DoTransactionFree; virtual;
425      function GetDBHandle: PISC_DB_HANDLE; virtual;
# Line 395 | Line 431 | type
431      destructor Destroy; override;
432      procedure CheckDatabase; virtual;
433      procedure CheckTransaction; virtual;
434 +    procedure DoAfterExecQuery(Sender: TObject); virtual;
435 +    procedure DoAfterEdit(Sender: TObject); virtual;
436 +    procedure DoAfterDelete(Sender: TObject); virtual;
437 +    procedure DoAfterInsert(Sender: TObject); virtual;
438 +    procedure DoAfterPost(Sender: TObject); virtual;
439 +    function GetCharSetSize(CharSetID: integer): integer;
440    public
441      property AfterDatabaseConnect: TNotifyEvent read FAfterDatabaseConnect
442                                                  write FAfterDatabaseConnect;
# Line 403 | Line 445 | type
445      property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
446                                                    write FAfterDatabaseDisconnect;
447      property OnDatabaseFree: TNotifyEvent read FOnDatabaseFree write FOnDatabaseFree;
448 <    property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
448 >    property BeforeTransactionEnd: TTransactionEndEvent read FBeforeTransactionEnd write FBeforeTransactionEnd;
449      property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd write FAfterTransactionEnd;
450      property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree;
451      property Database: TIBDatabase read FDatabase
# Line 440 | Line 482 | begin
482    FTransactions := TList.Create;
483    FDBName := '';
484    FDBParams := TStringList.Create;
485 +  FSQLHourGlass := true;
486    {$ifdef UNIX}
487    if csDesigning in ComponentState then
488      FDBParams.Add('lc_ctype=UTF-8');
# Line 571 | Line 614 | begin
614    if Connected then
615      InternalClose(False);
616    FDBSQLDialect := 1;
617 +  SetLength(FCharSetSizes,0);
618   end;
619  
620   procedure TIBDataBase.CreateDatabase;
# Line 765 | Line 809 | begin
809        SQLObjects[i].DoAfterDatabaseDisconnect;
810   end;
811  
812 + procedure TIBDataBase.LoadCharSetInfo;
813 + var Query: TIBSQL;
814 +    i: integer;
815 + begin
816 +  if not FInternalTransaction.Active then
817 +    FInternalTransaction.StartTransaction;
818 +  Query := TIBSQL.Create(self);
819 +  try
820 +    Query.Database := Self;
821 +    Query.Transaction := FInternalTransaction;
822 +    Query.SQL.Text := 'Select RDB$CHARACTER_SET_ID, RDB$BYTES_PER_CHARACTER ' +
823 +                      'From RDB$CHARACTER_SETS Order by 1 DESC'; {do not localize}
824 +    Query.Prepare;
825 +    Query.ExecQuery;
826 +    if not Query.EOF then
827 +    begin
828 +      SetLength(FCharSetSizes,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
829 +      for i := 0 to Length(FCharSetSizes) - 1 do FCharSetSizes[i] := 1;
830 +      repeat
831 +        FCharSetSizes[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
832 +                 Query.FieldByName('RDB$BYTES_PER_CHARACTER').AsInteger;
833 +        Query.Next;
834 +      until Query.EOF;
835 +    end;
836 +  finally
837 +    Query.free;
838 +    FInternalTransaction.Commit;
839 +  end;
840 + end;
841 +
842   procedure TIBDataBase.CheckStreamConnect;
843   var
844    i: integer;
# Line 944 | Line 1018 | begin
1018    end;
1019    if not (csDesigning in ComponentState) then
1020      MonitorHook.DBConnect(Self);
1021 +  LoadCharSetInfo;
1022   end;
1023  
1024   procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
# Line 1384 | Line 1459 | begin
1459      IBError(ibxeNotInTransaction, [nil]);
1460   end;
1461  
1462 + procedure TIBTransaction.DoBeforeTransactionEnd;
1463 + begin
1464 +  if Assigned(FBeforeTransactionEnd) then
1465 +    FBeforeTransactionEnd(self);
1466 + end;
1467 +
1468 + procedure TIBTransaction.DoAfterTransactionEnd;
1469 + begin
1470 +  if Assigned(FAfterTransactionEnd) then
1471 +    FAfterTransactionEnd(self);
1472 + end;
1473 +
1474 + procedure TIBTransaction.DoOnStartTransaction;
1475 + begin
1476 +  if assigned(FOnStartTransaction) then
1477 +    OnStartTransaction(self);
1478 + end;
1479 +
1480 + procedure TIBTransaction.DoAfterExecQuery(Sender: TObject);
1481 + begin
1482 +  if assigned(FAfterExecQuery) then
1483 +    AfterExecQuery(Sender);
1484 + end;
1485 +
1486 + procedure TIBTransaction.DoAfterEdit(Sender: TObject);
1487 + begin
1488 +  if assigned(FAfterEdit) then
1489 +    AfterEdit(Sender);
1490 + end;
1491 +
1492 + procedure TIBTransaction.DoAfterDelete(Sender: TObject);
1493 + begin
1494 +  if assigned(FAfterDelete) then
1495 +    AfterDelete(Sender);
1496 + end;
1497 +
1498 + procedure TIBTransaction.DoAfterInsert(Sender: TObject);
1499 + begin
1500 +  if assigned(FAfterInsert) then
1501 +    AfterInsert(Sender);
1502 + end;
1503 +
1504 + procedure TIBTransaction.DoAfterPost(Sender: TObject);
1505 + begin
1506 +  if assigned(FAfterPost) then
1507 +    AfterPost(Sender);
1508 + end;
1509 +
1510   procedure TIBTransaction.EnsureNotInTransaction;
1511   begin
1512    if csDesigning in ComponentState then
# Line 1460 | Line 1583 | begin
1583    CheckInTransaction;
1584    if FInEndTransaction then Exit;
1585    FInEndTransaction := true;
1586 +  FEndAction := Action;
1587    try
1588    case Action of
1589      TARollback, TACommit:
# Line 1468 | Line 1592 | begin
1592           (Action <> FDefaultAction) and
1593           (not Force) then
1594          IBError(ibxeCantEndSharedTransaction, [nil]);
1595 +      DoBeforeTransactionEnd;
1596        for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1597 <        SQLObjects[i].DoBeforeTransactionEnd;
1597 >        SQLObjects[i].DoBeforeTransactionEnd(Action);
1598        if InTransaction then
1599        begin
1600          if HandleIsShared then
# Line 1492 | Line 1617 | begin
1617              IBDataBaseError;
1618          for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1619            SQLObjects[i].DoAfterTransactionEnd;
1620 +        DoAfterTransactionEnd;
1621        end;
1622      end;
1623      TACommitRetaining:
# Line 1582 | Line 1708 | begin
1708    end;
1709   end;
1710  
1711 + function TIBTransaction.GetEndAction: TTransactionAction;
1712 + begin
1713 +  if FInEndTransaction then
1714 +     Result := FEndAction
1715 +  else
1716 +     IBError(ibxeIB60feature, [nil])
1717 + end;
1718 +
1719  
1720   function TIBTransaction.GetIdleTimer: Integer;
1721   begin
# Line 1793 | Line 1927 | begin
1927    finally
1928      FreeMem(pteb);
1929    end;
1930 +  DoOnStartTransaction;
1931   end;
1932  
1933   procedure TIBTransaction.TimeoutTransaction(Sender: TObject);
# Line 1834 | Line 1969 | begin
1969    inherited Destroy;
1970   end;
1971  
1972 + function TIBBase.GetCharSetSize(CharSetID: integer): integer;
1973 + begin
1974 +  if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetSizes)) then
1975 +    Result := Database.FCharSetSizes[CharSetID]
1976 +  else
1977 +    Result := 1; {Unknown character set}
1978 + end;
1979 +
1980   procedure TIBBase.CheckDatabase;
1981   begin
1982    if (FDatabase = nil) then
# Line 1886 | Line 2029 | begin
2029    SetTransaction(nil);
2030   end;
2031  
2032 < procedure TIBBase.DoBeforeTransactionEnd;
2032 > procedure TIBBase.DoBeforeTransactionEnd(Action: TTransactionAction);
2033   begin
2034    if Assigned(BeforeTransactionEnd) then
2035 <    BeforeTransactionEnd(Self);
2035 >    BeforeTransactionEnd(Self,Action);
2036   end;
2037  
2038   procedure TIBBase.DoAfterTransactionEnd;
# Line 1905 | Line 2048 | begin
2048    FTransaction := nil;
2049   end;
2050  
2051 + procedure TIBBase.DoAfterExecQuery(Sender: TObject);
2052 + begin
2053 +  if FTransaction <> nil then
2054 +    FTransaction.DoAfterExecQuery(Sender);
2055 + end;
2056 +
2057 + procedure TIBBase.DoAfterEdit(Sender: TObject);
2058 + begin
2059 +  if FTransaction <> nil then
2060 +    FTransaction.DoAfterEdit(Sender);
2061 + end;
2062 +
2063 + procedure TIBBase.DoAfterDelete(Sender: TObject);
2064 + begin
2065 +  if FTransaction <> nil then
2066 +    FTransaction.DoAfterDelete(Sender);
2067 + end;
2068 +
2069 + procedure TIBBase.DoAfterInsert(Sender: TObject);
2070 + begin
2071 +  if FTransaction <> nil then
2072 +    FTransaction.DoAfterInsert(Sender);
2073 + end;
2074 +
2075 + procedure TIBBase.DoAfterPost(Sender: TObject);
2076 + begin
2077 +  if FTransaction <> nil then
2078 +    FTransaction.DoAfterPost(Sender);
2079 + end;
2080 +
2081   procedure TIBBase.SetDatabase(Value: TIBDatabase);
2082   begin
2083    if (FDatabase <> nil) then
# Line 2114 | Line 2287 | end.
2287  
2288  
2289  
2290 <
2290 >

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines