35 |
|
|
36 |
|
{$Mode Delphi} |
37 |
|
|
38 |
+ |
{$codepage UTF8} |
39 |
+ |
|
40 |
|
interface |
41 |
|
|
42 |
|
uses |
45 |
|
{$ELSE} |
46 |
|
unix, |
47 |
|
{$ENDIF} |
48 |
< |
Dialogs, Controls, StdCtrls, SysUtils, Classes, Forms, ExtCtrls, IBHeader, IBExternals, DB, |
47 |
< |
IB, DBLoginDlg; |
48 |
> |
SysUtils, Classes, FPTimer, IBExternals, DB, IB, CustApp, IBTypes; |
49 |
|
|
50 |
|
const |
51 |
|
DPBPrefix = 'isc_dpb_'; |
116 |
|
'set_db_readonly', |
117 |
|
'set_db_sql_dialect', |
118 |
|
'gfix_attach', |
119 |
< |
'gstat_attach' |
119 |
> |
'gstat_attach', |
120 |
> |
'set_db_charset', |
121 |
> |
'gsec_attach', |
122 |
> |
'address_path' , |
123 |
> |
'process_id', |
124 |
> |
'no_db_triggers', |
125 |
> |
'trusted_auth', |
126 |
> |
'process_name', |
127 |
> |
'trusted_role', |
128 |
> |
'org_filename', |
129 |
> |
'utf8_ilename', |
130 |
> |
'ext_call_depth' |
131 |
|
); |
132 |
|
|
133 |
|
TPBPrefix = 'isc_tpb_'; |
151 |
|
'rec_version', |
152 |
|
'no_rec_version', |
153 |
|
'restart_requests', |
154 |
< |
'no_auto_undo' |
154 |
> |
'no_auto_undo', |
155 |
> |
'lock_timeout' |
156 |
|
); |
157 |
|
|
158 |
|
type |
168 |
|
{ TIBDatabase } |
169 |
|
TIBDataBase = class(TCustomConnection) |
170 |
|
private |
171 |
+ |
FAttachment: IAttachment; |
172 |
+ |
FCreateDatabase: boolean; |
173 |
+ |
FCreateIfNotExists: boolean; |
174 |
+ |
FDefaultCharSetID: integer; |
175 |
+ |
FDefaultCharSetName: RawByteString; |
176 |
+ |
FDefaultCodePage: TSystemCodePage; |
177 |
+ |
FDPB: IDPB; |
178 |
|
FAllowStreamedConnected: boolean; |
179 |
|
FHiddenPassword: string; |
180 |
< |
FIBLoaded: Boolean; |
180 |
> |
FOnCreateDatabase: TNotifyEvent; |
181 |
|
FOnLogin: TIBDatabaseLoginEvent; |
182 |
+ |
FSQLHourGlass: Boolean; |
183 |
|
FTraceFlags: TTraceFlags; |
184 |
|
FDBSQLDialect: Integer; |
185 |
|
FSQLDialect: Integer; |
186 |
|
FOnDialectDowngradeWarning: TNotifyEvent; |
166 |
– |
FCanTimeout: Boolean; |
187 |
|
FSQLObjects: TList; |
188 |
|
FTransactions: TList; |
189 |
|
FDBName: TIBFileName; |
190 |
|
FDBParams: TStrings; |
191 |
|
FDBParamsChanged: Boolean; |
172 |
– |
FDPB: PChar; |
173 |
– |
FDPBLength: Short; |
174 |
– |
FHandle: TISC_DB_HANDLE; |
175 |
– |
FHandleIsShared: Boolean; |
192 |
|
FOnIdleTimer: TNotifyEvent; |
193 |
|
FDefaultTransaction: TIBTransaction; |
194 |
|
FInternalTransaction: TIBTransaction; |
195 |
< |
FStreamedConnected: Boolean; |
180 |
< |
FTimer: TTimer; |
195 |
> |
FTimer: TFPTimer; |
196 |
|
FUserNames: TStringList; |
197 |
|
FDataSets: TList; |
198 |
|
FLoginCalled: boolean; |
199 |
+ |
FUseDefaultSystemCodePage: boolean; |
200 |
|
procedure EnsureInactive; |
201 |
|
function GetDBSQLDialect: Integer; |
202 |
|
function GetSQLDialect: Integer; |
206 |
|
procedure DBParamsChanging(Sender: TObject); |
207 |
|
function GetSQLObject(Index: Integer): TIBBase; |
208 |
|
function GetSQLObjectCount: Integer; |
193 |
– |
function GetDBParamByDPB(const Idx: Integer): String; |
209 |
|
function GetIdleTimer: Integer; |
210 |
|
function GetTransaction(Index: Integer): TIBTransaction; |
211 |
|
function GetTransactionCount: Integer; |
212 |
< |
function Login: Boolean; |
212 |
> |
function Login(var aDatabaseName: string): Boolean; |
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; |
248 |
|
function IndexOfDBConst(st: String): Integer; |
249 |
|
function TestConnected: Boolean; |
250 |
|
procedure CheckDatabaseName; |
234 |
– |
function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS; |
251 |
|
function AddTransaction(TR: TIBTransaction): Integer; |
252 |
|
function FindTransaction(TR: TIBTransaction): Integer; |
253 |
|
function FindDefaultTransaction(): TIBTransaction; |
254 |
|
procedure RemoveTransaction(Idx: Integer); |
255 |
|
procedure RemoveTransactions; |
240 |
– |
procedure SetHandle(Value: TISC_DB_HANDLE); |
256 |
|
|
257 |
< |
property Handle: TISC_DB_HANDLE read FHandle; |
257 |
> |
property Attachment: IAttachment read FAttachment; |
258 |
> |
property DBSQLDialect : Integer read FDBSQLDialect; |
259 |
|
property IsReadOnly: Boolean read GetIsReadOnly; |
244 |
– |
property DBParamByDPB[const Idx: Integer]: String read GetDBParamByDPB |
245 |
– |
write SetDBParamByDPB; |
260 |
|
property SQLObjectCount: Integer read GetSQLObjectCount; |
261 |
|
property SQLObjects[Index: Integer]: TIBBase read GetSQLObject; |
248 |
– |
property HandleIsShared: Boolean read FHandleIsShared; |
262 |
|
property TransactionCount: Integer read GetTransactionCount; |
263 |
|
property Transactions[Index: Integer]: TIBTransaction read GetTransaction; |
264 |
|
property InternalTransaction: TIBTransaction read FInternalTransaction; |
265 |
+ |
property DefaultCharSetName: RawByteString read FDefaultCharSetName; |
266 |
+ |
property DefaultCharSetID: integer read FDefaultCharSetID; |
267 |
+ |
property DefaultCodePage: TSystemCodePage read FDefaultCodePage; |
268 |
|
|
269 |
|
published |
270 |
|
property Connected; |
271 |
+ |
property CreateIfNotExists: boolean read FCreateIfNotExists write FCreateIfNotExists; |
272 |
|
property AllowStreamedConnected: boolean read FAllowStreamedConnected |
273 |
|
write FAllowStreamedConnected; |
274 |
|
property DatabaseName: TIBFileName read FDBName write SetDatabaseName; |
278 |
|
write SetDefaultTransaction; |
279 |
|
property IdleTimer: Integer read GetIdleTimer write SetIdleTimer; |
280 |
|
property SQLDialect : Integer read GetSQLDialect write SetSQLDialect default 3; |
281 |
< |
property DBSQLDialect : Integer read FDBSQLDialect; |
281 |
> |
property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true; |
282 |
|
property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags; |
283 |
+ |
property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage |
284 |
+ |
write FUseDefaultSystemCodePage; |
285 |
|
property AfterConnect; |
286 |
|
property AfterDisconnect; |
287 |
|
property BeforeConnect; |
288 |
|
property BeforeDisconnect; |
289 |
+ |
property OnCreateDatabase: TNotifyEvent read FOnCreateDatabase write FOnCreateDatabase; |
290 |
|
property OnLogin: TIBDatabaseLoginEvent read FOnLogin write FOnLogin; |
291 |
|
property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer; |
292 |
|
property OnDialectDowngradeWarning: TNotifyEvent read FOnDialectDowngradeWarning write FOnDialectDowngradeWarning; |
293 |
|
end; |
294 |
|
|
295 |
< |
{ TIBTransaction } |
295 |
> |
TDefaultEndAction = TARollback..TACommit; |
296 |
|
|
297 |
< |
TTransactionAction = (TARollback, TACommit, TARollbackRetaining, TACommitRetaining); |
297 |
> |
{ TIBTransaction } |
298 |
|
|
299 |
|
TIBTransaction = class(TComponent) |
300 |
|
private |
301 |
< |
FIBLoaded: Boolean; |
302 |
< |
FCanTimeout : Boolean; |
301 |
> |
FTransactionIntf: ITransaction; |
302 |
> |
FAfterDelete: TNotifyEvent; |
303 |
> |
FAfterEdit: TNotifyEvent; |
304 |
> |
FAfterExecQuery: TNotifyEvent; |
305 |
> |
FAfterInsert: TNotifyEvent; |
306 |
> |
FAfterPost: TNotifyEvent; |
307 |
> |
FAfterTransactionEnd: TNotifyEvent; |
308 |
> |
FBeforeTransactionEnd: TNotifyEvent; |
309 |
|
FDatabases : TList; |
310 |
+ |
FOnStartTransaction: TNotifyEvent; |
311 |
|
FSQLObjects : TList; |
312 |
|
FDefaultDatabase : TIBDatabase; |
286 |
– |
FHandle : TISC_TR_HANDLE; |
287 |
– |
FHandleIsShared : Boolean; |
313 |
|
FOnIdleTimer : TNotifyEvent; |
314 |
|
FStreamedActive : Boolean; |
315 |
< |
FTPB : PChar; |
316 |
< |
FTPBLength : Short; |
317 |
< |
FTimer : TTimer; |
293 |
< |
FDefaultAction : TTransactionAction; |
315 |
> |
FTPB : ITPB; |
316 |
> |
FTimer : TFPTimer; |
317 |
> |
FDefaultAction : TDefaultEndAction; |
318 |
|
FTRParams : TStrings; |
319 |
|
FTRParamsChanged : Boolean; |
320 |
|
FInEndTransaction : boolean; |
321 |
+ |
FEndAction : TTransactionAction; |
322 |
+ |
procedure DoBeforeTransactionEnd; |
323 |
+ |
procedure DoAfterTransactionEnd; |
324 |
+ |
procedure DoOnStartTransaction; |
325 |
+ |
procedure DoAfterExecQuery(Sender: TObject); |
326 |
+ |
procedure DoAfterEdit(Sender: TObject); |
327 |
+ |
procedure DoAfterDelete(Sender: TObject); |
328 |
+ |
procedure DoAfterInsert(Sender: TObject); |
329 |
+ |
procedure DoAfterPost(Sender: TObject); |
330 |
|
procedure EnsureNotInTransaction; |
331 |
|
procedure EndTransaction(Action: TTransactionAction; Force: Boolean); |
332 |
|
function GetDatabase(Index: Integer): TIBDatabase; |
337 |
|
function GetIdleTimer: Integer; |
338 |
|
procedure BeforeDatabaseDisconnect(DB: TIBDatabase); |
339 |
|
procedure SetActive(Value: Boolean); |
307 |
– |
procedure SetDefaultAction(Value: TTransactionAction); |
340 |
|
procedure SetDefaultDatabase(Value: TIBDatabase); |
341 |
|
procedure SetIdleTimer(Value: Integer); |
342 |
|
procedure SetTRParams(Value: TStrings); |
349 |
|
|
350 |
|
protected |
351 |
|
procedure Loaded; override; |
320 |
– |
procedure SetHandle(Value: TISC_TR_HANDLE); |
352 |
|
procedure Notification( AComponent: TComponent; Operation: TOperation); override; |
353 |
|
|
354 |
|
public |
355 |
|
constructor Create(AOwner: TComponent); override; |
356 |
|
destructor Destroy; override; |
326 |
– |
function Call(ErrCode: ISC_STATUS; RaiseError: Boolean): ISC_STATUS; |
357 |
|
procedure Commit; |
358 |
|
procedure CommitRetaining; |
359 |
|
procedure Rollback; |
365 |
|
function AddDatabase(db: TIBDatabase): Integer; |
366 |
|
function FindDatabase(db: TIBDatabase): Integer; |
367 |
|
function FindDefaultDatabase: TIBDatabase; |
368 |
+ |
function GetEndAction: TTransactionAction; |
369 |
|
procedure RemoveDatabase(Idx: Integer); |
370 |
|
procedure RemoveDatabases; |
371 |
|
procedure CheckDatabasesInList; |
374 |
|
property Databases[Index: Integer]: TIBDatabase read GetDatabase; |
375 |
|
property SQLObjectCount: Integer read GetSQLObjectCount; |
376 |
|
property SQLObjects[Index: Integer]: TIBBase read GetSQLObject; |
346 |
– |
property Handle: TISC_TR_HANDLE read FHandle; |
347 |
– |
property HandleIsShared: Boolean read FHandleIsShared; |
377 |
|
property InTransaction: Boolean read GetInTransaction; |
378 |
< |
property TPB: PChar read FTPB; |
379 |
< |
property TPBLength: Short read FTPBLength; |
378 |
> |
property TransactionIntf: ITransaction read FTransactionIntf; |
379 |
> |
property TPB: ITPB read FTPB; |
380 |
|
published |
381 |
|
property Active: Boolean read GetInTransaction write SetActive; |
382 |
|
property DefaultDatabase: TIBDatabase read FDefaultDatabase |
383 |
|
write SetDefaultDatabase; |
384 |
|
property IdleTimer: Integer read GetIdleTimer write SetIdleTimer default 0; |
385 |
< |
property DefaultAction: TTransactionAction read FDefaultAction write SetDefaultAction default taCommit; |
385 |
> |
property DefaultAction: TDefaultEndAction read FDefaultAction write FDefaultAction default taCommit; |
386 |
|
property Params: TStrings read FTRParams write SetTRParams; |
387 |
|
property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer; |
388 |
< |
end; |
388 |
> |
property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd |
389 |
> |
write FBeforeTransactionEnd; |
390 |
> |
property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd |
391 |
> |
write FAfterTransactionEnd; |
392 |
> |
property OnStartTransaction: TNotifyEvent read FOnStartTransaction |
393 |
> |
write FOnStartTransaction; |
394 |
> |
property AfterExecQuery: TNotifyEvent read FAfterExecQuery |
395 |
> |
write FAfterExecQuery; |
396 |
> |
property AfterEdit: TNotifyEvent read FAfterEdit write FAfterEdit; |
397 |
> |
property AfterDelete: TNotifyEvent read FAfterDelete write FAfterDelete; |
398 |
> |
property AfterInsert: TNotifyEvent read FAfterInsert write FAfterInsert; |
399 |
> |
property AfterPost: TNotifyEvent read FAfterPost write FAfterPost; |
400 |
> |
end; |
401 |
> |
|
402 |
> |
TTransactionEndEvent = procedure(Sender:TObject; Action: TTransactionAction) of object; |
403 |
> |
TBeforeDatabaseConnectEvent = procedure (Sender: TObject; DBParams: TStrings; |
404 |
> |
var DBName: string) of object; |
405 |
|
|
406 |
|
{ TIBBase } |
407 |
|
|
410 |
|
connections. } |
411 |
|
TIBBase = class(TObject) |
412 |
|
protected |
413 |
+ |
FBeforeDatabaseConnect: TBeforeDatabaseConnectEvent; |
414 |
|
FDatabase: TIBDatabase; |
415 |
|
FIndexInDatabase: Integer; |
416 |
|
FTransaction: TIBTransaction; |
420 |
|
FAfterDatabaseDisconnect: TNotifyEvent; |
421 |
|
FAfterDatabaseConnect: TNotifyEvent; |
422 |
|
FOnDatabaseFree: TNotifyEvent; |
423 |
< |
FBeforeTransactionEnd: TNotifyEvent; |
423 |
> |
FBeforeTransactionEnd: TTransactionEndEvent; |
424 |
|
FAfterTransactionEnd: TNotifyEvent; |
425 |
|
FOnTransactionFree: TNotifyEvent; |
426 |
|
|
427 |
+ |
procedure DoBeforeDatabaseConnect(DBParams: TStrings; |
428 |
+ |
var DBName: string); virtual; |
429 |
|
procedure DoAfterDatabaseConnect; virtual; |
430 |
|
procedure DoBeforeDatabaseDisconnect; virtual; |
431 |
|
procedure DoAfterDatabaseDisconnect; virtual; |
432 |
|
procedure DoDatabaseFree; virtual; |
433 |
< |
procedure DoBeforeTransactionEnd; virtual; |
433 |
> |
procedure DoBeforeTransactionEnd(Action: TTransactionAction); virtual; |
434 |
|
procedure DoAfterTransactionEnd; virtual; |
435 |
|
procedure DoTransactionFree; virtual; |
388 |
– |
function GetDBHandle: PISC_DB_HANDLE; virtual; |
389 |
– |
function GetTRHandle: PISC_TR_HANDLE; virtual; |
436 |
|
procedure SetDatabase(Value: TIBDatabase); virtual; |
437 |
|
procedure SetTransaction(Value: TIBTransaction); virtual; |
438 |
|
public |
440 |
|
destructor Destroy; override; |
441 |
|
procedure CheckDatabase; virtual; |
442 |
|
procedure CheckTransaction; virtual; |
443 |
+ |
procedure DoAfterExecQuery(Sender: TObject); virtual; |
444 |
+ |
procedure DoAfterEdit(Sender: TObject); virtual; |
445 |
+ |
procedure DoAfterDelete(Sender: TObject); virtual; |
446 |
+ |
procedure DoAfterInsert(Sender: TObject); virtual; |
447 |
+ |
procedure DoAfterPost(Sender: TObject); virtual; |
448 |
+ |
procedure HandleException(Sender: TObject); |
449 |
+ |
procedure SetCursor; |
450 |
+ |
procedure RestoreCursor; |
451 |
|
public |
452 |
+ |
property BeforeDatabaseConnect: TBeforeDatabaseConnectEvent read FBeforeDatabaseConnect |
453 |
+ |
write FBeforeDatabaseConnect; |
454 |
|
property AfterDatabaseConnect: TNotifyEvent read FAfterDatabaseConnect |
455 |
|
write FAfterDatabaseConnect; |
456 |
|
property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect |
458 |
|
property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect |
459 |
|
write FAfterDatabaseDisconnect; |
460 |
|
property OnDatabaseFree: TNotifyEvent read FOnDatabaseFree write FOnDatabaseFree; |
461 |
< |
property BeforeTransactionEnd: TNotifyEvent read FBeforeTransactionEnd write FBeforeTransactionEnd; |
461 |
> |
property BeforeTransactionEnd: TTransactionEndEvent read FBeforeTransactionEnd write FBeforeTransactionEnd; |
462 |
|
property AfterTransactionEnd: TNotifyEvent read FAfterTransactionEnd write FAfterTransactionEnd; |
463 |
|
property OnTransactionFree: TNotifyEvent read FOnTransactionFree write FOnTransactionFree; |
464 |
|
property Database: TIBDatabase read FDatabase |
465 |
|
write SetDatabase; |
410 |
– |
property DBHandle: PISC_DB_HANDLE read GetDBHandle; |
466 |
|
property Owner: TObject read FOwner; |
412 |
– |
property TRHandle: PISC_TR_HANDLE read GetTRHandle; |
467 |
|
property Transaction: TIBTransaction read FTransaction |
468 |
|
write SetTransaction; |
469 |
|
end; |
470 |
|
|
471 |
< |
procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short); |
472 |
< |
procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short); |
471 |
> |
function GenerateDPB(sl: TStrings): IDPB; |
472 |
> |
function GenerateTPB(sl: TStrings): ITPB; |
473 |
|
|
474 |
|
|
475 |
|
implementation |
476 |
|
|
477 |
< |
uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils, typInfo; |
477 |
> |
uses IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils, |
478 |
> |
typInfo, FBMessages, IBErrorCodes; |
479 |
|
|
480 |
|
{ TIBDatabase } |
481 |
|
|
482 |
< |
constructor TIBDatabase.Create(AOwner: TComponent); |
482 |
> |
constructor TIBDataBase.Create(AOwner: TComponent); |
483 |
|
begin |
484 |
|
inherited Create(AOwner); |
430 |
– |
FIBLoaded := False; |
431 |
– |
CheckIBLoaded; |
432 |
– |
FIBLoaded := True; |
485 |
|
LoginPrompt := True; |
486 |
|
FSQLObjects := TList.Create; |
487 |
|
FTransactions := TList.Create; |
488 |
|
FDBName := ''; |
489 |
|
FDBParams := TStringList.Create; |
490 |
+ |
FSQLHourGlass := true; |
491 |
+ |
if (AOwner <> nil) and |
492 |
+ |
(AOwner is TCustomApplication) and |
493 |
+ |
TCustomApplication(AOWner).ConsoleApplication then |
494 |
+ |
LoginPrompt := false; |
495 |
|
FDBParamsChanged := True; |
496 |
|
TStringList(FDBParams).OnChange := DBParamsChange; |
497 |
|
TStringList(FDBParams).OnChanging := DBParamsChanging; |
498 |
|
FDPB := nil; |
442 |
– |
FHandle := nil; |
499 |
|
FUserNames := nil; |
500 |
|
FInternalTransaction := TIBTransaction.Create(self); |
501 |
|
FInternalTransaction.DefaultDatabase := Self; |
502 |
< |
FTimer := TTimer.Create(Self); |
502 |
> |
FTimer := TFPTimer.Create(Self); |
503 |
|
FTimer.Enabled := False; |
504 |
|
FTimer.Interval := 0; |
505 |
|
FTimer.OnTimer := TimeoutConnection; |
510 |
|
CheckStreamConnect; |
511 |
|
end; |
512 |
|
|
513 |
< |
destructor TIBDatabase.Destroy; |
513 |
> |
destructor TIBDataBase.Destroy; |
514 |
|
var |
515 |
|
i: Integer; |
516 |
|
begin |
517 |
< |
if FIBLoaded then |
518 |
< |
begin |
519 |
< |
IdleTimer := 0; |
520 |
< |
if FHandle <> nil then |
521 |
< |
ForceClose; |
522 |
< |
for i := 0 to FSQLObjects.Count - 1 do |
523 |
< |
if FSQLObjects[i] <> nil then |
524 |
< |
SQLObjects[i].DoDatabaseFree; |
525 |
< |
RemoveSQLObjects; |
526 |
< |
RemoveTransactions; |
527 |
< |
FInternalTransaction.Free; |
528 |
< |
FreeMem(FDPB); |
529 |
< |
FDPB := nil; |
530 |
< |
FDBParams.Free; |
475 |
< |
FSQLObjects.Free; |
476 |
< |
FUserNames.Free; |
477 |
< |
FTransactions.Free; |
478 |
< |
end; |
517 |
> |
IdleTimer := 0; |
518 |
> |
if FAttachment <> nil then |
519 |
> |
ForceClose; |
520 |
> |
for i := 0 to FSQLObjects.Count - 1 do |
521 |
> |
if FSQLObjects[i] <> nil then |
522 |
> |
SQLObjects[i].DoDatabaseFree; |
523 |
> |
RemoveSQLObjects; |
524 |
> |
RemoveTransactions; |
525 |
> |
FInternalTransaction.Free; |
526 |
> |
FDPB := nil; |
527 |
> |
FDBParams.Free; |
528 |
> |
FSQLObjects.Free; |
529 |
> |
FUserNames.Free; |
530 |
> |
FTransactions.Free; |
531 |
|
FDataSets.Free; |
532 |
|
inherited Destroy; |
533 |
|
end; |
534 |
|
|
535 |
< |
function TIBDatabase.Call(ErrCode: ISC_STATUS; |
484 |
< |
RaiseError: Boolean): ISC_STATUS; |
485 |
< |
begin |
486 |
< |
result := ErrCode; |
487 |
< |
FCanTimeout := False; |
488 |
< |
if RaiseError and (ErrCode > 0) then |
489 |
< |
IBDataBaseError; |
490 |
< |
end; |
491 |
< |
|
492 |
< |
procedure TIBDatabase.CheckActive; |
535 |
> |
procedure TIBDataBase.CheckActive; |
536 |
|
begin |
537 |
|
if StreamedConnected and (not Connected) then |
538 |
|
Loaded; |
539 |
< |
if FHandle = nil then |
539 |
> |
if FAttachment = nil then |
540 |
|
IBError(ibxeDatabaseClosed, [nil]); |
541 |
|
end; |
542 |
|
|
543 |
< |
procedure TIBDatabase.EnsureInactive; |
543 |
> |
procedure TIBDataBase.EnsureInactive; |
544 |
|
begin |
545 |
|
if csDesigning in ComponentState then |
546 |
|
begin |
547 |
< |
if FHandle <> nil then |
547 |
> |
if FAttachment <> nil then |
548 |
|
Close; |
549 |
|
end |
550 |
|
end; |
551 |
|
|
552 |
< |
procedure TIBDatabase.CheckInactive; |
552 |
> |
procedure TIBDataBase.CheckInactive; |
553 |
|
begin |
554 |
< |
if FHandle <> nil then |
554 |
> |
if FAttachment <> nil then |
555 |
|
IBError(ibxeDatabaseOpen, [nil]); |
556 |
|
end; |
557 |
|
|
558 |
< |
procedure TIBDatabase.CheckDatabaseName; |
558 |
> |
procedure TIBDataBase.CheckDatabaseName; |
559 |
|
begin |
560 |
< |
if (FDBName = '') then |
560 |
> |
if (Trim(FDBName) = '') then |
561 |
|
IBError(ibxeDatabaseNameMissing, [nil]); |
562 |
|
end; |
563 |
|
|
564 |
< |
function TIBDatabase.AddSQLObject(ds: TIBBase): Integer; |
564 |
> |
function TIBDataBase.AddSQLObject(ds: TIBBase): Integer; |
565 |
|
begin |
566 |
|
result := 0; |
567 |
|
if (ds.Owner is TIBCustomDataSet) then |
574 |
|
FSQLObjects[result] := ds; |
575 |
|
end; |
576 |
|
|
577 |
< |
function TIBDatabase.AddTransaction(TR: TIBTransaction): Integer; |
577 |
> |
function TIBDataBase.AddTransaction(TR: TIBTransaction): Integer; |
578 |
|
begin |
579 |
|
result := FindTransaction(TR); |
580 |
|
if result <> -1 then |
591 |
|
FTransactions[result] := TR; |
592 |
|
end; |
593 |
|
|
594 |
< |
procedure TIBDatabase.DoDisconnect; |
594 |
> |
procedure TIBDataBase.DoDisconnect; |
595 |
|
begin |
596 |
|
if Connected then |
597 |
|
InternalClose(False); |
598 |
|
FDBSQLDialect := 1; |
599 |
+ |
FDefaultCharSetName := ''; |
600 |
+ |
FDefaultCharSetID := 0; |
601 |
+ |
FDefaultCodePage := CP_NONE; |
602 |
|
end; |
603 |
|
|
604 |
< |
procedure TIBDatabase.CreateDatabase; |
559 |
< |
var |
560 |
< |
tr_handle: TISC_TR_HANDLE; |
604 |
> |
procedure TIBDataBase.CreateDatabase; |
605 |
|
begin |
606 |
|
CheckInactive; |
607 |
< |
tr_handle := nil; |
608 |
< |
Call( |
609 |
< |
isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0, |
566 |
< |
PChar('CREATE DATABASE ''' + FDBName + ''' ' + {do not localize} |
567 |
< |
Params.Text), SQLDialect, nil), |
568 |
< |
True); |
607 |
> |
CheckDatabaseName; |
608 |
> |
FCreateDatabase := true; |
609 |
> |
Connected := true; |
610 |
|
end; |
611 |
|
|
612 |
< |
procedure TIBDatabase.DropDatabase; |
612 |
> |
procedure TIBDataBase.DropDatabase; |
613 |
|
begin |
614 |
|
CheckActive; |
615 |
< |
Call(isc_drop_database(StatusVector, @FHandle), True); |
615 |
> |
FAttachment.DropDatabase; |
616 |
> |
FAttachment := nil; |
617 |
|
end; |
618 |
|
|
619 |
< |
procedure TIBDatabase.DBParamsChange(Sender: TObject); |
619 |
> |
procedure TIBDataBase.DBParamsChange(Sender: TObject); |
620 |
|
begin |
621 |
|
FDBParamsChanged := True; |
622 |
|
end; |
623 |
|
|
624 |
< |
procedure TIBDatabase.DBParamsChanging(Sender: TObject); |
624 |
> |
procedure TIBDataBase.DBParamsChanging(Sender: TObject); |
625 |
|
begin |
626 |
|
EnsureInactive; |
627 |
|
CheckInactive; |
628 |
|
end; |
629 |
|
|
630 |
< |
function TIBDatabase.FindTransaction(TR: TIBTransaction): Integer; |
630 |
> |
function TIBDataBase.FindTransaction(TR: TIBTransaction): Integer; |
631 |
|
var |
632 |
|
i: Integer; |
633 |
|
begin |
640 |
|
end; |
641 |
|
end; |
642 |
|
|
643 |
< |
function TIBDatabase.FindDefaultTransaction(): TIBTransaction; |
643 |
> |
function TIBDataBase.FindDefaultTransaction: TIBTransaction; |
644 |
|
var |
645 |
|
i: Integer; |
646 |
|
begin |
658 |
|
end; |
659 |
|
end; |
660 |
|
|
661 |
< |
procedure TIBDatabase.ForceClose; |
661 |
> |
procedure TIBDataBase.ForceClose; |
662 |
|
begin |
663 |
|
if Connected then |
664 |
|
InternalClose(True); |
665 |
|
end; |
666 |
|
|
667 |
< |
function TIBDatabase.GetConnected: Boolean; |
667 |
> |
function TIBDataBase.GetConnected: Boolean; |
668 |
|
begin |
669 |
< |
result := FHandle <> nil; |
669 |
> |
result := (FAttachment <> nil) and FAttachment.IsConnected; |
670 |
|
end; |
671 |
|
|
672 |
< |
function TIBDatabase.GetSQLObject(Index: Integer): TIBBase; |
672 |
> |
function TIBDataBase.GetSQLObject(Index: Integer): TIBBase; |
673 |
|
begin |
674 |
|
result := FSQLObjects[Index]; |
675 |
|
end; |
676 |
|
|
677 |
< |
function TIBDatabase.GetSQLObjectCount: Integer; |
677 |
> |
function TIBDataBase.GetSQLObjectCount: Integer; |
678 |
|
var |
679 |
|
i: Integer; |
680 |
|
begin |
683 |
|
Inc(result); |
684 |
|
end; |
685 |
|
|
686 |
< |
function TIBDatabase.GetDBParamByDPB(const Idx: Integer): String; |
645 |
< |
var |
646 |
< |
ConstIdx, EqualsIdx: Integer; |
647 |
< |
begin |
648 |
< |
if (Idx > 0) and (Idx <= isc_dpb_last_dpb_constant) then |
649 |
< |
begin |
650 |
< |
ConstIdx := IndexOfDBConst(DPBConstantNames[Idx]); |
651 |
< |
if ConstIdx = -1 then |
652 |
< |
result := '' |
653 |
< |
else |
654 |
< |
begin |
655 |
< |
result := Params[ConstIdx]; |
656 |
< |
EqualsIdx := Pos('=', result); {mbcs ok} |
657 |
< |
if EqualsIdx = 0 then |
658 |
< |
result := '' |
659 |
< |
else |
660 |
< |
result := Copy(result, EqualsIdx + 1, Length(result)); |
661 |
< |
end; |
662 |
< |
end |
663 |
< |
else |
664 |
< |
result := ''; |
665 |
< |
end; |
666 |
< |
|
667 |
< |
function TIBDatabase.GetIdleTimer: Integer; |
686 |
> |
function TIBDataBase.GetIdleTimer: Integer; |
687 |
|
begin |
688 |
|
result := FTimer.Interval; |
689 |
|
end; |
690 |
|
|
691 |
< |
function TIBDatabase.GetTransaction(Index: Integer): TIBTransaction; |
691 |
> |
function TIBDataBase.GetTransaction(Index: Integer): TIBTransaction; |
692 |
|
begin |
693 |
|
result := FTransactions[Index]; |
694 |
|
end; |
695 |
|
|
696 |
< |
function TIBDatabase.GetTransactionCount: Integer; |
696 |
> |
function TIBDataBase.GetTransactionCount: Integer; |
697 |
|
var |
698 |
|
i: Integer; |
699 |
|
begin |
703 |
|
Inc(result); |
704 |
|
end; |
705 |
|
|
706 |
< |
function TIBDatabase.IndexOfDBConst(st: String): Integer; |
706 |
> |
function TIBDataBase.IndexOfDBConst(st: String): Integer; |
707 |
|
var |
708 |
|
i, pos_of_str: Integer; |
709 |
|
begin |
719 |
|
end; |
720 |
|
end; |
721 |
|
|
722 |
< |
procedure TIBDatabase.InternalClose(Force: Boolean); |
722 |
> |
procedure TIBDataBase.InternalClose(Force: Boolean); |
723 |
|
var |
724 |
|
i: Integer; |
725 |
|
begin |
748 |
|
end; |
749 |
|
end; |
750 |
|
|
751 |
< |
if (not HandleIsShared) and |
752 |
< |
(Call(isc_detach_database(StatusVector, @FHandle), False) > 0) and |
734 |
< |
(not Force) then |
735 |
< |
IBDataBaseError |
736 |
< |
else |
737 |
< |
begin |
738 |
< |
FHandle := nil; |
739 |
< |
FHandleIsShared := False; |
740 |
< |
end; |
751 |
> |
FAttachment.Disconnect(Force); |
752 |
> |
FAttachment := nil; |
753 |
|
|
754 |
|
if not (csDesigning in ComponentState) then |
755 |
|
MonitorHook.DBDisconnect(Self); |
781 |
|
(FDefaultTransaction.FStreamedActive) and |
782 |
|
(not FDefaultTransaction.InTransaction) then |
783 |
|
FDefaultTransaction.StartTransaction; |
784 |
< |
FStreamedConnected := False; |
784 |
> |
StreamedConnected := False; |
785 |
|
end; |
786 |
|
except |
787 |
|
if csDesigning in ComponentState then |
788 |
< |
Application.HandleException(Self) |
788 |
> |
HandleException(Self) |
789 |
|
else |
790 |
|
raise; |
791 |
|
end; |
792 |
|
end; |
793 |
|
|
794 |
< |
procedure TIBDatabase.Notification( AComponent: TComponent; |
795 |
< |
Operation: TOperation); |
794 |
> |
procedure TIBDataBase.HandleException(Sender: TObject); |
795 |
> |
var aParent: TComponent; |
796 |
> |
begin |
797 |
> |
aParent := Owner; |
798 |
> |
while aParent <> nil do |
799 |
> |
begin |
800 |
> |
if aParent is TCustomApplication then |
801 |
> |
begin |
802 |
> |
TCustomApplication(aParent).HandleException(Sender); |
803 |
> |
Exit; |
804 |
> |
end; |
805 |
> |
aParent := aParent.Owner; |
806 |
> |
end; |
807 |
> |
SysUtils.ShowException(ExceptObject,ExceptAddr); |
808 |
> |
end; |
809 |
> |
|
810 |
> |
procedure TIBDataBase.Notification(AComponent: TComponent; |
811 |
> |
Operation: TOperation); |
812 |
|
var |
813 |
|
i: Integer; |
814 |
|
begin |
822 |
|
end; |
823 |
|
end; |
824 |
|
|
825 |
< |
function TIBDatabase.Login: Boolean; |
825 |
> |
function TIBDataBase.Login(var aDatabaseName: string): Boolean; |
826 |
|
var |
827 |
|
IndexOfUser, IndexOfPassword: Integer; |
828 |
|
Username, Password, OldPassword: String; |
858 |
|
LoginParams.Assign(Params); |
859 |
|
FOnLogin(Self, LoginParams); |
860 |
|
Params.Assign (LoginParams); |
861 |
+ |
aDatabaseName := FDBName; |
862 |
|
HidePassword; |
863 |
|
finally |
864 |
|
LoginParams.Free; |
865 |
|
end; |
866 |
|
end |
867 |
|
else |
868 |
+ |
if assigned(IBGUIInterface) then |
869 |
|
begin |
870 |
|
IndexOfUser := IndexOfDBConst(DPBConstantNames[isc_dpb_user_name]); |
871 |
|
if IndexOfUser <> -1 then |
880 |
|
Length(Params[IndexOfPassword])); |
881 |
|
OldPassword := password; |
882 |
|
end; |
883 |
< |
result := LoginDialogEx(DatabaseName, Username, Password, False); |
883 |
> |
|
884 |
> |
result := IBGUIInterface.LoginDialogEx(aDatabaseName, Username, Password, False); |
885 |
|
if result then |
886 |
|
begin |
887 |
< |
if IndexOfUser = -1 then |
888 |
< |
Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username) |
889 |
< |
else |
890 |
< |
Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] + |
887 |
> |
if Username <> '' then |
888 |
> |
begin |
889 |
> |
if IndexOfUser = -1 then |
890 |
> |
Params.Add(DPBConstantNames[isc_dpb_user_name] + '=' + Username) |
891 |
> |
else |
892 |
> |
Params[IndexOfUser] := DPBConstantNames[isc_dpb_user_name] + |
893 |
|
'=' + Username; |
894 |
+ |
end |
895 |
+ |
else |
896 |
+ |
if IndexOfUser <> -1 then |
897 |
+ |
Params.Delete(IndexOfUser); |
898 |
|
if (Password = OldPassword) then |
899 |
|
FHiddenPassword := '' |
900 |
|
else |
904 |
|
HidePassword; |
905 |
|
end; |
906 |
|
end; |
907 |
< |
end; |
907 |
> |
end |
908 |
> |
else |
909 |
> |
if LoginPrompt then |
910 |
> |
IBError(ibxeNoLoginDialog,[]); |
911 |
|
finally |
912 |
|
FLoginCalled := false |
913 |
|
end; |
914 |
|
end; |
915 |
|
|
916 |
< |
procedure TIBDatabase.DoConnect; |
916 |
> |
procedure TIBDataBase.DoConnect; |
917 |
|
var |
878 |
– |
DPB: String; |
918 |
|
TempDBParams: TStrings; |
919 |
|
I: integer; |
920 |
< |
|
920 |
> |
aDBName: string; |
921 |
> |
Status: IStatus; |
922 |
> |
CharSetID: integer; |
923 |
|
begin |
924 |
|
CheckInactive; |
925 |
|
CheckDatabaseName; |
929 |
|
FDBParamsChanged := True; |
930 |
|
end; |
931 |
|
{ Use builtin login prompt if requested } |
932 |
< |
if (LoginPrompt or (csDesigning in ComponentState)) and not Login then |
932 |
> |
aDBName := FDBName; |
933 |
> |
if (LoginPrompt or (csDesigning in ComponentState)) and not Login(aDBName) then |
934 |
|
IBError(ibxeOperationCancelled, [nil]); |
935 |
< |
{ Generate a new DPB if necessary } |
936 |
< |
if (FDBParamsChanged) then |
937 |
< |
begin |
938 |
< |
FDBParamsChanged := False; |
939 |
< |
if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then |
940 |
< |
GenerateDPB(FDBParams, DPB, FDPBLength) |
935 |
> |
|
936 |
> |
TempDBParams := TStringList.Create; |
937 |
> |
try |
938 |
> |
TempDBParams.Assign(FDBParams); |
939 |
> |
if UseDefaultSystemCodePage then |
940 |
> |
begin |
941 |
> |
{$ifdef WINDOWS} |
942 |
> |
if FirebirdAPI.CodePage2CharSetID(GetACP,CharSetID) then |
943 |
> |
TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID) |
944 |
> |
{$else} |
945 |
> |
if FirebirdAPI.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then |
946 |
> |
TempDBParams.Values['lc_ctype'] := FirebirdAPI.GetCharsetName(CharSetID) |
947 |
> |
{$endif} |
948 |
> |
else |
949 |
> |
TempDBParams.Values['lc_ctype'] :='UTF8'; |
950 |
> |
end; |
951 |
> |
{Opportunity to override defaults} |
952 |
> |
for i := 0 to FSQLObjects.Count - 1 do |
953 |
> |
begin |
954 |
> |
if FSQLObjects[i] <> nil then |
955 |
> |
SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName); |
956 |
> |
end; |
957 |
> |
|
958 |
> |
FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']); |
959 |
> |
if FDefaultCharSetName <> '' then |
960 |
> |
FirebirdAPI.CharSetName2CharSetID(FDefaultCharSetName,FDefaultCharSetID); |
961 |
> |
FirebirdAPI.CharSetID2CodePage(FDefaultCharSetID,FDefaultCodePage); |
962 |
> |
{ Generate a new DPB if necessary } |
963 |
> |
if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then |
964 |
> |
begin |
965 |
> |
FDBParamsChanged := False; |
966 |
> |
if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then |
967 |
> |
FDPB := GenerateDPB(TempDBParams) |
968 |
> |
else |
969 |
> |
begin |
970 |
> |
TempDBParams.Add('password=' + FHiddenPassword); |
971 |
> |
FDPB := GenerateDPB(TempDBParams); |
972 |
> |
end; |
973 |
> |
end; |
974 |
> |
finally |
975 |
> |
TempDBParams.Free; |
976 |
> |
end; |
977 |
> |
|
978 |
> |
repeat |
979 |
> |
if FCreateDatabase then |
980 |
> |
begin |
981 |
> |
FCreateDatabase := false; |
982 |
> |
FAttachment := FirebirdAPI.CreateDatabase(aDBName,FDPB, false); |
983 |
> |
if assigned(FOnCreateDatabase) and (FAttachment <> nil) then |
984 |
> |
OnCreateDatabase(self); |
985 |
> |
end |
986 |
|
else |
987 |
+ |
FAttachment := FirebirdAPI.OpenDatabase(aDBName,FDPB,false); |
988 |
+ |
if FAttachment = nil then |
989 |
|
begin |
990 |
< |
TempDBParams := TStringList.Create; |
991 |
< |
try |
992 |
< |
TempDBParams.Assign(FDBParams); |
993 |
< |
TempDBParams.Add('password=' + FHiddenPassword); |
994 |
< |
GenerateDPB(TempDBParams, DPB, FDPBLength); |
995 |
< |
finally |
996 |
< |
TempDBParams.Free; |
990 |
> |
Status := FirebirdAPI.GetStatus; |
991 |
> |
{$IFDEF UNIX} |
992 |
> |
if Pos(':',aDBName) = 0 then |
993 |
> |
begin |
994 |
> |
if ((Status.GetSQLCode = -901) and (Status.GetIBErrorCode = isc_random)) {Access permissions on firebird temp} |
995 |
> |
or |
996 |
> |
((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_sys_request)) {Security DB Problem} |
997 |
> |
or |
998 |
> |
((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_psw_attach)) {Security DB Problem} |
999 |
> |
or |
1000 |
> |
((Status.GetSQLCode = -904) and (Status.GetIBErrorCode = isc_lock_dir_access)) {Lock File Problem} |
1001 |
> |
then |
1002 |
> |
begin |
1003 |
> |
aDBName := 'localhost:' + aDBName; |
1004 |
> |
Continue; |
1005 |
> |
end |
1006 |
|
end; |
1007 |
+ |
{$ENDIF} |
1008 |
+ |
if ((Status.GetSQLCode = -902) and (Status.GetIBErrorCode = isc_io_error)) {Database not found} |
1009 |
+ |
and CreateIfNotExists and not (csDesigning in ComponentState) then |
1010 |
+ |
FCreateDatabase := true |
1011 |
+ |
else |
1012 |
+ |
raise EIBInterBaseError.Create(Status); |
1013 |
|
end; |
1014 |
< |
IBAlloc(FDPB, 0, FDPBLength); |
1015 |
< |
Move(DPB[1], FDPB[0], FDPBLength); |
1016 |
< |
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; |
1014 |
> |
until FAttachment <> nil; |
1015 |
> |
if not (csDesigning in ComponentState) then |
1016 |
> |
FDBName := aDBName; {Synchronise at run time} |
1017 |
|
FDBSQLDialect := GetDBSQLDialect; |
1018 |
|
ValidateClientSQLDialect; |
1019 |
|
for i := 0 to FSQLObjects.Count - 1 do |
1025 |
|
MonitorHook.DBConnect(Self); |
1026 |
|
end; |
1027 |
|
|
1028 |
< |
procedure TIBDatabase.RemoveSQLObject(Idx: Integer); |
1028 |
> |
procedure TIBDataBase.RemoveSQLObject(Idx: Integer); |
1029 |
|
var |
1030 |
|
ds: TIBBase; |
1031 |
|
begin |
1039 |
|
end; |
1040 |
|
end; |
1041 |
|
|
1042 |
< |
procedure TIBDatabase.RemoveSQLObjects; |
1042 |
> |
procedure TIBDataBase.RemoveSQLObjects; |
1043 |
|
var |
1044 |
|
i: Integer; |
1045 |
|
begin |
1051 |
|
end; |
1052 |
|
end; |
1053 |
|
|
1054 |
< |
procedure TIBDatabase.RemoveTransaction(Idx: Integer); |
1054 |
> |
procedure TIBDataBase.RemoveTransaction(Idx: Integer); |
1055 |
|
var |
1056 |
|
TR: TIBTransaction; |
1057 |
|
begin |
1065 |
|
end; |
1066 |
|
end; |
1067 |
|
|
1068 |
< |
procedure TIBDatabase.RemoveTransactions; |
1068 |
> |
procedure TIBDataBase.RemoveTransactions; |
1069 |
|
var |
1070 |
|
i: Integer; |
1071 |
|
begin |
1073 |
|
RemoveTransaction(i); |
1074 |
|
end; |
1075 |
|
|
1076 |
< |
procedure TIBDatabase.SetDatabaseName(const Value: TIBFileName); |
1076 |
> |
procedure TIBDataBase.SetDatabaseName( const Value: TIBFileName); |
1077 |
|
begin |
1078 |
|
if FDBName <> Value then |
1079 |
|
begin |
1083 |
|
end; |
1084 |
|
end; |
1085 |
|
|
1086 |
< |
procedure TIBDatabase.SetDBParamByDPB(const Idx: Integer; Value: String); |
1086 |
> |
procedure TIBDataBase.SetDBParamByDPB( const Idx: Integer; Value: String); |
1087 |
|
var |
1088 |
|
ConstIdx: Integer; |
1089 |
|
begin |
1102 |
|
end; |
1103 |
|
end; |
1104 |
|
|
1105 |
< |
procedure TIBDatabase.SetDBParams(Value: TStrings); |
1105 |
> |
procedure TIBDataBase.SetDBParams(Value: TStrings); |
1106 |
|
begin |
1107 |
|
FDBParams.Assign(Value); |
1108 |
|
end; |
1109 |
|
|
1110 |
< |
procedure TIBDatabase.SetDefaultTransaction(Value: TIBTransaction); |
1110 |
> |
procedure TIBDataBase.SetDefaultTransaction(Value: TIBTransaction); |
1111 |
|
var |
1112 |
|
i: Integer; |
1113 |
|
begin |
1125 |
|
FDefaultTransaction := Value; |
1126 |
|
end; |
1127 |
|
|
1128 |
< |
procedure TIBDatabase.SetHandle(Value: TISC_DB_HANDLE); |
1032 |
< |
begin |
1033 |
< |
if HandleIsShared then |
1034 |
< |
Close |
1035 |
< |
else |
1036 |
< |
CheckInactive; |
1037 |
< |
FHandle := Value; |
1038 |
< |
FHandleIsShared := (Value <> nil); |
1039 |
< |
end; |
1040 |
< |
|
1041 |
< |
procedure TIBDatabase.SetIdleTimer(Value: Integer); |
1128 |
> |
procedure TIBDataBase.SetIdleTimer(Value: Integer); |
1129 |
|
begin |
1130 |
|
if Value < 0 then |
1131 |
|
IBError(ibxeTimeoutNegative, [nil]) |
1144 |
|
end; |
1145 |
|
end; |
1146 |
|
|
1147 |
< |
function TIBDatabase.TestConnected: Boolean; |
1147 |
> |
function TIBDataBase.TestConnected: Boolean; |
1148 |
|
var |
1149 |
|
DatabaseInfo: TIBDatabaseInfo; |
1150 |
|
begin |
1165 |
|
end; |
1166 |
|
end; |
1167 |
|
|
1168 |
< |
procedure TIBDatabase.TimeoutConnection(Sender: TObject); |
1168 |
> |
procedure TIBDataBase.TimeoutConnection(Sender: TObject); |
1169 |
|
begin |
1170 |
|
if Connected then |
1171 |
|
begin |
1172 |
< |
if FCanTimeout then |
1172 |
> |
if not FAttachment.HasActivity then |
1173 |
|
begin |
1174 |
|
ForceClose; |
1175 |
|
if Assigned(FOnIdleTimer) then |
1176 |
|
FOnIdleTimer(Self); |
1177 |
|
end |
1091 |
– |
else |
1092 |
– |
FCanTimeout := True; |
1178 |
|
end; |
1179 |
|
end; |
1180 |
|
|
1181 |
< |
function TIBDatabase.GetIsReadOnly: Boolean; |
1181 |
> |
function TIBDataBase.GetIsReadOnly: Boolean; |
1182 |
|
var |
1183 |
|
DatabaseInfo: TIBDatabaseInfo; |
1184 |
|
begin |
1196 |
|
DatabaseInfo.Free; |
1197 |
|
end; |
1198 |
|
|
1199 |
< |
function TIBDatabase.GetSQLDialect: Integer; |
1199 |
> |
function TIBDataBase.GetSQLDialect: Integer; |
1200 |
|
begin |
1201 |
|
Result := FSQLDialect; |
1202 |
|
end; |
1203 |
|
|
1204 |
|
|
1205 |
< |
procedure TIBDatabase.SetSQLDialect(const Value: Integer); |
1205 |
> |
procedure TIBDataBase.SetSQLDialect( const Value: Integer); |
1206 |
|
begin |
1207 |
|
if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]); |
1208 |
< |
if ((FHandle = nil) or (Value <= FDBSQLDialect)) then |
1208 |
> |
if ((FAttachment = nil) or (Value <= FDBSQLDialect)) then |
1209 |
|
FSQLDialect := Value |
1210 |
|
else |
1211 |
|
IBError(ibxeSQLDialectInvalid, [nil]); |
1212 |
|
end; |
1213 |
|
|
1214 |
< |
function TIBDatabase.GetDBSQLDialect: Integer; |
1214 |
> |
function TIBDataBase.GetDBSQLDialect: Integer; |
1215 |
|
var |
1216 |
|
DatabaseInfo: TIBDatabaseInfo; |
1217 |
|
begin |
1221 |
|
DatabaseInfo.Free; |
1222 |
|
end; |
1223 |
|
|
1224 |
< |
procedure TIBDatabase.ValidateClientSQLDialect; |
1224 |
> |
procedure TIBDataBase.ValidateClientSQLDialect; |
1225 |
|
begin |
1226 |
|
if (FDBSQLDialect < FSQLDialect) then |
1227 |
|
begin |
1231 |
|
end; |
1232 |
|
end; |
1233 |
|
|
1234 |
< |
procedure TIBDatabase.ApplyUpdates(const DataSets: array of TDataSet); |
1234 |
> |
procedure TIBDataBase.ApplyUpdates( const DataSets: array of TDataSet); |
1235 |
|
var |
1236 |
|
I: Integer; |
1237 |
|
DS: TIBCustomDataSet; |
1257 |
|
TR.CommitRetaining; |
1258 |
|
end; |
1259 |
|
|
1260 |
< |
procedure TIBDatabase.CloseDataSets; |
1260 |
> |
procedure TIBDataBase.CloseDataSets; |
1261 |
|
var |
1262 |
|
i: Integer; |
1263 |
|
begin |
1266 |
|
DataSets[i].close; |
1267 |
|
end; |
1268 |
|
|
1269 |
< |
function TIBDatabase.GetDataset(Index : longint) : TDataset; |
1269 |
> |
function TIBDataBase.GetDataset(Index: longint): TDataset; |
1270 |
|
begin |
1271 |
|
if (Index >= 0) and (Index < FDataSets.Count) then |
1272 |
|
Result := TDataSet(FDataSets[Index]) |
1274 |
|
raise Exception.Create('Invalid Index to DataSets'); |
1275 |
|
end; |
1276 |
|
|
1277 |
< |
function TIBDatabase.GetDataSetCount : Longint; |
1277 |
> |
function TIBDataBase.GetDataSetCount: Longint; |
1278 |
|
begin |
1279 |
|
Result := FDataSets.Count; |
1280 |
|
end; |
1281 |
|
|
1282 |
+ |
procedure TIBDataBase.ReadState(Reader: TReader); |
1283 |
+ |
begin |
1284 |
+ |
FDBParams.Clear; |
1285 |
+ |
inherited ReadState(Reader); |
1286 |
+ |
end; |
1287 |
+ |
|
1288 |
|
procedure TIBDataBase.SetConnected(Value: boolean); |
1289 |
|
begin |
1290 |
|
if StreamedConnected and not AllowStreamedConnected then |
1295 |
|
inherited SetConnected(Value); |
1296 |
|
end; |
1297 |
|
|
1298 |
< |
procedure TIBDatabase.GetFieldNames(const TableName: string; List: TStrings); |
1298 |
> |
procedure TIBDataBase.GetFieldNames( const TableName: string; List: TStrings); |
1299 |
|
var |
1300 |
|
Query: TIBSQL; |
1301 |
|
begin |
1324 |
|
BeginUpdate; |
1325 |
|
try |
1326 |
|
Clear; |
1327 |
< |
while (not Query.EOF) and (Query.Next <> nil) do |
1328 |
< |
List.Add(TrimRight(Query.Current.ByName('RDB$FIELD_NAME').AsString)); {do not localize} |
1327 |
> |
while (not Query.EOF) and Query.Next do |
1328 |
> |
List.Add(TrimRight(Query.FieldByName('RDB$FIELD_NAME').AsString)); {do not localize} |
1329 |
|
finally |
1330 |
|
EndUpdate; |
1331 |
|
end; |
1336 |
|
end; |
1337 |
|
end; |
1338 |
|
|
1339 |
< |
procedure TIBDatabase.GetTableNames(List: TStrings; SystemTables: Boolean); |
1339 |
> |
procedure TIBDataBase.GetTableNames(List: TStrings; SystemTables: Boolean); |
1340 |
|
var |
1341 |
|
Query : TIBSQL; |
1342 |
|
begin |
1364 |
|
BeginUpdate; |
1365 |
|
try |
1366 |
|
Clear; |
1367 |
< |
while (not Query.EOF) and (Query.Next <> nil) do |
1368 |
< |
List.Add(TrimRight(Query.Current[0].AsString)); |
1367 |
> |
while (not Query.EOF) and Query.Next do |
1368 |
> |
List.Add(TrimRight(Query.Fields[0].AsString)); |
1369 |
|
finally |
1370 |
|
EndUpdate; |
1371 |
|
end; |
1382 |
|
constructor TIBTransaction.Create(AOwner: TComponent); |
1383 |
|
begin |
1384 |
|
inherited Create(AOwner); |
1294 |
– |
FIBLoaded := False; |
1295 |
– |
CheckIBLoaded; |
1296 |
– |
FIBLoaded := True; |
1297 |
– |
CheckIBLoaded; |
1385 |
|
FDatabases := TList.Create; |
1386 |
|
FSQLObjects := TList.Create; |
1300 |
– |
FHandle := nil; |
1387 |
|
FTPB := nil; |
1302 |
– |
FTPBLength := 0; |
1388 |
|
FTRParams := TStringList.Create; |
1389 |
|
FTRParamsChanged := True; |
1390 |
|
TStringList(FTRParams).OnChange := TRParamsChange; |
1391 |
|
TStringList(FTRParams).OnChanging := TRParamsChanging; |
1392 |
< |
FTimer := TTimer.Create(Self); |
1392 |
> |
FTimer := TFPTimer.Create(Self); |
1393 |
|
FTimer.Enabled := False; |
1394 |
|
FTimer.Interval := 0; |
1395 |
|
FTimer.OnTimer := TimeoutTransaction; |
1400 |
|
var |
1401 |
|
i: Integer; |
1402 |
|
begin |
1403 |
< |
if FIBLoaded then |
1404 |
< |
begin |
1405 |
< |
if InTransaction then |
1406 |
< |
EndTransaction(FDefaultAction, True); |
1407 |
< |
for i := 0 to FSQLObjects.Count - 1 do |
1408 |
< |
if FSQLObjects[i] <> nil then |
1409 |
< |
SQLObjects[i].DoTransactionFree; |
1410 |
< |
RemoveSQLObjects; |
1411 |
< |
RemoveDatabases; |
1412 |
< |
FreeMem(FTPB); |
1413 |
< |
FTPB := nil; |
1329 |
< |
FTRParams.Free; |
1330 |
< |
FSQLObjects.Free; |
1331 |
< |
FDatabases.Free; |
1332 |
< |
end; |
1403 |
> |
if InTransaction then |
1404 |
> |
EndTransaction(FDefaultAction, True); |
1405 |
> |
for i := 0 to FSQLObjects.Count - 1 do |
1406 |
> |
if FSQLObjects[i] <> nil then |
1407 |
> |
SQLObjects[i].DoTransactionFree; |
1408 |
> |
RemoveSQLObjects; |
1409 |
> |
RemoveDatabases; |
1410 |
> |
FTPB := nil; |
1411 |
> |
FTRParams.Free; |
1412 |
> |
FSQLObjects.Free; |
1413 |
> |
FDatabases.Free; |
1414 |
|
inherited Destroy; |
1415 |
|
end; |
1416 |
|
|
1336 |
– |
function TIBTransaction.Call(ErrCode: ISC_STATUS; |
1337 |
– |
RaiseError: Boolean): ISC_STATUS; |
1338 |
– |
var |
1339 |
– |
i: Integer; |
1340 |
– |
begin |
1341 |
– |
result := ErrCode; |
1342 |
– |
for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then |
1343 |
– |
Databases[i].FCanTimeout := False; |
1344 |
– |
FCanTimeout := False; |
1345 |
– |
if RaiseError and (result > 0) then |
1346 |
– |
IBDataBaseError; |
1347 |
– |
end; |
1348 |
– |
|
1417 |
|
procedure TIBTransaction.CheckDatabasesInList; |
1418 |
|
begin |
1419 |
|
if GetDatabaseCount = 0 then |
1424 |
|
begin |
1425 |
|
if FStreamedActive and (not InTransaction) then |
1426 |
|
Loaded; |
1427 |
< |
if (FHandle = nil) then |
1427 |
> |
if (TransactionIntf = nil) then |
1428 |
|
IBError(ibxeNotInTransaction, [nil]); |
1429 |
|
end; |
1430 |
|
|
1431 |
+ |
procedure TIBTransaction.DoBeforeTransactionEnd; |
1432 |
+ |
begin |
1433 |
+ |
if Assigned(FBeforeTransactionEnd) then |
1434 |
+ |
FBeforeTransactionEnd(self); |
1435 |
+ |
end; |
1436 |
+ |
|
1437 |
+ |
procedure TIBTransaction.DoAfterTransactionEnd; |
1438 |
+ |
begin |
1439 |
+ |
if Assigned(FAfterTransactionEnd) then |
1440 |
+ |
FAfterTransactionEnd(self); |
1441 |
+ |
end; |
1442 |
+ |
|
1443 |
+ |
procedure TIBTransaction.DoOnStartTransaction; |
1444 |
+ |
begin |
1445 |
+ |
if assigned(FOnStartTransaction) then |
1446 |
+ |
OnStartTransaction(self); |
1447 |
+ |
end; |
1448 |
+ |
|
1449 |
+ |
procedure TIBTransaction.DoAfterExecQuery(Sender: TObject); |
1450 |
+ |
begin |
1451 |
+ |
if assigned(FAfterExecQuery) then |
1452 |
+ |
AfterExecQuery(Sender); |
1453 |
+ |
end; |
1454 |
+ |
|
1455 |
+ |
procedure TIBTransaction.DoAfterEdit(Sender: TObject); |
1456 |
+ |
begin |
1457 |
+ |
if assigned(FAfterEdit) then |
1458 |
+ |
AfterEdit(Sender); |
1459 |
+ |
end; |
1460 |
+ |
|
1461 |
+ |
procedure TIBTransaction.DoAfterDelete(Sender: TObject); |
1462 |
+ |
begin |
1463 |
+ |
if assigned(FAfterDelete) then |
1464 |
+ |
AfterDelete(Sender); |
1465 |
+ |
end; |
1466 |
+ |
|
1467 |
+ |
procedure TIBTransaction.DoAfterInsert(Sender: TObject); |
1468 |
+ |
begin |
1469 |
+ |
if assigned(FAfterInsert) then |
1470 |
+ |
AfterInsert(Sender); |
1471 |
+ |
end; |
1472 |
+ |
|
1473 |
+ |
procedure TIBTransaction.DoAfterPost(Sender: TObject); |
1474 |
+ |
begin |
1475 |
+ |
if assigned(FAfterPost) then |
1476 |
+ |
AfterPost(Sender); |
1477 |
+ |
end; |
1478 |
+ |
|
1479 |
|
procedure TIBTransaction.EnsureNotInTransaction; |
1480 |
|
begin |
1481 |
|
if csDesigning in ComponentState then |
1482 |
|
begin |
1483 |
< |
if FHandle <> nil then |
1483 |
> |
if TransactionIntf <> nil then |
1484 |
|
Rollback; |
1485 |
|
end; |
1486 |
|
end; |
1487 |
|
|
1488 |
|
procedure TIBTransaction.CheckNotInTransaction; |
1489 |
|
begin |
1490 |
< |
if (FHandle <> nil) then |
1490 |
> |
if (TransactionIntf <> nil) and TransactionIntf.InTransaction then |
1491 |
|
IBError(ibxeInTransaction, [nil]); |
1492 |
|
end; |
1493 |
|
|
1496 |
|
i: Integer; |
1497 |
|
NilFound: Boolean; |
1498 |
|
begin |
1499 |
+ |
EnsureNotInTransaction; |
1500 |
+ |
CheckNotInTransaction; |
1501 |
+ |
FTransactionIntf := nil; |
1502 |
+ |
|
1503 |
|
i := FindDatabase(db); |
1504 |
|
if i <> -1 then |
1505 |
|
begin |
1550 |
|
procedure TIBTransaction.EndTransaction(Action: TTransactionAction; |
1551 |
|
Force: Boolean); |
1552 |
|
var |
1433 |
– |
status: ISC_STATUS; |
1553 |
|
i: Integer; |
1554 |
|
begin |
1555 |
|
CheckInTransaction; |
1556 |
|
if FInEndTransaction then Exit; |
1557 |
|
FInEndTransaction := true; |
1558 |
+ |
FEndAction := Action; |
1559 |
|
try |
1560 |
|
case Action of |
1561 |
|
TARollback, TACommit: |
1562 |
|
begin |
1563 |
< |
if (HandleIsShared) and |
1444 |
< |
(Action <> FDefaultAction) and |
1445 |
< |
(not Force) then |
1446 |
< |
IBError(ibxeCantEndSharedTransaction, [nil]); |
1563 |
> |
DoBeforeTransactionEnd; |
1564 |
|
for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then |
1565 |
< |
SQLObjects[i].DoBeforeTransactionEnd; |
1565 |
> |
SQLObjects[i].DoBeforeTransactionEnd(Action); |
1566 |
|
if InTransaction then |
1567 |
|
begin |
1568 |
< |
if HandleIsShared then |
1569 |
< |
begin |
1453 |
< |
FHandle := nil; |
1454 |
< |
FHandleIsShared := False; |
1455 |
< |
status := 0; |
1456 |
< |
end |
1568 |
> |
if (Action = TARollback) then |
1569 |
> |
FTransactionIntf.Rollback(Force) |
1570 |
|
else |
1571 |
< |
if (Action = TARollback) then |
1572 |
< |
status := Call(isc_rollback_transaction(StatusVector, @FHandle), False) |
1573 |
< |
else |
1574 |
< |
status := Call(isc_commit_transaction(StatusVector, @FHandle), False); |
1575 |
< |
if ((Force) and (status > 0)) then |
1576 |
< |
status := Call(isc_rollback_transaction(StatusVector, @FHandle), False); |
1577 |
< |
if Force then |
1578 |
< |
FHandle := nil |
1579 |
< |
else |
1580 |
< |
if (status > 0) then |
1581 |
< |
IBDataBaseError; |
1571 |
> |
try |
1572 |
> |
FTransactionIntf.Commit; |
1573 |
> |
except on E: EIBInterBaseError do |
1574 |
> |
begin |
1575 |
> |
if Force then |
1576 |
> |
FTransactionIntf.Rollback(Force) |
1577 |
> |
else |
1578 |
> |
raise; |
1579 |
> |
end; |
1580 |
> |
end; |
1581 |
> |
|
1582 |
|
for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then |
1583 |
|
SQLObjects[i].DoAfterTransactionEnd; |
1584 |
+ |
DoAfterTransactionEnd; |
1585 |
|
end; |
1586 |
|
end; |
1587 |
|
TACommitRetaining: |
1588 |
< |
Call(isc_commit_retaining(StatusVector, @FHandle), True); |
1588 |
> |
FTransactionIntf.CommitRetaining; |
1589 |
> |
|
1590 |
|
TARollbackRetaining: |
1591 |
< |
Call(isc_rollback_retaining(StatusVector, @FHandle), True); |
1591 |
> |
FTransactionIntf.RollbackRetaining; |
1592 |
|
end; |
1593 |
|
if not (csDesigning in ComponentState) then |
1594 |
|
begin |
1640 |
|
|
1641 |
|
function TIBTransaction.GetInTransaction: Boolean; |
1642 |
|
begin |
1643 |
< |
result := (FHandle <> nil); |
1643 |
> |
result := (TransactionIntf <> nil) and TransactionIntf.InTransaction; |
1644 |
|
end; |
1645 |
|
|
1646 |
|
function TIBTransaction.FindDatabase(db: TIBDatabase): Integer; |
1673 |
|
end; |
1674 |
|
end; |
1675 |
|
|
1676 |
+ |
function TIBTransaction.GetEndAction: TTransactionAction; |
1677 |
+ |
begin |
1678 |
+ |
if FInEndTransaction then |
1679 |
+ |
Result := FEndAction |
1680 |
+ |
else |
1681 |
+ |
IBError(ibxeIB60feature, [nil]) |
1682 |
+ |
end; |
1683 |
+ |
|
1684 |
|
|
1685 |
|
function TIBTransaction.GetIdleTimer: Integer; |
1686 |
|
begin |
1696 |
|
begin |
1697 |
|
if InTransaction then |
1698 |
|
EndTransaction(FDefaultAction, True); |
1699 |
+ |
FTransactionIntf := nil; |
1700 |
|
end; |
1701 |
|
|
1702 |
|
procedure TIBTransaction.RemoveDatabase(Idx: Integer); |
1705 |
|
begin |
1706 |
|
if ((Idx >= 0) and (FDatabases[Idx] <> nil)) then |
1707 |
|
begin |
1708 |
+ |
EnsureNotInTransaction; |
1709 |
+ |
CheckNotInTransaction; |
1710 |
+ |
FTransactionIntf := nil; |
1711 |
+ |
|
1712 |
|
DB := Databases[Idx]; |
1713 |
|
FDatabases[Idx] := nil; |
1714 |
|
DB.RemoveTransaction(DB.FindTransaction(Self)); |
1721 |
|
var |
1722 |
|
i: Integer; |
1723 |
|
begin |
1724 |
+ |
EnsureNotInTransaction; |
1725 |
+ |
CheckNotInTransaction; |
1726 |
+ |
FTransactionIntf := nil; |
1727 |
+ |
|
1728 |
|
for i := 0 to FDatabases.Count - 1 do if FDatabases[i] <> nil then |
1729 |
|
RemoveDatabase(i); |
1730 |
|
end; |
1771 |
|
Rollback; |
1772 |
|
end; |
1773 |
|
|
1642 |
– |
procedure TIBTransaction.SetDefaultAction(Value: TTransactionAction); |
1643 |
– |
begin |
1644 |
– |
(* if (Value = taRollbackRetaining) and (GetIBClientVersion < 6) then |
1645 |
– |
IBError(ibxeIB60feature, [nil]);*) |
1646 |
– |
FDefaultAction := Value; |
1647 |
– |
end; |
1648 |
– |
|
1774 |
|
procedure TIBTransaction.SetDefaultDatabase(Value: TIBDatabase); |
1775 |
|
var |
1776 |
|
i: integer; |
1788 |
|
for i := 0 to FSQLObjects.Count - 1 do |
1789 |
|
if (FSQLObjects[i] <> nil) and |
1790 |
|
(TIBBase(FSQLObjects[i]).Database = nil) then |
1791 |
< |
SetOrdProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Integer(Value)); |
1791 |
> |
SetObjectProp(TIBBase(FSQLObjects[i]).Owner, 'Database', Value); |
1792 |
|
end; |
1793 |
|
FDefaultDatabase := Value; |
1794 |
|
end; |
1795 |
|
|
1671 |
– |
procedure TIBTransaction.SetHandle(Value: TISC_TR_HANDLE); |
1672 |
– |
begin |
1673 |
– |
if (HandleIsShared) then |
1674 |
– |
EndTransaction(DefaultAction, True) |
1675 |
– |
else |
1676 |
– |
CheckNotInTransaction; |
1677 |
– |
FHandle := Value; |
1678 |
– |
FHandleIsShared := (Value <> nil); |
1679 |
– |
end; |
1680 |
– |
|
1796 |
|
procedure TIBTransaction.Notification( AComponent: TComponent; |
1797 |
|
Operation: TOperation); |
1798 |
|
var |
1834 |
|
|
1835 |
|
procedure TIBTransaction.StartTransaction; |
1836 |
|
var |
1722 |
– |
pteb: PISC_TEB_ARRAY; |
1723 |
– |
TPB: String; |
1837 |
|
i: Integer; |
1838 |
+ |
Attachments: array of IAttachment; |
1839 |
+ |
ValidDatabaseCount: integer; |
1840 |
|
begin |
1841 |
|
CheckNotInTransaction; |
1842 |
|
CheckDatabasesInList; |
1843 |
+ |
if TransactionIntf <> nil then |
1844 |
+ |
begin |
1845 |
+ |
TransactionIntf.Start(DefaultAction); |
1846 |
+ |
Exit; |
1847 |
+ |
end; |
1848 |
+ |
|
1849 |
|
for i := 0 to FDatabases.Count - 1 do |
1850 |
|
if FDatabases[i] <> nil then |
1851 |
|
begin |
1852 |
|
with TIBDatabase(FDatabases[i]) do |
1853 |
|
if not Connected then |
1854 |
< |
if FStreamedConnected then |
1854 |
> |
if StreamedConnected then |
1855 |
|
begin |
1856 |
|
Open; |
1857 |
< |
FStreamedConnected := False; |
1857 |
> |
StreamedConnected := False; |
1858 |
|
end |
1859 |
|
else |
1860 |
|
IBError(ibxeDatabaseClosed, [nil]); |
1862 |
|
if FTRParamsChanged then |
1863 |
|
begin |
1864 |
|
FTRParamsChanged := False; |
1865 |
< |
GenerateTPB(FTRParams, TPB, FTPBLength); |
1745 |
< |
if FTPBLength > 0 then |
1746 |
< |
begin |
1747 |
< |
IBAlloc(FTPB, 0, FTPBLength); |
1748 |
< |
Move(TPB[1], FTPB[0], FTPBLength); |
1749 |
< |
end; |
1865 |
> |
FTPB := GenerateTPB(FTRParams); |
1866 |
|
end; |
1867 |
|
|
1868 |
< |
pteb := nil; |
1869 |
< |
IBAlloc(pteb, 0, DatabaseCount * SizeOf(TISC_TEB)); |
1870 |
< |
try |
1871 |
< |
for i := 0 to DatabaseCount - 1 do if Databases[i] <> nil then |
1872 |
< |
begin |
1873 |
< |
pteb^[i].db_handle := @(Databases[i].Handle); |
1874 |
< |
pteb^[i].tpb_length := FTPBLength; |
1875 |
< |
pteb^[i].tpb_address := FTPB; |
1876 |
< |
end; |
1877 |
< |
if Call(isc_start_multiple(StatusVector, @FHandle, |
1878 |
< |
DatabaseCount, PISC_TEB(pteb)), False) > 0 then |
1879 |
< |
begin |
1880 |
< |
FHandle := nil; |
1881 |
< |
IBDataBaseError; |
1766 |
< |
end; |
1767 |
< |
if not (csDesigning in ComponentState) then |
1768 |
< |
MonitorHook.TRStart(Self); |
1769 |
< |
finally |
1770 |
< |
FreeMem(pteb); |
1868 |
> |
ValidDatabaseCount := 0; |
1869 |
> |
for i := 0 to DatabaseCount - 1 do |
1870 |
> |
if Databases[i] <> nil then Inc(ValidDatabaseCount); |
1871 |
> |
|
1872 |
> |
if ValidDatabaseCount = 1 then |
1873 |
> |
FTransactionIntf := Databases[0].Attachment.StartTransaction(FTPB,DefaultAction) |
1874 |
> |
else |
1875 |
> |
begin |
1876 |
> |
SetLength(Attachments,ValidDatabaseCount); |
1877 |
> |
for i := 0 to DatabaseCount - 1 do |
1878 |
> |
if Databases[i] <> nil then |
1879 |
> |
Attachments[i] := Databases[i].Attachment; |
1880 |
> |
|
1881 |
> |
FTransactionIntf := FirebirdAPI.StartTransaction(Attachments,FTPB,DefaultAction); |
1882 |
|
end; |
1883 |
+ |
|
1884 |
+ |
if not (csDesigning in ComponentState) then |
1885 |
+ |
MonitorHook.TRStart(Self); |
1886 |
+ |
DoOnStartTransaction; |
1887 |
|
end; |
1888 |
|
|
1889 |
|
procedure TIBTransaction.TimeoutTransaction(Sender: TObject); |
1890 |
|
begin |
1891 |
|
if InTransaction then |
1892 |
|
begin |
1893 |
< |
if FCanTimeout then |
1893 |
> |
if not TransactionIntf.HasActivity then |
1894 |
|
begin |
1895 |
|
EndTransaction(FDefaultAction, True); |
1896 |
|
if Assigned(FOnIdleTimer) then |
1897 |
|
FOnIdleTimer(Self); |
1898 |
|
end |
1784 |
– |
else |
1785 |
– |
FCanTimeout := True; |
1899 |
|
end; |
1900 |
|
end; |
1901 |
|
|
1908 |
|
begin |
1909 |
|
EnsureNotInTransaction; |
1910 |
|
CheckNotInTransaction; |
1911 |
+ |
FTransactionIntf := nil; |
1912 |
|
end; |
1913 |
|
|
1914 |
|
{ TIBBase } |
1924 |
|
inherited Destroy; |
1925 |
|
end; |
1926 |
|
|
1927 |
+ |
procedure TIBBase.HandleException(Sender: TObject); |
1928 |
+ |
begin |
1929 |
+ |
if assigned(Database) then |
1930 |
+ |
Database.HandleException(Sender) |
1931 |
+ |
else |
1932 |
+ |
SysUtils.ShowException(ExceptObject,ExceptAddr); |
1933 |
+ |
end; |
1934 |
+ |
|
1935 |
+ |
procedure TIBBase.SetCursor; |
1936 |
+ |
begin |
1937 |
+ |
if Assigned(Database) and not Database.SQLHourGlass then |
1938 |
+ |
Exit; |
1939 |
+ |
if assigned(IBGUIInterface) then |
1940 |
+ |
IBGUIInterface.SetCursor; |
1941 |
+ |
end; |
1942 |
+ |
|
1943 |
+ |
procedure TIBBase.RestoreCursor; |
1944 |
+ |
begin |
1945 |
+ |
if Assigned(Database) and not Database.SQLHourGlass then |
1946 |
+ |
Exit; |
1947 |
+ |
if assigned(IBGUIInterface) then |
1948 |
+ |
IBGUIInterface.RestoreCursor; |
1949 |
+ |
end; |
1950 |
+ |
|
1951 |
|
procedure TIBBase.CheckDatabase; |
1952 |
|
begin |
1953 |
|
if (FDatabase = nil) then |
1962 |
|
FTransaction.CheckInTransaction; |
1963 |
|
end; |
1964 |
|
|
1965 |
< |
function TIBBase.GetDBHandle: PISC_DB_HANDLE; |
1966 |
< |
begin |
1829 |
< |
CheckDatabase; |
1830 |
< |
result := @FDatabase.Handle; |
1831 |
< |
end; |
1832 |
< |
|
1833 |
< |
function TIBBase.GetTRHandle: PISC_TR_HANDLE; |
1965 |
> |
procedure TIBBase.DoBeforeDatabaseConnect(DBParams: TStrings; var DBName: string |
1966 |
> |
); |
1967 |
|
begin |
1968 |
< |
CheckTransaction; |
1969 |
< |
result := @FTransaction.Handle; |
1968 |
> |
if assigned(FBeforeDatabaseConnect) then |
1969 |
> |
BeforeDatabaseConnect(self,DBParams,DBName); |
1970 |
|
end; |
1971 |
|
|
1972 |
|
procedure TIBBase.DoAfterDatabaseConnect; |
1995 |
|
SetTransaction(nil); |
1996 |
|
end; |
1997 |
|
|
1998 |
< |
procedure TIBBase.DoBeforeTransactionEnd; |
1998 |
> |
procedure TIBBase.DoBeforeTransactionEnd(Action: TTransactionAction); |
1999 |
|
begin |
2000 |
|
if Assigned(BeforeTransactionEnd) then |
2001 |
< |
BeforeTransactionEnd(Self); |
2001 |
> |
BeforeTransactionEnd(Self,Action); |
2002 |
|
end; |
2003 |
|
|
2004 |
|
procedure TIBBase.DoAfterTransactionEnd; |
2014 |
|
FTransaction := nil; |
2015 |
|
end; |
2016 |
|
|
2017 |
+ |
procedure TIBBase.DoAfterExecQuery(Sender: TObject); |
2018 |
+ |
begin |
2019 |
+ |
if FTransaction <> nil then |
2020 |
+ |
FTransaction.DoAfterExecQuery(Sender); |
2021 |
+ |
end; |
2022 |
+ |
|
2023 |
+ |
procedure TIBBase.DoAfterEdit(Sender: TObject); |
2024 |
+ |
begin |
2025 |
+ |
if FTransaction <> nil then |
2026 |
+ |
FTransaction.DoAfterEdit(Sender); |
2027 |
+ |
end; |
2028 |
+ |
|
2029 |
+ |
procedure TIBBase.DoAfterDelete(Sender: TObject); |
2030 |
+ |
begin |
2031 |
+ |
if FTransaction <> nil then |
2032 |
+ |
FTransaction.DoAfterDelete(Sender); |
2033 |
+ |
end; |
2034 |
+ |
|
2035 |
+ |
procedure TIBBase.DoAfterInsert(Sender: TObject); |
2036 |
+ |
begin |
2037 |
+ |
if FTransaction <> nil then |
2038 |
+ |
FTransaction.DoAfterInsert(Sender); |
2039 |
+ |
end; |
2040 |
+ |
|
2041 |
+ |
procedure TIBBase.DoAfterPost(Sender: TObject); |
2042 |
+ |
begin |
2043 |
+ |
if FTransaction <> nil then |
2044 |
+ |
FTransaction.DoAfterPost(Sender); |
2045 |
+ |
end; |
2046 |
+ |
|
2047 |
|
procedure TIBBase.SetDatabase(Value: TIBDatabase); |
2048 |
|
begin |
2049 |
|
if (FDatabase <> nil) then |
2076 |
|
parameter buffer, and return it and its length |
2077 |
|
in DPB and DPBLength, respectively. } |
2078 |
|
|
2079 |
< |
procedure GenerateDPB(sl: TStrings; var DPB: string; var DPBLength: Short); |
2079 |
> |
function GenerateDPB(sl: TStrings): IDPB; |
2080 |
|
var |
2081 |
< |
i, j, pval: Integer; |
2081 |
> |
i, j: Integer; |
2082 |
|
DPBVal: UShort; |
2083 |
|
ParamName, ParamValue: string; |
2084 |
|
begin |
2085 |
< |
{ The DPB is initially empty, with the exception that |
1923 |
< |
the DPB version must be the first byte of the string. } |
1924 |
< |
DPBLength := 1; |
1925 |
< |
DPB := Char(isc_dpb_version1); |
2085 |
> |
Result := FirebirdAPI.AllocateDPB; |
2086 |
|
|
2087 |
|
{Iterate through the textual database parameters, constructing |
2088 |
|
a DPB on-the-fly } |
2121 |
|
begin |
2122 |
|
if DPBVal = isc_dpb_sql_dialect then |
2123 |
|
ParamValue[1] := Char(Ord(ParamValue[1]) - 48); |
2124 |
< |
DPB := DPB + |
1965 |
< |
Char(DPBVal) + |
1966 |
< |
Char(Length(ParamValue)) + |
1967 |
< |
ParamValue; |
1968 |
< |
Inc(DPBLength, 2 + Length(ParamValue)); |
2124 |
> |
Result.Add(DPBVal).SetAsString(ParamValue); |
2125 |
|
end; |
2126 |
+ |
|
2127 |
|
isc_dpb_num_buffers, isc_dpb_dbkey_scope, isc_dpb_force_write, |
2128 |
|
isc_dpb_no_reserve, isc_dpb_damaged, isc_dpb_verify: |
2129 |
< |
begin |
2130 |
< |
DPB := DPB + |
1974 |
< |
Char(DPBVal) + |
1975 |
< |
#1 + |
1976 |
< |
Char(StrToInt(ParamValue)); |
1977 |
< |
Inc(DPBLength, 3); |
1978 |
< |
end; |
2129 |
> |
Result.Add(DPBVal).SetAsByte(byte(ParamValue[1])); |
2130 |
> |
|
2131 |
|
isc_dpb_sweep: |
2132 |
< |
begin |
2133 |
< |
DPB := DPB + |
1982 |
< |
Char(DPBVal) + |
1983 |
< |
#1 + |
1984 |
< |
Char(isc_dpb_records); |
1985 |
< |
Inc(DPBLength, 3); |
1986 |
< |
end; |
2132 |
> |
Result.Add(DPBVal).SetAsByte(isc_dpb_records); |
2133 |
> |
|
2134 |
|
isc_dpb_sweep_interval: |
2135 |
< |
begin |
2136 |
< |
pval := StrToInt(ParamValue); |
1990 |
< |
DPB := DPB + |
1991 |
< |
Char(DPBVal) + |
1992 |
< |
#4 + |
1993 |
< |
PChar(@pval)[0] + |
1994 |
< |
PChar(@pval)[1] + |
1995 |
< |
PChar(@pval)[2] + |
1996 |
< |
PChar(@pval)[3]; |
1997 |
< |
Inc(DPBLength, 6); |
1998 |
< |
end; |
2135 |
> |
Result.Add(DPBVal).SetAsInteger(StrToInt(ParamValue)); |
2136 |
> |
|
2137 |
|
isc_dpb_activate_shadow, isc_dpb_delete_shadow, isc_dpb_begin_log, |
2138 |
|
isc_dpb_quit_log: |
2139 |
< |
begin |
2002 |
< |
DPB := DPB + |
2003 |
< |
Char(DPBVal) + |
2004 |
< |
#1 + #0; |
2005 |
< |
Inc(DPBLength, 3); |
2006 |
< |
end; |
2139 |
> |
Result.Add(DPBVal).SetAsByte(0); |
2140 |
|
else |
2141 |
|
begin |
2142 |
|
if (DPBVal > 0) and |
2154 |
|
of the transaction parameters, generate a transaction |
2155 |
|
parameter buffer, and return it and its length in |
2156 |
|
TPB and TPBLength, respectively. } |
2157 |
< |
procedure GenerateTPB(sl: TStrings; var TPB: string; var TPBLength: Short); |
2157 |
> |
function GenerateTPB(sl: TStrings): ITPB; |
2158 |
|
var |
2159 |
< |
i, j, TPBVal, ParamLength: Integer; |
2159 |
> |
i, j, TPBVal: Integer; |
2160 |
|
ParamName, ParamValue: string; |
2161 |
|
begin |
2162 |
< |
TPB := ''; |
2030 |
< |
if (sl.Count = 0) then |
2031 |
< |
TPBLength := 0 |
2032 |
< |
else |
2033 |
< |
begin |
2034 |
< |
TPBLength := sl.Count + 1; |
2035 |
< |
TPB := TPB + Char(isc_tpb_version3); |
2036 |
< |
end; |
2162 |
> |
Result := FirebirdAPI.AllocateTPB; |
2163 |
|
for i := 0 to sl.Count - 1 do |
2164 |
|
begin |
2165 |
|
if (Trim(sl[i]) = '') then |
2040 |
– |
begin |
2041 |
– |
Dec(TPBLength); |
2166 |
|
Continue; |
2167 |
< |
end; |
2167 |
> |
|
2168 |
|
if (Pos('=', sl[i]) = 0) then {mbcs ok} |
2169 |
|
ParamName := LowerCase(sl[i]) {mbcs ok} |
2170 |
|
else |
2188 |
|
isc_tpb_concurrency, isc_tpb_shared, isc_tpb_wait, isc_tpb_nowait, |
2189 |
|
isc_tpb_read, isc_tpb_write, isc_tpb_ignore_limbo, |
2190 |
|
isc_tpb_read_committed, isc_tpb_rec_version, isc_tpb_no_rec_version: |
2191 |
< |
TPB := TPB + Char(TPBVal); |
2191 |
> |
Result.Add(TPBVal); |
2192 |
> |
|
2193 |
|
isc_tpb_lock_read, isc_tpb_lock_write: |
2194 |
< |
begin |
2195 |
< |
TPB := TPB + Char(TPBVal); |
2071 |
< |
{ Now set the string parameter } |
2072 |
< |
ParamLength := Length(ParamValue); |
2073 |
< |
Inc(TPBLength, ParamLength + 1); |
2074 |
< |
TPB := TPB + Char(ParamLength) + ParamValue; |
2075 |
< |
end; |
2194 |
> |
Result.Add(TPBVal).SetAsString(ParamValue); |
2195 |
> |
|
2196 |
|
else |
2197 |
|
begin |
2198 |
|
if (TPBVal > 0) and |