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 33 by tony, Sat Jul 18 12:30:52 2015 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 +
46   interface
47  
48   uses
49 <  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
50 <  IBDialogs, IBHeader, IB, IBExternals;
49 > {$IFDEF WINDOWS }
50 >  Windows,
51 > {$ELSE}
52 >  unix,
53 > {$ENDIF}
54 >  SysUtils, Classes, IBHeader, IB, IBExternals, CustApp;
55  
56   const
57    DefaultBufferSize = 32000;
# Line 86 | Line 96 | type
96    TLoginEvent = procedure(Database: TIBCustomService;
97      LoginParams: TStrings) of object;
98  
99 +  { TIBCustomService }
100 +
101    TIBCustomService = class(TComponent)
102    private
103      FIBLoaded: Boolean;
# Line 128 | Line 140 | type
140      function Login: Boolean;
141      procedure CheckActive;
142      procedure CheckInactive;
143 +    procedure HandleException(Sender: TObject);
144      property OutputBuffer : PChar read FOutputBuffer;
145      property OutputBufferOption : TOutputBufferOption read FOutputBufferOption write FOutputBufferOption;
146      property BufferSize : Integer read FBufferSize write SetBufferSize default DefaultBufferSize;
# Line 500 | Line 513 | type
513   implementation
514  
515   uses
516 <  IBIntf, IBSQLMonitor;
516 >  IBIntf , IBSQLMonitor, Math;
517  
518   { TIBCustomService }
519  
# Line 551 | Line 564 | begin
564        Attach;
565    except
566      if csDesigning in ComponentState then
567 <      Application.HandleException(Self)
567 >       HandleException(self)
568      else
569        raise;
570    end;
# Line 574 | Line 587 | begin
587        LoginParams.Free;
588      end;
589    end
590 <  else begin
590 >  else
591 >  if assigned(IBGUIInterface)  then
592 >  begin
593      IndexOfUser := IndexOfSPBConst(SPBConstantNames[isc_spb_user_name]);
594      if IndexOfUser <> -1 then
595        Username := Copy(Params[IndexOfUser],
# Line 585 | Line 600 | begin
600        Password := Copy(Params[IndexOfPassword],
601                                           Pos('=', Params[IndexOfPassword]) + 1, {mbcs ok}
602                                           Length(Params[IndexOfPassword]));
603 <    result := ServerLoginDialog(serverName, Username, Password);
603 >    result := IBGUIInterface.ServerLoginDialog(serverName, Username, Password);
604      if result then
605      begin
606        IndexOfPassword := IndexOfSPBConst(SPBConstantNames[isc_spb_password]);
# Line 599 | Line 614 | begin
614        else
615          Params[IndexOfPassword] := SPBConstantNames[isc_spb_password] +
616                                       '=' + Password;
617 <    end;
618 <  end;
617 >    end
618 >  end
619 >  else
620 >    IBError(ibxeNoLoginDialog,[]);
621   end;
622  
623   procedure TIBCustomService.CheckActive;
# Line 617 | Line 634 | begin
634      IBError(ibxeServiceInActive, [nil]);
635   end;
636  
637 + procedure TIBCustomService.HandleException(Sender: TObject);
638 + var aParent: TComponent;
639 + begin
640 +  aParent := Owner;
641 +  while aParent <> nil do
642 +  begin
643 +    if aParent is TCustomApplication then
644 +    begin
645 +      TCustomApplication(aParent).HandleException(Sender);
646 +      Exit;
647 +    end;
648 +    aParent := aParent.Owner;
649 +  end;
650 +  SysUtils.ShowException(ExceptObject,ExceptAddr);
651 + end;
652 +
653   constructor TIBCustomService.Create(AOwner: TComponent);
654   begin
655    inherited Create(AOwner);
# Line 634 | Line 667 | begin
667    FHandle := nil;
668    FLoginPrompt := True;
669    FTraceFlags := [];
670 +  FOutputbuffer := nil;
671 +  FProtocol := Local;
672 +  if (AOwner <> nil) and
673 +     (AOwner is TCustomApplication) and
674 +     TCustomApplication(AOwner).ConsoleApplication then
675 +    LoginPrompt := false;
676   end;
677  
678   destructor TIBCustomService.Destroy;
# Line 646 | Line 685 | begin
685      FSPB := nil;
686      FParams.Free;
687    end;
688 +  ReallocMem(FOutputBuffer, 0);
689    inherited Destroy;
690   end;
691  
# Line 721 | Line 761 | begin
761    if csReading in ComponentState then
762      FStreamedActive := Value
763    else
764 <    if Value then
765 <      Attach
766 <    else
767 <      Detach;
764 >    if Value <> Active then  
765 >      if Value then
766 >        Attach
767 >      else
768 >        Detach;
769   end;
770  
771   procedure TIBCustomService.SetBufferSize(const Value: Integer);
# Line 864 | Line 905 | begin
905    SPB := SPB + Char(isc_spb_current_version);
906    { Iterate through the textual service parameters, constructing
907     a SPB on-the-fly }
908 +  if sl.Count > 0 then
909    for i := 0 to sl.Count - 1 do
910    begin
911     { Get the parameter's name and value from the list,
# Line 1729 | Line 1771 | begin
1771    for i := 0 to High(FUserInfo) do
1772      FUserInfo[i].Free;
1773    FUserInfo := nil;
1774 <  inherited destroy;
1774 >  inherited Destroy;
1775   end;
1776  
1777   procedure TIBSecurityService.FetchUserInfo;
# Line 1795 | Line 1837 | end;
1837  
1838   function TIBSecurityService.GetUserInfoCount: Integer;
1839   begin
1840 <  Result := High(FUSerInfo);
1840 >  Result := Max(High(FUSerInfo),0);
1841   end;
1842  
1843   procedure TIBSecurityService.AddUser;
# Line 2043 | Line 2085 | end;
2085   destructor TDatabaseInfo.Destroy;
2086   begin
2087    DbName := nil;
2088 <  inherited;
2088 >  inherited Destroy;
2089   end;
2090  
2091   { TLicenseInfo }
# Line 2060 | Line 2102 | begin
2102    Key := nil;
2103    Id := nil;
2104    Desc := nil;
2105 <  inherited;
2105 >  inherited Destroy;
2106   end;
2107  
2108   { TConfigFileData }
# Line 2075 | Line 2117 | destructor TConfigFileData.Destroy;
2117   begin
2118    ConfigFileValue := nil;
2119    ConfigFileKey := nil;
2120 <  inherited;
2120 >  inherited Destroy;
2121   end;
2122  
2123   { TConfigParams }
# Line 2090 | Line 2132 | destructor TConfigParams.Destroy;
2132   begin
2133    ConfigFileData.Free;
2134    ConfigFileParams := nil;
2135 <  inherited;
2135 >  inherited Destroy;
2136   end;
2137  
2138   end.

Diff Legend

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