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 1 by tony, Mon Jul 31 16:43:00 2000 UTC vs.
Revision 39 by tony, Tue May 17 08:14:52 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 <  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
53 <  IBDialogs, IBHeader, IB, IBExternals;
52 > {$IFDEF WINDOWS }
53 >  Windows,
54 > {$ELSE}
55 >  unix,
56 > {$ENDIF}
57 >  SysUtils, Classes, IBHeader, IB, IBExternals, CustApp;
58  
59   const
60    DefaultBufferSize = 32000;
# Line 86 | 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 125 | 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 500 | Line 516 | type
516   implementation
517  
518   uses
519 <  IBIntf, IBSQLMonitor;
519 >  IBIntf , IBSQLMonitor, Math;
520  
521   { TIBCustomService }
522  
# Line 508 | 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 524 | 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 551 | 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 570 | 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 585 | 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 599 | 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 617 | 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 634 | Line 673 | begin
673    FHandle := nil;
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 646 | Line 691 | begin
691      FSPB := nil;
692      FParams.Free;
693    end;
694 +  ReallocMem(FOutputBuffer, 0);
695    inherited Destroy;
696   end;
697  
# Line 721 | Line 767 | begin
767    if csReading in ComponentState then
768      FStreamedActive := Value
769    else
770 <    if Value then
771 <      Attach
772 <    else
773 <      Detach;
770 >    if Value <> Active then  
771 >      if Value then
772 >        Attach
773 >      else
774 >        Detach;
775   end;
776  
777   procedure TIBCustomService.SetBufferSize(const Value: Integer);
# Line 864 | 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 1480 | 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 1729 | Line 1777 | begin
1777    for i := 0 to High(FUserInfo) do
1778      FUserInfo[i].Free;
1779    FUserInfo := nil;
1780 <  inherited destroy;
1780 >  inherited Destroy;
1781   end;
1782  
1783   procedure TIBSecurityService.FetchUserInfo;
# Line 1795 | 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;
# Line 2043 | Line 2091 | end;
2091   destructor TDatabaseInfo.Destroy;
2092   begin
2093    DbName := nil;
2094 <  inherited;
2094 >  inherited Destroy;
2095   end;
2096  
2097   { TLicenseInfo }
# Line 2060 | Line 2108 | begin
2108    Key := nil;
2109    Id := nil;
2110    Desc := nil;
2111 <  inherited;
2111 >  inherited Destroy;
2112   end;
2113  
2114   { TConfigFileData }
# Line 2075 | Line 2123 | destructor TConfigFileData.Destroy;
2123   begin
2124    ConfigFileValue := nil;
2125    ConfigFileKey := nil;
2126 <  inherited;
2126 >  inherited Destroy;
2127   end;
2128  
2129   { TConfigParams }
# Line 2090 | Line 2138 | destructor TConfigParams.Destroy;
2138   begin
2139    ConfigFileData.Free;
2140    ConfigFileParams := nil;
2141 <  inherited;
2141 >  inherited Destroy;
2142   end;
2143  
2144   end.

Diff Legend

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