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

Comparing ibx/trunk/runtime/IBServices.pas (file contents):
Revision 5 by tony, Fri Feb 18 16:26:16 2011 UTC vs.
Revision 43 by tony, Thu Sep 22 17:10:15 2016 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   {
35    InterBase Express provides component interfaces to
36    functions introduced in InterBase 6.0.  The Services
37 <  components (TIB*Service, TIBServerProperties) and
33 <  Install components (TIBInstall, TIBUninstall, TIBSetup)
37 >  components (TIB*Service, TIBServerProperties)
38    function only if you have installed InterBase 6.0 or
39 <  later software
39 >  later software, including Firebird
40   }
41  
42   unit IBServices;
43  
44   {$Mode Delphi}
45 + {$IF FPC_FULLVERSION >= 20700 }
46 + {$codepage UTF8}
47 + {$ENDIF}
48  
49   interface
50  
51   uses
52 < {$IFDEF LINUX }
46 <  unix,
47 < {$ELSE}
48 < {$DEFINE HAS_SQLMONITOR}
52 > {$IFDEF WINDOWS }
53    Windows,
54 + {$ELSE}
55 +  unix,
56   {$ENDIF}
57 <  Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
52 <  IBDialogs, IBHeader, IB, IBExternals;
57 >  SysUtils, Classes, IBHeader, IB, IBExternals, CustApp;
58  
59   const
60    DefaultBufferSize = 32000;
# Line 94 | Line 99 | type
99    TLoginEvent = procedure(Database: TIBCustomService;
100      LoginParams: TStrings) of object;
101  
102 +  { TIBCustomService }
103 +
104    TIBCustomService = class(TComponent)
105    private
106      FIBLoaded: Boolean;
# Line 133 | Line 140 | type
140  
141    protected
142      procedure Loaded; override;
143 <    function Login: Boolean;
143 >    function Login(var aServerName: string): Boolean;
144      procedure CheckActive;
145      procedure CheckInactive;
146 +    procedure HandleException(Sender: TObject);
147      property OutputBuffer : PChar read FOutputBuffer;
148      property OutputBufferOption : TOutputBufferOption read FOutputBufferOption write FOutputBufferOption;
149      property BufferSize : Integer read FBufferSize write SetBufferSize default DefaultBufferSize;
# Line 309 | Line 317 | type
317    published
318    end;
319  
320 <  TStatOption = (DataPages, DbLog, HeaderPages, IndexPages, SystemRelations);
320 >  TStatOption = (DataPages, {DbLog,} HeaderPages, IndexPages, SystemRelations);
321    TStatOptions = set of TStatOption;
322  
323    TIBStatisticalService = class(TIBControlAndQueryService)
# Line 508 | Line 516 | type
516   implementation
517  
518   uses
519 <  IBIntf {$IFDEF HAS_SQLMONITOR}, IBSQLMonitor {$ENDIF};
519 >  IBIntf , IBSQLMonitor, Math;
520  
521   { TIBCustomService }
522  
# Line 516 | Line 524 | procedure TIBCustomService.Attach;
524   var
525    SPB: String;
526    ConnectString: String;
527 +  aServerName: string;
528   begin
529    CheckInactive;
530    CheckServerName;
531  
532 <  if FLoginPrompt and not Login then
532 >  aServerName := FServerName;
533 >  if FLoginPrompt and not Login(aServerName) then
534      IBError(ibxeOperationCancelled, [nil]);
535  
536    { Generate a new SPB if necessary }
# Line 532 | Line 542 | begin
542      Move(SPB[1], FSPB[0], FSPBLength);
543    end;
544    case FProtocol of
545 <    TCP: ConnectString := FServerName + ':service_mgr'; {do not localize}
546 <    SPX: ConnectString := FServerName + '@service_mgr'; {do not localize}
547 <    NamedPipe: ConnectString := '\\' + FServerName + '\service_mgr'; {do not localize}
545 >    TCP: ConnectString := aServerName + ':service_mgr'; {do not localize}
546 >    SPX: ConnectString := aServerName + '@service_mgr'; {do not localize}
547 >    NamedPipe: ConnectString := '\\' + aServerName + '\service_mgr'; {do not localize}
548      Local: ConnectString := 'service_mgr'; {do not localize}
549    end;
550    if call(isc_service_attach(StatusVector, Length(ConnectString),
# Line 548 | Line 558 | begin
558    if Assigned(FOnAttach) then
559      FOnAttach(Self);
560  
551 –  {$IFDEF HAS_SQLMONITOR}
561    MonitorHook.ServiceAttach(Self);
553 –  {$ENDIF}
562   end;
563  
564   procedure TIBCustomService.Loaded;
# Line 561 | Line 569 | begin
569        Attach;
570    except
571      if csDesigning in ComponentState then
572 <      Application.HandleException(Self)
572 >       HandleException(self)
573      else
574        raise;
575    end;
576   end;
577  
578 < function TIBCustomService.Login: Boolean;
578 > function TIBCustomService.Login(var aServerName: string): Boolean;
579   var
580    IndexOfUser, IndexOfPassword: Integer;
581    Username, Password: String;
# Line 580 | Line 588 | begin
588        LoginParams.Assign(Params);
589        FOnLogin(Self, LoginParams);
590        Params.Assign (LoginParams);
591 +      aServerName := ServerName;
592      finally
593        LoginParams.Free;
594      end;
595    end
596 <  else begin
596 >  else
597 >  if assigned(IBGUIInterface)  then
598 >  begin
599      IndexOfUser := IndexOfSPBConst(SPBConstantNames[isc_spb_user_name]);
600      if IndexOfUser <> -1 then
601        Username := Copy(Params[IndexOfUser],
# Line 595 | Line 606 | begin
606        Password := Copy(Params[IndexOfPassword],
607                                           Pos('=', Params[IndexOfPassword]) + 1, {mbcs ok}
608                                           Length(Params[IndexOfPassword]));
609 <    result := ServerLoginDialog(serverName, Username, Password);
609 >    result := IBGUIInterface.ServerLoginDialog(aServerName, Username, Password);
610      if result then
611      begin
612        IndexOfPassword := IndexOfSPBConst(SPBConstantNames[isc_spb_password]);
# Line 609 | Line 620 | begin
620        else
621          Params[IndexOfPassword] := SPBConstantNames[isc_spb_password] +
622                                       '=' + Password;
623 <    end;
624 <  end;
623 >    end
624 >  end
625 >  else
626 >    IBError(ibxeNoLoginDialog,[]);
627   end;
628  
629   procedure TIBCustomService.CheckActive;
# Line 627 | Line 640 | begin
640      IBError(ibxeServiceInActive, [nil]);
641   end;
642  
643 + procedure TIBCustomService.HandleException(Sender: TObject);
644 + var aParent: TComponent;
645 + begin
646 +  aParent := Owner;
647 +  while aParent <> nil do
648 +  begin
649 +    if aParent is TCustomApplication then
650 +    begin
651 +      TCustomApplication(aParent).HandleException(Sender);
652 +      Exit;
653 +    end;
654 +    aParent := aParent.Owner;
655 +  end;
656 +  SysUtils.ShowException(ExceptObject,ExceptAddr);
657 + end;
658 +
659   constructor TIBCustomService.Create(AOwner: TComponent);
660   begin
661    inherited Create(AOwner);
# Line 645 | Line 674 | begin
674    FLoginPrompt := True;
675    FTraceFlags := [];
676    FOutputbuffer := nil;
677 +  FProtocol := Local;
678 +  if (AOwner <> nil) and
679 +     (AOwner is TCustomApplication) and
680 +     TCustomApplication(AOwner).ConsoleApplication then
681 +    LoginPrompt := false;
682   end;
683  
684   destructor TIBCustomService.Destroy;
# Line 671 | Line 705 | begin
705    end
706    else
707      FHandle := nil;
674 –  {$IFDEF HAS_SQLMONITOR}
708    MonitorHook.ServiceDetach(Self);
676 –  {$ENDIF}
709   end;
710  
711   function TIBCustomService.GetActive: Boolean;
# Line 727 | Line 759 | begin
759      FQuerySPBLength := 0;
760      FQueryParams := '';
761    end;
730 –  {$IFDEF HAS_SQLMONITOR}
762    MonitorHook.ServiceQuery(Self);
732 –  {$ENDIF}
763   end;
764  
765   procedure TIBCustomService.SetActive(const Value: Boolean);
# Line 881 | Line 911 | begin
911    SPB := SPB + Char(isc_spb_current_version);
912    { Iterate through the textual service parameters, constructing
913     a SPB on-the-fly }
914 +  if sl.Count > 0 then
915    for i := 0 to sl.Count - 1 do
916    begin
917     { Get the parameter's name and value from the list,
# Line 1247 | Line 1278 | begin
1278      FStartSPBLength := 0;
1279      FStartParams := '';
1280    end;
1250 –  {$IFDEF HAS_SQLMONITOR}
1281    MonitorHook.ServiceStart(Self);
1252 –  {$ENDIF}
1282   end;
1283  
1284   procedure TIBControlService.ServiceStart;
# Line 1386 | Line 1415 | begin
1415    param := 0;
1416    if (DataPages in Options) then
1417      param := param or isc_spb_sts_data_pages;
1418 <  if (DbLog in Options) then
1419 <    param := param or isc_spb_sts_db_log;
1418 > {  if (DbLog in Options) then
1419 >    param := param or isc_spb_sts_db_log; -- removed from Firebird 2}
1420    if (HeaderPages in Options) then
1421      param := param or isc_spb_sts_hdr_pages;
1422    if (IndexPages in Options) then
# Line 1499 | Line 1528 | begin
1528      if (Trim(FBackupFile[i]) = '') then continue;
1529      if (Pos('=', FBackupFile[i]) <> 0) then  {mbcs ok}
1530      begin
1531 <      ServiceStartAddParam(FBackupFile.Names[i], isc_spb_bkp_file);
1531 >      ServiceStartAddParam(AnsiUpperCase(FBackupFile.Names[i]), isc_spb_bkp_file);
1532        value := Copy(FBackupFile[i], Pos('=', FBackupFile[i]) + 1, Length(FBackupFile.Names[i])); {mbcs ok}
1533        param := StrToInt(value);
1534        ServiceStartAddParam(param, isc_spb_bkp_length);
# Line 1814 | Line 1843 | end;
1843  
1844   function TIBSecurityService.GetUserInfoCount: Integer;
1845   begin
1846 <  Result := High(FUSerInfo);
1846 >  Result := Max(High(FUSerInfo),0);
1847   end;
1848  
1849   procedure TIBSecurityService.AddUser;

Diff Legend

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