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 FPC}
{$mode objfpc}{$H+}
{$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;
    procedure StartMultiple;
    procedure FreeHandle;
  protected
    function GetActivityIntf(att: IAttachment): IActivityMonitor; 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 Firebird30ClientAPI 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;

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 Firebird30ClientAPI do
  begin
    FTransactionIntf.prepare(StatusIntf,0,nil);
    Check4DataBaseError;
  end;
  SignalActivity;
end;

procedure TFB30Transaction.Commit(Force: boolean);
begin
  if FTransactionIntf = nil then
    Exit;
  with Firebird30ClientAPI 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 Firebird30ClientAPI 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) > 0 then
    StartMultiple
  else
    with Firebird30ClientAPI do
    begin
      FTransactionIntf  := (FAttachments[0] as TFB30Attachment).AttachmentIntf.startTransaction(StatusIntf,
               (FTPB as TTPB).getDataLength,BytePtr((FTPB as TTPB).getBuffer));
      Check4DataBaseError;
    end;
  SignalActivity;
  Inc(FSeqNo);
end;

procedure TFB30Transaction.Rollback(Force: boolean);
begin
  if FTransactionIntf = nil then
    Exit;
  with Firebird30ClientAPI 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 Firebird30ClientAPI do
  begin
    FTransactionIntf.rollbackRetaining(StatusIntf);
    Check4DataBaseError;
  end;
  SignalActivity;
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:	5124 byte(s)
Log Message:	Committing updates for Release R2-0-0
#	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 FB30Transaction;
28
29	{$IFDEF FPC}
30	{$mode objfpc}{$H+}
31	{$interfaces COM}
32	{$ENDIF}
33
34	interface
35
36	uses
37	Classes, SysUtils, Firebird, IB, FBClientAPI, FB30ClientAPI,
38	FB30Attachment, FBParamBlock, FBActivityMonitor, FBTransaction;
39
40	type
41
42	{ TFB30Transaction }
43
44	TFB30Transaction = class(TFBTransaction,ITransaction, IActivityMonitor)
45	private
46	FTransactionIntf: Firebird.ITransaction;
47	procedure StartMultiple;
48	procedure FreeHandle;
49	protected
50	function GetActivityIntf(att: IAttachment): IActivityMonitor; override;
51	public
52	destructor Destroy; override;
53	property TransactionIntf: Firebird.ITransaction read FTransactionIntf;
54	{ITransaction}
55	function GetInTransaction: boolean; override;
56	procedure PrepareForCommit; override;
57	procedure Commit(Force: boolean=false); override;
58	procedure CommitRetaining; override;
59	procedure Start(DefaultCompletion: TTransactionCompletion=taCommit); overload; override;
60	procedure Rollback(Force: boolean=false); override;
61	procedure RollbackRetaining; override;
62	end;
63
64
65	implementation
66
67	uses FBMessages;
68
69	{ TFB30Transaction }
70
71	procedure TFB30Transaction.StartMultiple;
72	var Dtc: IDtc;
73	DtcStart: IDtcStart;
74	i: integer;
75	begin
76	with Firebird30ClientAPI do
77	begin
78	Dtc := MasterIntf.getDtc;
79	DtcStart := Dtc.startBuilder(StatusIntf);
80	Check4DataBaseError;
81
82	for i := 0 to Length(FAttachments) - 1 do
83	if (FAttachments[i] <> nil) then
84	begin
85	DTCStart.addWithTpb(StatusIntf,
86	(FAttachments[i] as TFB30Attachment).AttachmentIntf,
87	(FTPB as TTPB).getDataLength,
88	BytePtr((FTPB as TTPB).getBuffer));
89	Check4DataBaseError;
90	end;
91	FTransactionIntf := DtcStart.start(StatusIntf);
92	Check4DataBaseError;
93	end;
94	end;
95
96	procedure TFB30Transaction.FreeHandle;
97	begin
98	if assigned(FTransactionIntf) then
99	FTransactionIntf.release;
100	FTransactionIntf := nil;
101	end;
102
103	function TFB30Transaction.GetActivityIntf(att: IAttachment): IActivityMonitor;
104	begin
105	Result := att as TFB30Attachment;
106	end;
107
108	destructor TFB30Transaction.Destroy;
109	begin
110	inherited Destroy;
111	FreeHandle;
112	end;
113
114	function TFB30Transaction.GetInTransaction: boolean;
115	begin
116	Result := FTransactionIntf <> nil;
117	end;
118
119	procedure TFB30Transaction.PrepareForCommit;
120	begin
121	if Length(FAttachments) < 2 then
122	IBError(ibxeNotAMultiDatabaseTransaction,[nil]);
123	if FTransactionIntf = nil then
124	Exit;
125	with Firebird30ClientAPI do
126	begin
127	FTransactionIntf.prepare(StatusIntf,0,nil);
128	Check4DataBaseError;
129	end;
130	SignalActivity;
131	end;
132
133	procedure TFB30Transaction.Commit(Force: boolean);
134	begin
135	if FTransactionIntf = nil then
136	Exit;
137	with Firebird30ClientAPI do
138	begin
139	FTransactionIntf.commit(StatusIntf);
140	if not Force and InErrorState then
141	IBDataBaseError;
142	end;
143	SignalActivity;
144	FreeHandle;
145	end;
146
147	procedure TFB30Transaction.CommitRetaining;
148	begin
149	if FTransactionIntf = nil then
150	Exit;
151	with Firebird30ClientAPI do
152	begin
153	FTransactionIntf.commitRetaining(StatusIntf);
154	Check4DataBaseError;
155	end;
156	SignalActivity;
157	end;
158
159	procedure TFB30Transaction.Start(DefaultCompletion: TTransactionCompletion);
160	begin
161	if FTransactionIntf <> nil then
162	Exit;
163
164	FDefaultCompletion := DefaultCompletion;
165
166	if Length(FAttachments) > 0 then
167	StartMultiple
168	else
169	with Firebird30ClientAPI do
170	begin
171	FTransactionIntf := (FAttachments[0] as TFB30Attachment).AttachmentIntf.startTransaction(StatusIntf,
172	(FTPB as TTPB).getDataLength,BytePtr((FTPB as TTPB).getBuffer));
173	Check4DataBaseError;
174	end;
175	SignalActivity;
176	Inc(FSeqNo);
177	end;
178
179	procedure TFB30Transaction.Rollback(Force: boolean);
180	begin
181	if FTransactionIntf = nil then
182	Exit;
183	with Firebird30ClientAPI do
184	begin
185	FTransactionIntf.rollback(StatusIntf);
186	if not Force and InErrorState then
187	IBDataBaseError;
188	end;
189	SignalActivity;
190	FreeHandle;
191	end;
192
193	procedure TFB30Transaction.RollbackRetaining;
194	begin
195	if FTransactionIntf = nil then
196	Exit;
197	with Firebird30ClientAPI do
198	begin
199	FTransactionIntf.rollbackRetaining(StatusIntf);
200	Check4DataBaseError;
201	end;
202	SignalActivity;
203	end;
204
205
206	end.
207