client/3.0/FB30Services.pas

(*
 *  Firebird Interface (fbintf). The fbintf components provide a set of
 *  Pascal language bindings for the Firebird API.
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2016 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)
unit FB30Services;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

{$IFDEF FPC}
{$mode delphi}
{$interfaces COM}
{$ENDIF}

interface

uses
  Classes, SysUtils, Firebird, IB, FB30ClientAPI, FBParamBlock, FBOutputBlock,
    FBServices;

type
  { TFBServiceManager }

  { TFB30ServiceManager }

  TFB30ServiceManager = class(TFBServiceManager,IServiceManager)
  private
    FServiceIntf: Firebird.IService;
    FFirebird30ClientAPI: TFB30ClientAPI;
    procedure CheckActive;
    procedure CheckInactive;
  protected
    procedure InternalAttach(ConnectString: AnsiString); override;
  public
    constructor Create(api: TFB30ClientAPI; ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB; Port: AnsiString = '');
    property ServiceIntf: Firebird.IService read FServiceIntf;

  public
    {IServiceManager}
    procedure Detach(Force: boolean=false); override;
    function IsAttached: boolean;
    function Start(Request: ISRB; RaiseExceptionOnError: boolean=true): boolean;
    function Query(SQPB: ISQPB; Request: ISRB; RaiseExceptionOnError: boolean=true): IServiceQueryResults; override;
  end;

implementation

uses FBMessages;

{ TFBServiceManager }

procedure TFB30ServiceManager.CheckActive;
begin
  if FServiceIntf = nil then
    IBError(ibxeServiceActive, [nil]);
end;

procedure TFB30ServiceManager.CheckInactive;
begin
  if FServiceIntf <> nil then
    IBError(ibxeServiceInActive, [nil]);
end;

procedure TFB30ServiceManager.InternalAttach(ConnectString: AnsiString);
begin
  with FFirebird30ClientAPI do
  if FSPB = nil then
  begin
    FServiceIntf := ProviderIntf.attachServiceManager(StatusIntf, PAnsiChar(ConnectString), 0, nil);
    Check4DataBaseError;
  end
  else
  begin
    FServiceIntf := ProviderIntf.attachServiceManager(StatusIntf,
                                               PAnsiChar(ConnectString),
                                               (FSPB as TSPB).getDataLength,
                                               BytePtr((FSPB as TSPB).getBuffer));
    Check4DataBaseError;
  end;
end;

constructor TFB30ServiceManager.Create(api: TFB30ClientAPI;
  ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB; Port: AnsiString);
begin
  FFirebird30ClientAPI := api;
  inherited Create(api,ServerName, Protocol, SPB, Port);
end;

procedure TFB30ServiceManager.Detach(Force: boolean);
begin
  if FServiceIntf = nil then
    Exit;
  with FFirebird30ClientAPI do
  begin
    FServiceIntf.detach(StatusIntf);
    if not Force and InErrorState then
      IBDataBaseError;
    FServiceIntf := nil;
  end;
end;

function TFB30ServiceManager.IsAttached: boolean;
begin
  Result := FServiceIntf <> nil;
end;

function TFB30ServiceManager.Start(Request: ISRB; RaiseExceptionOnError: boolean
  ): boolean;
begin
  Result := true;
  CheckActive;
  with FFirebird30ClientAPI do
    begin
      FServiceIntf.Start(StatusIntf,
                           (Request as TSRB).getDataLength,
                           BytePtr((Request as TSRB).getBuffer));
      if RaiseExceptionOnError then
        Check4DataBaseError
      else
        Result := not InErrorState;
    end;
end;

function TFB30ServiceManager.Query(SQPB: ISQPB; Request: ISRB;
  RaiseExceptionOnError: boolean): IServiceQueryResults;
var QueryResults: TServiceQueryResults;
begin
  CheckActive;
  QueryResults := TServiceQueryResults.Create(FFirebird30ClientAPI);
  Result := QueryResults;
  with FFirebird30ClientAPI do
  begin
    if SQPB <> nil then
    begin
      FServiceIntf.query(StatusIntf,
                         (SQPB as TSQPB).getDataLength,
                         BytePtr((SQPB as TSQPB).getBuffer),
                         (Request as TSRB).getDataLength,
                         BytePtr((Request as TSRB).getBuffer),
                         QueryResults.getBufSize,
                         BytePtr(QueryResults.Buffer));
      if RaiseExceptionOnError then
        Check4DataBaseError
      else
      if InErrorState then
        Result := nil;
    end
    else
    begin
      FServiceIntf.query(StatusIntf, 0, nil,
                       (Request as TSRB).getDataLength,
                       BytePtr((Request as TSRB).getBuffer),
                       QueryResults.getBufSize,
                       BytePtr(QueryResults.Buffer));
      if RaiseExceptionOnError then
        Check4DataBaseError
      else
      if InErrorState then
        Result := nil;
    end;
  end;
end;

end.

