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;
    procedure CheckActive;
    procedure CheckInactive;
  protected
    procedure InternalAttach(ConnectString: AnsiString); override;
  public
    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 Firebird30ClientAPI 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;

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;

function TFB30ServiceManager.Start(Request: ISRB; RaiseExceptionOnError: boolean
  ): boolean;
begin
  Result := true;
  CheckActive;
  with Firebird30ClientAPI 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;
  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));
      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:	209
Committed:	Wed Mar 14 12:48:51 2018 UTC (6 years, 1 month ago) by tony
Content type:	text/x-pascal
File size:	4906 byte(s)
Log Message:	Fixes Merged
#	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	tony	56	{$IFDEF MSWINDOWS}
29			{$DEFINE WINDOWS}
30			{$ENDIF}
31	tony	45
32			{$IFDEF FPC}
33	tony	56	{$mode delphi}
34	tony	45	{$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	tony	209	{ TFB30ServiceManager }
47
48	tony	45	TFB30ServiceManager = class(TFBServiceManager,IServiceManager)
49			private
50			FServiceIntf: Firebird.IService;
51			procedure CheckActive;
52			procedure CheckInactive;
53			protected
54	tony	56	procedure InternalAttach(ConnectString: AnsiString); override;
55	tony	45	public
56			property ServiceIntf: Firebird.IService read FServiceIntf;
57
58			public
59			{IServiceManager}
60			procedure Detach(Force: boolean=false); override;
61			function IsAttached: boolean;
62	tony	209	function Start(Request: ISRB; RaiseExceptionOnError: boolean=true): boolean;
63			function Query(SQPB: ISQPB; Request: ISRB; RaiseExceptionOnError: boolean=true): IServiceQueryResults; override;
64	tony	45	end;
65
66			implementation
67
68			uses FBMessages;
69
70			{ TFBServiceManager }
71
72			procedure TFB30ServiceManager.CheckActive;
73			begin
74			if FServiceIntf = nil then
75			IBError(ibxeServiceActive, [nil]);
76			end;
77
78			procedure TFB30ServiceManager.CheckInactive;
79			begin
80			if FServiceIntf <> nil then
81			IBError(ibxeServiceInActive, [nil]);
82			end;
83
84	tony	56	procedure TFB30ServiceManager.InternalAttach(ConnectString: AnsiString);
85	tony	45	begin
86			with Firebird30ClientAPI do
87			if FSPB = nil then
88			begin
89	tony	56	FServiceIntf := ProviderIntf.attachServiceManager(StatusIntf, PAnsiChar(ConnectString), 0, nil);
90	tony	45	Check4DataBaseError;
91			end
92			else
93			begin
94			FServiceIntf := ProviderIntf.attachServiceManager(StatusIntf,
95	tony	56	PAnsiChar(ConnectString),
96	tony	45	(FSPB as TSPB).getDataLength,
97			BytePtr((FSPB as TSPB).getBuffer));
98			Check4DataBaseError;
99			end;
100			end;
101
102			procedure TFB30ServiceManager.Detach(Force: boolean);
103			begin
104			if FServiceIntf = nil then
105			Exit;
106			with Firebird30ClientAPI do
107			begin
108			FServiceIntf.detach(StatusIntf);
109			if not Force and InErrorState then
110			IBDataBaseError;
111			FServiceIntf := nil;
112			end;
113			end;
114
115			function TFB30ServiceManager.IsAttached: boolean;
116			begin
117			Result := FServiceIntf <> nil;
118			end;
119
120	tony	209	function TFB30ServiceManager.Start(Request: ISRB; RaiseExceptionOnError: boolean
121			): boolean;
122	tony	45	begin
123	tony	209	Result := true;
124	tony	45	CheckActive;
125			with Firebird30ClientAPI do
126			begin
127			FServiceIntf.Start(StatusIntf,
128			(Request as TSRB).getDataLength,
129			BytePtr((Request as TSRB).getBuffer));
130	tony	209	if RaiseExceptionOnError then
131			Check4DataBaseError
132			else
133			Result := not InErrorState;
134	tony	45	end;
135			end;
136
137	tony	209	function TFB30ServiceManager.Query(SQPB: ISQPB; Request: ISRB;
138			RaiseExceptionOnError: boolean): IServiceQueryResults;
139	tony	45	var QueryResults: TServiceQueryResults;
140			begin
141			CheckActive;
142			QueryResults := TServiceQueryResults.Create;
143			Result := QueryResults;
144			with Firebird30ClientAPI do
145			begin
146			if SQPB <> nil then
147			begin
148			FServiceIntf.query(StatusIntf,
149			(SQPB as TSQPB).getDataLength,
150			BytePtr((SQPB as TSQPB).getBuffer),
151			(Request as TSRB).getDataLength,
152			BytePtr((Request as TSRB).getBuffer),
153			QueryResults.getBufSize,
154			BytePtr(QueryResults.Buffer));
155	tony	209	if RaiseExceptionOnError then
156			Check4DataBaseError
157			else
158			if InErrorState then
159			Result := nil;
160	tony	45	end
161			else
162	tony	209	begin
163			FServiceIntf.query(StatusIntf, 0, nil,
164	tony	45	(Request as TSRB).getDataLength,
165			BytePtr((Request as TSRB).getBuffer),
166			QueryResults.getBufSize,
167			BytePtr(QueryResults.Buffer));
168	tony	209	if RaiseExceptionOnError then
169			Check4DataBaseError
170			else
171			if InErrorState then
172			Result := nil;
173			end;
174	tony	45	end;
175			end;
176
177			end.
178