client/3.0/FB30Transaction.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 FB30Transaction;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

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

interface

uses
  Classes, SysUtils, Firebird, IB, FBClientAPI, FB30ClientAPI,
  FB30Attachment, FBParamBlock, FBActivityMonitor, FBTransaction;

type

  { TFB30Transaction }

  TFB30Transaction = class(TFBTransaction,ITransaction, IActivityMonitor)
  private
    FTransactionIntf: Firebird.ITransaction;
    FFirebird30ClientAPI: TFB30ClientAPI;
    procedure StartMultiple;
    procedure FreeHandle;
  protected
    function GetActivityIntf(att: IAttachment): IActivityMonitor; override;
    procedure SetInterface(api: TFBClientAPI); override;
  public
    destructor Destroy; override;
    property TransactionIntf: Firebird.ITransaction read FTransactionIntf;
    {ITransaction}
    function GetInTransaction: boolean; override;
    procedure PrepareForCommit; override;
    procedure Commit(Force: boolean=false); override;
    procedure CommitRetaining; override;
    procedure Start(DefaultCompletion: TTransactionCompletion=taCommit); overload; override;
    procedure Rollback(Force: boolean=false); override;
    procedure RollbackRetaining; override;
  end;


implementation

uses FBMessages;

{ TFB30Transaction }

procedure TFB30Transaction.StartMultiple;
var Dtc: IDtc;
    DtcStart: IDtcStart;
    i: integer;
begin
  with FFirebird30ClientAPI do
  begin
    Dtc := MasterIntf.getDtc;
    DtcStart := Dtc.startBuilder(StatusIntf);
    Check4DataBaseError;

    for i := 0 to Length(FAttachments) - 1 do
    if (FAttachments[i] <> nil)  then
    begin
      DTCStart.addWithTpb(StatusIntf,
                          (FAttachments[i] as TFB30Attachment).AttachmentIntf,
                          (FTPB as TTPB).getDataLength,
                          BytePtr((FTPB as TTPB).getBuffer));
      Check4DataBaseError;
    end;
    FTransactionIntf := DtcStart.start(StatusIntf);
    Check4DataBaseError;
  end;
end;

procedure TFB30Transaction.FreeHandle;
begin
  if assigned(FTransactionIntf) then
    FTransactionIntf.release;
  FTransactionIntf := nil;
end;

function TFB30Transaction.GetActivityIntf(att: IAttachment): IActivityMonitor;
begin
  Result := att as TFB30Attachment;
end;

procedure TFB30Transaction.SetInterface(api: TFBClientAPI);
begin
  inherited SetInterface(api);
  FFirebird30ClientAPI := api as TFB30ClientAPI;
end;

destructor TFB30Transaction.Destroy;
begin
  inherited Destroy;
  FreeHandle;
end;

function TFB30Transaction.GetInTransaction: boolean;
begin
  Result := FTransactionIntf <> nil;
end;

procedure TFB30Transaction.PrepareForCommit;
begin
  if Length(FAttachments) < 2 then
    IBError(ibxeNotAMultiDatabaseTransaction,[nil]);
  if FTransactionIntf = nil then
    Exit;
  with FFirebird30ClientAPI do
  begin
    FTransactionIntf.prepare(StatusIntf,0,nil);
    Check4DataBaseError;
  end;
  SignalActivity;
end;

procedure TFB30Transaction.Commit(Force: boolean);
begin
  if FTransactionIntf = nil then
    Exit;
  with FFirebird30ClientAPI do
  begin
    FTransactionIntf.commit(StatusIntf);
    if not Force and InErrorState then
       IBDataBaseError;
  end;
  SignalActivity;
  FreeHandle;
end;

procedure TFB30Transaction.CommitRetaining;
begin
  if FTransactionIntf = nil then
    Exit;
  with FFirebird30ClientAPI do
  begin
    FTransactionIntf.commitRetaining(StatusIntf);
    Check4DataBaseError;
  end;
  SignalActivity;