Revision:	263
Committed:	Thu Dec 6 15:55:01 2018 UTC (5 years, 4 months ago) by tony
Content type:	text/x-pascal
File size:	5335 byte(s)
Log Message:	Release 2.3.2 committed
#	Content
1	(*
2	* Firebird Interface (fbintf). The fbintf components provide a set of
3	* Pascal language bindings for the Firebird API.
4	*
5	* The contents of this file are subject to the Initial Developer's
6	* Public License Version 1.0 (the "License"); you may not use this
7	* file except in compliance with the License. You may obtain a copy
8	* of the License here:
9	*
10	* http://www.firebirdsql.org/index.php?op=doc&id=idpl
11	*
12	* Software distributed under the License is distributed on an "AS
13	* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
14	* implied. See the License for the specific language governing rights
15	* and limitations under the License.
16	*
17	* The Initial Developer of the Original Code is Tony Whyman.
18	*
19	* The Original Code is (C) 2016 Tony Whyman, MWA Software
20	* (http://www.mwasoftware.co.uk).
21	*
22	* All Rights Reserved.
23	*
24	* Contributor(s): ______________________________________.
25	*
26	*)
27	unit FB30Services;
28	{$IFDEF MSWINDOWS}
29	{$DEFINE WINDOWS}
30	{$ENDIF}
31
32	{$IFDEF FPC}
33	{$mode delphi}
34	{$interfaces COM}
35	{$ENDIF}
36
37	interface
38
39	uses
40	Classes, SysUtils, Firebird, IB, FB30ClientAPI, FBParamBlock, FBOutputBlock,
41	FBServices;
42
43	type
44	{ TFBServiceManager }
45
46	{ TFB30ServiceManager }
47
48	TFB30ServiceManager = class(TFBServiceManager,IServiceManager)
49	private
50	FServiceIntf: Firebird.IService;
51	FFirebird30ClientAPI: TFB30ClientAPI;
52	procedure CheckActive;
53	procedure CheckInactive;
54	protected
55	procedure InternalAttach(ConnectString: AnsiString); override;
56	public
57	constructor Create(api: TFB30ClientAPI; ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB; Port: AnsiString = '');
58	property ServiceIntf: Firebird.IService read FServiceIntf;
59
60	public
61	{IServiceManager}
62	procedure Detach(Force: boolean=false); override;
63	function IsAttached: boolean;
64	function Start(Request: ISRB; RaiseExceptionOnError: boolean=true): boolean;
65	function Query(SQPB: ISQPB; Request: ISRB; RaiseExceptionOnError: boolean=true): IServiceQueryResults; override;
66	end;
67
68	implementation
69
70	uses FBMessages;
71
72	{ TFBServiceManager }
73
74	procedure TFB30ServiceManager.CheckActive;
75	begin
76	if FServiceIntf = nil then
77	IBError(ibxeServiceActive, [nil]);
78	end;
79
80	procedure TFB30ServiceManager.CheckInactive;
81	begin
82	if FServiceIntf <> nil then
83	IBError(ibxeServiceInActive, [nil]);
84	end;
85
86	procedure TFB30ServiceManager.InternalAttach(ConnectString: AnsiString);
87	begin
88	with FFirebird30ClientAPI do
89	if FSPB = nil then
90	begin
91	FServiceIntf := ProviderIntf.attachServiceManager(StatusIntf, PAnsiChar(ConnectString), 0, nil);
92	Check4DataBaseError;
93	end
94	else
95	begin
96	FServiceIntf := ProviderIntf.attachServiceManager(StatusIntf,
97	PAnsiChar(ConnectString),
98	(FSPB as TSPB).getDataLength,
99	BytePtr((FSPB as TSPB).getBuffer));
100	Check4DataBaseError;
101	end;
102	end;
103
104	constructor TFB30ServiceManager.Create(api: TFB30ClientAPI;
105	ServerName: AnsiString; Protocol: TProtocol; SPB: ISPB; Port: AnsiString);
106	begin
107	FFirebird30ClientAPI := api;
108	inherited Create(api,ServerName, Protocol, SPB, Port);
109	end;
110
111	procedure TFB30ServiceManager.Detach(Force: boolean);
112	begin
113	if FServiceIntf = nil then
114	Exit;
115	with FFirebird30ClientAPI do
116	begin
117	FServiceIntf.detach(StatusIntf);
118	if not Force and InErrorState then
119	IBDataBaseError;
120	FServiceIntf := nil;
121	end;
122	end;
123
124	function TFB30ServiceManager.IsAttached: boolean;
125	begin
126	Result := FServiceIntf <> nil;
127	end;
128
129	function TFB30ServiceManager.Start(Request: ISRB; RaiseExceptionOnError: boolean
130	): boolean;
131	begin
132	Result := true;
133	CheckActive;
134	with FFirebird30ClientAPI do
135	begin
136	FServiceIntf.Start(StatusIntf,
137	(Request as TSRB).getDataLength,
138	BytePtr((Request as TSRB).getBuffer));
139	if RaiseExceptionOnError then
140	Check4DataBaseError
141	else
142	Result := not InErrorState;
143	end;
144	end;
145
146	function TFB30ServiceManager.Query(SQPB: ISQPB; Request: ISRB;
147	RaiseExceptionOnError: boolean): IServiceQueryResults;
148	var QueryResults: TServiceQueryResults;
149	begin
150	CheckActive;
151	QueryResults := TServiceQueryResults.Create(FFirebird30ClientAPI);
152	Result := QueryResults;
153	with FFirebird30ClientAPI do
154	begin
155	if SQPB <> nil then
156	begin
157	FServiceIntf.query(StatusIntf,
158	(SQPB as TSQPB).getDataLength,
159	BytePtr((SQPB as TSQPB).getBuffer),
160	(Request as TSRB).getDataLength,
161	BytePtr((Request as TSRB).getBuffer),
162	QueryResults.getBufSize,
163	BytePtr(QueryResults.Buffer));
164	if RaiseExceptionOnError then
165	Check4DataBaseError
166	else
167	if InErrorState then
168	Result := nil;
169	end
170	else
171	begin
172	FServiceIntf.query(StatusIntf, 0, nil,
173	(Request as TSRB).getDataLength,
174	BytePtr((Request as TSRB).getBuffer),
175	QueryResults.getBufSize,
176	BytePtr(QueryResults.Buffer));
177	if RaiseExceptionOnError then
178	Check4DataBaseError
179	else
180	if InErrorState then
181	Result := nil;
182	end;
183	end;
184	end;
185
186	end.
187