24 |
|
{ Corporation. All Rights Reserved. } |
25 |
|
{ Contributor(s): Jeff Overcash } |
26 |
|
{ } |
27 |
+ |
{ IBX For Lazarus (Firebird Express) } |
28 |
+ |
{ Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk } |
29 |
+ |
{ Portions created by MWA Software are copyright McCallum Whyman } |
30 |
+ |
{ Associates Ltd 2011 } |
31 |
+ |
{ } |
32 |
|
{************************************************************************} |
33 |
|
|
34 |
|
unit IBDatabase; |
35 |
|
|
36 |
|
{$Mode Delphi} |
37 |
|
|
38 |
+ |
{$IF FPC_FULLVERSION >= 20700 } |
39 |
+ |
{$codepage UTF8} |
40 |
+ |
{$DEFINE HAS_ANSISTRING_CODEPAGE} |
41 |
+ |
{$ENDIF} |
42 |
+ |
|
43 |
|
interface |
44 |
|
|
45 |
|
uses |
46 |
< |
{$IFDEF LINUX } |
37 |
< |
unix, |
38 |
< |
{$ELSE} |
39 |
< |
{$DEFINE HAS_SQLMONITOR} |
46 |
> |
{$IFDEF WINDOWS } |
47 |
|
Windows, |
48 |
+ |
{$ELSE} |
49 |
+ |
unix, |
50 |
|
{$ENDIF} |
51 |
< |
Dialogs, Controls, StdCtrls, SysUtils, Classes, Forms, ExtCtrls, IBHeader, IBExternals, DB, |
52 |
< |
IB, DBLoginDlg; |
51 |
> |
SysUtils, Classes, FPTimer, IBHeader, IBExternals, DB, |
52 |
> |
IB, CustApp; |
53 |
|
|
54 |
|
const |
55 |
|
DPBPrefix = 'isc_dpb_'; |
160 |
|
{ TIBDatabase } |
161 |
|
TIBDataBase = class(TCustomConnection) |
162 |
|
private |
163 |
+ |
FAllowStreamedConnected: boolean; |
164 |
|
FHiddenPassword: string; |
165 |
|
FIBLoaded: Boolean; |
166 |
|
FOnLogin: TIBDatabaseLoginEvent; |
167 |
+ |
FSQLHourGlass: Boolean; |
168 |
|
FTraceFlags: TTraceFlags; |
169 |
|
FDBSQLDialect: Integer; |
170 |
|
FSQLDialect: Integer; |
183 |
|
FDefaultTransaction: TIBTransaction; |
184 |
|
FInternalTransaction: TIBTransaction; |
185 |
|
FStreamedConnected: Boolean; |
186 |
< |
FTimer: TTimer; |
186 |
> |
FTimer: TFPTimer; |
187 |
|
FUserNames: TStringList; |
188 |
|
FDataSets: TList; |
189 |
+ |
FLoginCalled: boolean; |
190 |
+ |
FDefaultCharSetName: RawByteString; |
191 |
+ |
FDefaultCharSetID: integer; |
192 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
193 |
+ |
FDefaultCodePage: TSystemCodePage; |
194 |
+ |
{$ENDIF} |
195 |
+ |
FUseDefaultSystemCodePage: boolean; |
196 |
|
procedure EnsureInactive; |
197 |
|
function GetDBSQLDialect: Integer; |
198 |
|
function GetSQLDialect: Integer; |
206 |
|
function GetIdleTimer: Integer; |
207 |
|
function GetTransaction(Index: Integer): TIBTransaction; |
208 |
|
function GetTransactionCount: Integer; |
209 |
< |
function Login: Boolean; |
209 |
> |
function Login(var aDatabaseName: string): Boolean; |
210 |
|
procedure SetDatabaseName(const Value: TIBFileName); |
211 |
|
procedure SetDBParamByDPB(const Idx: Integer; Value: String); |
212 |
|
procedure SetDBParams(Value: TStrings); |
223 |
|
procedure DoConnect; override; |
224 |
|
procedure DoDisconnect; override; |
225 |
|
function GetConnected: Boolean; override; |
226 |
< |
procedure Loaded; override; |
226 |
> |
procedure CheckStreamConnect; |
227 |
> |
procedure HandleException(Sender: TObject); |
228 |
|
procedure Notification( AComponent: TComponent; Operation: TOperation); override; |
229 |
|
function GetDataset(Index : longint) : TDataset; override; |
230 |
|
function GetDataSetCount : Longint; override; |
231 |
< |
|
231 |
> |
procedure ReadState(Reader: TReader); override; |
232 |
> |
procedure SetConnected (Value : boolean); override; |
233 |
|
public |
234 |
|
constructor Create(AOwner: TComponent); override; |
235 |
|
destructor Destroy; override; |
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 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
269 |
+ |
property DefaultCodePage: TSystemCodePage read FDefaultCodePage; |
270 |
+ |
{$ENDIF} |
271 |
|
|
272 |
|
published |
273 |
|
property Connected; |
274 |
< |
property StreamedConnected; |
274 |
> |
property AllowStreamedConnected: boolean read FAllowStreamedConnected |
275 |
> |
write FAllowStreamedConnected; |
276 |
|
property DatabaseName: TIBFileName read FDBName write SetDatabaseName; |
277 |
|
property Params: TStrings read FDBParams write SetDBParams; |
278 |
|
property LoginPrompt default True; |
280 |
|
write SetDefaultTransaction; |
281 |
|
property IdleTimer: Integer read GetIdleTimer write SetIdleTimer; |
282 |
|
property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3; |
283 |
+ |
property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true; |
284 |
|
property DBSQLDialect : Integer read FDBSQLDialect; |
285 |
|
property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags; |
286 |
+ |
property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage |
287 |
+ |
write FUseDefaultSystemCodePage; |
288 |
|
property AfterConnect; |
289 |
|
property AfterDisconnect; |
290 |
|
property BeforeConnect; |
300 |
|
|
301 |
|
TIBTransaction = class(TComponent) |
302 |
|
private |
303 |
+ |
FAfterDelete: TNotifyEvent; |
304 |
+ |
FAfterEdit: TNotifyEvent; |
305 |
+ |
FAfterExecQuery: TNotifyEvent; |
306 |
+ |
FAfterInsert: TNotifyEvent; |
307 |
+ |
FAfterPost: TNotifyEvent; |
308 |
+ |
FAfterTransactionEnd: TNotifyEvent; |
309 |
+ |
FBeforeTransactionEnd: TNotifyEvent; |
310 |
|
FIBLoaded: Boolean; |
311 |
|
FCanTimeout : Boolean; |
312 |
|
FDatabases : TList; |
313 |
+ |
FOnStartTransaction: TNotifyEvent; |
314 |
|
FSQLObjects : TList; |
315 |
|
FDefaultDatabase : TIBDatabase; |
316 |
|
FHandle : TISC_TR_HANDLE; |
319 |
|
FStreamedActive : Boolean; |
320 |
|
FTPB : PChar; |
321 |
|
FTPBLength : Short; |
322 |
< |
FTimer : TTimer; |
322 |
> |
FTimer : TFPTimer; |
323 |
|
FDefaultAction : TTransactionAction; |
324 |
|
FTRParams : TStrings; |
325 |
|
FTRParamsChanged : Boolean; |
326 |
+ |
FInEndTransaction : boolean; |
327 |
+ |
FEndAction : TTransactionAction; |
328 |
+ |
procedure DoBeforeTransactionEnd; |
329 |
+ |
procedure DoAfterTransactionEnd; |
330 |
+ |
procedure DoOnStartTransaction; |
331 |
+ |
procedure DoAfterExecQuery(Sender: TObject); |
332 |
+ |
procedure DoAfterEdit(Sender: TObject); |
333 |
+ |
procedure DoAfterDelete(Sender: TObject); |
334 |
+ |
procedure DoAfterInsert(Sender: TObject); |
335 |
+ |
procedure DoAfterPost(Sender: TObject); |
336 |
|
procedure EnsureNotInTransaction; |
337 |
|
procedure EndTransaction(Action: TTransactionAction; Force: Boolean); |
338 |
|
function GetDatabase(Index: Integer): TIBDatabase; |
374 |
|
function AddDatabase(db: TIBDatabase): Integer; |
375 |
|
function FindDatabase(db: TIBDatabase): Integer; |
376 |
|
function FindDefaultDatabase: TIBDatabase; |
377 |
+ |
function GetEndAction: TTransactionAction; |
378 |
|
procedure RemoveDatabase(Idx: Integer); |
379 |
|
procedure RemoveDatabases; |
380 |
|
procedure CheckDatabasesInList; |
396 |
|
property DefaultAction: TTransactionAction read FDefaultAction write SetDefaultAction default taCommit; |
397 |
|
property Params: TStrings read FTRParams write SetTRParams; |
398 |
|
property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer; |
399 |
< |
end; |
399 |
> |
property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd |
400 |
> |
write FBeforeTransactionEnd; |
401 |
> |
property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd |
402 |
> |
write FAfterTransactionEnd; |
403 |
> |
property OnStartTransaction: TNotifyEvent read FOnStartTransaction |
404 |
> |
write FOnStartTransaction; |
405 |
> |
property AfterExecQuery: TNotifyEvent read FAfterExecQuery |
406 |
> |
write FAfterExecQuery; |
407 |
> |
property AfterEdit: TNotifyEvent read FAfterEdit write FAfterEdit; |
408 |
> |
property AfterDelete: TNotifyEvent read FAfterDelete write FAfterDelete; |
409 |
> |
property AfterInsert: TNotifyEvent read FAfterInsert write FAfterInsert; |
410 |
> |
property AfterPost: TNotifyEvent read FAfterPost write FAfterPost; |
411 |
> |
end; |
412 |
> |
|
413 |
> |
TTransactionEndEvent = procedure(Sender:TObject; Action: TTransactionAction) of object; |
414 |
> |
TBeforeDatabaseConnectEvent = procedure (Sender: TObject; DBParams: TStrings; |
415 |
> |
var DBName: string) of object; |
416 |
|
|
417 |
|
{ TIBBase } |
418 |
|
|
421 |
|
connections. } |
422 |
|
TIBBase = class(TObject) |
423 |
|
protected |
424 |
+ |
FBeforeDatabaseConnect: TBeforeDatabaseConnectEvent; |
425 |
|
FDatabase: TIBDatabase; |
426 |
|
FIndexInDatabase: Integer; |
427 |
|
FTransaction: TIBTransaction; |
429 |
|
FOwner: TObject; |
430 |
|
FBeforeDatabaseDisconnect: TNotifyEvent; |
431 |
|
FAfterDatabaseDisconnect: TNotifyEvent; |
432 |
+ |
FAfterDatabaseConnect: TNotifyEvent; |
433 |
|
FOnDatabaseFree: TNotifyEvent; |
434 |
< |
FBeforeTransactionEnd: TNotifyEvent; |
434 |
> |
FBeforeTransactionEnd: TTransactionEndEvent; |
435 |
|
FAfterTransactionEnd: TNotifyEvent; |
436 |
|
FOnTransactionFree: TNotifyEvent; |
437 |
|
|
438 |
+ |
procedure DoBeforeDatabaseConnect(DBParams: TStrings; |
439 |
+ |
var DBName: string); virtual; |
440 |
+ |
procedure DoAfterDatabaseConnect; virtual; |
441 |
|
procedure DoBeforeDatabaseDisconnect; virtual; |
442 |
|
procedure DoAfterDatabaseDisconnect; virtual; |
443 |
|
procedure DoDatabaseFree; virtual; |
444 |
< |
procedure DoBeforeTransactionEnd; virtual; |
444 |
> |
procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual; |
445 |
|
procedure DoAfterTransactionEnd; virtual; |
446 |
|
procedure DoTransactionFree; virtual; |
447 |
|
function GetDBHandle: PISC_DB_HANDLE; virtual; |
453 |
|
destructor Destroy; override; |
454 |
|
procedure CheckDatabase; virtual; |
455 |
|
procedure CheckTransaction; virtual; |
456 |
+ |
procedure DoAfterExecQuery(Sender: TObject); virtual; |
457 |
+ |
procedure DoAfterEdit(Sender: TObject); virtual; |
458 |
+ |
procedure DoAfterDelete(Sender: TObject); virtual; |
459 |
+ |
procedure DoAfterInsert(Sender: TObject); virtual; |
460 |
+ |
procedure DoAfterPost(Sender: TObject); virtual; |
461 |
+ |
function GetDefaultCharSetName: RawByteString; |
462 |
+ |
function GetDefaultCharSetID: cardinal; |
463 |
+ |
procedure HandleException(Sender: TObject); |
464 |
+ |
procedure SetCursor; |
465 |
+ |
procedure RestoreCursor; |
466 |
|
public |
467 |
+ |
property BeforeDatabaseConnect: TBeforeDatabaseConnectEvent read FBeforeDatabaseConnect |
468 |
+ |
write FBeforeDatabaseConnect; |
469 |
+ |
property AfterDatabaseConnect: TNotifyEvent read FAfterDatabaseConnect |
470 |
+ |
write FAfterDatabaseConnect; |
471 |
|
property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect |
472 |
|
write FBeforeDatabaseDisconnect; |
473 |
|
property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect |
474 |
|
write FAfterDatabaseDisconnect; |
475 |
|
property OnDatabaseFree: TNotifyEvent read FOnDatabaseFree write FOnDatabaseFree; |
476 |
< |
property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd write FBeforeTransactionEnd; |
476 |
> |
property BeforeTransactionEnd: TTransactionEndEvent read FBeforeTransactionEnd write FBeforeTransactionEnd; |
477 |
|
property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd write FAfterTransactionEnd; |
478 |
|
property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree; |
479 |
|
property Database: TIBDatabase read FDatabase |
491 |
|
|
492 |
|
implementation |
493 |
|
|
494 |
< |
uses IBIntf,{$IFDEF HAS_SQLMONITOR}IBSQLMonitor,{$ENDIF} IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils, typInfo; |
494 |
> |
uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils, |
495 |
> |
typInfo, IBCodePage; |
496 |
|
|
497 |
|
{ TIBDatabase } |
498 |
|
|
499 |
< |
constructor TIBDatabase.Create(AOwner: TComponent); |
499 |
> |
constructor TIBDataBase.Create(AOwner: TComponent); |
500 |
|
begin |
501 |
|
inherited Create(AOwner); |
502 |
|
FIBLoaded := False; |
507 |
|
FTransactions := TList.Create; |
508 |
|
FDBName := ''; |
509 |
|
FDBParams := TStringList.Create; |
510 |
+ |
FSQLHourGlass := true; |
511 |
+ |
if (AOwner <> nil) and |
512 |
+ |
(AOwner is TCustomApplication) and |
513 |
+ |
TCustomApplication(AOWner).ConsoleApplication then |
514 |
+ |
LoginPrompt := false; |
515 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
516 |
+ |
FDefaultCodePage := CP_NONE; |
517 |
+ |
{$ENDIF} |
518 |
|
FDBParamsChanged := True; |
519 |
|
TStringList(FDBParams).OnChange := DBParamsChange; |
520 |
|
TStringList(FDBParams).OnChanging := DBParamsChanging; |
523 |
|
FUserNames := nil; |
524 |
|
FInternalTransaction := TIBTransaction.Create(self); |
525 |
|
FInternalTransaction.DefaultDatabase := Self; |
526 |
< |
FTimer := TTimer.Create(Self); |
526 |
> |
FTimer := TFPTimer.Create(Self); |
527 |
|
FTimer.Enabled := False; |
528 |
|
FTimer.Interval := 0; |
529 |
|
FTimer.OnTimer := TimeoutConnection; |
531 |
|
FSQLDialect := 3; |
532 |
|
FTraceFlags := []; |
533 |
|
FDataSets := TList.Create; |
534 |
+ |
CheckStreamConnect; |
535 |
|
end; |
536 |
|
|
537 |
< |
destructor TIBDatabase.Destroy; |
537 |
> |
destructor TIBDataBase.Destroy; |
538 |
|
var |
539 |
|
i: Integer; |
540 |
|
begin |
560 |
|
inherited Destroy; |
561 |
|
end; |
562 |
|
|
563 |
< |
function TIBDatabase.Call(ErrCode: ISC_STATUS; |
564 |
< |
RaiseError: Boolean): ISC_STATUS; |
563 |
> |
function TIBDataBase.Call(ErrCode: ISC_STATUS; RaiseError: Boolean |
564 |
> |
): ISC_STATUS; |
565 |
|
begin |
566 |
|
result := ErrCode; |
567 |
|
FCanTimeout := False; |
569 |
|
IBDataBaseError; |
570 |
|
end; |
571 |
|
|
572 |
< |
procedure TIBDatabase.CheckActive; |
572 |
> |
procedure TIBDataBase.CheckActive; |
573 |
|
begin |
574 |
|
if StreamedConnected and (not Connected) then |
575 |
|
Loaded; |
577 |
|
IBError(ibxeDatabaseClosed, [nil]); |
578 |
|
end; |
579 |
|
|
580 |
< |
procedure TIBDatabase.EnsureInactive; |
580 |
> |
procedure TIBDataBase.EnsureInactive; |
581 |
|
begin |
582 |
|
if csDesigning in ComponentState then |
583 |
|
begin |
586 |
|
end |
587 |
|
end; |
588 |
|
|
589 |
< |
procedure TIBDatabase.CheckInactive; |
589 |
> |
procedure TIBDataBase.CheckInactive; |
590 |
|
begin |
591 |
|
if FHandle <> nil then |
592 |
|
IBError(ibxeDatabaseOpen, [nil]); |
593 |
|
end; |
594 |
|
|
595 |
< |
procedure TIBDatabase.CheckDatabaseName; |
595 |
> |
procedure TIBDataBase.CheckDatabaseName; |
596 |
|
begin |
597 |
< |
if (FDBName = '') then |
597 |
> |
if (Trim(FDBName) = '') then |
598 |
|
IBError(ibxeDatabaseNameMissing, [nil]); |
599 |
|
end; |
600 |
|
|
601 |
< |
function TIBDatabase.AddSQLObject(ds: TIBBase): Integer; |
601 |
> |
function TIBDataBase.AddSQLObject(ds: TIBBase): Integer; |
602 |
|
begin |
603 |
|
result := 0; |
604 |
|
if (ds.Owner is TIBCustomDataSet) then |
605 |
< |
{$IFDEF LINUX} |
513 |
< |
FDataSets.Add(TDataSet(ds.Owner)); |
514 |
< |
{$ELSE} |
515 |
< |
RegisterClient(TDataSet(ds.Owner)); |
516 |
< |
{$ENDIF} |
605 |
> |
FDataSets.Add(ds.Owner); |
606 |
|
while (result < FSQLObjects.Count) and (FSQLObjects[result] <> nil) do |
607 |
|
Inc(result); |
608 |
|
if (result = FSQLObjects.Count) then |
611 |
|
FSQLObjects[result] := ds; |
612 |
|
end; |
613 |
|
|
614 |
< |
function TIBDatabase.AddTransaction(TR: TIBTransaction): Integer; |
614 |
> |
function TIBDataBase.AddTransaction(TR: TIBTransaction): Integer; |
615 |
|
begin |
616 |
|
result := FindTransaction(TR); |
617 |
|
if result <> -1 then |
628 |
|
FTransactions[result] := TR; |
629 |
|
end; |
630 |
|
|
631 |
< |
procedure TIBDatabase.DoDisconnect; |
631 |
> |
procedure TIBDataBase.DoDisconnect; |
632 |
|
begin |
633 |
|
if Connected then |
634 |
|
InternalClose(False); |
635 |
|
FDBSQLDialect := 1; |
636 |
+ |
FDefaultCharSetName := ''; |
637 |
+ |
FDefaultCharSetID := 0; |
638 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
639 |
+ |
FDefaultCodePage := CP_NONE; |
640 |
+ |
{$ENDIF} |
641 |
|
end; |
642 |
|
|
643 |
< |
procedure TIBDatabase.CreateDatabase; |
643 |
> |
procedure TIBDataBase.CreateDatabase; |
644 |
|
var |
645 |
|
tr_handle: TISC_TR_HANDLE; |
646 |
|
begin |
653 |
|
True); |
654 |
|
end; |
655 |
|
|
656 |
< |
procedure TIBDatabase.DropDatabase; |
656 |
> |
procedure TIBDataBase.DropDatabase; |
657 |
|
begin |
658 |
|
CheckActive; |
659 |
|
Call(isc_drop_database(StatusVector, @FHandle), True); |
660 |
|
end; |
661 |
|
|
662 |
< |
procedure TIBDatabase.DBParamsChange(Sender: TObject); |
662 |
> |
procedure TIBDataBase.DBParamsChange(Sender: TObject); |
663 |
|
begin |
664 |
|
FDBParamsChanged := True; |
665 |
|
end; |
666 |
|
|
667 |
< |
procedure TIBDatabase.DBParamsChanging(Sender: TObject); |
667 |
> |
procedure TIBDataBase.DBParamsChanging(Sender: TObject); |
668 |
|
begin |
669 |
|
EnsureInactive; |
670 |
|
CheckInactive; |
671 |
|
end; |
672 |
|
|
673 |
< |
function TIBDatabase.FindTransaction(TR: TIBTransaction): Integer; |
673 |
> |
function TIBDataBase.FindTransaction(TR: TIBTransaction): Integer; |
674 |
|
var |
675 |
|
i: Integer; |
676 |
|
begin |
683 |
|
end; |
684 |
|
end; |
685 |
|
|
686 |
< |
function TIBDatabase.FindDefaultTransaction(): TIBTransaction; |
686 |
> |
function TIBDataBase.FindDefaultTransaction: TIBTransaction; |
687 |
|
var |
688 |
|
i: Integer; |
689 |
|
begin |
701 |
|
end; |
702 |
|
end; |
703 |
|
|
704 |
< |
procedure TIBDatabase.ForceClose; |
704 |
> |
procedure TIBDataBase.ForceClose; |
705 |
|
begin |
706 |
|
if Connected then |
707 |
|
InternalClose(True); |
708 |
|
end; |
709 |
|
|
710 |
< |
function TIBDatabase.GetConnected: Boolean; |
710 |
> |
function TIBDataBase.GetConnected: Boolean; |
711 |
|
begin |
712 |
|
result := FHandle <> nil; |
713 |
|
end; |
714 |
|
|
715 |
< |
function TIBDatabase.GetSQLObject(Index: Integer): TIBBase; |
715 |
> |
function TIBDataBase.GetSQLObject(Index: Integer): TIBBase; |
716 |
|
begin |
717 |
|
result := FSQLObjects[Index]; |
718 |
|
end; |
719 |
|
|
720 |
< |
function TIBDatabase.GetSQLObjectCount: Integer; |
720 |
> |
function TIBDataBase.GetSQLObjectCount: Integer; |
721 |
|
var |
722 |
|
i: Integer; |
723 |
|
begin |
726 |
|
Inc(result); |
727 |
|
end; |
728 |
|
|
729 |
< |
function TIBDatabase.GetDBParamByDPB(const Idx: Integer): String; |
729 |
> |
function TIBDataBase.GetDBParamByDPB( const Idx: Integer): String; |
730 |
|
var |
731 |
|
ConstIdx, EqualsIdx: Integer; |
732 |
|
begin |
749 |
|
result := ''; |
750 |
|
end; |
751 |
|
|
752 |
< |
function TIBDatabase.GetIdleTimer: Integer; |
752 |
> |
function TIBDataBase.GetIdleTimer: Integer; |
753 |
|
begin |
754 |
|
result := FTimer.Interval; |
755 |
|
end; |
756 |
|
|
757 |
< |
function TIBDatabase.GetTransaction(Index: Integer): TIBTransaction; |
757 |
> |
function TIBDataBase.GetTransaction(Index: Integer): TIBTransaction; |
758 |
|
begin |
759 |
|
result := FTransactions[Index]; |
760 |
|
end; |
761 |
|
|
762 |
< |
function TIBDatabase.GetTransactionCount: Integer; |
762 |
> |
function TIBDataBase.GetTransactionCount: Integer; |
763 |
|
var |
764 |
|
i: Integer; |
765 |
|
begin |
769 |
|
Inc(result); |
770 |
|
end; |
771 |
|
|
772 |
< |
function TIBDatabase.IndexOfDBConst(st: String): Integer; |
772 |
> |
function TIBDataBase.IndexOfDBConst(st: String): Integer; |
773 |
|
var |
774 |
|
i, pos_of_str: Integer; |
775 |
|
begin |
785 |
|
end; |
786 |
|
end; |
787 |
|
|
788 |
< |
procedure TIBDatabase.InternalClose(Force: Boolean); |
788 |
> |
procedure TIBDataBase.InternalClose(Force: Boolean); |
789 |
|
var |
790 |
|
i: Integer; |
791 |
|
begin |
824 |
|
FHandleIsShared := False; |
825 |
|
end; |
826 |
|
|
733 |
– |
{$IFDEF HAS_SQLMONITOR} |
827 |
|
if not (csDesigning in ComponentState) then |
828 |
|
MonitorHook.DBDisconnect(Self); |
736 |
– |
{$ENDIF} |
829 |
|
|
830 |
|
for i := 0 to FSQLObjects.Count - 1 do |
831 |
|
if FSQLObjects[i] <> nil then |
832 |
|
SQLObjects[i].DoAfterDatabaseDisconnect; |
833 |
|
end; |
834 |
|
|
835 |
< |
procedure TIBDatabase.Loaded; |
835 |
> |
procedure TIBDataBase.CheckStreamConnect; |
836 |
|
var |
837 |
|
i: integer; |
838 |
|
begin |
839 |
|
try |
840 |
< |
if StreamedConnected and (not Connected) then |
840 |
> |
if not (csDesigning in ComponentState) and StreamedConnected and (not Connected) then |
841 |
|
begin |
750 |
– |
inherited Loaded; |
842 |
|
for i := 0 to FTransactions.Count - 1 do |
843 |
|
if FTransactions[i] <> nil then |
844 |
|
begin |
858 |
|
end; |
859 |
|
except |
860 |
|
if csDesigning in ComponentState then |
861 |
< |
Application.HandleException(Self) |
861 |
> |
HandleException(Self) |
862 |
|
else |
863 |
|
raise; |
864 |
|
end; |
865 |
|
end; |
866 |
|
|
867 |
< |
procedure TIBDatabase.Notification( AComponent: TComponent; |
868 |
< |
Operation: TOperation); |
867 |
> |
procedure TIBDataBase.HandleException(Sender: TObject); |
868 |
> |
var aParent: TComponent; |
869 |
> |
begin |
870 |
> |
aParent := Owner; |
871 |
> |
while aParent <> nil do |
872 |
> |
begin |
873 |
> |
if aParent is TCustomApplication then |
874 |
> |
begin |
875 |
> |
TCustomApplication(aParent).HandleException(Sender); |
876 |
> |
Exit; |
877 |
> |
end; |
878 |
> |
aParent := aParent.Owner; |
879 |
> |
end; |
880 |
> |
SysUtils.ShowException(ExceptObject,ExceptAddr); |
881 |
> |
end; |
882 |
> |
|
883 |
> |
procedure TIBDataBase.Notification(AComponent: TComponent; |
884 |
> |
Operation: TOperation); |
885 |
|
var |
886 |
|
i: Integer; |
887 |
|
begin |
895 |
|
end; |
896 |
|
end; |
897 |
|
|
898 |
< |
function TIBDatabase.Login: Boolean; |
898 |
> |
function TIBDataBase.Login(var aDatabaseName: string): Boolean; |
899 |
|
var |
900 |
|
IndexOfUser, IndexOfPassword: Integer; |
901 |
|
Username, Password, OldPassword: String; |
919 |
|
end; |
920 |
|
|
921 |
|
begin |
922 |
< |
if Assigned(FOnLogin) then |
922 |
> |
Result := false; |
923 |
> |
if FLoginCalled then Exit; |
924 |
> |
FLoginCalled := true; |
925 |
> |
try |
926 |
> |
if Assigned(FOnLogin) and not (csDesigning in ComponentState) then |
927 |
|
begin |
928 |
|
result := True; |
929 |
|
LoginParams := TStringList.Create; |
931 |
|
LoginParams.Assign(Params); |
932 |
|
FOnLogin(Self, LoginParams); |
933 |
|
Params.Assign (LoginParams); |
934 |
+ |
aDatabaseName := FDBName; |
935 |
|
HidePassword; |
936 |
|
finally |
937 |
|
LoginParams.Free; |
938 |
|
end; |
939 |
|
end |
940 |
|
else |
941 |
+ |
if assigned(IBGUIInterface) then |
942 |
|
begin |
943 |
|
IndexOfUser := IndexOfDBConst(DPBConstantNames[isc_dpb_user_name]); |
944 |
|
if IndexOfUser <> -1 then |
953 |
|
Length(Params[IndexOfPassword])); |
954 |
|
OldPassword := password; |
955 |
|
end; |
956 |
< |
result := LoginDialogEx(DatabaseName, Username, Password, False); |
956 |
> |
result := IBGUIInterface.LoginDialogEx(aDatabaseName, Username, Password, False); |
957 |
|
if result then |
958 |
|
begin |
959 |
|
if IndexOfUser = -1 then |
970 |
|
HidePassword; |
971 |
|
end; |
972 |
|
end; |
973 |
+ |
end |
974 |
+ |
else |
975 |
+ |
if LoginPrompt then |
976 |
+ |
IBError(ibxeNoLoginDialog,[]); |
977 |
+ |
finally |
978 |
+ |
FLoginCalled := false |
979 |
|
end; |
980 |
|
end; |
981 |
|
|
982 |
< |
procedure TIBDatabase.DoConnect; |
982 |
> |
procedure TIBDataBase.DoConnect; |
983 |
|
var |
984 |
|
DPB: String; |
985 |
|
TempDBParams: TStrings; |
986 |
+ |
I: integer; |
987 |
+ |
aDBName: string; |
988 |
|
|
989 |
+ |
{Call error analysis} |
990 |
+ |
sqlcode: Long; |
991 |
+ |
IBErrorCode: Long; |
992 |
+ |
status_vector: PISC_STATUS; |
993 |
+ |
CharSetID: integer; |
994 |
|
begin |
995 |
|
CheckInactive; |
996 |
|
CheckDatabaseName; |
1000 |
|
FDBParamsChanged := True; |
1001 |
|
end; |
1002 |
|
{ Use builtin login prompt if requested } |
1003 |
< |
if LoginPrompt and not Login then |
1003 |
> |
aDBName := FDBName; |
1004 |
> |
if (LoginPrompt or (csDesigning in ComponentState)) and not Login(aDBName) then |
1005 |
|
IBError(ibxeOperationCancelled, [nil]); |
1006 |
< |
{ Generate a new DPB if necessary } |
1007 |
< |
if (FDBParamsChanged) then |
1008 |
< |
begin |
1009 |
< |
FDBParamsChanged := False; |
1010 |
< |
if (not LoginPrompt) or (FHiddenPassword = '') then |
1011 |
< |
GenerateDPB(FDBParams, DPB, FDPBLength) |
1012 |
< |
else |
1006 |
> |
|
1007 |
> |
TempDBParams := TStringList.Create; |
1008 |
> |
try |
1009 |
> |
TempDBParams.Assign(FDBParams); |
1010 |
> |
if UseDefaultSystemCodePage then |
1011 |
> |
begin |
1012 |
> |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
1013 |
> |
{$ifdef WINDOWS} |
1014 |
> |
if TFirebirdCharacterSets.CodePage2CharSetID(GetACP,CharSetID) then |
1015 |
> |
TempDBParams.Values['lc_ctype'] := TFirebirdCharacterSets.GetCharsetName(CharSetID) |
1016 |
> |
else |
1017 |
> |
{$else} |
1018 |
> |
if TFirebirdCharacterSets.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then |
1019 |
> |
TempDBParams.Values['lc_ctype'] := TFirebirdCharacterSets.GetCharsetName(CharSetID) |
1020 |
> |
else |
1021 |
> |
{$endif} |
1022 |
> |
{$ENDIF} |
1023 |
> |
TempDBParams.Values['lc_ctype'] :='UTF8'; |
1024 |
> |
end; |
1025 |
> |
{Opportunity to override defaults} |
1026 |
> |
for i := 0 to FSQLObjects.Count - 1 do |
1027 |
> |
begin |
1028 |
> |
if FSQLObjects[i] <> nil then |
1029 |
> |
SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName); |
1030 |
> |
end; |
1031 |
> |
FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']); |
1032 |
> |
if FDefaultCharSetName <> '' then |
1033 |
> |
TFirebirdCharacterSets.CharSetName2CharSetID(FDefaultCharSetName,FDefaultCharSetID); |
1034 |
> |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
1035 |
> |
TFirebirdCharacterSets.CharSetID2CodePage(FDefaultCharSetID,FDefaultCodePage); |
1036 |
> |
{$ENDIF} |
1037 |
> |
{ Generate a new DPB if necessary } |
1038 |
> |
if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then |
1039 |
> |
begin |
1040 |
> |
FDBParamsChanged := False; |
1041 |
> |
if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then |
1042 |
> |
GenerateDPB(TempDBParams, DPB, FDPBLength) |
1043 |
> |
else |
1044 |
> |
begin |
1045 |
> |
TempDBParams.Add('password=' + FHiddenPassword); |
1046 |
> |
GenerateDPB(TempDBParams, DPB, FDPBLength); |
1047 |
> |
end; |
1048 |
> |
IBAlloc(FDPB, 0, FDPBLength); |
1049 |
> |
Move(DPB[1], FDPB[0], FDPBLength); |
1050 |
> |
end; |
1051 |
> |
finally |
1052 |
> |
TempDBParams.Free; |
1053 |
> |
end; |
1054 |
> |
repeat |
1055 |
> |
if Call(isc_attach_database(StatusVector, Length(aDBName), |
1056 |
> |
PChar(aDBName), @FHandle, |
1057 |
> |
FDPBLength, FDPB), False) > 0 then |
1058 |
|
begin |
1059 |
< |
TempDBParams := TStringList.Create; |
1060 |
< |
try |
1061 |
< |
TempDBParams.Assign(FDBParams); |
1062 |
< |
TempDBParams.Add('password=' + FHiddenPassword); |
1063 |
< |
GenerateDPB(TempDBParams, DPB, FDPBLength); |
1064 |
< |
finally |
1065 |
< |
TempDBParams.Free; |
1059 |
> |
{$IFDEF UNIX} |
1060 |
> |
if IsEmbeddedServer and (Pos(':',aDBName) = 0) then |
1061 |
> |
begin |
1062 |
> |
status_vector := StatusVector; |
1063 |
> |
IBErrorCode := StatusVectorArray[1]; |
1064 |
> |
sqlcode := isc_sqlcode(StatusVector); |
1065 |
> |
|
1066 |
> |
if ((sqlcode = -901) and (IBErrorCode = 335544382)) {Access permissions on firebird temp} |
1067 |
> |
or |
1068 |
> |
((sqlcode = -902) and (IBErrorCode = 335544373)) {Security DB Problem} |
1069 |
> |
then |
1070 |
> |
begin |
1071 |
> |
aDBName := 'localhost:' + aDBName; |
1072 |
> |
Continue; |
1073 |
> |
end; |
1074 |
|
end; |
1075 |
+ |
{$ENDIF} |
1076 |
+ |
FHandle := nil; |
1077 |
+ |
IBDataBaseError; |
1078 |
|
end; |
1079 |
< |
IBAlloc(FDPB, 0, FDPBLength); |
1080 |
< |
Move(DPB[1], FDPB[0], FDPBLength); |
1081 |
< |
end; |
899 |
< |
if Call(isc_attach_database(StatusVector, Length(FDBName), |
900 |
< |
PChar(FDBName), @FHandle, |
901 |
< |
FDPBLength, FDPB), False) > 0 then |
902 |
< |
begin |
903 |
< |
FHandle := nil; |
904 |
< |
IBDataBaseError; |
905 |
< |
end; |
1079 |
> |
until FHandle <> nil; |
1080 |
> |
if not (csDesigning in ComponentState) then |
1081 |
> |
FDBName := aDBName; {Synchronise at run time} |
1082 |
|
FDBSQLDialect := GetDBSQLDialect; |
1083 |
|
ValidateClientSQLDialect; |
1084 |
< |
{$IFDEF HAS_SQLMONITOR} |
1084 |
> |
for i := 0 to FSQLObjects.Count - 1 do |
1085 |
> |
begin |
1086 |
> |
if FSQLObjects[i] <> nil then |
1087 |
> |
SQLObjects[i].DoAfterDatabaseConnect; |
1088 |
> |
end; |
1089 |
|
if not (csDesigning in ComponentState) then |
1090 |
|
MonitorHook.DBConnect(Self); |
911 |
– |
{$ENDIF} |
1091 |
|
end; |
1092 |
|
|
1093 |
< |
procedure TIBDatabase.RemoveSQLObject(Idx: Integer); |
1093 |
> |
procedure TIBDataBase.RemoveSQLObject(Idx: Integer); |
1094 |
|
var |
1095 |
|
ds: TIBBase; |
1096 |
|
begin |
1100 |
|
FSQLObjects[Idx] := nil; |
1101 |
|
ds.Database := nil; |
1102 |
|
if (ds.owner is TDataSet) then |
924 |
– |
{$IFDEF LINUX} |
1103 |
|
FDataSets.Remove(TDataSet(ds.Owner)); |
926 |
– |
{$ELSE} |
927 |
– |
UnregisterClient(TDataSet(ds.Owner)); |
928 |
– |
{$ENDIF} |
1104 |
|
end; |
1105 |
|
end; |
1106 |
|
|
1107 |
< |
procedure TIBDatabase.RemoveSQLObjects; |
1107 |
> |
procedure TIBDataBase.RemoveSQLObjects; |
1108 |
|
var |
1109 |
|
i: Integer; |
1110 |
|
begin |
1112 |
|
begin |
1113 |
|
RemoveSQLObject(i); |
1114 |
|
if (TIBBase(FSQLObjects[i]).owner is TDataSet) then |
940 |
– |
{$IFDEF LINUX} |
1115 |
|
FDataSets.Remove(TDataSet(TIBBase(FSQLObjects[i]).owner)); |
942 |
– |
{$ELSE} |
943 |
– |
UnregisterClient(TDataSet(TIBBase(FSQLObjects[i]).owner)); |
944 |
– |
{$ENDIF} |
1116 |
|
end; |
1117 |
|
end; |
1118 |
|
|
1119 |
< |
procedure TIBDatabase.RemoveTransaction(Idx: Integer); |
1119 |
> |
procedure TIBDataBase.RemoveTransaction(Idx: Integer); |
1120 |
|
var |
1121 |
|
TR: TIBTransaction; |
1122 |
|
begin |
1130 |
|
end; |
1131 |
|
end; |
1132 |
|
|
1133 |
< |
procedure TIBDatabase.RemoveTransactions; |
1133 |
> |
procedure TIBDataBase.RemoveTransactions; |
1134 |
|
var |
1135 |
|
i: Integer; |
1136 |
|
begin |
1138 |
|
RemoveTransaction(i); |
1139 |
|
end; |
1140 |
|
|
1141 |
< |
procedure TIBDatabase.SetDatabaseName(const Value: TIBFileName); |
1141 |
> |
procedure TIBDataBase.SetDatabaseName( const Value: TIBFileName); |
1142 |
|
begin |
1143 |
|
if FDBName <> Value then |
1144 |
|
begin |
1148 |
|
end; |
1149 |
|
end; |
1150 |
|
|
1151 |
< |
procedure TIBDatabase.SetDBParamByDPB(const Idx: Integer; Value: String); |
1151 |
> |
procedure TIBDataBase.SetDBParamByDPB( const Idx: Integer; Value: String); |
1152 |
|
var |
1153 |
|
ConstIdx: Integer; |
1154 |
|
begin |
1167 |
|
end; |
1168 |
|
end; |
1169 |
|
|
1170 |
< |
procedure TIBDatabase.SetDBParams(Value: TStrings); |
1170 |
> |
procedure TIBDataBase.SetDBParams(Value: TStrings); |
1171 |
|
begin |
1172 |
|
FDBParams.Assign(Value); |
1173 |
|
end; |
1174 |
|
|
1175 |
< |
procedure TIBDatabase.SetDefaultTransaction(Value: TIBTransaction); |
1175 |
> |
procedure TIBDataBase.SetDefaultTransaction(Value: TIBTransaction); |
1176 |
|
var |
1177 |
|
i: Integer; |
1178 |
|
begin |
1190 |
|
FDefaultTransaction := Value; |
1191 |
|
end; |
1192 |
|
|
1193 |
< |
procedure TIBDatabase.SetHandle(Value: TISC_DB_HANDLE); |
1193 |
> |
procedure TIBDataBase.SetHandle(Value: TISC_DB_HANDLE); |
1194 |
|
begin |
1195 |
|
if HandleIsShared then |
1196 |
|
Close |
1200 |
|
FHandleIsShared := (Value <> nil); |
1201 |
|
end; |
1202 |
|
|
1203 |
< |
procedure TIBDatabase.SetIdleTimer(Value: Integer); |
1203 |
> |
procedure TIBDataBase.SetIdleTimer(Value: Integer); |
1204 |
|
begin |
1205 |
|
if Value < 0 then |
1206 |
|
IBError(ibxeTimeoutNegative, [nil]) |
1219 |
|
end; |
1220 |
|
end; |
1221 |
|
|
1222 |
< |
function TIBDatabase.TestConnected: Boolean; |
1222 |
> |
function TIBDataBase.TestConnected: Boolean; |
1223 |
|
var |
1224 |
|
DatabaseInfo: TIBDatabaseInfo; |
1225 |
|
begin |
1240 |
|
end; |
1241 |
|
end; |
1242 |
|
|
1243 |
< |
procedure TIBDatabase.TimeoutConnection(Sender: TObject); |
1243 |
> |
procedure TIBDataBase.TimeoutConnection(Sender: TObject); |
1244 |
|
begin |
1245 |
|
if Connected then |
1246 |
|
begin |
1255 |
|
end; |
1256 |
|
end; |
1257 |
|
|
1258 |
< |
function TIBDatabase.GetIsReadOnly: Boolean; |
1258 |
> |
function TIBDataBase.GetIsReadOnly: Boolean; |
1259 |
|
var |
1260 |
|
DatabaseInfo: TIBDatabaseInfo; |
1261 |
|
begin |
1273 |
|
DatabaseInfo.Free; |
1274 |
|
end; |
1275 |
|
|
1276 |
< |
function TIBDatabase.GetSQLDialect: Integer; |
1276 |
> |
function TIBDataBase.GetSQLDialect: Integer; |
1277 |
|
begin |
1278 |
|
Result := FSQLDialect; |
1279 |
|
end; |
1280 |
|
|
1281 |
< |
procedure TIBDatabase.SetSQLDialect(const Value: Integer); |
1281 |
> |
|
1282 |
> |
procedure TIBDataBase.SetSQLDialect( const Value: Integer); |
1283 |
|
begin |
1284 |
|
if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]); |
1285 |
|
if ((FHandle = nil) or (Value <= FDBSQLDialect)) then |
1288 |
|
IBError(ibxeSQLDialectInvalid, [nil]); |
1289 |
|
end; |
1290 |
|
|
1291 |
< |
function TIBDatabase.GetDBSQLDialect: Integer; |
1291 |
> |
function TIBDataBase.GetDBSQLDialect: Integer; |
1292 |
|
var |
1293 |
|
DatabaseInfo: TIBDatabaseInfo; |
1294 |
|
begin |
1298 |
|
DatabaseInfo.Free; |
1299 |
|
end; |
1300 |
|
|
1301 |
< |
procedure TIBDatabase.ValidateClientSQLDialect; |
1301 |
> |
procedure TIBDataBase.ValidateClientSQLDialect; |
1302 |
|
begin |
1303 |
|
if (FDBSQLDialect < FSQLDialect) then |
1304 |
|
begin |
1308 |
|
end; |
1309 |
|
end; |
1310 |
|
|
1311 |
< |
procedure TIBDatabase.ApplyUpdates(const DataSets: array of TDataSet); |
1311 |
> |
procedure TIBDataBase.ApplyUpdates( const DataSets: array of TDataSet); |
1312 |
|
var |
1313 |
|
I: Integer; |
1314 |
|
DS: TIBCustomDataSet; |
1334 |
|
TR.CommitRetaining; |
1335 |
|
end; |
1336 |
|
|
1337 |
< |
procedure TIBDatabase.CloseDataSets; |
1337 |
> |
procedure TIBDataBase.CloseDataSets; |
1338 |
|
var |
1339 |
|
i: Integer; |
1340 |
|
begin |
1343 |
|
DataSets[i].close; |
1344 |
|
end; |
1345 |
|
|
1346 |
< |
function TIBDatabase.GetDataset(Index : longint) : TDataset; |
1346 |
> |
function TIBDataBase.GetDataset(Index: longint): TDataset; |
1347 |
|
begin |
1348 |
|
if (Index >= 0) and (Index < FDataSets.Count) then |
1349 |
|
Result := TDataSet(FDataSets[Index]) |
1351 |
|
raise Exception.Create('Invalid Index to DataSets'); |
1352 |
|
end; |
1353 |
|
|
1354 |
< |
function TIBDatabase.GetDataSetCount : Longint; |
1354 |
> |
function TIBDataBase.GetDataSetCount: Longint; |
1355 |
|
begin |
1356 |
|
Result := FDataSets.Count; |
1357 |
|
end; |
1358 |
|
|
1359 |
< |
procedure TIBDatabase.GetFieldNames(const TableName: string; List: TStrings); |
1359 |
> |
procedure TIBDataBase.ReadState(Reader: TReader); |
1360 |
> |
begin |
1361 |
> |
FDBParams.Clear; |
1362 |
> |
inherited ReadState(Reader); |
1363 |
> |
end; |
1364 |
> |
|
1365 |
> |
procedure TIBDataBase.SetConnected(Value: boolean); |
1366 |
> |
begin |
1367 |
> |
if StreamedConnected and not AllowStreamedConnected then |
1368 |
> |
begin |
1369 |
> |
StreamedConnected := false; |
1370 |
> |
Value := false |
1371 |
> |
end; |
1372 |
> |
inherited SetConnected(Value); |
1373 |
> |
end; |
1374 |
> |
|
1375 |
> |
procedure TIBDataBase.GetFieldNames( const TableName: string; List: TStrings); |
1376 |
|
var |
1377 |
|
Query: TIBSQL; |
1378 |
|
begin |
1413 |
|
end; |
1414 |
|
end; |
1415 |
|
|
1416 |
< |
procedure TIBDatabase.GetTableNames(List: TStrings; SystemTables: Boolean); |
1416 |
> |
procedure TIBDataBase.GetTableNames(List: TStrings; SystemTables: Boolean); |
1417 |
|
var |
1418 |
|
Query : TIBSQL; |
1419 |
|
begin |
1472 |
|
FTRParamsChanged := True; |
1473 |
|
TStringList(FTRParams).OnChange := TRParamsChange; |
1474 |
|
TStringList(FTRParams).OnChanging := TRParamsChanging; |
1475 |
< |
FTimer := TTimer.Create(Self); |
1475 |
> |
FTimer := TFPTimer.Create(Self); |
1476 |
|
FTimer.Enabled := False; |
1477 |
|
FTimer.Interval := 0; |
1478 |
|
FTimer.OnTimer := TimeoutTransaction; |
1528 |
|
IBError(ibxeNotInTransaction, [nil]); |
1529 |
|
end; |
1530 |
|
|
1531 |
+ |
procedure TIBTransaction.DoBeforeTransactionEnd; |
1532 |
+ |
begin |
1533 |
+ |
if Assigned(FBeforeTransactionEnd) then |
1534 |
+ |
FBeforeTransactionEnd(self); |
1535 |
+ |
end; |
1536 |
+ |
|
1537 |
+ |
procedure TIBTransaction.DoAfterTransactionEnd; |
1538 |
+ |
begin |
1539 |
+ |
if Assigned(FAfterTransactionEnd) then |
1540 |
+ |
FAfterTransactionEnd(self); |
1541 |
+ |
end; |
1542 |
+ |
|
1543 |
+ |
procedure TIBTransaction.DoOnStartTransaction; |
1544 |
+ |
begin |
1545 |
+ |
if assigned(FOnStartTransaction) then |
1546 |
+ |
OnStartTransaction(self); |
1547 |
+ |
end; |
1548 |
+ |
|
1549 |
+ |
procedure TIBTransaction.DoAfterExecQuery(Sender: TObject); |
1550 |
+ |
begin |
1551 |
+ |
if assigned(FAfterExecQuery) then |
1552 |
+ |
AfterExecQuery(Sender); |
1553 |
+ |
end; |
1554 |
+ |
|
1555 |
+ |
procedure TIBTransaction.DoAfterEdit(Sender: TObject); |
1556 |
+ |
begin |
1557 |
+ |
if assigned(FAfterEdit) then |
1558 |
+ |
AfterEdit(Sender); |
1559 |
+ |
end; |
1560 |
+ |
|
1561 |
+ |
procedure TIBTransaction.DoAfterDelete(Sender: TObject); |
1562 |
+ |
begin |
1563 |
+ |
if assigned(FAfterDelete) then |
1564 |
+ |
AfterDelete(Sender); |
1565 |
+ |
end; |
1566 |
+ |
|
1567 |
+ |
procedure TIBTransaction.DoAfterInsert(Sender: TObject); |
1568 |
+ |
begin |
1569 |
+ |
if assigned(FAfterInsert) then |
1570 |
+ |
AfterInsert(Sender); |
1571 |
+ |
end; |
1572 |
+ |
|
1573 |
+ |
procedure TIBTransaction.DoAfterPost(Sender: TObject); |
1574 |
+ |
begin |
1575 |
+ |
if assigned(FAfterPost) then |
1576 |
+ |
AfterPost(Sender); |
1577 |
+ |
end; |
1578 |
+ |
|
1579 |
|
procedure TIBTransaction.EnsureNotInTransaction; |
1580 |
|
begin |
1581 |
|
if csDesigning in ComponentState then |
1650 |
|
i: Integer; |
1651 |
|
begin |
1652 |
|
CheckInTransaction; |
1653 |
+ |
if FInEndTransaction then Exit; |
1654 |
+ |
FInEndTransaction := true; |
1655 |
+ |
FEndAction := Action; |
1656 |
+ |
try |
1657 |
|
case Action of |
1658 |
|
TARollback, TACommit: |
1659 |
|
begin |
1661 |
|
(Action <> FDefaultAction) and |
1662 |
|
(not Force) then |
1663 |
|
IBError(ibxeCantEndSharedTransaction, [nil]); |
1664 |
+ |
DoBeforeTransactionEnd; |
1665 |
|
for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then |
1666 |
< |
SQLObjects[i].DoBeforeTransactionEnd; |
1666 |
> |
SQLObjects[i].DoBeforeTransactionEnd(Action); |
1667 |
|
if InTransaction then |
1668 |
|
begin |
1669 |
|
if HandleIsShared then |
1686 |
|
IBDataBaseError; |
1687 |
|
for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then |
1688 |
|
SQLObjects[i].DoAfterTransactionEnd; |
1689 |
+ |
DoAfterTransactionEnd; |
1690 |
|
end; |
1691 |
|
end; |
1692 |
|
TACommitRetaining: |
1694 |
|
TARollbackRetaining: |
1695 |
|
Call(isc_rollback_retaining(StatusVector, @FHandle), True); |
1696 |
|
end; |
1455 |
– |
{$IFDEF HAS_SQLMONITOR} |
1697 |
|
if not (csDesigning in ComponentState) then |
1698 |
|
begin |
1699 |
|
case Action of |
1707 |
|
MonitorHook.TRRollbackRetaining(Self); |
1708 |
|
end; |
1709 |
|
end; |
1710 |
< |
{$ENDIF} |
1710 |
> |
finally |
1711 |
> |
FInEndTransaction := false |
1712 |
> |
end; |
1713 |
|
end; |
1714 |
|
|
1715 |
|
function TIBTransaction.GetDatabase(Index: Integer): TIBDatabase; |
1777 |
|
end; |
1778 |
|
end; |
1779 |
|
|
1780 |
+ |
function TIBTransaction.GetEndAction: TTransactionAction; |
1781 |
+ |
begin |
1782 |
+ |
if FInEndTransaction then |
1783 |
+ |
Result := FEndAction |
1784 |
+ |
else |
1785 |
+ |
IBError(ibxeIB60feature, [nil]) |
1786 |
+ |
end; |
1787 |
+ |
|
1788 |
|
|
1789 |
|
function TIBTransaction.GetIdleTimer: Integer; |
1790 |
|
begin |
1890 |
|
for i := 0 to FSQLObjects.Count - 1 do |
1891 |
|
if (FSQLObjects[i] <> nil) and |
1892 |
|
(TIBBase(FSQLObjects[i]).Database = nil) then |
1893 |
< |
SetOrdProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Integer(Value)); |
1893 |
> |
SetObjectProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Value); |
1894 |
|
end; |
1895 |
|
FDefaultDatabase := Value; |
1896 |
|
end; |
1991 |
|
FHandle := nil; |
1992 |
|
IBDataBaseError; |
1993 |
|
end; |
1743 |
– |
{$IFDEF HAS_SQLMONITOR} |
1994 |
|
if not (csDesigning in ComponentState) then |
1995 |
|
MonitorHook.TRStart(Self); |
1746 |
– |
{$ENDIF} |
1996 |
|
finally |
1997 |
|
FreeMem(pteb); |
1998 |
|
end; |
1999 |
+ |
DoOnStartTransaction; |
2000 |
|
end; |
2001 |
|
|
2002 |
|
procedure TIBTransaction.TimeoutTransaction(Sender: TObject); |
2038 |
|
inherited Destroy; |
2039 |
|
end; |
2040 |
|
|
2041 |
+ |
function TIBBase.GetDefaultCharSetName: RawByteString; |
2042 |
+ |
begin |
2043 |
+ |
Result := Database.FDefaultCharSetName; |
2044 |
+ |
end; |
2045 |
+ |
|
2046 |
+ |
function TIBBase.GetDefaultCharSetID: cardinal; |
2047 |
+ |
begin |
2048 |
+ |
Result := Database.DefaultCharSetID; |
2049 |
+ |
end; |
2050 |
+ |
|
2051 |
+ |
procedure TIBBase.HandleException(Sender: TObject); |
2052 |
+ |
begin |
2053 |
+ |
if assigned(Database) then |
2054 |
+ |
Database.HandleException(Sender) |
2055 |
+ |
else |
2056 |
+ |
SysUtils.ShowException(ExceptObject,ExceptAddr); |
2057 |
+ |
end; |
2058 |
+ |
|
2059 |
+ |
procedure TIBBase.SetCursor; |
2060 |
+ |
begin |
2061 |
+ |
if Assigned(Database) and not Database.SQLHourGlass then |
2062 |
+ |
Exit; |
2063 |
+ |
if assigned(IBGUIInterface) then |
2064 |
+ |
IBGUIInterface.SetCursor; |
2065 |
+ |
end; |
2066 |
+ |
|
2067 |
+ |
procedure TIBBase.RestoreCursor; |
2068 |
+ |
begin |
2069 |
+ |
if Assigned(Database) and not Database.SQLHourGlass then |
2070 |
+ |
Exit; |
2071 |
+ |
if assigned(IBGUIInterface) then |
2072 |
+ |
IBGUIInterface.RestoreCursor; |
2073 |
+ |
end; |
2074 |
+ |
|
2075 |
|
procedure TIBBase.CheckDatabase; |
2076 |
|
begin |
2077 |
|
if (FDatabase = nil) then |
2098 |
|
result := @FTransaction.Handle; |
2099 |
|
end; |
2100 |
|
|
2101 |
+ |
procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string |
2102 |
+ |
); |
2103 |
+ |
begin |
2104 |
+ |
if assigned(FBeforeDatabaseConnect) then |
2105 |
+ |
BeforeDatabaseConnect(self,DBParams,DBName); |
2106 |
+ |
end; |
2107 |
+ |
|
2108 |
+ |
procedure TIBBase.DoAfterDatabaseConnect; |
2109 |
+ |
begin |
2110 |
+ |
if assigned(FAfterDatabaseConnect) then |
2111 |
+ |
AfterDatabaseConnect(self); |
2112 |
+ |
end; |
2113 |
+ |
|
2114 |
|
procedure TIBBase.DoBeforeDatabaseDisconnect; |
2115 |
|
begin |
2116 |
|
if Assigned(BeforeDatabaseDisconnect) then |
2131 |
|
SetTransaction(nil); |
2132 |
|
end; |
2133 |
|
|
2134 |
< |
procedure TIBBase.DoBeforeTransactionEnd; |
2134 |
> |
procedure TIBBase.DoBeforeTransactionEnd(Action: TTransactionAction); |
2135 |
|
begin |
2136 |
|
if Assigned(BeforeTransactionEnd) then |
2137 |
< |
BeforeTransactionEnd(Self); |
2137 |
> |
BeforeTransactionEnd(Self,Action); |
2138 |
|
end; |
2139 |
|
|
2140 |
|
procedure TIBBase.DoAfterTransactionEnd; |
2150 |
|
FTransaction := nil; |
2151 |
|
end; |
2152 |
|
|
2153 |
+ |
procedure TIBBase.DoAfterExecQuery(Sender: TObject); |
2154 |
+ |
begin |
2155 |
+ |
if FTransaction <> nil then |
2156 |
+ |
FTransaction.DoAfterExecQuery(Sender); |
2157 |
+ |
end; |
2158 |
+ |
|
2159 |
+ |
procedure TIBBase.DoAfterEdit(Sender: TObject); |
2160 |
+ |
begin |
2161 |
+ |
if FTransaction <> nil then |
2162 |
+ |
FTransaction.DoAfterEdit(Sender); |
2163 |
+ |
end; |
2164 |
+ |
|
2165 |
+ |
procedure TIBBase.DoAfterDelete(Sender: TObject); |
2166 |
+ |
begin |
2167 |
+ |
if FTransaction <> nil then |
2168 |
+ |
FTransaction.DoAfterDelete(Sender); |
2169 |
+ |
end; |
2170 |
+ |
|
2171 |
+ |
procedure TIBBase.DoAfterInsert(Sender: TObject); |
2172 |
+ |
begin |
2173 |
+ |
if FTransaction <> nil then |
2174 |
+ |
FTransaction.DoAfterInsert(Sender); |
2175 |
+ |
end; |
2176 |
+ |
|
2177 |
+ |
procedure TIBBase.DoAfterPost(Sender: TObject); |
2178 |
+ |
begin |
2179 |
+ |
if FTransaction <> nil then |
2180 |
+ |
FTransaction.DoAfterPost(Sender); |
2181 |
+ |
end; |
2182 |
+ |
|
2183 |
|
procedure TIBBase.SetDatabase(Value: TIBDatabase); |
2184 |
|
begin |
2185 |
|
if (FDatabase <> nil) then |