end;

procedure TFB30Transaction.Start(DefaultCompletion: TTransactionCompletion);
begin
  if FTransactionIntf <> nil then
    Exit;
  FDefaultCompletion := DefaultCompletion;

  if Length(FAttachments) = 1 then
    with FFirebird30ClientAPI do
    begin
      FTransactionIntf  := (FAttachments[0] as TFB30Attachment).AttachmentIntf.startTransaction(StatusIntf,
               (FTPB as TTPB).getDataLength,BytePtr((FTPB as TTPB).getBuffer));
      Check4DataBaseError;
    end
  else
    StartMultiple;
  SignalActivity;
  Inc(FSeqNo);
end;

procedure TFB30Transaction.Rollback(Force: boolean);
begin
  if FTransactionIntf = nil then
    Exit;
  with FFirebird30ClientAPI do
  begin
    FTransactionIntf.rollback(StatusIntf);
    if not Force and InErrorState then
       IBDataBaseError;
  end;
  SignalActivity;
  FreeHandle;
end;

procedure TFB30Transaction.RollbackRetaining;
begin
  if FTransactionIntf = nil then
    Exit;
  with FFirebird30ClientAPI do
  begin
    FTransactionIntf.rollbackRetaining(StatusIntf);
    Check4DataBaseError;
  end;
  SignalActivity;
end;


end.

