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 |
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_'; |
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 |
+ |
FCharSetSizes: array of integer; |
191 |
+ |
FCharSetNames: array of RawByteString; |
192 |
+ |
FDefaultCharSetName: RawByteString; |
193 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
194 |
+ |
FCodePages: array of TSystemCodePage; |
195 |
+ |
FDefaultCodePage: TSystemCodePage; |
196 |
+ |
{$ENDIF} |
197 |
+ |
FUseDefaultSystemCodePage: boolean; |
198 |
|
procedure EnsureInactive; |
199 |
|
function GetDBSQLDialect: Integer; |
200 |
|
function GetSQLDialect: Integer; |
208 |
|
function GetIdleTimer: Integer; |
209 |
|
function GetTransaction(Index: Integer): TIBTransaction; |
210 |
|
function GetTransactionCount: Integer; |
211 |
< |
function Login: Boolean; |
211 |
> |
function Login(var aDatabaseName: string): Boolean; |
212 |
> |
procedure LoadCharSetInfo; |
213 |
|
procedure SetDatabaseName(const Value: TIBFileName); |
214 |
|
procedure SetDBParamByDPB(const Idx: Integer; Value: String); |
215 |
|
procedure SetDBParams(Value: TStrings); |
227 |
|
procedure DoDisconnect; override; |
228 |
|
function GetConnected: Boolean; override; |
229 |
|
procedure CheckStreamConnect; |
230 |
+ |
procedure HandleException(Sender: TObject); |
231 |
|
procedure Notification( AComponent: TComponent; Operation: TOperation); override; |
232 |
|
function GetDataset(Index : longint) : TDataset; override; |
233 |
|
function GetDataSetCount : Longint; override; |
234 |
+ |
procedure ReadState(Reader: TReader); override; |
235 |
|
procedure SetConnected (Value : boolean); override; |
236 |
|
public |
237 |
|
constructor Create(AOwner: TComponent); override; |
266 |
|
property TransactionCount: Integer read GetTransactionCount; |
267 |
|
property Transactions[Index: Integer]: TIBTransaction read GetTransaction; |
268 |
|
property InternalTransaction: TIBTransaction read FInternalTransaction; |
269 |
+ |
property DefaultCharSetName: RawByteString read FDefaultCharSetName; |
270 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
271 |
+ |
property DefaultCodePage: TSystemCodePage read FDefaultCodePage; |
272 |
+ |
{$ENDIF} |
273 |
|
|
274 |
|
published |
275 |
|
property Connected; |
282 |
|
write SetDefaultTransaction; |
283 |
|
property IdleTimer: Integer read GetIdleTimer write SetIdleTimer; |
284 |
|
property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3; |
285 |
+ |
property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true; |
286 |
|
property DBSQLDialect : Integer read FDBSQLDialect; |
287 |
|
property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags; |
288 |
+ |
property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage |
289 |
+ |
write FUseDefaultSystemCodePage; |
290 |
|
property AfterConnect; |
291 |
|
property AfterDisconnect; |
292 |
|
property BeforeConnect; |
302 |
|
|
303 |
|
TIBTransaction = class(TComponent) |
304 |
|
private |
305 |
+ |
FAfterDelete: TNotifyEvent; |
306 |
+ |
FAfterEdit: TNotifyEvent; |
307 |
+ |
FAfterExecQuery: TNotifyEvent; |
308 |
+ |
FAfterInsert: TNotifyEvent; |
309 |
+ |
FAfterPost: TNotifyEvent; |
310 |
+ |
FAfterTransactionEnd: TNotifyEvent; |
311 |
+ |
FBeforeTransactionEnd: TNotifyEvent; |
312 |
|
FIBLoaded: Boolean; |
313 |
|
FCanTimeout : Boolean; |
314 |
|
FDatabases : TList; |
315 |
+ |
FOnStartTransaction: TNotifyEvent; |
316 |
|
FSQLObjects : TList; |
317 |
|
FDefaultDatabase : TIBDatabase; |
318 |
|
FHandle : TISC_TR_HANDLE; |
321 |
|
FStreamedActive : Boolean; |
322 |
|
FTPB : PChar; |
323 |
|
FTPBLength : Short; |
324 |
< |
FTimer : TTimer; |
324 |
> |
FTimer : TFPTimer; |
325 |
|
FDefaultAction : TTransactionAction; |
326 |
|
FTRParams : TStrings; |
327 |
|
FTRParamsChanged : Boolean; |
328 |
|
FInEndTransaction : boolean; |
329 |
+ |
FEndAction : TTransactionAction; |
330 |
+ |
procedure DoBeforeTransactionEnd; |
331 |
+ |
procedure DoAfterTransactionEnd; |
332 |
+ |
procedure DoOnStartTransaction; |
333 |
+ |
procedure DoAfterExecQuery(Sender: TObject); |
334 |
+ |
procedure DoAfterEdit(Sender: TObject); |
335 |
+ |
procedure DoAfterDelete(Sender: TObject); |
336 |
+ |
procedure DoAfterInsert(Sender: TObject); |
337 |
+ |
procedure DoAfterPost(Sender: TObject); |
338 |
|
procedure EnsureNotInTransaction; |
339 |
|
procedure EndTransaction(Action: TTransactionAction; Force: Boolean); |
340 |
|
function GetDatabase(Index: Integer): TIBDatabase; |
376 |
|
function AddDatabase(db: TIBDatabase): Integer; |
377 |
|
function FindDatabase(db: TIBDatabase): Integer; |
378 |
|
function FindDefaultDatabase: TIBDatabase; |
379 |
+ |
function GetEndAction: TTransactionAction; |
380 |
|
procedure RemoveDatabase(Idx: Integer); |
381 |
|
procedure RemoveDatabases; |
382 |
|
procedure CheckDatabasesInList; |
398 |
|
property DefaultAction: TTransactionAction read FDefaultAction write SetDefaultAction default taCommit; |
399 |
|
property Params: TStrings read FTRParams write SetTRParams; |
400 |
|
property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer; |
401 |
< |
end; |
401 |
> |
property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd |
402 |
> |
write FBeforeTransactionEnd; |
403 |
> |
property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd |
404 |
> |
write FAfterTransactionEnd; |
405 |
> |
property OnStartTransaction: TNotifyEvent read FOnStartTransaction |
406 |
> |
write FOnStartTransaction; |
407 |
> |
property AfterExecQuery: TNotifyEvent read FAfterExecQuery |
408 |
> |
write FAfterExecQuery; |
409 |
> |
property AfterEdit: TNotifyEvent read FAfterEdit write FAfterEdit; |
410 |
> |
property AfterDelete: TNotifyEvent read FAfterDelete write FAfterDelete; |
411 |
> |
property AfterInsert: TNotifyEvent read FAfterInsert write FAfterInsert; |
412 |
> |
property AfterPost: TNotifyEvent read FAfterPost write FAfterPost; |
413 |
> |
end; |
414 |
> |
|
415 |
> |
TTransactionEndEvent = procedure(Sender:TObject; Action: TTransactionAction) of object; |
416 |
> |
TBeforeDatabaseConnectEvent = procedure (Sender: TObject; DBParams: TStrings; |
417 |
> |
var DBName: string) of object; |
418 |
|
|
419 |
|
{ TIBBase } |
420 |
|
|
423 |
|
connections. } |
424 |
|
TIBBase = class(TObject) |
425 |
|
protected |
426 |
+ |
FBeforeDatabaseConnect: TBeforeDatabaseConnectEvent; |
427 |
|
FDatabase: TIBDatabase; |
428 |
|
FIndexInDatabase: Integer; |
429 |
|
FTransaction: TIBTransaction; |
433 |
|
FAfterDatabaseDisconnect: TNotifyEvent; |
434 |
|
FAfterDatabaseConnect: TNotifyEvent; |
435 |
|
FOnDatabaseFree: TNotifyEvent; |
436 |
< |
FBeforeTransactionEnd: TNotifyEvent; |
436 |
> |
FBeforeTransactionEnd: TTransactionEndEvent; |
437 |
|
FAfterTransactionEnd: TNotifyEvent; |
438 |
|
FOnTransactionFree: TNotifyEvent; |
439 |
|
|
440 |
+ |
procedure DoBeforeDatabaseConnect(DBParams: TStrings; |
441 |
+ |
var DBName: string); virtual; |
442 |
|
procedure DoAfterDatabaseConnect; virtual; |
443 |
|
procedure DoBeforeDatabaseDisconnect; virtual; |
444 |
|
procedure DoAfterDatabaseDisconnect; virtual; |
445 |
|
procedure DoDatabaseFree; virtual; |
446 |
< |
procedure DoBeforeTransactionEnd; virtual; |
446 |
> |
procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual; |
447 |
|
procedure DoAfterTransactionEnd; virtual; |
448 |
|
procedure DoTransactionFree; virtual; |
449 |
|
function GetDBHandle: PISC_DB_HANDLE; virtual; |
455 |
|
destructor Destroy; override; |
456 |
|
procedure CheckDatabase; virtual; |
457 |
|
procedure CheckTransaction; virtual; |
458 |
+ |
procedure DoAfterExecQuery(Sender: TObject); virtual; |
459 |
+ |
procedure DoAfterEdit(Sender: TObject); virtual; |
460 |
+ |
procedure DoAfterDelete(Sender: TObject); virtual; |
461 |
+ |
procedure DoAfterInsert(Sender: TObject); virtual; |
462 |
+ |
procedure DoAfterPost(Sender: TObject); virtual; |
463 |
+ |
function GetCharSetSize(CharSetID: integer): integer; |
464 |
+ |
function GetDefaultCharSetSize: integer; |
465 |
+ |
function GetCharSetName(CharSetID: integer): string; |
466 |
+ |
function GetDefaultCharSetName: RawByteString; |
467 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
468 |
+ |
function GetCodePage(CharSetID: integer): TSystemCodePage; |
469 |
+ |
function GetDefaultCodePage: TSystemCodePage; |
470 |
+ |
{$ENDIF} |
471 |
+ |
procedure HandleException(Sender: TObject); |
472 |
+ |
procedure SetCursor; |
473 |
+ |
procedure RestoreCursor; |
474 |
|
public |
475 |
+ |
property BeforeDatabaseConnect: TBeforeDatabaseConnectEvent read FBeforeDatabaseConnect |
476 |
+ |
write FBeforeDatabaseConnect; |
477 |
|
property AfterDatabaseConnect: TNotifyEvent read FAfterDatabaseConnect |
478 |
|
write FAfterDatabaseConnect; |
479 |
|
property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect |
481 |
|
property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect |
482 |
|
write FAfterDatabaseDisconnect; |
483 |
|
property OnDatabaseFree: TNotifyEvent read FOnDatabaseFree write FOnDatabaseFree; |
484 |
< |
property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd write FBeforeTransactionEnd; |
484 |
> |
property BeforeTransactionEnd: TTransactionEndEvent read FBeforeTransactionEnd write FBeforeTransactionEnd; |
485 |
|
property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd write FAfterTransactionEnd; |
486 |
|
property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree; |
487 |
|
property Database: TIBDatabase read FDatabase |
499 |
|
|
500 |
|
implementation |
501 |
|
|
502 |
< |
uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils, typInfo; |
502 |
> |
uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils, |
503 |
> |
typInfo, IBCodePage; |
504 |
|
|
505 |
|
{ TIBDatabase } |
506 |
|
|
507 |
< |
constructor TIBDatabase.Create(AOwner: TComponent); |
507 |
> |
constructor TIBDataBase.Create(AOwner: TComponent); |
508 |
|
begin |
509 |
|
inherited Create(AOwner); |
510 |
|
FIBLoaded := False; |
515 |
|
FTransactions := TList.Create; |
516 |
|
FDBName := ''; |
517 |
|
FDBParams := TStringList.Create; |
518 |
+ |
FSQLHourGlass := true; |
519 |
+ |
if (AOwner <> nil) and |
520 |
+ |
(AOwner is TCustomApplication) and |
521 |
+ |
TCustomApplication(AOWner).ConsoleApplication then |
522 |
+ |
LoginPrompt := false; |
523 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
524 |
+ |
FDefaultCodePage := CP_NONE; |
525 |
+ |
{$ENDIF} |
526 |
|
FDBParamsChanged := True; |
527 |
|
TStringList(FDBParams).OnChange := DBParamsChange; |
528 |
|
TStringList(FDBParams).OnChanging := DBParamsChanging; |
531 |
|
FUserNames := nil; |
532 |
|
FInternalTransaction := TIBTransaction.Create(self); |
533 |
|
FInternalTransaction.DefaultDatabase := Self; |
534 |
< |
FTimer := TTimer.Create(Self); |
534 |
> |
FTimer := TFPTimer.Create(Self); |
535 |
|
FTimer.Enabled := False; |
536 |
|
FTimer.Interval := 0; |
537 |
|
FTimer.OnTimer := TimeoutConnection; |
542 |
|
CheckStreamConnect; |
543 |
|
end; |
544 |
|
|
545 |
< |
destructor TIBDatabase.Destroy; |
545 |
> |
destructor TIBDataBase.Destroy; |
546 |
|
var |
547 |
|
i: Integer; |
548 |
|
begin |
568 |
|
inherited Destroy; |
569 |
|
end; |
570 |
|
|
571 |
< |
function TIBDatabase.Call(ErrCode: ISC_STATUS; |
572 |
< |
RaiseError: Boolean): ISC_STATUS; |
571 |
> |
function TIBDataBase.Call(ErrCode: ISC_STATUS; RaiseError: Boolean |
572 |
> |
): ISC_STATUS; |
573 |
|
begin |
574 |
|
result := ErrCode; |
575 |
|
FCanTimeout := False; |
577 |
|
IBDataBaseError; |
578 |
|
end; |
579 |
|
|
580 |
< |
procedure TIBDatabase.CheckActive; |
580 |
> |
procedure TIBDataBase.CheckActive; |
581 |
|
begin |
582 |
|
if StreamedConnected and (not Connected) then |
583 |
|
Loaded; |
585 |
|
IBError(ibxeDatabaseClosed, [nil]); |
586 |
|
end; |
587 |
|
|
588 |
< |
procedure TIBDatabase.EnsureInactive; |
588 |
> |
procedure TIBDataBase.EnsureInactive; |
589 |
|
begin |
590 |
|
if csDesigning in ComponentState then |
591 |
|
begin |
594 |
|
end |
595 |
|
end; |
596 |
|
|
597 |
< |
procedure TIBDatabase.CheckInactive; |
597 |
> |
procedure TIBDataBase.CheckInactive; |
598 |
|
begin |
599 |
|
if FHandle <> nil then |
600 |
|
IBError(ibxeDatabaseOpen, [nil]); |
601 |
|
end; |
602 |
|
|
603 |
< |
procedure TIBDatabase.CheckDatabaseName; |
603 |
> |
procedure TIBDataBase.CheckDatabaseName; |
604 |
|
begin |
605 |
< |
if (FDBName = '') then |
605 |
> |
if (Trim(FDBName) = '') then |
606 |
|
IBError(ibxeDatabaseNameMissing, [nil]); |
607 |
|
end; |
608 |
|
|
609 |
< |
function TIBDatabase.AddSQLObject(ds: TIBBase): Integer; |
609 |
> |
function TIBDataBase.AddSQLObject(ds: TIBBase): Integer; |
610 |
|
begin |
611 |
|
result := 0; |
612 |
|
if (ds.Owner is TIBCustomDataSet) then |
619 |
|
FSQLObjects[result] := ds; |
620 |
|
end; |
621 |
|
|
622 |
< |
function TIBDatabase.AddTransaction(TR: TIBTransaction): Integer; |
622 |
> |
function TIBDataBase.AddTransaction(TR: TIBTransaction): Integer; |
623 |
|
begin |
624 |
|
result := FindTransaction(TR); |
625 |
|
if result <> -1 then |
636 |
|
FTransactions[result] := TR; |
637 |
|
end; |
638 |
|
|
639 |
< |
procedure TIBDatabase.DoDisconnect; |
639 |
> |
procedure TIBDataBase.DoDisconnect; |
640 |
|
begin |
641 |
|
if Connected then |
642 |
|
InternalClose(False); |
643 |
|
FDBSQLDialect := 1; |
644 |
+ |
SetLength(FCharSetSizes,0); |
645 |
+ |
SetLength(FCharSetNames,0); |
646 |
+ |
FDefaultCharSetName := ''; |
647 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
648 |
+ |
SetLength(FCodePages,0); |
649 |
+ |
FDefaultCodePage := CP_NONE; |
650 |
+ |
{$ENDIF} |
651 |
|
end; |
652 |
|
|
653 |
< |
procedure TIBDatabase.CreateDatabase; |
653 |
> |
procedure TIBDataBase.CreateDatabase; |
654 |
|
var |
655 |
|
tr_handle: TISC_TR_HANDLE; |
656 |
|
begin |
663 |
|
True); |
664 |
|
end; |
665 |
|
|
666 |
< |
procedure TIBDatabase.DropDatabase; |
666 |
> |
procedure TIBDataBase.DropDatabase; |
667 |
|
begin |
668 |
|
CheckActive; |
669 |
|
Call(isc_drop_database(StatusVector, @FHandle), True); |
670 |
|
end; |
671 |
|
|
672 |
< |
procedure TIBDatabase.DBParamsChange(Sender: TObject); |
672 |
> |
procedure TIBDataBase.DBParamsChange(Sender: TObject); |
673 |
|
begin |
674 |
|
FDBParamsChanged := True; |
675 |
|
end; |
676 |
|
|
677 |
< |
procedure TIBDatabase.DBParamsChanging(Sender: TObject); |
677 |
> |
procedure TIBDataBase.DBParamsChanging(Sender: TObject); |
678 |
|
begin |
679 |
|
EnsureInactive; |
680 |
|
CheckInactive; |
681 |
|
end; |
682 |
|
|
683 |
< |
function TIBDatabase.FindTransaction(TR: TIBTransaction): Integer; |
683 |
> |
function TIBDataBase.FindTransaction(TR: TIBTransaction): Integer; |
684 |
|
var |
685 |
|
i: Integer; |
686 |
|
begin |
693 |
|
end; |
694 |
|
end; |
695 |
|
|
696 |
< |
function TIBDatabase.FindDefaultTransaction(): TIBTransaction; |
696 |
> |
function TIBDataBase.FindDefaultTransaction: TIBTransaction; |
697 |
|
var |
698 |
|
i: Integer; |
699 |
|
begin |
711 |
|
end; |
712 |
|
end; |
713 |
|
|
714 |
< |
procedure TIBDatabase.ForceClose; |
714 |
> |
procedure TIBDataBase.ForceClose; |
715 |
|
begin |
716 |
|
if Connected then |
717 |
|
InternalClose(True); |
718 |
|
end; |
719 |
|
|
720 |
< |
function TIBDatabase.GetConnected: Boolean; |
720 |
> |
function TIBDataBase.GetConnected: Boolean; |
721 |
|
begin |
722 |
|
result := FHandle <> nil; |
723 |
|
end; |
724 |
|
|
725 |
< |
function TIBDatabase.GetSQLObject(Index: Integer): TIBBase; |
725 |
> |
function TIBDataBase.GetSQLObject(Index: Integer): TIBBase; |
726 |
|
begin |
727 |
|
result := FSQLObjects[Index]; |
728 |
|
end; |
729 |
|
|
730 |
< |
function TIBDatabase.GetSQLObjectCount: Integer; |
730 |
> |
function TIBDataBase.GetSQLObjectCount: Integer; |
731 |
|
var |
732 |
|
i: Integer; |
733 |
|
begin |
736 |
|
Inc(result); |
737 |
|
end; |
738 |
|
|
739 |
< |
function TIBDatabase.GetDBParamByDPB(const Idx: Integer): String; |
739 |
> |
function TIBDataBase.GetDBParamByDPB( const Idx: Integer): String; |
740 |
|
var |
741 |
|
ConstIdx, EqualsIdx: Integer; |
742 |
|
begin |
759 |
|
result := ''; |
760 |
|
end; |
761 |
|
|
762 |
< |
function TIBDatabase.GetIdleTimer: Integer; |
762 |
> |
function TIBDataBase.GetIdleTimer: Integer; |
763 |
|
begin |
764 |
|
result := FTimer.Interval; |
765 |
|
end; |
766 |
|
|
767 |
< |
function TIBDatabase.GetTransaction(Index: Integer): TIBTransaction; |
767 |
> |
function TIBDataBase.GetTransaction(Index: Integer): TIBTransaction; |
768 |
|
begin |
769 |
|
result := FTransactions[Index]; |
770 |
|
end; |
771 |
|
|
772 |
< |
function TIBDatabase.GetTransactionCount: Integer; |
772 |
> |
function TIBDataBase.GetTransactionCount: Integer; |
773 |
|
var |
774 |
|
i: Integer; |
775 |
|
begin |
779 |
|
Inc(result); |
780 |
|
end; |
781 |
|
|
782 |
< |
function TIBDatabase.IndexOfDBConst(st: String): Integer; |
782 |
> |
function TIBDataBase.IndexOfDBConst(st: String): Integer; |
783 |
|
var |
784 |
|
i, pos_of_str: Integer; |
785 |
|
begin |
795 |
|
end; |
796 |
|
end; |
797 |
|
|
798 |
< |
procedure TIBDatabase.InternalClose(Force: Boolean); |
798 |
> |
procedure TIBDataBase.InternalClose(Force: Boolean); |
799 |
|
var |
800 |
|
i: Integer; |
801 |
|
begin |
842 |
|
SQLObjects[i].DoAfterDatabaseDisconnect; |
843 |
|
end; |
844 |
|
|
845 |
+ |
procedure TIBDataBase.LoadCharSetInfo; |
846 |
+ |
var Query: TIBSQL; |
847 |
+ |
i: integer; |
848 |
+ |
begin |
849 |
+ |
if not FInternalTransaction.Active then |
850 |
+ |
FInternalTransaction.StartTransaction; |
851 |
+ |
Query := TIBSQL.Create(self); |
852 |
+ |
try |
853 |
+ |
Query.Database := Self; |
854 |
+ |
Query.Transaction := FInternalTransaction; |
855 |
+ |
Query.SQL.Text := 'Select RDB$CHARACTER_SET_ID, RDB$BYTES_PER_CHARACTER, RDB$CHARACTER_SET_NAME ' + |
856 |
+ |
'From RDB$CHARACTER_SETS Order by 1 DESC'; {do not localize} |
857 |
+ |
Query.Prepare; |
858 |
+ |
Query.ExecQuery; |
859 |
+ |
if not Query.EOF then |
860 |
+ |
begin |
861 |
+ |
SetLength(FCharSetSizes,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1); |
862 |
+ |
SetLength(FCharSetNames,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1); |
863 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
864 |
+ |
SetLength(FCodePages, Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1); |
865 |
+ |
{$ENDIF} |
866 |
+ |
for i := 0 to Length(FCharSetSizes) - 1 do FCharSetSizes[i] := 1; |
867 |
+ |
repeat |
868 |
+ |
FCharSetSizes[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] := |
869 |
+ |
Query.FieldByName('RDB$BYTES_PER_CHARACTER').AsInteger; |
870 |
+ |
FCharSetNames[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] := |
871 |
+ |
Trim(Query.FieldByName('RDB$CHARACTER_SET_NAME').AsString); |
872 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
873 |
+ |
FCodePages[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] := |
874 |
+ |
IBGetCodePage(Trim(Query.FieldByName('RDB$CHARACTER_SET_NAME').AsString)); |
875 |
+ |
{$ENDIF} |
876 |
+ |
Query.Next; |
877 |
+ |
until Query.EOF; |
878 |
+ |
end; |
879 |
+ |
finally |
880 |
+ |
Query.free; |
881 |
+ |
FInternalTransaction.Commit; |
882 |
+ |
end; |
883 |
+ |
end; |
884 |
+ |
|
885 |
|
procedure TIBDataBase.CheckStreamConnect; |
886 |
|
var |
887 |
|
i: integer; |
908 |
|
end; |
909 |
|
except |
910 |
|
if csDesigning in ComponentState then |
911 |
< |
Application.HandleException(Self) |
911 |
> |
HandleException(Self) |
912 |
|
else |
913 |
|
raise; |
914 |
|
end; |
915 |
|
end; |
916 |
|
|
917 |
< |
procedure TIBDatabase.Notification( AComponent: TComponent; |
918 |
< |
Operation: TOperation); |
917 |
> |
procedure TIBDataBase.HandleException(Sender: TObject); |
918 |
> |
var aParent: TComponent; |
919 |
> |
begin |
920 |
> |
aParent := Owner; |
921 |
> |
while aParent <> nil do |
922 |
> |
begin |
923 |
> |
if aParent is TCustomApplication then |
924 |
> |
begin |
925 |
> |
TCustomApplication(aParent).HandleException(Sender); |
926 |
> |
Exit; |
927 |
> |
end; |
928 |
> |
aParent := aParent.Owner; |
929 |
> |
end; |
930 |
> |
SysUtils.ShowException(ExceptObject,ExceptAddr); |
931 |
> |
end; |
932 |
> |
|
933 |
> |
procedure TIBDataBase.Notification(AComponent: TComponent; |
934 |
> |
Operation: TOperation); |
935 |
|
var |
936 |
|
i: Integer; |
937 |
|
begin |
945 |
|
end; |
946 |
|
end; |
947 |
|
|
948 |
< |
function TIBDatabase.Login: Boolean; |
948 |
> |
function TIBDataBase.Login(var aDatabaseName: string): Boolean; |
949 |
|
var |
950 |
|
IndexOfUser, IndexOfPassword: Integer; |
951 |
|
Username, Password, OldPassword: String; |
981 |
|
LoginParams.Assign(Params); |
982 |
|
FOnLogin(Self, LoginParams); |
983 |
|
Params.Assign (LoginParams); |
984 |
+ |
aDatabaseName := FDBName; |
985 |
|
HidePassword; |
986 |
|
finally |
987 |
|
LoginParams.Free; |
988 |
|
end; |
989 |
|
end |
990 |
|
else |
991 |
+ |
if assigned(IBGUIInterface) then |
992 |
|
begin |
993 |
|
IndexOfUser := IndexOfDBConst(DPBConstantNames[isc_dpb_user_name]); |
994 |
|
if IndexOfUser <> -1 then |
1003 |
|
Length(Params[IndexOfPassword])); |
1004 |
|
OldPassword := password; |
1005 |
|
end; |
1006 |
< |
result := LoginDialogEx(DatabaseName, Username, Password, False); |
1006 |
> |
result := IBGUIInterface.LoginDialogEx(aDatabaseName, Username, Password, False); |
1007 |
|
if result then |
1008 |
|
begin |
1009 |
|
if IndexOfUser = -1 then |
1020 |
|
HidePassword; |
1021 |
|
end; |
1022 |
|
end; |
1023 |
< |
end; |
1023 |
> |
end |
1024 |
> |
else |
1025 |
> |
if LoginPrompt then |
1026 |
> |
IBError(ibxeNoLoginDialog,[]); |
1027 |
|
finally |
1028 |
|
FLoginCalled := false |
1029 |
|
end; |
1030 |
|
end; |
1031 |
|
|
1032 |
< |
procedure TIBDatabase.DoConnect; |
1032 |
> |
procedure TIBDataBase.DoConnect; |
1033 |
|
var |
1034 |
|
DPB: String; |
1035 |
|
TempDBParams: TStrings; |
1036 |
|
I: integer; |
1037 |
+ |
aDBName: string; |
1038 |
|
|
1039 |
+ |
{Call error analysis} |
1040 |
+ |
sqlcode: Long; |
1041 |
+ |
IBErrorCode: Long; |
1042 |
+ |
status_vector: PISC_STATUS; |
1043 |
+ |
{$ifdef WINDOWS} |
1044 |
+ |
acp: uint; |
1045 |
+ |
{$endif} |
1046 |
|
begin |
1047 |
|
CheckInactive; |
1048 |
|
CheckDatabaseName; |
1052 |
|
FDBParamsChanged := True; |
1053 |
|
end; |
1054 |
|
{ Use builtin login prompt if requested } |
1055 |
< |
if (LoginPrompt or (csDesigning in ComponentState)) and not Login then |
1055 |
> |
aDBName := FDBName; |
1056 |
> |
if (LoginPrompt or (csDesigning in ComponentState)) and not Login(aDBName) then |
1057 |
|
IBError(ibxeOperationCancelled, [nil]); |
1058 |
< |
{ Generate a new DPB if necessary } |
1059 |
< |
if (FDBParamsChanged) then |
1060 |
< |
begin |
1061 |
< |
FDBParamsChanged := False; |
1062 |
< |
if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then |
1063 |
< |
GenerateDPB(FDBParams, DPB, FDPBLength) |
1064 |
< |
else |
1058 |
> |
|
1059 |
> |
TempDBParams := TStringList.Create; |
1060 |
> |
try |
1061 |
> |
TempDBParams.Assign(FDBParams); |
1062 |
> |
if UseDefaultSystemCodePage then |
1063 |
> |
begin |
1064 |
> |
{$ifdef WINDOWS} |
1065 |
> |
acp := GetACP; |
1066 |
> |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
1067 |
> |
TempDBParams.Values['lc_ctype'] := IBGetCharacterSetName(acp); |
1068 |
> |
FDefaultCodePage := IBGetCodePage(AnsiUpperCase(TempDBParams.Values['lc_ctype'])); |
1069 |
> |
{$ELSE} |
1070 |
> |
if (acp >= 1250) and (acp <= 1258) then |
1071 |
> |
TempDBParams.Values['lc_ctype'] := Format('WIN%d',[acp]) |
1072 |
> |
else |
1073 |
> |
TempDBParams.Values['lc_ctype'] :='UTF8'; |
1074 |
> |
{$ENDIF} |
1075 |
> |
{$else} |
1076 |
> |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
1077 |
> |
TempDBParams.Values['lc_ctype'] := IBGetCharacterSetName(DefaultSystemCodePage); |
1078 |
> |
FDefaultCodePage := IBGetCodePage(AnsiUpperCase(TempDBParams.Values['lc_ctype'])); |
1079 |
> |
{$ELSE} |
1080 |
> |
TempDBParams.Values['lc_ctype'] :='UTF8'; |
1081 |
> |
{$ENDIF} |
1082 |
> |
{$endif} |
1083 |
> |
end; |
1084 |
> |
{Opportunity to override defaults} |
1085 |
> |
for i := 0 to FSQLObjects.Count - 1 do |
1086 |
> |
begin |
1087 |
> |
if FSQLObjects[i] <> nil then |
1088 |
> |
SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName); |
1089 |
> |
end; |
1090 |
> |
FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']); |
1091 |
> |
|
1092 |
> |
{ Generate a new DPB if necessary } |
1093 |
> |
if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then |
1094 |
> |
begin |
1095 |
> |
FDBParamsChanged := False; |
1096 |
> |
if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then |
1097 |
> |
GenerateDPB(TempDBParams, DPB, FDPBLength) |
1098 |
> |
else |
1099 |
> |
begin |
1100 |
> |
TempDBParams.Add('password=' + FHiddenPassword); |
1101 |
> |
GenerateDPB(TempDBParams, DPB, FDPBLength); |
1102 |
> |
end; |
1103 |
> |
IBAlloc(FDPB, 0, FDPBLength); |
1104 |
> |
Move(DPB[1], FDPB[0], FDPBLength); |
1105 |
> |
end; |
1106 |
> |
finally |
1107 |
> |
TempDBParams.Free; |
1108 |
> |
end; |
1109 |
> |
repeat |
1110 |
> |
if Call(isc_attach_database(StatusVector, Length(aDBName), |
1111 |
> |
PChar(aDBName), @FHandle, |
1112 |
> |
FDPBLength, FDPB), False) > 0 then |
1113 |
|
begin |
1114 |
< |
TempDBParams := TStringList.Create; |
1115 |
< |
try |
1116 |
< |
TempDBParams.Assign(FDBParams); |
1117 |
< |
TempDBParams.Add('password=' + FHiddenPassword); |
1118 |
< |
GenerateDPB(TempDBParams, DPB, FDPBLength); |
1119 |
< |
finally |
1120 |
< |
TempDBParams.Free; |
1114 |
> |
{$IFDEF UNIX} |
1115 |
> |
if IsEmbeddedServer and (Pos(':',aDBName) = 0) then |
1116 |
> |
begin |
1117 |
> |
status_vector := StatusVector; |
1118 |
> |
IBErrorCode := StatusVectorArray[1]; |
1119 |
> |
sqlcode := isc_sqlcode(StatusVector); |
1120 |
> |
|
1121 |
> |
if ((sqlcode = -901) and (IBErrorCode = 335544382)) {Access permissions on firebird temp} |
1122 |
> |
or |
1123 |
> |
((sqlcode = -902) and (IBErrorCode = 335544373)) {Security DB Problem} |
1124 |
> |
then |
1125 |
> |
begin |
1126 |
> |
aDBName := 'localhost:' + aDBName; |
1127 |
> |
Continue; |
1128 |
> |
end; |
1129 |
|
end; |
1130 |
+ |
{$ENDIF} |
1131 |
+ |
FHandle := nil; |
1132 |
+ |
IBDataBaseError; |
1133 |
|
end; |
1134 |
< |
IBAlloc(FDPB, 0, FDPBLength); |
1135 |
< |
Move(DPB[1], FDPB[0], FDPBLength); |
1136 |
< |
end; |
913 |
< |
if Call(isc_attach_database(StatusVector, Length(FDBName), |
914 |
< |
PChar(FDBName), @FHandle, |
915 |
< |
FDPBLength, FDPB), False) > 0 then |
916 |
< |
begin |
917 |
< |
FHandle := nil; |
918 |
< |
IBDataBaseError; |
919 |
< |
end; |
1134 |
> |
until FHandle <> nil; |
1135 |
> |
if not (csDesigning in ComponentState) then |
1136 |
> |
FDBName := aDBName; {Synchronise at run time} |
1137 |
|
FDBSQLDialect := GetDBSQLDialect; |
1138 |
|
ValidateClientSQLDialect; |
1139 |
|
for i := 0 to FSQLObjects.Count - 1 do |
1143 |
|
end; |
1144 |
|
if not (csDesigning in ComponentState) then |
1145 |
|
MonitorHook.DBConnect(Self); |
1146 |
+ |
LoadCharSetInfo; |
1147 |
|
end; |
1148 |
|
|
1149 |
< |
procedure TIBDatabase.RemoveSQLObject(Idx: Integer); |
1149 |
> |
procedure TIBDataBase.RemoveSQLObject(Idx: Integer); |
1150 |
|
var |
1151 |
|
ds: TIBBase; |
1152 |
|
begin |
1160 |
|
end; |
1161 |
|
end; |
1162 |
|
|
1163 |
< |
procedure TIBDatabase.RemoveSQLObjects; |
1163 |
> |
procedure TIBDataBase.RemoveSQLObjects; |
1164 |
|
var |
1165 |
|
i: Integer; |
1166 |
|
begin |
1172 |
|
end; |
1173 |
|
end; |
1174 |
|
|
1175 |
< |
procedure TIBDatabase.RemoveTransaction(Idx: Integer); |
1175 |
> |
procedure TIBDataBase.RemoveTransaction(Idx: Integer); |
1176 |
|
var |
1177 |
|
TR: TIBTransaction; |
1178 |
|
begin |
1186 |
|
end; |
1187 |
|
end; |
1188 |
|
|
1189 |
< |
procedure TIBDatabase.RemoveTransactions; |
1189 |
> |
procedure TIBDataBase.RemoveTransactions; |
1190 |
|
var |
1191 |
|
i: Integer; |
1192 |
|
begin |
1194 |
|
RemoveTransaction(i); |
1195 |
|
end; |
1196 |
|
|
1197 |
< |
procedure TIBDatabase.SetDatabaseName(const Value: TIBFileName); |
1197 |
> |
procedure TIBDataBase.SetDatabaseName( const Value: TIBFileName); |
1198 |
|
begin |
1199 |
|
if FDBName <> Value then |
1200 |
|
begin |
1204 |
|
end; |
1205 |
|
end; |
1206 |
|
|
1207 |
< |
procedure TIBDatabase.SetDBParamByDPB(const Idx: Integer; Value: String); |
1207 |
> |
procedure TIBDataBase.SetDBParamByDPB( const Idx: Integer; Value: String); |
1208 |
|
var |
1209 |
|
ConstIdx: Integer; |
1210 |
|
begin |
1223 |
|
end; |
1224 |
|
end; |
1225 |
|
|
1226 |
< |
procedure TIBDatabase.SetDBParams(Value: TStrings); |
1226 |
> |
procedure TIBDataBase.SetDBParams(Value: TStrings); |
1227 |
|
begin |
1228 |
|
FDBParams.Assign(Value); |
1229 |
|
end; |
1230 |
|
|
1231 |
< |
procedure TIBDatabase.SetDefaultTransaction(Value: TIBTransaction); |
1231 |
> |
procedure TIBDataBase.SetDefaultTransaction(Value: TIBTransaction); |
1232 |
|
var |
1233 |
|
i: Integer; |
1234 |
|
begin |
1246 |
|
FDefaultTransaction := Value; |
1247 |
|
end; |
1248 |
|
|
1249 |
< |
procedure TIBDatabase.SetHandle(Value: TISC_DB_HANDLE); |
1249 |
> |
procedure TIBDataBase.SetHandle(Value: TISC_DB_HANDLE); |
1250 |
|
begin |
1251 |
|
if HandleIsShared then |
1252 |
|
Close |
1256 |
|
FHandleIsShared := (Value <> nil); |
1257 |
|
end; |
1258 |
|
|
1259 |
< |
procedure TIBDatabase.SetIdleTimer(Value: Integer); |
1259 |
> |
procedure TIBDataBase.SetIdleTimer(Value: Integer); |
1260 |
|
begin |
1261 |
|
if Value < 0 then |
1262 |
|
IBError(ibxeTimeoutNegative, [nil]) |
1275 |
|
end; |
1276 |
|
end; |
1277 |
|
|
1278 |
< |
function TIBDatabase.TestConnected: Boolean; |
1278 |
> |
function TIBDataBase.TestConnected: Boolean; |
1279 |
|
var |
1280 |
|
DatabaseInfo: TIBDatabaseInfo; |
1281 |
|
begin |
1296 |
|
end; |
1297 |
|
end; |
1298 |
|
|
1299 |
< |
procedure TIBDatabase.TimeoutConnection(Sender: TObject); |
1299 |
> |
procedure TIBDataBase.TimeoutConnection(Sender: TObject); |
1300 |
|
begin |
1301 |
|
if Connected then |
1302 |
|
begin |
1311 |
|
end; |
1312 |
|
end; |
1313 |
|
|
1314 |
< |
function TIBDatabase.GetIsReadOnly: Boolean; |
1314 |
> |
function TIBDataBase.GetIsReadOnly: Boolean; |
1315 |
|
var |
1316 |
|
DatabaseInfo: TIBDatabaseInfo; |
1317 |
|
begin |
1329 |
|
DatabaseInfo.Free; |
1330 |
|
end; |
1331 |
|
|
1332 |
< |
function TIBDatabase.GetSQLDialect: Integer; |
1332 |
> |
function TIBDataBase.GetSQLDialect: Integer; |
1333 |
|
begin |
1334 |
|
Result := FSQLDialect; |
1335 |
|
end; |
1336 |
|
|
1337 |
|
|
1338 |
< |
procedure TIBDatabase.SetSQLDialect(const Value: Integer); |
1338 |
> |
procedure TIBDataBase.SetSQLDialect( const Value: Integer); |
1339 |
|
begin |
1340 |
|
if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]); |
1341 |
|
if ((FHandle = nil) or (Value <= FDBSQLDialect)) then |
1344 |
|
IBError(ibxeSQLDialectInvalid, [nil]); |
1345 |
|
end; |
1346 |
|
|
1347 |
< |
function TIBDatabase.GetDBSQLDialect: Integer; |
1347 |
> |
function TIBDataBase.GetDBSQLDialect: Integer; |
1348 |
|
var |
1349 |
|
DatabaseInfo: TIBDatabaseInfo; |
1350 |
|
begin |
1354 |
|
DatabaseInfo.Free; |
1355 |
|
end; |
1356 |
|
|
1357 |
< |
procedure TIBDatabase.ValidateClientSQLDialect; |
1357 |
> |
procedure TIBDataBase.ValidateClientSQLDialect; |
1358 |
|
begin |
1359 |
|
if (FDBSQLDialect < FSQLDialect) then |
1360 |
|
begin |
1364 |
|
end; |
1365 |
|
end; |
1366 |
|
|
1367 |
< |
procedure TIBDatabase.ApplyUpdates(const DataSets: array of TDataSet); |
1367 |
> |
procedure TIBDataBase.ApplyUpdates( const DataSets: array of TDataSet); |
1368 |
|
var |
1369 |
|
I: Integer; |
1370 |
|
DS: TIBCustomDataSet; |
1390 |
|
TR.CommitRetaining; |
1391 |
|
end; |
1392 |
|
|
1393 |
< |
procedure TIBDatabase.CloseDataSets; |
1393 |
> |
procedure TIBDataBase.CloseDataSets; |
1394 |
|
var |
1395 |
|
i: Integer; |
1396 |
|
begin |
1399 |
|
DataSets[i].close; |
1400 |
|
end; |
1401 |
|
|
1402 |
< |
function TIBDatabase.GetDataset(Index : longint) : TDataset; |
1402 |
> |
function TIBDataBase.GetDataset(Index: longint): TDataset; |
1403 |
|
begin |
1404 |
|
if (Index >= 0) and (Index < FDataSets.Count) then |
1405 |
|
Result := TDataSet(FDataSets[Index]) |
1407 |
|
raise Exception.Create('Invalid Index to DataSets'); |
1408 |
|
end; |
1409 |
|
|
1410 |
< |
function TIBDatabase.GetDataSetCount : Longint; |
1410 |
> |
function TIBDataBase.GetDataSetCount: Longint; |
1411 |
|
begin |
1412 |
|
Result := FDataSets.Count; |
1413 |
|
end; |
1414 |
|
|
1415 |
+ |
procedure TIBDataBase.ReadState(Reader: TReader); |
1416 |
+ |
begin |
1417 |
+ |
FDBParams.Clear; |
1418 |
+ |
inherited ReadState(Reader); |
1419 |
+ |
end; |
1420 |
+ |
|
1421 |
|
procedure TIBDataBase.SetConnected(Value: boolean); |
1422 |
|
begin |
1423 |
|
if StreamedConnected and not AllowStreamedConnected then |
1428 |
|
inherited SetConnected(Value); |
1429 |
|
end; |
1430 |
|
|
1431 |
< |
procedure TIBDatabase.GetFieldNames(const TableName: string; List: TStrings); |
1431 |
> |
procedure TIBDataBase.GetFieldNames( const TableName: string; List: TStrings); |
1432 |
|
var |
1433 |
|
Query: TIBSQL; |
1434 |
|
begin |
1469 |
|
end; |
1470 |
|
end; |
1471 |
|
|
1472 |
< |
procedure TIBDatabase.GetTableNames(List: TStrings; SystemTables: Boolean); |
1472 |
> |
procedure TIBDataBase.GetTableNames(List: TStrings; SystemTables: Boolean); |
1473 |
|
var |
1474 |
|
Query : TIBSQL; |
1475 |
|
begin |
1528 |
|
FTRParamsChanged := True; |
1529 |
|
TStringList(FTRParams).OnChange := TRParamsChange; |
1530 |
|
TStringList(FTRParams).OnChanging := TRParamsChanging; |
1531 |
< |
FTimer := TTimer.Create(Self); |
1531 |
> |
FTimer := TFPTimer.Create(Self); |
1532 |
|
FTimer.Enabled := False; |
1533 |
|
FTimer.Interval := 0; |
1534 |
|
FTimer.OnTimer := TimeoutTransaction; |
1584 |
|
IBError(ibxeNotInTransaction, [nil]); |
1585 |
|
end; |
1586 |
|
|
1587 |
+ |
procedure TIBTransaction.DoBeforeTransactionEnd; |
1588 |
+ |
begin |
1589 |
+ |
if Assigned(FBeforeTransactionEnd) then |
1590 |
+ |
FBeforeTransactionEnd(self); |
1591 |
+ |
end; |
1592 |
+ |
|
1593 |
+ |
procedure TIBTransaction.DoAfterTransactionEnd; |
1594 |
+ |
begin |
1595 |
+ |
if Assigned(FAfterTransactionEnd) then |
1596 |
+ |
FAfterTransactionEnd(self); |
1597 |
+ |
end; |
1598 |
+ |
|
1599 |
+ |
procedure TIBTransaction.DoOnStartTransaction; |
1600 |
+ |
begin |
1601 |
+ |
if assigned(FOnStartTransaction) then |
1602 |
+ |
OnStartTransaction(self); |
1603 |
+ |
end; |
1604 |
+ |
|
1605 |
+ |
procedure TIBTransaction.DoAfterExecQuery(Sender: TObject); |
1606 |
+ |
begin |
1607 |
+ |
if assigned(FAfterExecQuery) then |
1608 |
+ |
AfterExecQuery(Sender); |
1609 |
+ |
end; |
1610 |
+ |
|
1611 |
+ |
procedure TIBTransaction.DoAfterEdit(Sender: TObject); |
1612 |
+ |
begin |
1613 |
+ |
if assigned(FAfterEdit) then |
1614 |
+ |
AfterEdit(Sender); |
1615 |
+ |
end; |
1616 |
+ |
|
1617 |
+ |
procedure TIBTransaction.DoAfterDelete(Sender: TObject); |
1618 |
+ |
begin |
1619 |
+ |
if assigned(FAfterDelete) then |
1620 |
+ |
AfterDelete(Sender); |
1621 |
+ |
end; |
1622 |
+ |
|
1623 |
+ |
procedure TIBTransaction.DoAfterInsert(Sender: TObject); |
1624 |
+ |
begin |
1625 |
+ |
if assigned(FAfterInsert) then |
1626 |
+ |
AfterInsert(Sender); |
1627 |
+ |
end; |
1628 |
+ |
|
1629 |
+ |
procedure TIBTransaction.DoAfterPost(Sender: TObject); |
1630 |
+ |
begin |
1631 |
+ |
if assigned(FAfterPost) then |
1632 |
+ |
AfterPost(Sender); |
1633 |
+ |
end; |
1634 |
+ |
|
1635 |
|
procedure TIBTransaction.EnsureNotInTransaction; |
1636 |
|
begin |
1637 |
|
if csDesigning in ComponentState then |
1708 |
|
CheckInTransaction; |
1709 |
|
if FInEndTransaction then Exit; |
1710 |
|
FInEndTransaction := true; |
1711 |
+ |
FEndAction := Action; |
1712 |
|
try |
1713 |
|
case Action of |
1714 |
|
TARollback, TACommit: |
1717 |
|
(Action <> FDefaultAction) and |
1718 |
|
(not Force) then |
1719 |
|
IBError(ibxeCantEndSharedTransaction, [nil]); |
1720 |
+ |
DoBeforeTransactionEnd; |
1721 |
|
for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then |
1722 |
< |
SQLObjects[i].DoBeforeTransactionEnd; |
1722 |
> |
SQLObjects[i].DoBeforeTransactionEnd(Action); |
1723 |
|
if InTransaction then |
1724 |
|
begin |
1725 |
|
if HandleIsShared then |
1742 |
|
IBDataBaseError; |
1743 |
|
for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then |
1744 |
|
SQLObjects[i].DoAfterTransactionEnd; |
1745 |
+ |
DoAfterTransactionEnd; |
1746 |
|
end; |
1747 |
|
end; |
1748 |
|
TACommitRetaining: |
1833 |
|
end; |
1834 |
|
end; |
1835 |
|
|
1836 |
+ |
function TIBTransaction.GetEndAction: TTransactionAction; |
1837 |
+ |
begin |
1838 |
+ |
if FInEndTransaction then |
1839 |
+ |
Result := FEndAction |
1840 |
+ |
else |
1841 |
+ |
IBError(ibxeIB60feature, [nil]) |
1842 |
+ |
end; |
1843 |
+ |
|
1844 |
|
|
1845 |
|
function TIBTransaction.GetIdleTimer: Integer; |
1846 |
|
begin |
1946 |
|
for i := 0 to FSQLObjects.Count - 1 do |
1947 |
|
if (FSQLObjects[i] <> nil) and |
1948 |
|
(TIBBase(FSQLObjects[i]).Database = nil) then |
1949 |
< |
SetOrdProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Integer(Value)); |
1949 |
> |
SetObjectProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Value); |
1950 |
|
end; |
1951 |
|
FDefaultDatabase := Value; |
1952 |
|
end; |
2052 |
|
finally |
2053 |
|
FreeMem(pteb); |
2054 |
|
end; |
2055 |
+ |
DoOnStartTransaction; |
2056 |
|
end; |
2057 |
|
|
2058 |
|
procedure TIBTransaction.TimeoutTransaction(Sender: TObject); |
2094 |
|
inherited Destroy; |
2095 |
|
end; |
2096 |
|
|
2097 |
+ |
function TIBBase.GetCharSetSize(CharSetID: integer): integer; |
2098 |
+ |
begin |
2099 |
+ |
if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetSizes)) then |
2100 |
+ |
Result := Database.FCharSetSizes[CharSetID] |
2101 |
+ |
else |
2102 |
+ |
Result := 1; {Unknown character set} |
2103 |
+ |
end; |
2104 |
+ |
|
2105 |
+ |
function TIBBase.GetDefaultCharSetSize: integer; |
2106 |
+ |
var DefaultCharSetName: string; |
2107 |
+ |
i: integer; |
2108 |
+ |
begin |
2109 |
+ |
DefaultCharSetName := GetDefaultCharSetName; |
2110 |
+ |
Result := 4; {worse case} |
2111 |
+ |
for i := 0 to Length(Database.FCharSetSizes) - 1 do |
2112 |
+ |
if Database.FCharSetNames[i] = DefaultCharSetName then |
2113 |
+ |
begin |
2114 |
+ |
Result := Database.FCharSetSizes[i]; |
2115 |
+ |
break; |
2116 |
+ |
end; |
2117 |
+ |
end; |
2118 |
+ |
|
2119 |
+ |
function TIBBase.GetCharSetName(CharSetID: integer): string; |
2120 |
+ |
begin |
2121 |
+ |
if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetNames)) then |
2122 |
+ |
Result := Database.FCharSetNames[CharSetID] |
2123 |
+ |
else |
2124 |
+ |
Result := ''; {Unknown character set} |
2125 |
+ |
end; |
2126 |
+ |
|
2127 |
+ |
function TIBBase.GetDefaultCharSetName: RawByteString; |
2128 |
+ |
begin |
2129 |
+ |
Result := Database.FDefaultCharSetName; |
2130 |
+ |
end; |
2131 |
+ |
|
2132 |
+ |
{$IFDEF HAS_ANSISTRING_CODEPAGE} |
2133 |
+ |
function TIBBase.GetCodePage(CharSetID: integer): TSystemCodePage; |
2134 |
+ |
begin |
2135 |
+ |
if (CharSetID >= 0) and (CharSetID < Length(Database.FCodePages)) then |
2136 |
+ |
Result := Database.FCodePages[CharSetID] |
2137 |
+ |
else |
2138 |
+ |
Result := CP_NONE; {Unknown character set} |
2139 |
+ |
end; |
2140 |
+ |
|
2141 |
+ |
function TIBBase.GetDefaultCodePage: TSystemCodePage; |
2142 |
+ |
begin |
2143 |
+ |
Result := Database.FDefaultCodePage; |
2144 |
+ |
end; |
2145 |
+ |
|
2146 |
+ |
{$ENDIF} |
2147 |
+ |
|
2148 |
+ |
procedure TIBBase.HandleException(Sender: TObject); |
2149 |
+ |
begin |
2150 |
+ |
if assigned(Database) then |
2151 |
+ |
Database.HandleException(Sender) |
2152 |
+ |
else |
2153 |
+ |
SysUtils.ShowException(ExceptObject,ExceptAddr); |
2154 |
+ |
end; |
2155 |
+ |
|
2156 |
+ |
procedure TIBBase.SetCursor; |
2157 |
+ |
begin |
2158 |
+ |
if Assigned(Database) and not Database.SQLHourGlass then |
2159 |
+ |
Exit; |
2160 |
+ |
if assigned(IBGUIInterface) then |
2161 |
+ |
IBGUIInterface.SetCursor; |
2162 |
+ |
end; |
2163 |
+ |
|
2164 |
+ |
procedure TIBBase.RestoreCursor; |
2165 |
+ |
begin |
2166 |
+ |
if Assigned(Database) and not Database.SQLHourGlass then |
2167 |
+ |
Exit; |
2168 |
+ |
if assigned(IBGUIInterface) then |
2169 |
+ |
IBGUIInterface.RestoreCursor; |
2170 |
+ |
end; |
2171 |
+ |
|
2172 |
|
procedure TIBBase.CheckDatabase; |
2173 |
|
begin |
2174 |
|
if (FDatabase = nil) then |
2195 |
|
result := @FTransaction.Handle; |
2196 |
|
end; |
2197 |
|
|
2198 |
+ |
procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string |
2199 |
+ |
); |
2200 |
+ |
begin |
2201 |
+ |
if assigned(FBeforeDatabaseConnect) then |
2202 |
+ |
BeforeDatabaseConnect(self,DBParams,DBName); |
2203 |
+ |
end; |
2204 |
+ |
|
2205 |
|
procedure TIBBase.DoAfterDatabaseConnect; |
2206 |
|
begin |
2207 |
|
if assigned(FAfterDatabaseConnect) then |
2228 |
|
SetTransaction(nil); |
2229 |
|
end; |
2230 |
|
|
2231 |
< |
procedure TIBBase.DoBeforeTransactionEnd; |
2231 |
> |
procedure TIBBase.DoBeforeTransactionEnd(Action: TTransactionAction); |
2232 |
|
begin |
2233 |
|
if Assigned(BeforeTransactionEnd) then |
2234 |
< |
BeforeTransactionEnd(Self); |
2234 |
> |
BeforeTransactionEnd(Self,Action); |
2235 |
|
end; |
2236 |
|
|
2237 |
|
procedure TIBBase.DoAfterTransactionEnd; |
2247 |
|
FTransaction := nil; |
2248 |
|
end; |
2249 |
|
|
2250 |
+ |
procedure TIBBase.DoAfterExecQuery(Sender: TObject); |
2251 |
+ |
begin |
2252 |
+ |
if FTransaction <> nil then |
2253 |
+ |
FTransaction.DoAfterExecQuery(Sender); |
2254 |
+ |
end; |
2255 |
+ |
|
2256 |
+ |
procedure TIBBase.DoAfterEdit(Sender: TObject); |
2257 |
+ |
begin |
2258 |
+ |
if FTransaction <> nil then |
2259 |
+ |
FTransaction.DoAfterEdit(Sender); |
2260 |
+ |
end; |
2261 |
+ |
|
2262 |
+ |
procedure TIBBase.DoAfterDelete(Sender: TObject); |
2263 |
+ |
begin |
2264 |
+ |
if FTransaction <> nil then |
2265 |
+ |
FTransaction.DoAfterDelete(Sender); |
2266 |
+ |
end; |
2267 |
+ |
|
2268 |
+ |
procedure TIBBase.DoAfterInsert(Sender: TObject); |
2269 |
+ |
begin |
2270 |
+ |
if FTransaction <> nil then |
2271 |
+ |
FTransaction.DoAfterInsert(Sender); |
2272 |
+ |
end; |
2273 |
+ |
|
2274 |
+ |
procedure TIBBase.DoAfterPost(Sender: TObject); |
2275 |
+ |
begin |
2276 |
+ |
if FTransaction <> nil then |
2277 |
+ |
FTransaction.DoAfterPost(Sender); |
2278 |
+ |
end; |
2279 |
+ |
|
2280 |
|
procedure TIBBase.SetDatabase(Value: TIBDatabase); |
2281 |
|
begin |
2282 |
|
if (FDatabase <> nil) then |