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

Comparing ibx/trunk/runtime/nongui/IBDatabase.pas (file contents):
Revision 229 by tony, Tue Apr 10 13:32:36 2018 UTC vs.
Revision 272 by tony, Mon Feb 4 13:34:37 2019 UTC

# Line 185 | Line 185 | type
185    private
186      FCloseAction: TIBDatabaseCloseActions;
187      FAttachment: IAttachment;
188 +    FConfigOverrides: TStrings;
189      FCreateDatabase: boolean;
190      FCreateIfNotExists: boolean;
191      FAllowStreamedConnected: boolean;
192 +    FFirebirdLibraryPathName: TIBFileName;
193      FHiddenPassword: string;
194      FOnCreateDatabase: TNotifyEvent;
195      FOnLogin: TIBDatabaseLoginEvent;
# Line 208 | Line 210 | type
210      FLoginCalled: boolean;
211      FUseDefaultSystemCodePage: boolean;
212      FUseHiddenPassword: boolean;
213 +    FFirebirdAPI: IFirebirdAPI;
214      procedure EnsureInactive;
215      function GetAuthenticationMethod: string;
216      function GetDBSQLDialect: Integer;
217      function GetDefaultCharSetID: integer;
218      function GetDefaultCharSetName: AnsiString;
219      function GetDefaultCodePage: TSystemCodePage;
220 +    function GetFirebirdAPI: IFirebirdAPI;
221      function GetRemoteProtocol: string;
222      function GetSQLObjectsCount: Integer;
223 +    function GetWireCompression: boolean;
224 +    procedure SetAttachment(AValue: IAttachment);
225 +    procedure SetConfigOverrides(AValue: TStrings);
226 +    procedure SetFirebirdLibraryPathName(AValue: TIBFileName);
227      procedure SetSQLDialect(const Value: Integer);
228 +    procedure SetWireCompression(AValue: boolean);
229      procedure ValidateClientSQLDialect;
230      procedure DBParamsChange(Sender: TObject);
231      procedure DBParamsChanging(Sender: TObject);
232 +    function GenerateDPB(FirebirdAPI: IFirebirdAPI; sl: TStrings): IDPB;
233      function GetSQLObject(Index: Integer): TIBBase;
234      function GetSQLObjectCount: Integer;
235      function GetIdleTimer: Integer;
# Line 237 | Line 247 | type
247      procedure RemoveSQLObject(Idx: Integer);
248      procedure RemoveSQLObjects;
249      procedure InternalClose;
250 +    procedure InternalBeforeClose;
251 +    procedure InternalAfterClose;
252 +    procedure InternalBeforeConnect(aDBParams: TStrings; var aDBName: string;
253 +      var aCreateIfNotExists: boolean);
254 +    procedure InternalAfterConnect;
255      procedure DoOnCreateDatabase;
256  
257    protected
# Line 273 | Line 288 | type
288      procedure RemoveTransaction(Idx: Integer);
289      procedure RemoveTransactions;
290  
291 <    property Attachment: IAttachment read FAttachment;
291 >    property Attachment: IAttachment read FAttachment write SetAttachment;
292 >    property FirebirdAPI: IFirebirdAPI read GetFirebirdAPI;
293      property DBSQLDialect : Integer read GetDBSQLDialect;
294      property IsReadOnly: Boolean read GetIsReadOnly;
295      property SQLObjectCount: Integer read GetSQLObjectCount; {ignores nil objects}
# Line 294 | Line 310 | type
310      property AllowStreamedConnected: boolean read FAllowStreamedConnected
311               write FAllowStreamedConnected;
312      property DatabaseName: TIBFileName read FDBName write SetDatabaseName;
313 +    property FirebirdLibraryPathName: TIBFileName read FFirebirdLibraryPathName
314 +                                             write SetFirebirdLibraryPathName;
315      property Params: TStrings read FDBParams write SetDBParams;
316 +    property ConfigOverrides: TStrings read FConfigOverrides write SetConfigOverrides;
317      property LoginPrompt default True;
318      property DefaultTransaction: TIBTransaction read FDefaultTransaction
319                                                   write SetDefaultTransaction;
# Line 304 | Line 323 | type
323      property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
324      property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage
325                                                 write FUseDefaultSystemCodePage;
326 +    property WireCompression: boolean read GetWireCompression write SetWireCompression
327 +             stored false;
328      property AfterConnect;
329      property AfterDisconnect;
330      property BeforeConnect;
# Line 311 | Line 332 | type
332      property OnCreateDatabase: TNotifyEvent read FOnCreateDatabase write FOnCreateDatabase;
333      property OnLogin: TIBDatabaseLoginEvent read FOnLogin write FOnLogin;
334      property OnIdleTimer: TNotifyEvent read FOnIdleTimer write FOnIdleTimer;
335 <    property OnDialectDowngradeWarning: TNotifyEvent read FOnDialectDowngradeWarning write FOnDialectDowngradeWarning;
335 >    property OnDialectDowngradeWarning: TNotifyEvent read FOnDialectDowngradeWarning
336 >                                                     write FOnDialectDowngradeWarning;
337    end;
338  
339    TDefaultEndAction = TARollback..TACommit;
# Line 368 | Line 390 | type
390      function AddSQLObject(ds: TIBBase): Integer;
391      procedure RemoveSQLObject(Idx: Integer);
392      procedure RemoveSQLObjects;
393 +    function GenerateTPB(FirebirdAPI: IFirebirdAPI; sl: TStrings): ITPB;
394  
395    protected
396      procedure Loaded; override;
# Line 495 | Line 518 | type
518                                            write SetTransaction;
519    end;
520  
498 – function GenerateDPB(sl: TStrings): IDPB;
499 – function GenerateTPB(sl: TStrings): ITPB;
500 –
521  
522   implementation
523  
# Line 512 | Line 532 | begin
532    LoginPrompt := True;
533    FSQLObjects := TList.Create;
534    FTransactions := TList.Create;
535 +  FConfigOverrides := TStringList.Create;
536    FDBName := '';
537    FDBParams := TStringList.Create;
538    FSQLHourGlass := true;
# Line 548 | Line 569 | begin
569    RemoveSQLObjects;
570    RemoveTransactions;
571    FInternalTransaction.Free;
572 +  FConfigOverrides.Free;
573    FDBParams.Free;
574    FSQLObjects.Free;
575    FTransactions.Free;
576    FDataSets.Free;
577 +  FFirebirdAPI := nil;
578    inherited Destroy;
579   end;
580  
# Line 793 | Line 816 | begin
816   end;
817  
818   procedure TIBDataBase.InternalClose;
819 + begin
820 +  CheckActive;
821 +  InternalBeforeClose;
822 +  case FCloseAction of
823 +  caNormal:
824 +    FAttachment.Disconnect(false);
825 +  caForce:
826 +    FAttachment.Disconnect(true);
827 +  caDropDatabase:
828 +    FAttachment.DropDatabase;
829 +  end;
830 +  FAttachment := nil;
831 +  FHiddenPassword := '';
832 +  FCloseAction := caNormal;
833 +
834 +  if not (csDesigning in ComponentState) then
835 +    MonitorHook.DBDisconnect(Self);
836 +
837 +  InternalAfterClose;
838 + end;
839 +
840 + procedure TIBDataBase.InternalBeforeClose;
841   var
842    i: Integer;
843   begin
799 –  CheckActive;
844    { Tell all connected transactions that we're disconnecting.
845      This is so transactions can commit/rollback, accordingly
846    }
# Line 821 | Line 865 | begin
865      end;
866    end;
867  
868 <  case FCloseAction of
825 <  caNormal:
826 <    FAttachment.Disconnect(false);
827 <  caForce:
828 <    FAttachment.Disconnect(true);
829 <  caDropDatabase:
830 <    FAttachment.DropDatabase;
831 <  end;
832 <  FAttachment := nil;
833 <  FHiddenPassword := '';
834 <  FCloseAction := caNormal;
835 <
836 <  if not (csDesigning in ComponentState) then
837 <    MonitorHook.DBDisconnect(Self);
868 > end;
869  
870 + procedure TIBDataBase.InternalAfterClose;
871 + var
872 +  i: Integer;
873 + begin
874    for i := 0 to FSQLObjects.Count - 1 do
875      if FSQLObjects[i] <> nil then
876        SQLObjects[i].DoAfterDatabaseDisconnect;
877   end;
878  
879 + procedure TIBDataBase.InternalBeforeConnect(aDBParams: TStrings; var aDBName: string;
880 +                          var aCreateIfNotExists: boolean);
881 + var i: integer;
882 + begin
883 +  {Opportunity to override defaults}
884 +  for i := 0 to FSQLObjects.Count - 1 do
885 +  begin
886 +      if FSQLObjects[i] <> nil then
887 +        SQLObjects[i].DoBeforeDatabaseConnect(aDBParams,aDBName, aCreateIfNotExists);
888 +  end;
889 + end;
890 +
891 + procedure TIBDataBase.InternalAfterConnect;
892 + var i: integer;
893 + begin
894 +  for i := 0 to FSQLObjects.Count - 1 do
895 +  begin
896 +      if FSQLObjects[i] <> nil then
897 +        SQLObjects[i].DoAfterDatabaseConnect;
898 +  end;
899 + end;
900 +
901   procedure TIBDataBase.DoOnCreateDatabase;
902   var i: integer;
903   begin
# Line 1034 | Line 1091 | procedure TIBDataBase.DoConnect;
1091  
1092   var
1093    TempDBParams: TStrings;
1037 –  I: integer;
1094    aDBName, oldDBName: string;
1095    Status: IStatus;
1096    CharSetID: integer;
# Line 1072 | Line 1128 | begin
1128     if UseDefaultSystemCodePage then
1129       TempDBParams.Values['lc_ctype'] :='UTF8';
1130     {$endif}
1131 <   {Opportunity to override defaults}
1076 <   for i := 0 to FSQLObjects.Count - 1 do
1077 <   begin
1078 <       if FSQLObjects[i] <> nil then
1079 <         SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName, aCreateIfNotExists);
1080 <   end;
1131 >   InternalBeforeConnect(TempDBParams,aDBName,aCreateIfNotExists);
1132  
1133     repeat
1134       { Generate a new DPB if necessary }
# Line 1085 | Line 1136 | begin
1136       begin
1137         FDBParamsChanged := False;
1138         if not FUseHiddenPassword and (not LoginPrompt and not (csDesigning in ComponentState)) or (FHiddenPassword = '') then
1139 <         DPB := GenerateDPB(TempDBParams)
1139 >         DPB := GenerateDPB(FirebirdAPI,TempDBParams)
1140         else
1141         begin
1142            TempDBParams.Values['password'] := FHiddenPassword;
1143 <          DPB := GenerateDPB(TempDBParams);
1143 >          DPB := GenerateDPB(FirebirdAPI,TempDBParams);
1144         end;
1145       end;
1146  
# Line 1099 | Line 1150 | begin
1150         DPB.Add(isc_dpb_set_db_SQL_dialect).AsByte := SQLDialect; {create with this SQL Dialect}
1151         FAttachment := FirebirdAPI.CreateDatabase(aDBName,DPB, false);
1152         if FAttachment = nil then
1153 <         DPB := nil;
1154 <       DoOnCreateDatabase;
1153 >         DPB := nil
1154 >       else
1155 >         DoOnCreateDatabase;
1156       end
1157       else
1158         FAttachment := FirebirdAPI.OpenDatabase(aDBName,DPB,false);
# Line 1163 | Line 1215 | begin
1215    if not (csDesigning in ComponentState) then
1216      FDBName := aDBName; {Synchronise at run time}
1217    ValidateClientSQLDialect;
1218 <  for i := 0 to FSQLObjects.Count - 1 do
1167 <  begin
1168 <      if FSQLObjects[i] <> nil then
1169 <        SQLObjects[i].DoAfterDatabaseConnect;
1170 <  end;
1218 >  InternalAfterConnect;
1219    if not (csDesigning in ComponentState) then
1220      MonitorHook.DBConnect(Self);
1221   end;
# Line 1353 | Line 1401 | begin
1401      IBError(ibxeSQLDialectInvalid, [nil]);
1402   end;
1403  
1404 + procedure TIBDataBase.SetWireCompression(AValue: boolean);
1405 + var Index: integer;
1406 + begin
1407 +  if AValue then
1408 +    FConfigOverrides.Values['WireCompression'] := 'true'
1409 +  else
1410 +  begin
1411 +    Index := FConfigOverrides.IndexOfName('WireCompression');
1412 +    if Index <> -1 then
1413 +      FConfigOverrides.Delete(Index);
1414 +  end;
1415 + end;
1416 +
1417   function TIBDataBase.GetDBSQLDialect: Integer;
1418   begin
1419    CheckActive;
# Line 1383 | Line 1444 | begin
1444      Result := CP_NONE;
1445   end;
1446  
1447 + function TIBDataBase.GetFirebirdAPI: IFirebirdAPI;
1448 + var fblib: IFirebirdLibrary;
1449 + begin
1450 +  if FFirebirdAPI = nil then
1451 +  begin
1452 +    if (csDesigning in ComponentState) or (Trim(FFirebirdLibraryPathName) = '') then
1453 +      FFirebirdAPI := IB.FirebirdAPI
1454 +    else
1455 +    begin
1456 +      fblib := IB.LoadFBLibrary(FFirebirdLibraryPathName);
1457 +      if assigned(fblib) then
1458 +        FFirebirdAPI := fblib.GetFirebirdAPI;
1459 +    end;
1460 +  end;
1461 +  Result := FFirebirdAPI;
1462 + end;
1463 +
1464   function TIBDataBase.GetRemoteProtocol: string;
1465   begin
1466    CheckActive;
# Line 1394 | Line 1472 | begin
1472    Result := FSQLObjects.Count;
1473   end;
1474  
1475 + function TIBDataBase.GetWireCompression: boolean;
1476 + begin
1477 +  Result := CompareText(FConfigOverrides.Values['WireCompression'],'true') = 0;
1478 + end;
1479 +
1480 + procedure TIBDataBase.SetAttachment(AValue: IAttachment);
1481 + begin
1482 +  if FAttachment = AValue then Exit;
1483 +  if FAttachment <> nil then
1484 +  begin
1485 +    if Assigned(BeforeDisconnect) then
1486 +      BeforeDisconnect(self);
1487 +    InternalBeforeClose;
1488 +    FAttachment := nil;
1489 +    FFirebirdAPI := nil;
1490 +    InternalAfterClose;
1491 +    if Assigned(AfterDisconnect) then
1492 +      AfterDisconnect(self);
1493 +  end;
1494 +  if Assigned(BeforeConnect) then
1495 +    BeforeConnect(self);
1496 +  FAttachment := AValue;
1497 +  if FAttachment <> nil then
1498 +  begin
1499 +    ValidateClientSQLDialect;
1500 +    FDBName := FAttachment.GetConnectString;
1501 +    if FFirebirdLibraryPathName <> '' then
1502 +      FFirebirdLibraryPathName := FAttachment.getFirebirdAPI.GetFBLibrary.GetLibraryFilePath;
1503 +    InternalAfterConnect;
1504 +    if Assigned(AfterConnect) then
1505 +      AfterConnect(self);
1506 +  end;
1507 + end;
1508 +
1509 + procedure TIBDataBase.SetConfigOverrides(AValue: TStrings);
1510 + begin
1511 +  if FConfigOverrides = AValue then Exit;
1512 +  FConfigOverrides.Assign(AValue);
1513 + end;
1514 +
1515 + procedure TIBDataBase.SetFirebirdLibraryPathName(AValue: TIBFileName);
1516 + begin
1517 +  if FFirebirdLibraryPathName = AValue then Exit;
1518 +  FFirebirdLibraryPathName := AValue;
1519 +  ForceClose;
1520 +  FFirebirdAPI := nil;
1521 + end;
1522 +
1523   procedure TIBDataBase.ValidateClientSQLDialect;
1524   begin
1525    if (DBSQLDialect < FSQLDialect) then
# Line 2061 | Line 2187 | begin
2187      if FTRParamsChanged then
2188      begin
2189        FTRParamsChanged := False;
2190 <      FTPB :=  GenerateTPB(FTRParams);
2190 >      FTPB :=  GenerateTPB(Databases[0].FirebirdAPI,FTRParams);
2191      end;
2192  
2193      ValidDatabaseCount := 0;
# Line 2077 | Line 2203 | begin
2203          if Databases[i] <> nil then
2204            Attachments[i] := Databases[i].Attachment;
2205  
2206 <      FTransactionIntf := FirebirdAPI.StartTransaction(Attachments,FTPB,DefaultAction);
2206 >      FTransactionIntf := Databases[0].FirebirdAPI.StartTransaction(Attachments,FTPB,DefaultAction);
2207      end;
2208    end;
2209  
# Line 2282 | Line 2408 | end;
2408    parameter buffer, and return it and its length
2409    in DPB and DPBLength, respectively. }
2410  
2411 < function GenerateDPB(sl: TStrings): IDPB;
2411 > function TIBDataBase.GenerateDPB(FirebirdAPI: IFirebirdAPI; sl: TStrings): IDPB;
2412   var
2413    i, j: Integer;
2414    DPBVal: UShort;
# Line 2353 | Line 2479 | begin
2479        end;
2480      end;
2481    end;
2482 +  if FConfigOverrides.Count > 0 then
2483 +    Result.Add(isc_dpb_config).SetAsString(FConfigOverrides.Text);
2484   end;
2485  
2486   { GenerateTPB -
# Line 2360 | Line 2488 | end;
2488    of the transaction parameters, generate a transaction
2489    parameter buffer, and return it and its length in
2490    TPB and TPBLength, respectively. }
2491 < function GenerateTPB(sl: TStrings): ITPB;
2491 > function TIBTransaction.GenerateTPB(FirebirdAPI: IFirebirdAPI; sl: TStrings): ITPB;
2492   var
2493    i, j, TPBVal: Integer;
2494    ParamName, ParamValue: string;

Diff Legend

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