Revision:	263
Committed:	Thu Dec 6 15:55:01 2018 UTC (5 years, 11 months ago) by tony
Content type:	text/x-pascal
Original Path:	*ibx/trunk/fbintf/client/3.0/FB30Transaction.pas*
File size:	5424 byte(s)
Log Message:	Release 2.3.2 committed
#	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 FB30Transaction;
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, FBClientAPI, FB30ClientAPI,
41			FB30Attachment, FBParamBlock, FBActivityMonitor, FBTransaction;
42
43			type
44
45			{ TFB30Transaction }
46
47			TFB30Transaction = class(TFBTransaction,ITransaction, IActivityMonitor)
48			private
49			FTransactionIntf: Firebird.ITransaction;
50	tony	263	FFirebird30ClientAPI: TFB30ClientAPI;
51	tony	45	procedure StartMultiple;
52			procedure FreeHandle;
53			protected
54			function GetActivityIntf(att: IAttachment): IActivityMonitor; override;
55	tony	263	procedure SetInterface(api: TFBClientAPI); override;
56	tony	45	public
57			destructor Destroy; override;
58			property TransactionIntf: Firebird.ITransaction read FTransactionIntf;
59			{ITransaction}
60			function GetInTransaction: boolean; override;
61			procedure PrepareForCommit; override;
62			procedure Commit(Force: boolean=false); override;
63			procedure CommitRetaining; override;
64			procedure Start(DefaultCompletion: TTransactionCompletion=taCommit); overload; override;
65			procedure Rollback(Force: boolean=false); override;
66			procedure RollbackRetaining; override;
67			end;
68
69
70			implementation
71
72			uses FBMessages;
73
74			{ TFB30Transaction }
75
76			procedure TFB30Transaction.StartMultiple;
77			var Dtc: IDtc;
78			DtcStart: IDtcStart;
79			i: integer;
80			begin
81	tony	263	with FFirebird30ClientAPI do
82	tony	45	begin
83			Dtc := MasterIntf.getDtc;
84			DtcStart := Dtc.startBuilder(StatusIntf);
85			Check4DataBaseError;
86
87			for i := 0 to Length(FAttachments) - 1 do
88			if (FAttachments[i] <> nil) then
89			begin
90			DTCStart.addWithTpb(StatusIntf,
91			(FAttachments[i] as TFB30Attachment).AttachmentIntf,
92			(FTPB as TTPB).getDataLength,
93			BytePtr((FTPB as TTPB).getBuffer));
94			Check4DataBaseError;
95			end;
96			FTransactionIntf := DtcStart.start(StatusIntf);
97			Check4DataBaseError;
98			end;
99			end;
100
101			procedure TFB30Transaction.FreeHandle;
102			begin
103			if assigned(FTransactionIntf) then
104			FTransactionIntf.release;
105			FTransactionIntf := nil;
106			end;
107
108			function TFB30Transaction.GetActivityIntf(att: IAttachment): IActivityMonitor;
109			begin
110			Result := att as TFB30Attachment;
111			end;
112
113	tony	263	procedure TFB30Transaction.SetInterface(api: TFBClientAPI);
114			begin
115			inherited SetInterface(api);
116			FFirebird30ClientAPI := api as TFB30ClientAPI;
117			end;
118
119	tony	45	destructor TFB30Transaction.Destroy;
120			begin
121			inherited Destroy;
122			FreeHandle;
123			end;
124
125			function TFB30Transaction.GetInTransaction: boolean;
126			begin
127			Result := FTransactionIntf <> nil;
128			end;
129
130			procedure TFB30Transaction.PrepareForCommit;
131			begin
132			if Length(FAttachments) < 2 then
133			IBError(ibxeNotAMultiDatabaseTransaction,[nil]);
134			if FTransactionIntf = nil then
135			Exit;
136	tony	263	with FFirebird30ClientAPI do
137	tony	45	begin
138			FTransactionIntf.prepare(StatusIntf,0,nil);
139			Check4DataBaseError;
140			end;
141			SignalActivity;
142			end;
143
144			procedure TFB30Transaction.Commit(Force: boolean);
145			begin
146			if FTransactionIntf = nil then
147			Exit;
148	tony	263	with FFirebird30ClientAPI do
149	tony	45	begin
150			FTransactionIntf.commit(StatusIntf);
151			if not Force and InErrorState then
152			IBDataBaseError;
153			end;
154			SignalActivity;
155			FreeHandle;
156			end;
157
158			procedure TFB30Transaction.CommitRetaining;
159			begin
160			if FTransactionIntf = nil then
161			Exit;
162	tony	263	with FFirebird30ClientAPI do
163	tony	45	begin
164			FTransactionIntf.commitRetaining(StatusIntf);
165			Check4DataBaseError;
166			end;
167			SignalActivity;
168			end;
169
170			procedure TFB30Transaction.Start(DefaultCompletion: TTransactionCompletion);
171			begin
172			if FTransactionIntf <> nil then
173			Exit;
174			FDefaultCompletion := DefaultCompletion;
175
176	tony	63	if Length(FAttachments) = 1 then
177	tony	263	with FFirebird30ClientAPI do
178	tony	45	begin
179			FTransactionIntf := (FAttachments[0] as TFB30Attachment).AttachmentIntf.startTransaction(StatusIntf,
180			(FTPB as TTPB).getDataLength,BytePtr((FTPB as TTPB).getBuffer));
181			Check4DataBaseError;
182	tony	63	end
183			else
184			StartMultiple;
185	tony	45	SignalActivity;
186			Inc(FSeqNo);
187			end;
188
189			procedure TFB30Transaction.Rollback(Force: boolean);
190			begin
191			if FTransactionIntf = nil then
192			Exit;
193	tony	263	with FFirebird30ClientAPI do
194	tony	45	begin
195			FTransactionIntf.rollback(StatusIntf);
196			if not Force and InErrorState then
197			IBDataBaseError;
198			end;
199			SignalActivity;
200			FreeHandle;
201			end;
202
203			procedure TFB30Transaction.RollbackRetaining;
204			begin
205			if FTransactionIntf = nil then
206			Exit;
207	tony	263	with FFirebird30ClientAPI do
208	tony	45	begin
209			FTransactionIntf.rollbackRetaining(StatusIntf);
210			Check4DataBaseError;
211			end;
212			SignalActivity;
213			end;
214
215
216			end.
217