ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBDatabase.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBDatabase.pas (file contents):
Revision 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 13 by tony, Thu Nov 22 22:53:40 2012 UTC

# Line 24 | Line 24
24   {       Corporation. All Rights Reserved.                                }
25   {    Contributor(s): Jeff Overcash                                       }
26   {                                                                        }
27 + {    IBX For Lazarus (Firebird Express)                                  }
28 + {    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
29 + {    Portions created by MWA Software are copyright McCallum Whyman      }
30 + {    Associates Ltd 2011                                                 }
31 + {                                                                        }
32   {************************************************************************}
33  
34   unit IBDatabase;
# Line 33 | Line 38 | unit IBDatabase;
38   interface
39  
40   uses
41 < {$IFDEF LINUX }
37 <  unix,
38 < {$ELSE}
39 < {$DEFINE HAS_SQLMONITOR}
41 > {$IFDEF WINDOWS }
42    Windows,
43 + {$ELSE}
44 +  unix,
45   {$ENDIF}
46    Dialogs, Controls, StdCtrls, SysUtils, Classes, Forms, ExtCtrls, IBHeader, IBExternals, DB,
47    IB, DBLoginDlg;
# Line 151 | Line 155 | type
155    { TIBDatabase }
156    TIBDataBase = class(TCustomConnection)
157    private
158 +    FAllowStreamedConnected: boolean;
159      FHiddenPassword: string;
160      FIBLoaded: Boolean;
161      FOnLogin: TIBDatabaseLoginEvent;
# Line 175 | Line 180 | type
180      FTimer: TTimer;
181      FUserNames: TStringList;
182      FDataSets: TList;
183 +    FLoginCalled: boolean;
184      procedure EnsureInactive;
185      function GetDBSQLDialect: Integer;
186      function GetSQLDialect: Integer;
# Line 205 | Line 211 | type
211      procedure DoConnect; override;
212      procedure DoDisconnect; override;
213      function GetConnected: Boolean; override;
214 <    procedure Loaded; override;
214 >    procedure CheckStreamConnect;
215      procedure Notification( AComponent: TComponent; Operation: TOperation); override;
216      function GetDataset(Index : longint) : TDataset; override;
217      function GetDataSetCount : Longint; override;
218 <
218 >    procedure ReadState(Reader: TReader); override;
219 >    procedure SetConnected (Value : boolean); override;
220    public
221      constructor Create(AOwner: TComponent); override;
222      destructor Destroy; override;
# Line 246 | Line 253 | type
253  
254    published
255      property Connected;
256 <    property StreamedConnected;
256 >    property AllowStreamedConnected: boolean read FAllowStreamedConnected
257 >             write FAllowStreamedConnected;
258      property DatabaseName: TIBFileName read FDBName write SetDatabaseName;
259      property Params: TStrings read FDBParams write SetDBParams;
260      property LoginPrompt default True;
# Line 286 | Line 294 | type
294      FDefaultAction      : TTransactionAction;
295      FTRParams           : TStrings;
296      FTRParamsChanged    : Boolean;
297 +    FInEndTransaction   : boolean;
298      procedure EnsureNotInTransaction;
299      procedure EndTransaction(Action: TTransactionAction; Force: Boolean);
300      function GetDatabase(Index: Integer): TIBDatabase;
# Line 364 | Line 373 | type
373      FOwner: TObject;
374      FBeforeDatabaseDisconnect: TNotifyEvent;
375      FAfterDatabaseDisconnect: TNotifyEvent;
376 +    FAfterDatabaseConnect: TNotifyEvent;
377      FOnDatabaseFree: TNotifyEvent;
378      FBeforeTransactionEnd: TNotifyEvent;
379      FAfterTransactionEnd: TNotifyEvent;
380      FOnTransactionFree: TNotifyEvent;
381  
382 +    procedure DoAfterDatabaseConnect; virtual;
383      procedure DoBeforeDatabaseDisconnect; virtual;
384      procedure DoAfterDatabaseDisconnect; virtual;
385      procedure DoDatabaseFree; virtual;
# Line 385 | Line 396 | type
396      procedure CheckDatabase; virtual;
397      procedure CheckTransaction; virtual;
398    public
399 +    property AfterDatabaseConnect: TNotifyEvent read FAfterDatabaseConnect
400 +                                                write FAfterDatabaseConnect;
401      property BeforeDatabaseDisconnect: TNotifyEvent read FBeforeDatabaseDisconnect
402                                                     write FBeforeDatabaseDisconnect;
403      property AfterDatabaseDisconnect: TNotifyEvent read FAfterDatabaseDisconnect
# Line 408 | Line 421 | procedure GenerateTPB(sl: TStrings; var
421  
422   implementation
423  
424 < uses IBIntf,{$IFDEF HAS_SQLMONITOR}IBSQLMonitor,{$ENDIF} IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils, typInfo;
424 > uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
425 >     typInfo;
426  
427   { TIBDatabase }
428  
429   constructor TIBDatabase.Create(AOwner: TComponent);
430 + {$ifdef WINDOWS}
431 + var acp: uint;
432 + {$endif}
433   begin
434    inherited Create(AOwner);
435    FIBLoaded := False;
# Line 423 | Line 440 | begin
440    FTransactions := TList.Create;
441    FDBName := '';
442    FDBParams := TStringList.Create;
443 +  {$ifdef UNIX}
444 +  if csDesigning in ComponentState then
445 +    FDBParams.Add('lc_ctype=UTF-8');
446 +  {$else}
447 +  {$ifdef WINDOWS}
448 +  if csDesigning in ComponentState then
449 +  begin
450 +    acp := GetACP;
451 +    if (acp >= 1250) and (acp <= 1254) then
452 +      FDBParams.Values['lc_ctype'] := Format('WIN%d',[acp]);
453 +  end;
454 +  {$endif}
455 +  {$endif}
456    FDBParamsChanged := True;
457    TStringList(FDBParams).OnChange := DBParamsChange;
458    TStringList(FDBParams).OnChanging := DBParamsChanging;
# Line 439 | Line 469 | begin
469    FSQLDialect := 3;
470    FTraceFlags := [];
471    FDataSets := TList.Create;
472 +  CheckStreamConnect;
473   end;
474  
475   destructor TIBDatabase.Destroy;
# Line 509 | Line 540 | function TIBDatabase.AddSQLObject(ds: TI
540   begin
541    result := 0;
542    if (ds.Owner is TIBCustomDataSet) then
543 <  {$IFDEF LINUX}
513 <      FDataSets.Add(TDataSet(ds.Owner));
514 <  {$ELSE}
515 <      RegisterClient(TDataSet(ds.Owner));
516 <  {$ENDIF}
543 >    FDataSets.Add(ds.Owner);
544    while (result < FSQLObjects.Count) and (FSQLObjects[result] <> nil) do
545      Inc(result);
546    if (result = FSQLObjects.Count) then
# Line 730 | Line 757 | begin
757      FHandleIsShared := False;
758    end;
759  
733 –  {$IFDEF HAS_SQLMONITOR}
760    if not (csDesigning in ComponentState) then
761      MonitorHook.DBDisconnect(Self);
736 –  {$ENDIF}
762  
763    for i := 0 to FSQLObjects.Count - 1 do
764      if FSQLObjects[i] <> nil then
765        SQLObjects[i].DoAfterDatabaseDisconnect;
766   end;
767  
768 < procedure TIBDatabase.Loaded;
768 > procedure TIBDataBase.CheckStreamConnect;
769   var
770    i: integer;
771   begin
772    try
773 <    if StreamedConnected and (not Connected) then
773 >    if not (csDesigning in ComponentState) and StreamedConnected and (not Connected) then
774      begin
750 –      inherited Loaded;
775        for i := 0 to FTransactions.Count - 1 do
776          if  FTransactions[i] <> nil then
777          begin
# Line 812 | Line 836 | var
836    end;
837  
838   begin
839 <  if Assigned(FOnLogin) then
839 >  Result := false;
840 >  if FLoginCalled then Exit;
841 >  FLoginCalled := true;
842 >  try
843 >  if Assigned(FOnLogin) and not (csDesigning in ComponentState) then
844    begin
845      result := True;
846      LoginParams := TStringList.Create;
# Line 858 | Line 886 | begin
886        end;
887      end;
888    end;
889 +  finally
890 +    FLoginCalled := false
891 +  end;
892   end;
893  
894   procedure TIBDatabase.DoConnect;
895   var
896    DPB: String;
897    TempDBParams: TStrings;
898 +  I: integer;
899  
900   begin
901    CheckInactive;
# Line 874 | Line 906 | begin
906      FDBParamsChanged := True;
907    end;
908    { Use builtin login prompt if requested }
909 <  if LoginPrompt and not Login then
909 >  if (LoginPrompt or (csDesigning in ComponentState)) and not Login then
910      IBError(ibxeOperationCancelled, [nil]);
911    { Generate a new DPB if necessary }
912    if (FDBParamsChanged) then
913    begin
914      FDBParamsChanged := False;
915 <    if (not LoginPrompt) or (FHiddenPassword = '') then
915 >    if (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
916        GenerateDPB(FDBParams, DPB, FDPBLength)
917      else
918      begin
# Line 905 | Line 937 | begin
937    end;
938    FDBSQLDialect := GetDBSQLDialect;
939    ValidateClientSQLDialect;
940 <  {$IFDEF HAS_SQLMONITOR}
940 >  for i := 0 to FSQLObjects.Count - 1 do
941 >  begin
942 >      if FSQLObjects[i] <> nil then
943 >        SQLObjects[i].DoAfterDatabaseConnect;
944 >  end;
945    if not (csDesigning in ComponentState) then
946      MonitorHook.DBConnect(Self);
911 –  {$ENDIF}
947   end;
948  
949   procedure TIBDatabase.RemoveSQLObject(Idx: Integer);
# Line 921 | Line 956 | begin
956      FSQLObjects[Idx] := nil;
957      ds.Database := nil;
958      if (ds.owner is TDataSet) then
924 –    {$IFDEF LINUX}
959        FDataSets.Remove(TDataSet(ds.Owner));
926 –    {$ELSE}
927 –      UnregisterClient(TDataSet(ds.Owner));
928 –    {$ENDIF}
960    end;
961   end;
962  
# Line 937 | Line 968 | begin
968    begin
969      RemoveSQLObject(i);
970      if (TIBBase(FSQLObjects[i]).owner is TDataSet) then
940 –    {$IFDEF LINUX}
971        FDataSets.Remove(TDataSet(TIBBase(FSQLObjects[i]).owner));
942 –    {$ELSE}
943 –      UnregisterClient(TDataSet(TIBBase(FSQLObjects[i]).owner));
944 –    {$ENDIF}
972    end;
973   end;
974  
# Line 1107 | Line 1134 | begin
1134    Result := FSQLDialect;
1135   end;
1136  
1137 +
1138   procedure TIBDatabase.SetSQLDialect(const Value: Integer);
1139   begin
1140    if (Value < 1) then IBError(ibxeSQLDialectInvalid, [nil]);
# Line 1184 | Line 1212 | begin
1212    Result := FDataSets.Count;
1213   end;
1214  
1215 + procedure TIBDataBase.ReadState(Reader: TReader);
1216 + begin
1217 +  FDBParams.Clear;
1218 +  inherited ReadState(Reader);
1219 + end;
1220 +
1221 + procedure TIBDataBase.SetConnected(Value: boolean);
1222 + begin
1223 +  if StreamedConnected and not AllowStreamedConnected then
1224 +  begin
1225 +    StreamedConnected := false;
1226 +    Value := false
1227 +  end;
1228 +  inherited SetConnected(Value);
1229 + end;
1230 +
1231   procedure TIBDatabase.GetFieldNames(const TableName: string; List: TStrings);
1232   var
1233    Query: TIBSQL;
# Line 1414 | Line 1458 | var
1458    i: Integer;
1459   begin
1460    CheckInTransaction;
1461 +  if FInEndTransaction then Exit;
1462 +  FInEndTransaction := true;
1463 +  try
1464    case Action of
1465      TARollback, TACommit:
1466      begin
# Line 1452 | Line 1499 | begin
1499      TARollbackRetaining:
1500        Call(isc_rollback_retaining(StatusVector, @FHandle), True);
1501    end;
1455 –  {$IFDEF HAS_SQLMONITOR}
1502    if not (csDesigning in ComponentState) then
1503    begin
1504      case Action of
# Line 1466 | Line 1512 | begin
1512          MonitorHook.TRRollbackRetaining(Self);
1513      end;
1514    end;
1515 <  {$ENDIF}
1515 >  finally
1516 >    FInEndTransaction := false
1517 >  end;
1518   end;
1519  
1520   function TIBTransaction.GetDatabase(Index: Integer): TIBDatabase;
# Line 1740 | Line 1788 | begin
1788        FHandle := nil;
1789        IBDataBaseError;
1790      end;
1743 –  {$IFDEF HAS_SQLMONITOR}
1791      if not (csDesigning in ComponentState) then
1792        MonitorHook.TRStart(Self);
1746 –  {$ENDIF}
1793    finally
1794      FreeMem(pteb);
1795    end;
# Line 1814 | Line 1860 | begin
1860    result := @FTransaction.Handle;
1861   end;
1862  
1863 + procedure TIBBase.DoAfterDatabaseConnect;
1864 + begin
1865 +  if assigned(FAfterDatabaseConnect) then
1866 +    AfterDatabaseConnect(self);
1867 + end;
1868 +
1869   procedure TIBBase.DoBeforeDatabaseDisconnect;
1870   begin
1871    if Assigned(BeforeDatabaseDisconnect) then

Diff Legend

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