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; |
46 |
|
interface |
47 |
|
|
48 |
|
uses |
49 |
< |
{$IFDEF LINUX } |
46 |
< |
unix, |
47 |
< |
{$ELSE} |
48 |
< |
{$DEFINE HAS_SQLMONITOR} |
49 |
> |
{$IFDEF WINDOWS } |
50 |
|
Windows, |
51 |
+ |
{$ELSE} |
52 |
+ |
unix, |
53 |
|
{$ENDIF} |
54 |
< |
Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, |
52 |
< |
IBDialogs, IBHeader, IB, IBExternals; |
54 |
> |
SysUtils, Classes, IBHeader, IB, IBExternals, CustApp; |
55 |
|
|
56 |
|
const |
57 |
|
DefaultBufferSize = 32000; |
96 |
|
TLoginEvent = procedure(Database: TIBCustomService; |
97 |
|
LoginParams: TStrings) of object; |
98 |
|
|
99 |
+ |
{ TIBCustomService } |
100 |
+ |
|
101 |
|
TIBCustomService = class(TComponent) |
102 |
|
private |
103 |
|
FIBLoaded: Boolean; |
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; |
513 |
|
implementation |
514 |
|
|
515 |
|
uses |
516 |
< |
IBIntf {$IFDEF HAS_SQLMONITOR}, IBSQLMonitor {$ENDIF}; |
516 |
> |
IBIntf , IBSQLMonitor, Math; |
517 |
|
|
518 |
|
{ TIBCustomService } |
519 |
|
|
553 |
|
if Assigned(FOnAttach) then |
554 |
|
FOnAttach(Self); |
555 |
|
|
551 |
– |
{$IFDEF HAS_SQLMONITOR} |
556 |
|
MonitorHook.ServiceAttach(Self); |
553 |
– |
{$ENDIF} |
557 |
|
end; |
558 |
|
|
559 |
|
procedure TIBCustomService.Loaded; |
564 |
|
Attach; |
565 |
|
except |
566 |
|
if csDesigning in ComponentState then |
567 |
< |
Application.HandleException(Self) |
567 |
> |
HandleException(self) |
568 |
|
else |
569 |
|
raise; |
570 |
|
end; |
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], |
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]); |
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; |
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); |
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; |
699 |
|
end |
700 |
|
else |
701 |
|
FHandle := nil; |
674 |
– |
{$IFDEF HAS_SQLMONITOR} |
702 |
|
MonitorHook.ServiceDetach(Self); |
676 |
– |
{$ENDIF} |
703 |
|
end; |
704 |
|
|
705 |
|
function TIBCustomService.GetActive: Boolean; |
753 |
|
FQuerySPBLength := 0; |
754 |
|
FQueryParams := ''; |
755 |
|
end; |
730 |
– |
{$IFDEF HAS_SQLMONITOR} |
756 |
|
MonitorHook.ServiceQuery(Self); |
732 |
– |
{$ENDIF} |
757 |
|
end; |
758 |
|
|
759 |
|
procedure TIBCustomService.SetActive(const Value: Boolean); |
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, |
1272 |
|
FStartSPBLength := 0; |
1273 |
|
FStartParams := ''; |
1274 |
|
end; |
1250 |
– |
{$IFDEF HAS_SQLMONITOR} |
1275 |
|
MonitorHook.ServiceStart(Self); |
1252 |
– |
{$ENDIF} |
1276 |
|
end; |
1277 |
|
|
1278 |
|
procedure TIBControlService.ServiceStart; |
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; |