45 |
|
{$ELSE} |
46 |
|
unix, |
47 |
|
{$ENDIF} |
48 |
< |
SysUtils, Classes, FPTimer, IBExternals, DB, IB, CustApp, IBInternals; |
48 |
> |
SysUtils, Classes, FPTimer, IBExternals, DB, IB, CustApp, IBInternals, |
49 |
> |
syncobjs; |
50 |
|
|
51 |
|
type |
52 |
|
TIBDatabase = class; |
223 |
|
|
224 |
|
TIBTransaction = class(TComponent) |
225 |
|
private |
226 |
+ |
class var FCriticalSection: TCriticalSection; |
227 |
+ |
class var FTransactionList: TList; |
228 |
+ |
private |
229 |
|
FTransactionIntf: ITransaction; |
230 |
|
FAfterDelete: TNotifyEvent; |
231 |
|
FAfterEdit: TNotifyEvent; |
247 |
|
FTRParamsChanged : Boolean; |
248 |
|
FInEndTransaction : boolean; |
249 |
|
FEndAction : TTransactionAction; |
250 |
+ |
FTransactionName : string; |
251 |
|
procedure DoBeforeTransactionEnd; |
252 |
|
procedure DoAfterTransactionEnd; |
253 |
|
procedure DoOnStartTransaction; |
260 |
|
procedure EndTransaction(Action: TTransactionAction; Force: Boolean); |
261 |
|
function GetDatabase(Index: Integer): TIBDatabase; |
262 |
|
function GetDatabaseCount: Integer; |
263 |
+ |
function GetIsReadOnly: boolean; |
264 |
|
function GetSQLObject(Index: Integer): TIBBase; |
265 |
|
function GetSQLObjectCount: Integer; |
266 |
|
function GetInTransaction: Boolean; |
267 |
|
function GetIdleTimer: Integer; |
268 |
|
procedure BeforeDatabaseDisconnect(DB: TIBDatabase); |
269 |
|
function GetTPBConstantNames(index: byte): string; |
270 |
+ |
function GetTransactionID: integer; |
271 |
|
procedure SetActive(Value: Boolean); |
272 |
|
procedure SetDefaultDatabase(Value: TIBDatabase); |
273 |
|
procedure SetIdleTimer(Value: Integer); |
274 |
+ |
procedure SetTransactionName(AValue: string); |
275 |
|
procedure SetTRParams(Value: TStrings); |
276 |
|
procedure TimeoutTransaction(Sender: TObject); |
277 |
|
procedure TRParamsChange(Sender: TObject); |
280 |
|
procedure RemoveSQLObject(Idx: Integer); |
281 |
|
procedure RemoveSQLObjects; |
282 |
|
function GenerateTPB(FirebirdAPI: IFirebirdAPI; sl: TStrings): ITPB; |
275 |
– |
|
283 |
|
protected |
284 |
|
procedure Loaded; override; |
285 |
|
procedure Notification( AComponent: TComponent; Operation: TOperation); override; |
298 |
|
function AddDatabase(db: TIBDatabase): Integer; |
299 |
|
function FindDatabase(db: TIBDatabase): Integer; |
300 |
|
function FindDefaultDatabase: TIBDatabase; |
301 |
+ |
class function FindTransactionNyName(aTransactionName: string): TIBTransaction; |
302 |
|
function GetEndAction: TTransactionAction; |
303 |
|
procedure RemoveDatabase(Idx: Integer); |
304 |
|
procedure RemoveDatabases; |
312 |
|
property TransactionIntf: ITransaction read FTransactionIntf; |
313 |
|
property TPB: ITPB read FTPB; |
314 |
|
property TPBConstantNames[index: byte]: string read GetTPBConstantNames; |
315 |
+ |
property TransactionID: integer read GetTransactionID; |
316 |
+ |
property IsReadOnly: boolean read GetIsReadOnly; |
317 |
|
published |
318 |
+ |
property TransactionName: string read FTransactionName write SetTransactionName; |
319 |
|
property Active: Boolean read GetInTransaction write SetActive; |
320 |
|
property DefaultDatabase: TIBDatabase read FDefaultDatabase |
321 |
|
write SetDefaultDatabase; |
438 |
|
TStringList(FDBParams).OnChanging := DBParamsChanging; |
439 |
|
FInternalTransaction := TIBTransaction.Create(self); |
440 |
|
FInternalTransaction.DefaultDatabase := Self; |
441 |
+ |
with FInternalTransaction.Params do |
442 |
+ |
begin |
443 |
+ |
Clear; |
444 |
+ |
Add('concurrency'); |
445 |
+ |
Add('wait'); |
446 |
+ |
Add('read'); |
447 |
+ |
end; |
448 |
|
FTimer := TFPTimer.Create(Self); |
449 |
|
FTimer.Enabled := False; |
450 |
|
FTimer.Interval := 0; |
1584 |
|
{ TIBTransaction } |
1585 |
|
|
1586 |
|
constructor TIBTransaction.Create(AOwner: TComponent); |
1587 |
+ |
var uuid: TGUID; |
1588 |
|
begin |
1589 |
|
inherited Create(AOwner); |
1590 |
|
FDatabases := TList.Create; |
1599 |
|
FTimer.Interval := 0; |
1600 |
|
FTimer.OnTimer := TimeoutTransaction; |
1601 |
|
FDefaultAction := taCommit; |
1602 |
+ |
FTransactionList.Add(self); |
1603 |
+ |
if (FTransactionName = '') and (CreateGUID(uuid) = 0) then |
1604 |
+ |
FTransactionName := GUIDToString(uuid); |
1605 |
|
end; |
1606 |
|
|
1607 |
|
destructor TIBTransaction.Destroy; |
1615 |
|
SQLObjects[i].DoTransactionFree; |
1616 |
|
RemoveSQLObjects; |
1617 |
|
RemoveDatabases; |
1618 |
+ |
if assigned(FTransactionList) then |
1619 |
+ |
FTransactionList.Remove(self); |
1620 |
|
FTPB := nil; |
1621 |
|
FTRParams.Free; |
1622 |
|
FSQLObjects.Free; |
1759 |
|
|
1760 |
|
procedure TIBTransaction.EndTransaction(Action: TTransactionAction; |
1761 |
|
Force: Boolean); |
1762 |
< |
var |
1763 |
< |
i: Integer; |
1764 |
< |
begin |
1765 |
< |
CheckInTransaction; |
1766 |
< |
if FInEndTransaction then Exit; |
1767 |
< |
FInEndTransaction := true; |
1768 |
< |
FEndAction := Action; |
1769 |
< |
try |
1770 |
< |
case Action of |
1771 |
< |
TARollback, TACommit: |
1772 |
< |
begin |
1773 |
< |
try |
1774 |
< |
DoBeforeTransactionEnd; |
1775 |
< |
except on E: EIBInterBaseError do |
1776 |
< |
begin |
1777 |
< |
if not Force then |
1762 |
> |
|
1763 |
> |
|
1764 |
> |
procedure InternalDoBeforeTransactionEnd; |
1765 |
> |
var i: integer; |
1766 |
> |
begin |
1767 |
> |
try |
1768 |
> |
DoBeforeTransactionEnd; |
1769 |
> |
except on E: EIBInterBaseError do |
1770 |
> |
begin |
1771 |
> |
if not Force then |
1772 |
> |
raise; |
1773 |
> |
end; |
1774 |
> |
end; |
1775 |
> |
|
1776 |
> |
for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then |
1777 |
> |
try |
1778 |
> |
SQLObjects[i].DoBeforeTransactionEnd(Action); |
1779 |
> |
except on E: EIBInterBaseError do |
1780 |
> |
begin |
1781 |
> |
if not Force then |
1782 |
|
raise; |
1783 |
|
end; |
1784 |
< |
end; |
1784 |
> |
end; |
1785 |
> |
end; |
1786 |
|
|
1787 |
< |
for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then |
1787 |
> |
procedure InternalDoAfterTransctionEnd; |
1788 |
> |
var i: integer; |
1789 |
> |
begin |
1790 |
> |
for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then |
1791 |
|
try |
1792 |
< |
SQLObjects[i].DoBeforeTransactionEnd(Action); |
1792 |
> |
SQLObjects[i].DoAfterTransactionEnd; |
1793 |
|
except on E: EIBInterBaseError do |
1794 |
|
begin |
1795 |
|
if not Force then |
1796 |
< |
raise; |
1797 |
< |
end; |
1796 |
> |
raise; |
1797 |
> |
end; |
1798 |
|
end; |
1799 |
< |
|
1800 |
< |
if InTransaction then |
1799 |
> |
try |
1800 |
> |
DoAfterTransactionEnd; |
1801 |
> |
except on E: EIBInterBaseError do |
1802 |
|
begin |
1803 |
< |
if (Action = TARollback) then |
1804 |
< |
FTransactionIntf.Rollback(Force) |
1772 |
< |
else |
1773 |
< |
try |
1774 |
< |
FTransactionIntf.Commit; |
1775 |
< |
except on E: EIBInterBaseError do |
1776 |
< |
begin |
1777 |
< |
if Force then |
1778 |
< |
FTransactionIntf.Rollback(Force) |
1779 |
< |
else |
1780 |
< |
raise; |
1781 |
< |
end; |
1782 |
< |
end; |
1783 |
< |
|
1784 |
< |
for i := 0 to FSQLObjects.Count - 1 do if FSQLObjects[i] <> nil then |
1785 |
< |
try |
1786 |
< |
SQLObjects[i].DoAfterTransactionEnd; |
1787 |
< |
except on E: EIBInterBaseError do |
1788 |
< |
begin |
1789 |
< |
if not Force then |
1790 |
< |
raise; |
1791 |
< |
end; |
1792 |
< |
end; |
1793 |
< |
try |
1794 |
< |
DoAfterTransactionEnd; |
1795 |
< |
except on E: EIBInterBaseError do |
1796 |
< |
begin |
1797 |
< |
if not Force then |
1798 |
< |
raise; |
1799 |
< |
end; |
1800 |
< |
end; |
1803 |
> |
if not Force then |
1804 |
> |
raise; |
1805 |
|
end; |
1806 |
|
end; |
1803 |
– |
TACommitRetaining: |
1804 |
– |
FTransactionIntf.CommitRetaining; |
1805 |
– |
|
1806 |
– |
TARollbackRetaining: |
1807 |
– |
FTransactionIntf.RollbackRetaining; |
1808 |
– |
end; |
1809 |
– |
if not (csDesigning in ComponentState) then |
1810 |
– |
begin |
1811 |
– |
case Action of |
1812 |
– |
TACommit: |
1813 |
– |
MonitorHook.TRCommit(Self); |
1814 |
– |
TARollback: |
1815 |
– |
MonitorHook.TRRollback(Self); |
1816 |
– |
TACommitRetaining: |
1817 |
– |
MonitorHook.TRCommitRetaining(Self); |
1818 |
– |
TARollbackRetaining: |
1819 |
– |
MonitorHook.TRRollbackRetaining(Self); |
1820 |
– |
end; |
1807 |
|
end; |
1808 |
+ |
|
1809 |
+ |
begin |
1810 |
+ |
CheckInTransaction; |
1811 |
+ |
if FInEndTransaction then Exit; |
1812 |
+ |
FCriticalSection.Enter; {Ensure that only one thread can commit a transaction |
1813 |
+ |
at any one time} |
1814 |
+ |
FEndAction := Action; |
1815 |
+ |
FInEndTransaction := true; |
1816 |
+ |
try |
1817 |
+ |
case Action of |
1818 |
+ |
TARollback: |
1819 |
+ |
begin |
1820 |
+ |
InternalDoBeforeTransactionEnd; |
1821 |
+ |
FTransactionIntf.Rollback(Force); |
1822 |
+ |
InternalDoAfterTransctionEnd; |
1823 |
+ |
if not (csDesigning in ComponentState) then |
1824 |
+ |
MonitorHook.TRRollback(Self); |
1825 |
+ |
end; |
1826 |
+ |
TACommit: |
1827 |
+ |
begin |
1828 |
+ |
InternalDoBeforeTransactionEnd; |
1829 |
+ |
try |
1830 |
+ |
FTransactionIntf.Commit; |
1831 |
+ |
except on E: EIBInterBaseError do |
1832 |
+ |
begin |
1833 |
+ |
if Force then |
1834 |
+ |
FTransactionIntf.Rollback(Force) |
1835 |
+ |
else |
1836 |
+ |
raise; |
1837 |
+ |
end; |
1838 |
+ |
end; |
1839 |
+ |
InternalDoAfterTransctionEnd; |
1840 |
+ |
if not (csDesigning in ComponentState) then |
1841 |
+ |
MonitorHook.TRCommit(Self); |
1842 |
+ |
end; |
1843 |
+ |
TACommitRetaining: |
1844 |
+ |
begin |
1845 |
+ |
FTransactionIntf.CommitRetaining; |
1846 |
+ |
if not (csDesigning in ComponentState) then |
1847 |
+ |
MonitorHook.TRCommitRetaining(Self); |
1848 |
+ |
end; |
1849 |
+ |
|
1850 |
+ |
TARollbackRetaining: |
1851 |
+ |
begin |
1852 |
+ |
FTransactionIntf.RollbackRetaining; |
1853 |
+ |
if not (csDesigning in ComponentState) then |
1854 |
+ |
MonitorHook.TRRollbackRetaining(Self); |
1855 |
+ |
end; |
1856 |
+ |
end; |
1857 |
|
finally |
1858 |
< |
FInEndTransaction := false |
1858 |
> |
FInEndTransaction := false; |
1859 |
> |
FCriticalSection.Leave; |
1860 |
|
end; |
1861 |
|
end; |
1862 |
|
|
1875 |
|
Inc(result); |
1876 |
|
end; |
1877 |
|
|
1878 |
+ |
function TIBTransaction.GetIsReadOnly: boolean; |
1879 |
+ |
begin |
1880 |
+ |
CheckInTransaction; |
1881 |
+ |
Result := FTransactionIntf.GetIsReadOnly; |
1882 |
+ |
end; |
1883 |
+ |
|
1884 |
|
function TIBTransaction.GetSQLObject(Index: Integer): TIBBase; |
1885 |
|
begin |
1886 |
|
result := FSQLObjects[Index]; |
1931 |
|
end; |
1932 |
|
end; |
1933 |
|
|
1934 |
+ |
class function TIBTransaction.FindTransactionNyName(aTransactionName: string |
1935 |
+ |
): TIBTransaction; |
1936 |
+ |
var i: integer; |
1937 |
+ |
begin |
1938 |
+ |
Result := nil; |
1939 |
+ |
for i := 0 to FTransactionList.Count - 1 do |
1940 |
+ |
if TIBTransaction(FTransactionList[i]).TransactionName = aTransactionName then |
1941 |
+ |
begin |
1942 |
+ |
Result := FTransactionList[i]; |
1943 |
+ |
break; |
1944 |
+ |
end; |
1945 |
+ |
end; |
1946 |
+ |
|
1947 |
|
function TIBTransaction.GetEndAction: TTransactionAction; |
1948 |
|
begin |
1949 |
|
if FInEndTransaction then |
1980 |
|
IBError(ibxeTPBConstantUnknown,[index]); |
1981 |
|
end; |
1982 |
|
|
1983 |
+ |
function TIBTransaction.GetTransactionID: integer; |
1984 |
+ |
begin |
1985 |
+ |
CheckInTransaction; |
1986 |
+ |
Result := FTransactionIntf.GetTransactionID; |
1987 |
+ |
end; |
1988 |
+ |
|
1989 |
|
procedure TIBTransaction.RemoveDatabase(Idx: Integer); |
1990 |
|
var |
1991 |
|
DB: TIBDatabase; |
2114 |
|
end; |
2115 |
|
end; |
2116 |
|
|
2117 |
+ |
procedure TIBTransaction.SetTransactionName(AValue: string); |
2118 |
+ |
begin |
2119 |
+ |
if FTransactionName = AValue then Exit; |
2120 |
+ |
CheckNotInTransaction; |
2121 |
+ |
FTransactionName := AValue; |
2122 |
+ |
end; |
2123 |
+ |
|
2124 |
|
procedure TIBTransaction.SetTRParams(Value: TStrings); |
2125 |
|
begin |
2126 |
|
FTRParams.Assign(Value); |
2162 |
|
if Databases[i] <> nil then Inc(ValidDatabaseCount); |
2163 |
|
|
2164 |
|
if ValidDatabaseCount = 1 then |
2165 |
< |
FTransactionIntf := Databases[0].Attachment.StartTransaction(FTPB,DefaultAction) |
2165 |
> |
FTransactionIntf := Databases[0].Attachment.StartTransaction(FTPB, |
2166 |
> |
DefaultAction,TransactionName) |
2167 |
|
else |
2168 |
|
begin |
2169 |
|
SetLength(Attachments,ValidDatabaseCount); |
2171 |
|
if Databases[i] <> nil then |
2172 |
|
Attachments[i] := Databases[i].Attachment; |
2173 |
|
|
2174 |
< |
FTransactionIntf := Databases[0].FirebirdAPI.StartTransaction(Attachments,FTPB,DefaultAction); |
2174 |
> |
FTransactionIntf := Databases[0].FirebirdAPI.StartTransaction(Attachments,FTPB, |
2175 |
> |
DefaultAction,TransactionName); |
2176 |
|
end; |
2177 |
+ |
|
2178 |
|
end; |
2179 |
|
|
2180 |
|
if not (csDesigning in ComponentState) then |
2181 |
< |
MonitorHook.TRStart(Self); |
2181 |
> |
MonitorHook.TRStart(Self); |
2182 |
> |
|
2183 |
|
DoOnStartTransaction; |
2184 |
|
end; |
2185 |
|
|
2479 |
|
end; |
2480 |
|
end; |
2481 |
|
|
2482 |
+ |
|
2483 |
+ |
Initialization |
2484 |
+ |
TIBTransaction.FCriticalSection := TCriticalSection.Create; |
2485 |
+ |
TIBTransaction.FTransactionList := TList.Create; |
2486 |
+ |
|
2487 |
+ |
Finalization |
2488 |
+ |
if assigned(TIBTransaction.FCriticalSection) then TIBTransaction.FCriticalSection.Free; |
2489 |
+ |
if assigned(TIBTransaction.FTransactionList) then TIBTransaction.FTransactionList.Free; |
2490 |
+ |
|
2491 |
|
end. |
2492 |
|
|
2493 |
|
|