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

Comparing ibx/trunk/examples/DBAdmin/DataModule.pas (file contents):
Revision 158 by tony, Thu Mar 1 11:23:33 2018 UTC vs.
Revision 209 by tony, Wed Mar 14 12:48:51 2018 UTC

# Line 23 | Line 23 | interface
23  
24   uses
25    Classes, SysUtils, FileUtil, db, memds, IBDatabase, IBSQL, IBQuery,
26 <  IBCustomDataSet, IBUpdate, IBDatabaseInfo, IBServices, IB, Dialogs, Controls,
27 <  Forms;
26 >  IBCustomDataSet, IBUpdate, IBDatabaseInfo, IBXServices, IB,
27 >  Dialogs, Controls, Forms;
28  
29   type
30  
# Line 74 | Line 74 | type
74      CurrentTransaction: TIBTransaction;
75      DatabaseQuery: TIBQuery;
76      Attachments: TIBQuery;
77    IBOnlineValidationService1: TIBOnlineValidationService;
77      DBTables: TIBQuery;
78      AuthMappings: TIBQuery;
79      AccessRights: TIBQuery;
80 +    IBConfigService1: TIBXConfigService;
81 +    IBServerProperties1: TIBXServerProperties;
82 +    IBLogService1: TIBXLogService;
83 +    IBSecurityService1: TIBXSecurityService;
84 +    IBOnlineValidationService1: TIBXOnlineValidationService;
85 +
86 +      IBLimboTrans: TIBXLimboTransactionResolutionService;
87 +    IBXServicesConnection1: TIBXServicesConnection;
88 +    IBStatisticalService1: TIBXStatisticalService;
89 +    IBValidationService1: TIBXValidationService;
90 +    InLimboList: TIBXServicesLimboTransactionsList;
91 +    LegacyUserList: TIBXServicesUserList;
92      SubjectAccessRights: TIBQuery;
82    IBSecurityService1: TIBSecurityService;
93      AttUpdate: TIBUpdate;
94      AdminUserQuery: TIBSQL;
95      DBTablesUpdate: TIBUpdate;
86    IBValidationService1: TIBValidationService;
87    InLimboList: TMemDataset;
88    LegacyUserList: TMemDataset;
96      UserListGROUPID: TLongintField;
97 +    UserListSECPASSWORD: TIBStringField;
98 +    UserListSECUSER_NAME: TIBStringField;
99      UserListSource: TDataSource;
100      DBCharSet: TIBQuery;
101      DBSecFiles: TIBQuery;
102      ExecDDL: TIBSQL;
94    IBConfigService1: TIBConfigService;
103      IBDatabase1: TIBDatabase;
104      IBDatabaseInfo: TIBDatabaseInfo;
105      AttmtQuery: TIBQuery;
98    IBLogService1: TIBLogService;
99    IBServerProperties1: TIBServerProperties;
100    IBStatisticalService1: TIBStatisticalService;
106      RoleNameList: TIBQuery;
107      TableNameLookup: TIBQuery;
108      TagsUpdate: TIBUpdate;
# Line 124 | Line 129 | type
129      UserListSECMIDDLE_NAME: TIBStringField;
130      UserListSECPLUGIN: TIBStringField;
131      UserListUSERID: TLongintField;
127    UserListUSERNAME: TIBStringField;
128    UserListUSERPASSWORD: TIBStringField;
132      UserTags: TIBQuery;
133      procedure AccessRightsCalcFields(DataSet: TDataSet);
134      procedure ApplicationProperties1Exception(Sender: TObject; E: Exception);
# Line 145 | Line 148 | type
148        Params: ISQLParams);
149      procedure DBTablesUpdateApplyUpdates(Sender: TObject; UpdateKind: TUpdateKind;
150        Params: ISQLParams);
151 <    procedure InLimboListAfterOpen(DataSet: TDataSet);
152 <    procedure InLimboListBeforeClose(DataSet: TDataSet);
153 <    procedure InLimboListBeforePost(DataSet: TDataSet);
151 >    procedure IBValidationService1GetNextLine(Sender: TObject; var Line: string
152 >      );
153 >    procedure IBXServicesConnection1Login(Service: TIBXServicesConnection;
154 >      var aServerName: string; LoginParams: TStrings);
155      procedure LegacyUserListAfterOpen(DataSet: TDataSet);
156      procedure LegacyUserListBeforeClose(DataSet: TDataSet);
153    procedure LegacyUserListBeforeDelete(DataSet: TDataSet);
154    procedure LegacyUserListBeforePost(DataSet: TDataSet);
157      procedure ShadowFilesCalcFields(DataSet: TDataSet);
158      procedure SubjectAccessRightsBeforeOpen(DataSet: TDataSet);
159      procedure TagsUpdateApplyUpdates(Sender: TObject; UpdateKind: TUpdateKind;
# Line 177 | Line 179 | type
179      FDBUserName: string;
180      FDBPassword: string;
181      FLocalConnect: boolean;
180    FUsersLoading: boolean;
181    FLoadingLimboTr: boolean;
182      FSubjectAccessRightsID: string;
183      {Parsed results of connectstring;}
184      FServerName: string;
185      FPortNo: string;
186      FProtocol: TProtocolAll;
187      FDatabasePathName: string;
188 <    procedure ActivateService(aService: TIBCustomService);
188 >    procedure ConnectServicesAPI;
189      function GetAuthMethod: string;
190      function GetAutoAdmin: boolean;
191      function GetDatabaseName: string;
# Line 220 | Line 220 | type
220      procedure BackupDatabase;
221      procedure RestoreDatabase;
222      procedure BringDatabaseOnline;
223 <    procedure ShutDown(aShutDownmode: TShutdownMode; aDelay: integer);
223 >    procedure ShutDown(aShutDownmode: TDBShutdownMode; aDelay: integer);
224      procedure DatabaseRepair(Options: TValidateOptions; ReportLines: TStrings);
225      procedure OnlineValidation(ReportLines: TStrings; SelectedTablesOnly: boolean);
226      procedure LimboResolution(ActionID: TTransactionGlobalAction; Report: TStrings);
# Line 295 | Line 295 | procedure TDatabaseData.UpdateUserRolesA
295  
296    procedure Grant(Params: ISQLParams);
297    begin
298 <    ExecDDL.SQL.Text := 'Grant ' + trim(Params.ByName('RDB$ROLE_NAME').AsString) + ' to ' + Params.ByName('USERNAME').AsString;
298 >    ExecDDL.SQL.Text := 'Grant ' + trim(Params.ByName('RDB$ROLE_NAME').AsString) + ' to ' + Params.ByName('SEC$USER_NAME').AsString;
299      ExecDDL.ExecQuery;
300    end;
301  
302    procedure Revoke(Params: ISQLParams);
303    begin
304 <    ExecDDL.SQL.Text := 'Revoke ' + trim(Params.ByName('RDB$ROLE_NAME').AsString) + ' from ' + Params.ByName('USERNAME').AsString;
304 >    ExecDDL.SQL.Text := 'Revoke ' + trim(Params.ByName('RDB$ROLE_NAME').AsString) + ' from ' + Params.ByName('SEC$USER_NAME').AsString;
305      ExecDDL.ExecQuery;
306    end;
307  
# Line 318 | Line 318 | end;
318   procedure TDatabaseData.UpdateUsersApplyUpdates(Sender: TObject;
319    UpdateKind: TUpdateKind; Params: ISQLParams);
320  
321 + var UserName: string;
322 +
323    function FormatStmtOptions: string;
324    var Param: ISQLParam;
325    begin
326 <    Result := Trim(Params.ByName('UserName').AsString);
327 <    Param := Params.ByName('USERPASSWORD');
326 >    Result := UserName;
327 >    Param := Params.ByName('SEC$PASSWORD');
328      if (Param <> nil) and not Param.IsNull  then
329        Result += ' PASSWORD ''' + SQLSafeString(Param.AsString) + '''';
330      Param := Params.ByName('SEC$FIRST_NAME');
# Line 351 | Line 353 | procedure TDatabaseData.UpdateUsersApply
353    var Param: ISQLParam;
354    begin
355      Result := '';
356 <    Param := Params.ByName('USERPASSWORD');
356 >    Param := Params.ByName('SEC$PASSWORD');
357      if (UpdateKind = ukModify) and not Param.IsNull then
358      begin
359 <      Result := 'ALTER USER ' + Trim(Params.ByName('UserName').AsString) +
359 >      Result := 'ALTER USER ' + UserName +
360            ' PASSWORD ''' + SQLSafeString(Param.AsString) + '''';
361        Param := Params.ByName('SEC$PLUGIN');
362       if Param <> nil then
# Line 363 | Line 365 | procedure TDatabaseData.UpdateUsersApply
365    end;
366  
367   begin
368 <    {non SYSDBA user not an RDB$ADMIN can only change their password}
369 <    if (DBUserName <> 'SYSDBA') and (RoleName <> 'RDB$ADMIN') then
370 <    begin
371 <     ExecDDL.SQL.Text := GetAlterPasswordStmt;
372 <     if ExecDDL.SQL.Text <> '' then
373 <       ExecDDL.ExecQuery;
374 <     Exit;
375 <    end;
368 >  UserName := Trim(Params.ByName('SEC$USER_NAME').AsString);
369 >  {non SYSDBA user not an RDB$ADMIN can only change their password}
370 >  if (DBUserName <> 'SYSDBA') and (RoleName <> 'RDB$ADMIN') then
371 >  begin
372 >   ExecDDL.SQL.Text := GetAlterPasswordStmt;
373 >   if ExecDDL.SQL.Text <> '' then
374 >     ExecDDL.ExecQuery;
375 >   Exit;
376 >  end;
377  
378 <    case UpdateKind of
379 <    ukInsert:
380 <        ExecDDL.SQL.Text := 'CREATE USER ' + FormatStmtOptions;
381 <    ukModify:
382 <        ExecDDL.SQL.Text := 'ALTER USER ' + FormatStmtOptions;
383 <    ukDelete:
384 <      ExecDDL.SQL.Text := 'DROP USER ' + Trim(Params.ByName('UserName').AsString);
385 <    end;
386 <    ExecDDL.ExecQuery;
378 >  case UpdateKind of
379 >  ukInsert:
380 >      ExecDDL.SQL.Text := 'CREATE USER ' + FormatStmtOptions;
381 >  ukModify:
382 >      ExecDDL.SQL.Text := 'ALTER USER ' + FormatStmtOptions;
383 >  ukDelete:
384 >    ExecDDL.SQL.Text := 'DROP USER ' + UserName;
385 >  end;
386 >  ExecDDL.ExecQuery;
387  
388    if UpdateKind = ukInsert then
389    begin
390      {if new user is also given the admin role then we need to add this}
391      if Params.ByName('SEC$ADMIN').AsBoolean then
392      begin
393 <      ExecDDL.SQL.Text := 'ALTER USER ' + Trim(Params.ByName('UserName').AsString) + ' GRANT ADMIN ROLE';
393 >      ExecDDL.SQL.Text := 'ALTER USER ' + UserName + ' GRANT ADMIN ROLE';
394        ExecDDL.ExecQuery;
395      end;
396    end
# Line 397 | Line 400 | begin
400    begin
401      if Params.ByName('SEC$ADMIN').AsBoolean and not Params.ByName('OLD_SEC$ADMIN').AsBoolean then
402      begin
403 <      ExecDDL.SQL.Text := 'ALTER USER ' + Trim(Params.ByName('UserName').AsString) + ' GRANT ADMIN ROLE';
403 >      ExecDDL.SQL.Text := 'ALTER USER ' + UserName + ' GRANT ADMIN ROLE';
404        ExecDDL.ExecQuery;
405      end
406      else
407      if not Params.ByName('SEC$ADMIN').AsBoolean and Params.ByName('OLD_SEC$ADMIN').AsBoolean then
408      begin
409 <      ExecDDL.SQL.Text := 'ALTER USER ' + Trim(Params.ByName('UserName').AsString) + ' REVOKE ADMIN ROLE';
409 >      ExecDDL.SQL.Text := 'ALTER USER ' + UserName + ' REVOKE ADMIN ROLE';
410        ExecDDL.ExecQuery;
411      end
412    end;
# Line 411 | Line 414 | begin
414    {Update DB Creator Role}
415    if Params.ByName('DBCreator').AsBoolean and not Params.ByName('OLD_DBCreator').AsBoolean then
416    begin
417 <    ExecDDL.SQL.Text := 'GRANT CREATE DATABASE TO USER ' + Trim(Params.ByName('UserName').AsString);
417 >    ExecDDL.SQL.Text := 'GRANT CREATE DATABASE TO USER ' + UserName;
418      ExecDDL.ExecQuery;
419    end
420    else
421    if not Params.ByName('DBCreator').AsBoolean and Params.ByName('OLD_DBCreator').AsBoolean then
422    begin
423 <    ExecDDL.SQL.Text := 'REVOKE CREATE DATABASE FROM USER ' + Trim(Params.ByName('UserName').AsString);
423 >    ExecDDL.SQL.Text := 'REVOKE CREATE DATABASE FROM USER ' + UserName;
424      ExecDDL.ExecQuery;
425    end
426   end;
# Line 430 | Line 433 | begin
433    DataSet.FieldByName('SEC$PLUGIN').AsString := 'Srp';
434    DataSet.FieldByName('UserID').AsInteger := 0;
435    DataSet.FieldByName('GroupID').AsInteger := 0;
436 <  DataSet.FieldByName('UserPassword').Clear;
436 >  DataSet.FieldByName('SEC$PASSWORD').Clear;
437    RoleNameList.Active := false; {Prevent role assignments until saved}
438    UserTags.Active := false; {ditto}
439   end;
# Line 460 | Line 463 | end;
463  
464   procedure TDatabaseData.UserTagsAfterInsert(DataSet: TDataSet);
465   begin
466 <  DataSet.FieldByName('SEC$USER_NAME').AsString := DataSet.DataSource.DataSet.FieldByName('UserName').AsString;
466 >  DataSet.FieldByName('SEC$USER_NAME').AsString := DataSet.DataSource.DataSet.FieldByName('SEC$USER_NAME').AsString;
467 > end;
468 >
469 > procedure TDatabaseData.ConnectServicesAPI;
470 > begin
471 >  if IBXServicesConnection1.Connected then Exit;
472 >  try
473 >    IBXServicesConnection1.ConnectUsing(IBDatabase1);
474 >  except on E: Exception do
475 >    begin
476 >      Application.ShowException(E);
477 >      IBDatabase1.Connected := false;
478 >      FDBPassword := '';
479 >      Exit;
480 >    end;
481 >  end;
482   end;
483  
484   procedure TDatabaseData.GetDBFlags;
485 < var Line: string;
485 > var Lines: TStringList;
486 >    i: integer;
487 >    line: string;
488   begin
489    if FDBHeaderScanned or not DatabaseQuery.Active or not AttmtQuery.Active then Exit;
490    FIsShadowDatabase := false;
491  
492    try
473    ActivateService(IBStatisticalService1);
474
493      with IBStatisticalService1 do
494      begin
477      try
495          Options := [HeaderPages];
496 <        ServiceStart;
497 <        while not Eof do
498 <        begin
499 <           Line := GetNextLine;
500 <           if (Pos('Attributes',Line) <> 0) and (Pos('shadow',Line) <> 0) then
501 <             FIsShadowDatabase := true;
502 <
503 <        end
504 <      finally
505 <        Active := False;
506 <      end
496 >        Lines := TStringList.Create;
497 >        try
498 >          Execute(Lines);
499 >          for i := 0 to Lines.Count - 1 do
500 >          begin
501 >            line := Lines[i];
502 >             if (Pos('Attributes',Line) <> 0) and (Pos('shadow',Line) <> 0) then
503 >             begin
504 >               FIsShadowDatabase := true;
505 >               break;
506 >             end;
507 >          end;
508 >        finally
509 >          Lines.Free;
510 >        end;
511 >        FDBHeaderScanned := true;
512      end;
513    except on E: Exception do
514      MessageDlg('Error getting DB Header Page: ' + E.Message,mtError,[mbOK],0);
# Line 556 | Line 578 | begin
578    begin
579      if MessageDlg('Turn off Linger Permanently?',mtConfirmation,[mbYes,mbNo],0) = mrNo then
580      begin
559      ActivateService(IBConfigService1);
581        IBConfigService1.SetNoLinger;
582        CurrentTransaction.Commit; {Refresh}
583        Exit;
# Line 573 | Line 594 | begin
594    end;
595   end;
596  
576 procedure TDatabaseData.ActivateService(aService: TIBCustomService);
577
578  procedure AssignDatabase(IBService: TIBCustomService; DBName: string);
579  begin
580    if IBService is TIBValidationService then
581      TIBValidationService(IBService).DatabaseName := DBName
582    else
583    if IBService is TIBOnlineValidationService then
584        TIBOnlineValidationService(IBService).DatabaseName := DBName
585    else
586    if IBService is TIBStatisticalService then
587      TIBStatisticalService(IBService).DatabaseName := DBName
588    else
589    if IBService is TIBConfigService then
590      TIBConfigService(IBService).DatabaseName := DBName
591    else
592    if IBService is TIBBackupService then
593      TIBBackupService(IBService).DatabaseName := DBName
594    else
595    if IBService is TIBRestoreService then
596    begin
597      TIBRestoreService(IBService).DatabaseName.Clear;
598      TIBRestoreService(IBService).DatabaseName.Add(DBName);
599    end;
600  end;
601
602  procedure SetupParams(IBService: TIBCustomService; UseDefaultSecDatabase: boolean; DBName: string);
603  var index: integer;
604  begin
605    with IBService do
606    begin
607      Active := false;
608      {Use database login user name and password}
609      Params.Values['user_name'] := FDBUserName;
610      Params.Values['password'] := FDBPassword;
611      Params.Values['sql_role_name'] := 'RDB$ADMIN';
612
613      if FProtocol <> unknownProtocol then
614        Protocol := FProtocol
615      else
616        Protocol := Local;
617      PortNo := FPortNo;
618      if Protocol = Local then
619      begin
620        {If Local we must specify the server as the Localhost}
621        ServerName := 'Localhost';
622        if AttmtQuery.Active then
623        begin
624          if not AttmtQuery.FieldByName('MON$REMOTE_PROTOCOL').IsNull then
625            Protocol := TCP; {Use loopback if database does not use embedded server}
626        end
627        else {Special case - database not open}
628        if not FileExists(DBName) or FileIsReadOnly(DBName) then
629          Protocol := TCP; {Use loopback if database does not use embedded server}
630      end
631      else
632        ServerName := FServername;
633    end;
634    AssignDatabase(IBService,DBName);
635
636    {Are we using a different security database?}
637
638    if not UseDefaultSecDatabase then
639      IBService.Params.Values['expected_db'] := DBName
640    else
641    begin
642      index := IBService.Params.IndexOfName('expected_db');
643      if index <> -1 then IBService.Params.Delete(index);
644    end;
645  end;
646
647 var SecPlugin: TField;
648    UsingDefaultSecDatabase: boolean;
649 begin
650  {Are we using a different security database?}
651
652  SecPlugin := DatabaseQuery.FindField('MON$SEC_DATABASE');
653  UsingDefaultSecDatabase := (SecPlugin = nil) or (Trim(SecPlugin.AsString) = 'Default');
654
655  {The server properties service is the base service holding the service interface}
656  if not IBServerProperties1.Active then
657  begin
658    SetupParams(IBServerProperties1,UsingDefaultSecDatabase,
659                   {note that on a local server, the following always gives us the actual path}
660                   GetDatabaseName);
661    with IBServerProperties1 do
662    begin
663      LoginPrompt := (Protocol <> Local) and (FDBPassword = '');  {Does this ever occur?}
664      repeat
665        try
666          Active := true;
667          LoginPrompt := false;
668        except
669          on E:EIBClientError do {Typically Login cancelled}
670            begin
671              MessageDlg(E.Message,mtError,[mbOK],0);
672              Exit;
673            end;
674          on E:Exception do
675            begin
676              MessageDlg(E.Message,mtError,[mbOK],0);
677              LoginPrompt := true;
678            end;
679          end;
680      until Active;
681    end;
682  end;
683
684  if aService = IBServerProperties1 then
685    Exit;
686
687  aService.Assign(IBServerProperties1);
688  AssignDatabase(aService,FDatabasePathName);
689 end;
597  
598   function TDatabaseData.GetAuthMethod: string;
599   var AuthMeth: TField;
# Line 700 | Line 607 | end;
607  
608   procedure TDatabaseData.SetNoReserve(AValue: boolean);
609   begin
703  ActivateService(IBConfigService1);
610    IBConfigService1.SetReserveSpace(AValue);
705  while IBConfigService1.IsServiceRunning do;
611   end;
612  
613   procedure TDatabaseData.SetPageBuffers(AValue: integer);
614   begin
710  ActivateService(IBConfigService1);
615    IBDatabase1.Connected := false;
616    try
617      IBConfigService1.SetPageBuffers(AValue);
714   while IBConfigService1.IsServiceRunning do;
618    finally
619      IBDatabase1.Connected := true;
620    end;
# Line 719 | Line 622 | end;
622  
623   procedure TDatabaseData.SetSweepInterval(AValue: integer);
624   begin
722  ActivateService(IBConfigService1);
625    IBDatabase1.Connected := false;
626    try
627      IBConfigService1.SetSweepInterval(AValue);
726    while IBConfigService1.IsServiceRunning do;
628    finally
629      IBDatabase1.Connected := true;
630    end;
# Line 735 | Line 636 | begin
636    CurrentTransaction.Active := true;
637    DataBaseQuery.Active := true;
638    AttmtQuery.Active := true;
738  if assigned(FAfterDataReload) then
739    AfterDataReload(self);
639    if LegacyUserList.Active then
640      RoleNameList.Active := true;
641 +  if assigned(FAfterDataReload) then
642 +    AfterDataReload(self);
643   end;
644  
645   destructor TDatabaseData.Destroy;
# Line 757 | Line 658 | procedure TDatabaseData.Connect;
658  
659    procedure KillShadows;
660    begin
760    ActivateService(IBValidationService1);
661      with IBValidationService1 do
662      begin
663 <      Options := [IBServices.KillShadows];
664 <      try
765 <        try
766 <          ServiceStart;
767 <        except  end;
768 <        While not Eof do
769 <          GetNextLine;
770 <      finally
771 <        while IsServiceRunning do;
772 <      end;
663 >      Options := [IBXServices.KillShadows];
664 >      Execute(nil);
665        MessageDlg('All Unavailable Shadows killed',mtInformation,[mbOK],0);
666      end;
667    end;
# Line 814 | Line 706 | begin
706    FDBPassword := '';
707    FLocalConnect := false;
708    IBDatabase1.Connected := false;
709 <  IBConfigService1.Active := false;
710 <  IBStatisticalService1.Active := false;
819 <  IBServerProperties1.Active := false;
820 <  IBValidationService1.Active := false;
821 <  IBLogService1.Active := false;
822 <  IBSecurityService1.Active := false;
709 >  IBXServicesConnection1.Connected := false;
710 >  FDBHeaderScanned := false;
711   end;
712  
713   procedure TDatabaseData.DropDatabase;
# Line 830 | Line 718 | end;
718  
719   procedure TDatabaseData.BackupDatabase;
720   begin
721 <  with BackupDlg do
834 <  begin
835 <    ActivateService(IBBackupService1);
836 <    ShowModal;
837 <  end;
721 >  BackupDlg.ShowModal;
722   end;
723  
724   procedure TDatabaseData.RestoreDatabase;
# Line 843 | Line 727 | var DefaultPageSize: integer;
727   begin
728    DefaultPageSize := DatabaseQuery.FieldByName('MON$PAGE_SIZE').AsInteger;
729    DefaultNumBuffers := DatabaseQuery.FieldByName('MON$PAGE_BUFFERS').AsInteger;
846  ActivateService(RestoreDlg.IBRestoreService1);
730    IBDatabase1.Connected := false;
731    try
732      RestoreDlg.ShowModal(DefaultPageSize,DefaultNumBuffers);
# Line 858 | Line 741 | begin
741      MessageDlg('Database is already online!',mtInformation,[mbOK],0)
742    else
743    begin
861    ActivateService(IBConfigService1);
744      IBDatabase1.Connected := false;
745      try
746        IBConfigService1.BringDatabaseOnline;
865      while IBConfigService1.IsServiceRunning do;
747      finally
748        IBDatabase1.Connected := true;
749      end;
# Line 873 | Line 754 | begin
754    end;
755   end;
756  
757 < procedure TDatabaseData.ShutDown(aShutDownmode: TShutdownMode; aDelay: integer);
757 > procedure TDatabaseData.ShutDown(aShutDownmode: TDBShutdownMode; aDelay: integer
758 >  );
759   begin
878  ActivateService(IBConfigService1);
760    IBDatabase1.Connected := false;
761    try
762 <    ShutdownDatabaseDlg.Shutdown(IBConfigService1, aShutDownmode, aDelay);
762 >    ShutdownDatabaseDlg.Shutdown(DatabaseName, aShutDownmode, aDelay);
763    finally
764      IBDatabase1.Connected := true;
765    end;
# Line 902 | Line 783 | procedure TDatabaseData.DatabaseRepair(O
783    end;
784  
785   begin
905  ActivateService(IBValidationService1);
786    ReportLines.Add(Format('Validation of %s started',[IBValidationService1.DatabaseName]));
787    ReportOptions;
788    IBDatabase1.Connected := false;
789    with IBValidationService1 do
790    try
791 <    try
912 <      ServiceStart;
913 <      while not Eof do
914 <      begin
915 <        Application.ProcessMessages;
916 <        ReportLines.Add(GetNextLine);
917 <      end;
918 <    finally
919 <      while IsServiceRunning do;
920 <    end;
791 >    Execute(ReportLines);
792      ReportLines.Add('Operation Completed');
793      MessageDlg('Operation Completed',mtInformation,[mbOK],0);
794    finally
# Line 932 | Line 803 | var TableNames: string;
803   begin
804    if IBDatabaseInfo.ODSMajorVersion < 12 then
805      raise Exception.Create('Online Validation is not supported');
935  ActivateService(IBOnlineValidationService1);
806    with IBOnlineValidationService1 do
807    begin
808      if SelectedTablesOnly then
# Line 963 | Line 833 | begin
833      else
834        IncludeTables := '';
835      ReportLines.Add(Format('Online Validation of %s started',[IBOnlineValidationService1.DatabaseName]));
836 <    try
967 <      ServiceStart;
968 <      while not Eof do
969 <      begin
970 <        Application.ProcessMessages;
971 <        ReportLines.Add(GetNextLine);
972 <      end;
973 <    finally
974 <      while IsServiceRunning do;
975 <    end;
836 >    Execute(ReportLines);
837      ReportLines.Add('Online Validation Completed');
838      MessageDlg('Online Validation Completed',mtInformation,[mbOK],0);
839    end;
# Line 987 | Line 848 | begin
848    with InLimboList do
849      if State = dsEdit then Post;
850    Report.Clear;
851 <  ActivateService(IBValidationService1);
852 <  with IBValidationService1 do
853 <  begin
854 <    GlobalAction := ActionID;
994 <    Report.Add('Starting Limbo transaction resolution');
995 <    FixLimboTransactionErrors;
996 <    while not Eof do
997 <    begin
998 <      Application.ProcessMessages;
999 <      Report.Add(GetNextLine);
1000 <    end;
1001 <    Report.Add('Limbo Transaction resolution complete');
1002 <    CurrentTransaction.Commit;
1003 <    InLimboList.Active := false;
1004 <    InLimboList.Active := true;
1005 <  end;
851 >  Report.Add('Starting Limbo transaction resolution');
852 >  InLimboList.FixErrors(ActionID,Report);
853 >  Report.Add('Limbo Transaction resolution complete');
854 >  CurrentTransaction.Commit;
855   end;
856  
857   function TDatabaseData.GetLingerDelay: string;
# Line 1070 | Line 919 | begin
919    {if need to know for ODS 11.2 then will have to use Service API}
920    else
921    begin
1073    ActivateService(IBSecurityService1);
922      with IBSecurityService1 do
923      begin
924        DisplayUser(DBUserName);
# Line 1081 | Line 929 | end;
929  
930   procedure TDatabaseData.SetAutoAdmin(AValue: boolean);
931   begin
932 <  ActivateService(IBConfigService1);
1085 <  IBConfigService1.SetAutoAdmin(AValue);
1086 <  while IBConfigService1.IsServiceRunning do;
932 >  IBSecurityService1.SetAutoAdmin(AValue);
933    CurrentTransaction.Commit;
934   end;
935  
936   procedure TDatabaseData.SetDBReadOnly(AValue: boolean);
937   begin
1092  ActivateService(IBConfigService1);
938    IBDatabase1.Connected := false;
939    try
940      IBConfigService1.SetReadOnly(AValue);
1096    while IBConfigService1.IsServiceRunning do;
941    finally
942      IBDatabase1.Connected := true;
943    end;
# Line 1101 | Line 945 | end;
945  
946   procedure TDatabaseData.SetDBSQLDialect(AValue: integer);
947   begin
1104  ActivateService(IBConfigService1);
948    IBDatabase1.Connected := false;
949    try
950      IBConfigService1.SetDBSqlDialect(AValue);
1108    while IBConfigService1.IsServiceRunning do;
951    finally
952      IBDatabase1.Connected := true;
953    end;
# Line 1113 | Line 955 | end;
955  
956   procedure TDatabaseData.SetForcedWrites(AValue: boolean);
957   begin
1116  ActivateService(IBConfigService1);
958    IBConfigService1.SetAsyncMode(not AValue);
1118  while IBConfigService1.IsServiceRunning do;
959   end;
960  
961   function TDatabaseData.IsDatabaseOnline: boolean;
# Line 1131 | Line 971 | end;
971  
972   procedure TDatabaseData.ActivateShadow;
973   begin
1134  ActivateService(IBConfigService1);
974    IBConfigService1.ActivateShadow;
1136  while IBConfigService1.IsServiceRunning do;
975    MessageDlg('Shadow Database activated. You should now rename the file or change the database alias name to point to the shadow',
976      mtInformation,[mbOK],0);
977   end;
# Line 1235 | Line 1073 | end;
1073  
1074   procedure TDatabaseData.LoadDatabaseStatistics(OptionID: integer; Lines: TStrings);
1075   begin
1238  ActivateService(IBStatisticalService1);
1076    if OptionID = 1 then
1077      LoadPerformanceStatistics(Lines)
1078    else
# Line 1247 | Line 1084 | begin
1084      3: Options := [IndexPages];
1085      4: Options := [SystemRelations]
1086      end;
1087 <    Active := true;
1251 <    ServiceStart;
1252 <    while not Eof do
1253 <      Lines.Add(GetNextLine);
1087 >    Execute(Lines);
1088    end;
1089   end;
1090  
# Line 1258 | Line 1092 | procedure TDatabaseData.LoadServerProper
1092   var i: integer;
1093   begin
1094    Lines.Clear;
1261  ActivateService(IBServerProperties1);
1095    with IBServerProperties1 do
1096    begin
1264    FetchVersionInfo;
1097      Lines.Add('Server Version = ' + VersionInfo.ServerVersion);
1098      Lines.Add('Server Implementation = ' + VersionInfo.ServerImplementation);
1099      Lines.Add('Service Version = ' + IntToStr(VersionInfo.ServiceVersion));
1100 +    with ServicesConnection do
1101      Lines.Add(Format('Firebird Release = %d.%d.%d (Build no. %d)',[ServerVersionNo[1],
1102                                                               ServerVersionNo[2],
1103                                                               ServerVersionNo[3],
1104                                                               ServerVersionNo[4]]));
1272    FetchDatabaseInfo;
1105      Lines.Add('No. of attachments = ' + IntToStr(DatabaseInfo.NoOfAttachments));
1106      Lines.Add('No. of databases = ' + IntToStr(DatabaseInfo.NoOfDatabases));
1107      for i := 0 to DatabaseInfo.NoOfDatabases - 1 do
1108        Lines.Add(Format('DB Name (%d) = %s',[i+1, DatabaseInfo.DbName[i]]));
1277    FetchConfigParams;
1109      Lines.Add('Base Location = ' + ConfigParams.BaseLocation);
1110      Lines.Add('Lock File Location = ' + ConfigParams.LockFileLocation);
1111      Lines.Add('Security Database Location = ' + ConfigParams.SecurityDatabaseLocation);
# Line 1285 | Line 1116 | end;
1116   procedure TDatabaseData.LoadServerLog(Lines: TStrings);
1117   begin
1118    Lines.Clear;
1119 <  ActivateService(IBLogService1);
1289 <  if IBLogService1.Protocol = Local then
1119 >  if IBLogService1.ServicesConnection.ServiceIntf.getProtocol = Local then
1120      Lines.Add('Server Log not available with embedded server')
1121    else
1122 <  with IBLogService1 do
1293 <  begin
1294 <    ServiceStart;
1295 <    while not Eof do
1296 <      Lines.Add(GetNextLine);
1297 <  end;
1122 >    IBLogService1.Execute(Lines);
1123   end;
1124  
1125   procedure TDatabaseData.RevokeAll;
# Line 1389 | Line 1214 | begin
1214    // Do nothing
1215   end;
1216  
1217 < procedure TDatabaseData.InLimboListAfterOpen(DataSet: TDataSet);
1218 <
1394 <  function TypeToStr(MultiDatabase: boolean): string;
1395 <  begin
1396 <    if MultiDatabase then
1397 <      Result := 'Multi DB'
1398 <    else
1399 <      Result := 'Single DB';
1400 <  end;
1401 <
1402 <  function StateToStr(State: TTransactionState): string;
1403 <  begin
1404 <    case State of
1405 <    LimboState:
1406 <      Result := 'Limbo';
1407 <    CommitState:
1408 <      Result := 'Commit';
1409 <    RollbackState:
1410 <      Result := 'Rollback';
1411 <    else
1412 <      Result := 'Unknown';
1413 <    end;
1414 <  end;
1415 <
1416 <  function AdviseToStr(Advise: TTransactionAdvise): string;
1417 <  begin
1418 <    case Advise of
1419 <    CommitAdvise:
1420 <      Result := 'Commit';
1421 <    RollbackAdvise:
1422 <      Result := 'Rollback';
1423 <    else
1424 <      Result := 'Unknown';
1425 <    end;
1426 <  end;
1427 <
1428 <  function ActionToStr(anAction: IBServices.TTransactionAction): string;
1429 <  begin
1430 <    case anAction of
1431 <    CommitAction:
1432 <      Result := 'Commit';
1433 <    RollbackAction:
1434 <      Result := 'Rollback';
1435 <    end;
1436 <  end;
1437 <
1438 < var i: integer;
1439 < begin
1440 <  if FLoadingLimboTr then Exit;
1441 <  FLoadingLimboTr := true;
1442 <  with IBValidationService1 do
1443 <  try
1444 <    ActivateService(IBValidationService1);
1445 <    Options := [LimboTransactions];
1446 <    ServiceStart;
1447 <    FetchLimboTransactionInfo;
1448 <    for i := 0 to LimboTransactionInfoCount - 1 do
1449 <    with LimboTransactionInfo[i] do
1450 <    begin
1451 <      InLimboList.Append;
1452 <      InLimboList.FieldByName('TransactionID').AsInteger := ID;
1453 <      InLimboList.FieldByName('TransactionType').AsString := TypeToStr(MultiDatabase);
1454 <      InLimboList.FieldByName('HostSite').AsString := HostSite;
1455 <      InLimboList.FieldByName('RemoteSite').AsString := RemoteSite;
1456 <      InLimboList.FieldByName('DatabasePath').AsString := RemoteDatabasePath;
1457 <      InLimboList.FieldByName('State').AsString := StateToStr(State);
1458 <      InLimboList.FieldByName('RecommendedAction').AsString := AdviseToStr(Advise);
1459 <      InLimboList.FieldByName('RequestedAction').AsString := ActionToStr(Action);
1460 <      InLimboList.Post;
1461 <    end;
1462 <  finally
1463 <    FLoadingLimboTr := false;
1464 <  end;
1465 < end;
1466 <
1467 < procedure TDatabaseData.InLimboListBeforeClose(DataSet: TDataSet);
1217 > procedure TDatabaseData.IBValidationService1GetNextLine(Sender: TObject;
1218 >  var Line: string);
1219   begin
1220 <  InLimboList.Clear(false);
1220 >  Application.ProcessMessages;
1221   end;
1222  
1223 < procedure TDatabaseData.InLimboListBeforePost(DataSet: TDataSet);
1224 < var i: integer;
1223 > procedure TDatabaseData.IBXServicesConnection1Login(
1224 >  Service: TIBXServicesConnection; var aServerName: string; LoginParams: TStrings);
1225   begin
1226 <  if FLoadingLimboTr then Exit;
1227 <  with IBValidationService1 do
1477 <  for i := 0 to LimboTransactionInfoCount - 1 do
1478 <    with LimboTransactionInfo[i] do
1479 <    begin
1480 <      if ID = InLimboList.FieldByName('TransactionID').AsInteger then
1481 <      begin
1482 <       if InLimboList.FieldByName('RequestedAction').AsString = 'Commit' then
1483 <         Action := CommitAction
1484 <       else
1485 <         if InLimboList.FieldByName('RequestedAction').AsString = 'Rollback' then
1486 <           Action := RollbackAction;
1487 <       break;
1488 <      end;
1489 <    end;
1226 >  LoginParams.Values['user_name'] := FDBUserName;
1227 >  LoginParams.Values['password'] := FDBPassword;
1228   end;
1229  
1230   procedure TDatabaseData.LegacyUserListAfterOpen(DataSet: TDataSet);
1493 var i: integer;
1231   begin
1495  ActivateService(IBSecurityService1);
1496  with IBSecurityService1 do
1497  begin
1498    DisplayUsers;
1499    FUsersLoading := true;
1500    try
1501      for i := 0 to UserInfoCount - 1 do
1502      with UserInfo[i],LegacyUserList do
1503      begin
1504        Append;
1505        FieldByName('UserID').AsInteger := UserID;
1506        FieldByName('GroupID').AsInteger := GroupID;
1507        FieldByName('UserName').AsString := Trim(UserName);
1508        FieldByName('SEC$FIRST_NAME').AsString := FirstName;
1509        FieldByName('SEC$MIDDLE_NAME').AsString := MiddleName;
1510        FieldByName('SEC$LAST_NAME').AsString := LastName;
1511        FieldByName('UserPassword').Clear;
1512        FieldByName('SEC$ADMIN').AsBoolean := AdminRole;
1513        Post;
1514      end;
1515    finally
1516      FUsersLoading := false;
1517    end;
1518  end;
1232    UserListSource.DataSet := LegacyUserList;
1233    CurrentTransaction.Active := true;
1234    RoleNameList.Active := true;
# Line 1524 | Line 1237 | end;
1237   procedure TDatabaseData.LegacyUserListBeforeClose(DataSet: TDataSet);
1238   begin
1239    RoleNameList.Active := false;
1527  with LegacyUserList do
1528  begin
1529    if State in [dsEdit,dsInsert] then Post;
1530    Clear(false);
1531  end;
1532 end;
1533
1534 procedure TDatabaseData.LegacyUserListBeforeDelete(DataSet: TDataSet);
1535 begin
1536  ActivateService(IBSecurityService1);
1537  with IBSecurityService1 do
1538  begin
1539    UserName := DataSet.FieldByName('UserName').AsString;
1540    DeleteUser;
1541    while IsServiceRunning do;
1542  end;
1543 end;
1544
1545 procedure TDatabaseData.LegacyUserListBeforePost(DataSet: TDataSet);
1546
1547  procedure SetParams;
1548  begin
1549    with LegacyUserList, IBSecurityService1 do
1550    begin
1551      UserID := FieldByName('UserID').AsInteger;
1552      GroupID := FieldByName('GroupID').AsInteger;
1553      UserName := FieldByName('UserName').AsString;
1554      FirstName := FieldByName('SEC$FIRST_NAME').AsString;
1555      MiddleName := FieldByName('SEC$MIDDLE_NAME').AsString;
1556      LastName := FieldByName('SEC$LAST_NAME').AsString;
1557      if not FieldByName('UserPassword').IsNull then
1558        Password := FieldByName('UserPassword').AsString;
1559      AdminRole := FieldByName('SEC$ADMIN').AsBoolean;
1560    end;
1561  end;
1562
1563 begin
1564    if FUsersLoading then Exit;
1565    ActivateService(IBSecurityService1);
1566    case LegacyUserList.State of
1567    dsEdit:
1568      begin
1569        SetParams;
1570        IBSecurityService1.ModifyUser;
1571      end;
1572    dsInsert:
1573      begin
1574        SetParams;
1575        IBSecurityService1.AddUser;
1576      end;
1577    end;
1578    while IBSecurityService1.IsServiceRunning do;
1240   end;
1241  
1242   procedure TDatabaseData.ShadowFilesCalcFields(DataSet: TDataSet);
# Line 1662 | Line 1323 | begin
1323      end;
1324  
1325    FLocalConnect := FProtocol = Local;
1326 +  ConnectServicesAPI;
1327    ReloadData;
1328   end;
1329  
# Line 1707 | Line 1369 | begin
1369    if AccessRightsSUBJECT_TYPE.AsInteger = 8 then
1370    begin
1371      if  (AccessRightsSUBJECT_NAME.AsString <> 'PUBLIC') and UserListSource.DataSet.Active and
1372 <       not UserListSource.DataSet.Locate('USERNAME',AccessRightsSUBJECT_NAME.AsString,[]) then
1372 >       not UserListSource.DataSet.Locate('SEC$USER_NAME',AccessRightsSUBJECT_NAME.AsString,[]) then
1373      begin
1374        AccessRightsImageIndex.AsInteger := 4;
1375        AccessRightsDisplayName.AsString := AccessRightsSUBJECT_NAME.AsString + ' (stale)';

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines