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 26 by tony, Fri Mar 13 10:26:52 2015 UTC vs.
Revision 27 by tony, Tue Apr 14 13:10:23 2015 UTC

# Line 182 | 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 196 | 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 281 | 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 302 | Line 310 | type
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 369 | Line 383 | type
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 387 | 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 395 | 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 407 | 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 415 | 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 584 | 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 778 | 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 957 | 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 1409 | Line 1471 | begin
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 1496 | Line 1594 | begin
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 1829 | Line 1927 | begin
1927    finally
1928      FreeMem(pteb);
1929    end;
1930 +  DoOnStartTransaction;
1931   end;
1932  
1933   procedure TIBTransaction.TimeoutTransaction(Sender: TObject);
# Line 1870 | 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 1922 | 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 1941 | 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 2150 | Line 2287 | end.
2287  
2288  
2289  
2290 <
2290 >

Diff Legend

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