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

Comparing ibx/trunk/runtime/nongui/IBDatabase.pas (file contents):
Revision 263 by tony, Thu Dec 6 15:55:01 2018 UTC vs.
Revision 291 by tony, Fri Apr 17 10:26:08 2020 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;
# Line 219 | Line 220 | type
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 241 | 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 277 | 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;
# Line 302 | Line 313 | type
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 311 | 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 376 | 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 503 | Line 518 | type
518                                            write SetTransaction;
519    end;
520  
506 – function GenerateDPB(FirebirdAPI: IFirebirdAPI; sl: TStrings): IDPB;
507 – function GenerateTPB(FirebirdAPI: IFirebirdAPI; sl: TStrings): ITPB;
508 –
521  
522   implementation
523  
524   uses  IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
525 <     typInfo, FBMessages, IBErrorCodes {$IFDEF WINDOWS}, Windirs {$ENDIF};
525 >     typInfo, IBMessages, IBErrorCodes {$IFDEF WINDOWS}, Windirs {$ENDIF};
526  
527   { TIBDatabase }
528  
# Line 520 | 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 556 | Line 569 | begin
569    RemoveSQLObjects;
570    RemoveTransactions;
571    FInternalTransaction.Free;
572 +  FConfigOverrides.Free;
573    FDBParams.Free;
574    FSQLObjects.Free;
575    FTransactions.Free;
# Line 802 | 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
808 –  CheckActive;
844    { Tell all connected transactions that we're disconnecting.
845      This is so transactions can commit/rollback, accordingly
846    }
# Line 830 | Line 865 | begin
865      end;
866    end;
867  
868 <  case FCloseAction of
834 <  caNormal:
835 <    FAttachment.Disconnect(false);
836 <  caForce:
837 <    FAttachment.Disconnect(true);
838 <  caDropDatabase:
839 <    FAttachment.DropDatabase;
840 <  end;
841 <  FAttachment := nil;
842 <  FHiddenPassword := '';
843 <  FCloseAction := caNormal;
844 <
845 <  if not (csDesigning in ComponentState) then
846 <    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 1043 | Line 1091 | procedure TIBDataBase.DoConnect;
1091  
1092   var
1093    TempDBParams: TStrings;
1046 –  I: integer;
1094    aDBName, oldDBName: string;
1095    Status: IStatus;
1096    CharSetID: integer;
# Line 1081 | Line 1128 | begin
1128     if UseDefaultSystemCodePage then
1129       TempDBParams.Values['lc_ctype'] :='UTF8';
1130     {$endif}
1131 <   {Opportunity to override defaults}
1085 <   for i := 0 to FSQLObjects.Count - 1 do
1086 <   begin
1087 <       if FSQLObjects[i] <> nil then
1088 <         SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName, aCreateIfNotExists);
1089 <   end;
1131 >   InternalBeforeConnect(TempDBParams,aDBName,aCreateIfNotExists);
1132  
1133     repeat
1134       { Generate a new DPB if necessary }
# Line 1108 | 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 1172 | 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
1176 <  begin
1177 <      if FSQLObjects[i] <> nil then
1178 <        SQLObjects[i].DoAfterDatabaseConnect;
1179 <  end;
1218 >  InternalAfterConnect;
1219    if not (csDesigning in ComponentState) then
1220      MonitorHook.DBConnect(Self);
1221   end;
# Line 1362 | 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 1420 | 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;
# Line 2316 | Line 2408 | end;
2408    parameter buffer, and return it and its length
2409    in DPB and DPBLength, respectively. }
2410  
2411 < function GenerateDPB(FirebirdAPI: IFirebirdAPI; sl: TStrings): IDPB;
2411 > function TIBDataBase.GenerateDPB(FirebirdAPI: IFirebirdAPI; sl: TStrings): IDPB;
2412   var
2413    i, j: Integer;
2414    DPBVal: UShort;
# Line 2387 | 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 2394 | 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(FirebirdAPI: IFirebirdAPI; 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