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 17 by tony, Sat Dec 28 19:22:24 2013 UTC vs.
Revision 23 by tony, Fri Mar 13 10:26:52 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 262 | Line 263 | type
263                                                   write SetDefaultTransaction;
264      property IdleTimer: Integer read GetIdleTimer write SetIdleTimer;
265      property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3;
266 +    property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
267      property DBSQLDialect : Integer read FDBSQLDialect;
268      property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
269      property AfterConnect;
# Line 279 | Line 281 | type
281  
282    TIBTransaction = class(TComponent)
283    private
284 +    FAfterTransactionEnd: TNotifyEvent;
285 +    FBeforeTransactionEnd: TNotifyEvent;
286      FIBLoaded: Boolean;
287      FCanTimeout         : Boolean;
288      FDatabases          : TList;
# Line 295 | Line 299 | type
299      FTRParams           : TStrings;
300      FTRParamsChanged    : Boolean;
301      FInEndTransaction   : boolean;
302 +    FEndAction          : TTransactionAction;
303 +    procedure DoBeforeTransactionEnd;
304 +    procedure DoAfterTransactionEnd;
305      procedure EnsureNotInTransaction;
306      procedure EndTransaction(Action: TTransactionAction; Force: Boolean);
307      function GetDatabase(Index: Integer): TIBDatabase;
# Line 336 | Line 343 | type
343      function AddDatabase(db: TIBDatabase): Integer;
344      function FindDatabase(db: TIBDatabase): Integer;
345      function FindDefaultDatabase: TIBDatabase;
346 +    function GetEndAction: TTransactionAction;
347      procedure RemoveDatabase(Idx: Integer);
348      procedure RemoveDatabases;
349      procedure CheckDatabasesInList;
# Line 357 | Line 365 | type
365      property DefaultAction: TTransactionAction read FDefaultAction write SetDefaultAction default taCommit;
366      property Params: TStrings read FTRParams write SetTRParams;
367      property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
368 +    property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd
369 +                                             write FBeforeTransactionEnd;
370 +    property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd
371 +                                            write FAfterTransactionEnd;
372    end;
373  
374    { TIBBase }
# Line 426 | Line 438 | uses IBIntf, IBSQLMonitor, IBCustomDataS
438  
439   { TIBDatabase }
440  
441 < constructor TIBDatabase.Create(AOwner: TComponent);
441 > constructor TIBDataBase.Create(AOwner: TComponent);
442   {$ifdef WINDOWS}
443   var acp: uint;
444   {$endif}
# Line 440 | Line 452 | begin
452    FTransactions := TList.Create;
453    FDBName := '';
454    FDBParams := TStringList.Create;
455 +  FSQLHourGlass := true;
456    {$ifdef UNIX}
457    if csDesigning in ComponentState then
458      FDBParams.Add('lc_ctype=UTF-8');
# Line 472 | Line 485 | begin
485    CheckStreamConnect;
486   end;
487  
488 < destructor TIBDatabase.Destroy;
488 > destructor TIBDataBase.Destroy;
489   var
490    i: Integer;
491   begin
# Line 498 | Line 511 | begin
511    inherited Destroy;
512   end;
513  
514 < function TIBDatabase.Call(ErrCode: ISC_STATUS;
515 <  RaiseError: Boolean): ISC_STATUS;
514 > function TIBDataBase.Call(ErrCode: ISC_STATUS; RaiseError: Boolean
515 >   ): ISC_STATUS;
516   begin
517    result := ErrCode;
518    FCanTimeout := False;
# Line 507 | Line 520 | begin
520      IBDataBaseError;
521   end;
522  
523 < procedure TIBDatabase.CheckActive;
523 > procedure TIBDataBase.CheckActive;
524   begin
525    if StreamedConnected and (not Connected) then
526      Loaded;
# Line 515 | Line 528 | begin
528      IBError(ibxeDatabaseClosed, [nil]);
529   end;
530  
531 < procedure TIBDatabase.EnsureInactive;
531 > procedure TIBDataBase.EnsureInactive;
532   begin
533    if csDesigning in ComponentState then
534    begin
# Line 524 | Line 537 | begin
537    end
538   end;
539  
540 < procedure TIBDatabase.CheckInactive;
540 > procedure TIBDataBase.CheckInactive;
541   begin
542    if FHandle <> nil then
543      IBError(ibxeDatabaseOpen, [nil]);
544   end;
545  
546 < procedure TIBDatabase.CheckDatabaseName;
546 > procedure TIBDataBase.CheckDatabaseName;
547   begin
548    if (FDBName = '') then
549      IBError(ibxeDatabaseNameMissing, [nil]);
550   end;
551  
552 < function TIBDatabase.AddSQLObject(ds: TIBBase): Integer;
552 > function TIBDataBase.AddSQLObject(ds: TIBBase): Integer;
553   begin
554    result := 0;
555    if (ds.Owner is TIBCustomDataSet) then
# Line 549 | Line 562 | begin
562      FSQLObjects[result] := ds;
563   end;
564  
565 < function TIBDatabase.AddTransaction(TR: TIBTransaction): Integer;
565 > function TIBDataBase.AddTransaction(TR: TIBTransaction): Integer;
566   begin
567    result := FindTransaction(TR);
568    if result <> -1 then
# Line 566 | Line 579 | begin
579      FTransactions[result] := TR;
580   end;
581  
582 < procedure TIBDatabase.DoDisconnect;
582 > procedure TIBDataBase.DoDisconnect;
583   begin
584    if Connected then
585      InternalClose(False);
586    FDBSQLDialect := 1;
587   end;
588  
589 < procedure TIBDatabase.CreateDatabase;
589 > procedure TIBDataBase.CreateDatabase;
590   var
591    tr_handle: TISC_TR_HANDLE;
592   begin
# Line 586 | Line 599 | begin
599      True);
600   end;
601  
602 < procedure TIBDatabase.DropDatabase;
602 > procedure TIBDataBase.DropDatabase;
603   begin
604    CheckActive;
605    Call(isc_drop_database(StatusVector, @FHandle), True);
606   end;
607  
608 < procedure TIBDatabase.DBParamsChange(Sender: TObject);
608 > procedure TIBDataBase.DBParamsChange(Sender: TObject);
609   begin
610    FDBParamsChanged := True;
611   end;
612  
613 < procedure TIBDatabase.DBParamsChanging(Sender: TObject);
613 > procedure TIBDataBase.DBParamsChanging(Sender: TObject);
614   begin
615    EnsureInactive;
616    CheckInactive;
617   end;
618  
619 < function TIBDatabase.FindTransaction(TR: TIBTransaction): Integer;
619 > function TIBDataBase.FindTransaction(TR: TIBTransaction): Integer;
620   var
621    i: Integer;
622   begin
# Line 616 | Line 629 | begin
629      end;
630   end;
631  
632 < function TIBDatabase.FindDefaultTransaction(): TIBTransaction;
632 > function TIBDataBase.FindDefaultTransaction: TIBTransaction;
633   var
634    i: Integer;
635   begin
# Line 634 | Line 647 | begin
647    end;
648   end;
649  
650 < procedure TIBDatabase.ForceClose;
650 > procedure TIBDataBase.ForceClose;
651   begin
652    if Connected then
653      InternalClose(True);
654   end;
655  
656 < function TIBDatabase.GetConnected: Boolean;
656 > function TIBDataBase.GetConnected: Boolean;
657   begin
658    result := FHandle <> nil;
659   end;
660  
661 < function TIBDatabase.GetSQLObject(Index: Integer): TIBBase;
661 > function TIBDataBase.GetSQLObject(Index: Integer): TIBBase;
662   begin
663    result := FSQLObjects[Index];
664   end;
665  
666 < function TIBDatabase.GetSQLObjectCount: Integer;
666 > function TIBDataBase.GetSQLObjectCount: Integer;
667   var
668    i: Integer;
669   begin
# Line 659 | Line 672 | begin
672      Inc(result);
673   end;
674  
675 < function TIBDatabase.GetDBParamByDPB(const Idx: Integer): String;
675 > function TIBDataBase.GetDBParamByDPB( const Idx: Integer): String;
676   var
677    ConstIdx, EqualsIdx: Integer;
678   begin
# Line 682 | Line 695 | begin
695      result := '';
696   end;
697  
698 < function TIBDatabase.GetIdleTimer: Integer;
698 > function TIBDataBase.GetIdleTimer: Integer;
699   begin
700    result := FTimer.Interval;
701   end;
702  
703 < function TIBDatabase.GetTransaction(Index: Integer): TIBTransaction;
703 > function TIBDataBase.GetTransaction(Index: Integer): TIBTransaction;
704   begin
705    result := FTransactions[Index];
706   end;
707  
708 < function TIBDatabase.GetTransactionCount: Integer;
708 > function TIBDataBase.GetTransactionCount: Integer;
709   var
710    i: Integer;
711   begin
# Line 702 | Line 715 | begin
715        Inc(result);
716   end;
717  
718 < function TIBDatabase.IndexOfDBConst(st: String): Integer;
718 > function TIBDataBase.IndexOfDBConst(st: String): Integer;
719   var
720    i, pos_of_str: Integer;
721   begin
# Line 718 | Line 731 | begin
731    end;
732   end;
733  
734 < procedure TIBDatabase.InternalClose(Force: Boolean);
734 > procedure TIBDataBase.InternalClose(Force: Boolean);
735   var
736    i: Integer;
737   begin
# Line 797 | Line 810 | begin
810    end;
811   end;
812  
813 < procedure TIBDatabase.Notification( AComponent: TComponent;
814 <                                        Operation: TOperation);
813 > procedure TIBDataBase.Notification(AComponent: TComponent;
814 >   Operation: TOperation);
815   var
816    i: Integer;
817   begin
# Line 812 | Line 825 | begin
825    end;
826   end;
827  
828 < function TIBDatabase.Login: Boolean;
828 > function TIBDataBase.Login: Boolean;
829   var
830    IndexOfUser, IndexOfPassword: Integer;
831    Username, Password, OldPassword: String;
# Line 891 | Line 904 | begin
904    end;
905   end;
906  
907 < procedure TIBDatabase.DoConnect;
907 > procedure TIBDataBase.DoConnect;
908   var
909    DPB: String;
910    TempDBParams: TStrings;
# Line 946 | Line 959 | begin
959      MonitorHook.DBConnect(Self);
960   end;
961  
962 < procedure TIBDatabase.RemoveSQLObject(Idx: Integer);
962 > procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
963   var
964    ds: TIBBase;
965   begin
# Line 960 | Line 973 | begin
973    end;
974   end;
975  
976 < procedure TIBDatabase.RemoveSQLObjects;
976 > procedure TIBDataBase.RemoveSQLObjects;
977   var
978    i: Integer;
979   begin
# Line 972 | Line 985 | begin
985    end;
986   end;
987  
988 < procedure TIBDatabase.RemoveTransaction(Idx: Integer);
988 > procedure TIBDataBase.RemoveTransaction(Idx: Integer);
989   var
990    TR: TIBTransaction;
991   begin
# Line 986 | Line 999 | begin
999    end;
1000   end;
1001  
1002 < procedure TIBDatabase.RemoveTransactions;
1002 > procedure TIBDataBase.RemoveTransactions;
1003   var
1004    i: Integer;
1005   begin
# Line 994 | Line 1007 | begin
1007      RemoveTransaction(i);
1008   end;
1009  
1010 < procedure TIBDatabase.SetDatabaseName(const Value: TIBFileName);
1010 > procedure TIBDataBase.SetDatabaseName( const Value: TIBFileName);
1011   begin
1012    if FDBName <> Value then
1013    begin
# Line 1004 | Line 1017 | begin
1017    end;
1018   end;
1019  
1020 < procedure TIBDatabase.SetDBParamByDPB(const Idx: Integer; Value: String);
1020 > procedure TIBDataBase.SetDBParamByDPB( const Idx: Integer; Value: String);
1021   var
1022    ConstIdx: Integer;
1023   begin
# Line 1023 | Line 1036 | begin
1036    end;
1037   end;
1038  
1039 < procedure TIBDatabase.SetDBParams(Value: TStrings);
1039 > procedure TIBDataBase.SetDBParams(Value: TStrings);
1040   begin
1041    FDBParams.Assign(Value);
1042   end;
1043  
1044 < procedure TIBDatabase.SetDefaultTransaction(Value: TIBTransaction);
1044 > procedure TIBDataBase.SetDefaultTransaction(Value: TIBTransaction);
1045   var
1046    i: Integer;
1047   begin
# Line 1046 | Line 1059 | begin
1059    FDefaultTransaction := Value;
1060   end;
1061  
1062 < procedure TIBDatabase.SetHandle(Value: TISC_DB_HANDLE);
1062 > procedure TIBDataBase.SetHandle(Value: TISC_DB_HANDLE);
1063   begin
1064    if HandleIsShared then
1065      Close
# Line 1056 | Line 1069 | begin
1069    FHandleIsShared := (Value <> nil);
1070   end;
1071  
1072 < procedure TIBDatabase.SetIdleTimer(Value: Integer);
1072 > procedure TIBDataBase.SetIdleTimer(Value: Integer);
1073   begin
1074    if Value < 0 then
1075      IBError(ibxeTimeoutNegative, [nil])
# Line 1075 | Line 1088 | begin
1088        end;
1089   end;
1090  
1091 < function TIBDatabase.TestConnected: Boolean;
1091 > function TIBDataBase.TestConnected: Boolean;
1092   var
1093    DatabaseInfo: TIBDatabaseInfo;
1094   begin
# Line 1096 | Line 1109 | begin
1109    end;
1110   end;
1111  
1112 < procedure TIBDatabase.TimeoutConnection(Sender: TObject);
1112 > procedure TIBDataBase.TimeoutConnection(Sender: TObject);
1113   begin
1114    if Connected then
1115    begin
# Line 1111 | Line 1124 | begin
1124    end;
1125   end;
1126  
1127 < function TIBDatabase.GetIsReadOnly: Boolean;
1127 > function TIBDataBase.GetIsReadOnly: Boolean;
1128   var
1129    DatabaseInfo: TIBDatabaseInfo;
1130   begin
# Line 1129 | Line 1142 | begin
1142    DatabaseInfo.Free;
1143   end;
1144  
1145 < function TIBDatabase.GetSQLDialect: Integer;
1145 > function TIBDataBase.GetSQLDialect: Integer;
1146   begin
1147    Result := FSQLDialect;
1148   end;
1149  
1150  
1151 < procedure TIBDatabase.SetSQLDialect(const Value: Integer);
1151 > procedure TIBDataBase.SetSQLDialect( const Value: Integer);
1152   begin
1153    if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
1154    if ((FHandle = nil) or (Value <= FDBSQLDialect))  then
# Line 1144 | Line 1157 | begin
1157      IBError(ibxeSQLDialectInvalid, [nil]);
1158   end;
1159  
1160 < function TIBDatabase.GetDBSQLDialect: Integer;
1160 > function TIBDataBase.GetDBSQLDialect: Integer;
1161   var
1162    DatabaseInfo: TIBDatabaseInfo;
1163   begin
# Line 1154 | Line 1167 | begin
1167    DatabaseInfo.Free;
1168   end;
1169  
1170 < procedure TIBDatabase.ValidateClientSQLDialect;
1170 > procedure TIBDataBase.ValidateClientSQLDialect;
1171   begin
1172    if (FDBSQLDialect < FSQLDialect) then
1173    begin
# Line 1164 | Line 1177 | begin
1177    end;
1178   end;
1179  
1180 < procedure TIBDatabase.ApplyUpdates(const DataSets: array of TDataSet);
1180 > procedure TIBDataBase.ApplyUpdates( const DataSets: array of TDataSet);
1181   var
1182    I: Integer;
1183    DS: TIBCustomDataSet;
# Line 1190 | Line 1203 | begin
1203    TR.CommitRetaining;
1204   end;
1205  
1206 < procedure TIBDatabase.CloseDataSets;
1206 > procedure TIBDataBase.CloseDataSets;
1207   var
1208    i: Integer;
1209   begin
# Line 1199 | Line 1212 | begin
1212        DataSets[i].close;
1213   end;
1214  
1215 < function TIBDatabase.GetDataset(Index : longint) : TDataset;
1215 > function TIBDataBase.GetDataset(Index: longint): TDataset;
1216   begin
1217    if (Index >= 0) and (Index < FDataSets.Count) then
1218      Result := TDataSet(FDataSets[Index])
# Line 1207 | Line 1220 | begin
1220      raise Exception.Create('Invalid Index to DataSets');
1221   end;
1222  
1223 < function TIBDatabase.GetDataSetCount : Longint;
1223 > function TIBDataBase.GetDataSetCount: Longint;
1224   begin
1225    Result := FDataSets.Count;
1226   end;
# Line 1228 | Line 1241 | begin
1241    inherited SetConnected(Value);
1242   end;
1243  
1244 < procedure TIBDatabase.GetFieldNames(const TableName: string; List: TStrings);
1244 > procedure TIBDataBase.GetFieldNames( const TableName: string; List: TStrings);
1245   var
1246    Query: TIBSQL;
1247   begin
# Line 1269 | Line 1282 | begin
1282    end;
1283   end;
1284  
1285 < procedure TIBDatabase.GetTableNames(List: TStrings; SystemTables: Boolean);
1285 > procedure TIBDataBase.GetTableNames(List: TStrings; SystemTables: Boolean);
1286   var
1287    Query : TIBSQL;
1288   begin
# Line 1384 | Line 1397 | begin
1397      IBError(ibxeNotInTransaction, [nil]);
1398   end;
1399  
1400 + procedure TIBTransaction.DoBeforeTransactionEnd;
1401 + begin
1402 +  if Assigned(FBeforeTransactionEnd) then
1403 +    FBeforeTransactionEnd(self);
1404 + end;
1405 +
1406 + procedure TIBTransaction.DoAfterTransactionEnd;
1407 + begin
1408 +  if Assigned(FAfterTransactionEnd) then
1409 +    FAfterTransactionEnd(self);
1410 + end;
1411 +
1412   procedure TIBTransaction.EnsureNotInTransaction;
1413   begin
1414    if csDesigning in ComponentState then
# Line 1460 | Line 1485 | begin
1485    CheckInTransaction;
1486    if FInEndTransaction then Exit;
1487    FInEndTransaction := true;
1488 +  FEndAction := Action;
1489    try
1490    case Action of
1491      TARollback, TACommit:
# Line 1468 | Line 1494 | begin
1494           (Action <> FDefaultAction) and
1495           (not Force) then
1496          IBError(ibxeCantEndSharedTransaction, [nil]);
1497 +      DoBeforeTransactionEnd;
1498        for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1499          SQLObjects[i].DoBeforeTransactionEnd;
1500        if InTransaction then
# Line 1492 | Line 1519 | begin
1519              IBDataBaseError;
1520          for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then
1521            SQLObjects[i].DoAfterTransactionEnd;
1522 +        DoAfterTransactionEnd;
1523        end;
1524      end;
1525      TACommitRetaining:
# Line 1582 | Line 1610 | begin
1610    end;
1611   end;
1612  
1613 + function TIBTransaction.GetEndAction: TTransactionAction;
1614 + begin
1615 +  if FInEndTransaction then
1616 +     Result := FEndAction
1617 +  else
1618 +     IBError(ibxeIB60feature, [nil])
1619 + end;
1620 +
1621  
1622   function TIBTransaction.GetIdleTimer: Integer;
1623   begin
# Line 1687 | Line 1723 | begin
1723      for i := 0 to FSQLObjects.Count - 1 do
1724        if (FSQLObjects[i] <> nil) and
1725           (TIBBase(FSQLObjects[i]).Database = nil) then
1726 <        SetOrdProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Integer(Value));
1726 >         SetObjectProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Value);
1727    end;
1728    FDefaultDatabase := Value;
1729   end;
# Line 2114 | Line 2150 | end.
2150  
2151  
2152  
2153 <
2153 >

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines