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 FPC}
{$mode objfpc}{$H+}
{$interfaces COM}
{$ENDIF}

interface

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

type
  { TFBServiceManager }

  TFB30ServiceManager = class(TFBServiceManager,IServiceManager)
  private
    FServiceIntf: Firebird.IService;
    procedure CheckActive;
    procedure CheckInactive;
  protected
    procedure InternalAttach(ConnectString: string); override;
  public
    property ServiceIntf: Firebird.IService read FServiceIntf;

  public
    {IServiceManager}
    procedure Detach(Force: boolean=false); override;
    function IsAttached: boolean;
    procedure Start(Request: ISRB);
    function Query(SQPB: ISQPB; Request: ISRB): 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: String);
begin
  with Firebird30ClientAPI do
  if FSPB = nil then
  begin
    FServiceIntf := ProviderIntf.attachServiceManager(StatusIntf, PChar(ConnectString), 0, nil);
    Check4DataBaseError;
  end
  else
  begin
    FServiceIntf := ProviderIntf.attachServiceManager(StatusIntf,
                                               PChar(ConnectString),
                                               (FSPB as TSPB).getDataLength,
                                               BytePtr((FSPB as TSPB).getBuffer));
    Check4DataBaseError;
  end;
end;

procedure TFB30ServiceManager.Detach(Force: boolean);
begin
  if FServiceIntf = nil then
    Exit;
  with Firebird30ClientAPI 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;

procedure TFB30ServiceManager.Start(Request: ISRB);
begin
  CheckActive;
  with Firebird30ClientAPI do
    begin
      FServiceIntf.Start(StatusIntf,
                           (Request as TSRB).getDataLength,
                           BytePtr((Request as TSRB).getBuffer));
      Check4DataBaseError;
    end;
end;

function TFB30ServiceManager.Query(SQPB: ISQPB; Request: ISRB
  ): IServiceQueryResults;
var QueryResults: TServiceQueryResults;
begin
  CheckActive;
  QueryResults := TServiceQueryResults.Create;
  Result := QueryResults;
  with Firebird30ClientAPI 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));
        Check4DataBaseError;
    end
    else
     FServiceIntf.query(StatusIntf, 0, nil,
                       (Request as TSRB).getDataLength,
                       BytePtr((Request as TSRB).getBuffer),
                       QueryResults.getBufSize,
                       BytePtr(QueryResults.Buffer));
      Check4DataBaseError;
  end;
end;

end.

Revision:	45
Committed:	Tue Dec 6 10:33:46 2016 UTC (7 years, 4 months ago) by tony
Content type:	text/x-pascal
File size:	4348 byte(s)
Log Message:	Committing updates for Release R2-0-0
#	User	Rev	Content
1	tony	45	(*
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
29			{$IFDEF FPC}
30			{$mode objfpc}{$H+}
31			{$interfaces COM}
32			{$ENDIF}
33
34			interface
35
36			uses
37			Classes, SysUtils, Firebird, IB, FB30ClientAPI, FBParamBlock, FBOutputBlock,
38			FBServices;
39
40			type
41			{ TFBServiceManager }
42
43			TFB30ServiceManager = class(TFBServiceManager,IServiceManager)
44			private
45			FServiceIntf: Firebird.IService;
46			procedure CheckActive;
47			procedure CheckInactive;
48			protected
49			procedure InternalAttach(ConnectString: string); override;
50			public
51			property ServiceIntf: Firebird.IService read FServiceIntf;
52
53			public
54			{IServiceManager}
55			procedure Detach(Force: boolean=false); override;
56			function IsAttached: boolean;
57			procedure Start(Request: ISRB);
58			function Query(SQPB: ISQPB; Request: ISRB): IServiceQueryResults; override;
59			end;
60
61			implementation
62
63			uses FBMessages;
64
65			{ TFBServiceManager }
66
67			procedure TFB30ServiceManager.CheckActive;
68			begin
69			if FServiceIntf = nil then
70			IBError(ibxeServiceActive, [nil]);
71			end;
72
73			procedure TFB30ServiceManager.CheckInactive;
74			begin
75			if FServiceIntf <> nil then
76			IBError(ibxeServiceInActive, [nil]);
77			end;
78
79			procedure TFB30ServiceManager.InternalAttach(ConnectString: String);
80			begin
81			with Firebird30ClientAPI do
82			if FSPB = nil then
83			begin
84			FServiceIntf := ProviderIntf.attachServiceManager(StatusIntf, PChar(ConnectString), 0, nil);
85			Check4DataBaseError;
86			end
87			else
88			begin
89			FServiceIntf := ProviderIntf.attachServiceManager(StatusIntf,
90			PChar(ConnectString),
91			(FSPB as TSPB).getDataLength,
92			BytePtr((FSPB as TSPB).getBuffer));
93			Check4DataBaseError;
94			end;
95			end;
96
97			procedure TFB30ServiceManager.Detach(Force: boolean);
98			begin
99			if FServiceIntf = nil then
100			Exit;
101			with Firebird30ClientAPI do
102			begin
103			FServiceIntf.detach(StatusIntf);
104			if not Force and InErrorState then
105			IBDataBaseError;
106			FServiceIntf := nil;
107			end;
108			end;
109
110			function TFB30ServiceManager.IsAttached: boolean;
111			begin
112			Result := FServiceIntf <> nil;
113			end;
114
115			procedure TFB30ServiceManager.Start(Request: ISRB);
116			begin
117			CheckActive;
118			with Firebird30ClientAPI do
119			begin
120			FServiceIntf.Start(StatusIntf,
121			(Request as TSRB).getDataLength,
122			BytePtr((Request as TSRB).getBuffer));
123			Check4DataBaseError;
124			end;
125			end;
126
127			function TFB30ServiceManager.Query(SQPB: ISQPB; Request: ISRB
128			): IServiceQueryResults;
129			var QueryResults: TServiceQueryResults;
130			begin
131			CheckActive;
132			QueryResults := TServiceQueryResults.Create;
133			Result := QueryResults;
134			with Firebird30ClientAPI do
135			begin
136			if SQPB <> nil then
137			begin
138			FServiceIntf.query(StatusIntf,
139			(SQPB as TSQPB).getDataLength,
140			BytePtr((SQPB as TSQPB).getBuffer),
141			(Request as TSRB).getDataLength,
142			BytePtr((Request as TSRB).getBuffer),
143			QueryResults.getBufSize,
144			BytePtr(QueryResults.Buffer));
145			Check4DataBaseError;
146			end
147			else
148			FServiceIntf.query(StatusIntf, 0, nil,
149			(Request as TSRB).getDataLength,
150			BytePtr((Request as TSRB).getBuffer),
151			QueryResults.getBufSize,
152			BytePtr(QueryResults.Buffer));
153			Check4DataBaseError;
154			end;
155			end;
156
157			end.
158