Понадобилось мне разгрести бардак с транзакциями на IBX.
Полазив по коду самого IBX, увидел, что вся действия логируются через MonitorHook и далее выводятся через TIBSQLMonitor. Проблема в том, что логирование крайне скудное, а реализация IIBSQLMonitorHook скрыта так далеко в implementation, что до нее не добраться. Поэтому решил патчить VMT у IIBSQLMonitorHook.
Вот, что в итоге получилось. Может кому пригодится
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
uses
IBSQLMonitor;
type
TMyMonitorHook = class
strict private
type
TTranProc = procedure (tr: TIBTransaction) of object;
TErrProc = procedure (AMsg: string) of object;
class var
FTransactions: TThreadedDictionary<TIBTransaction, string>;
FOldMethods: TList<TPair<Integer, Pointer>>;
strict private
class constructor Create;
class destructor Destroy;
strict private
class function WriteAddr(const AHook: IIBSQLMonitorHook;
AMethodIdx: Integer; const ANewMethod: TTranProc): Pointer; overload;
class function WriteAddr(const AHook: IIBSQLMonitorHook;
AMethodIdx: Integer; ANewMethod: Pointer): Pointer; overload;
strict private
class procedure TRStart(tr: TIBTransaction);
class procedure TRCommit(tr: TIBTransaction);
class procedure TRRollback(tr: TIBTransaction);
class procedure SendError(AMsg : String);
public
class procedure Init;
end;
{ TMyMonitorHook }
class constructor TMyMonitorHook.Create;
begin
FTransactions := TThreadedDictionary<TIBTransaction, string>.Create;
FOldMethods := TList<TPair<Integer, Pointer>>.Create;
end;
class destructor TMyMonitorHook.Destroy;
var
LHook: IIBSQLMonitorHook;
LPair: TPair<Integer, Pointer>;
begin
if FOldMethods.Count > 0 then begin
LHook := MonitorHook;
for LPair in FOldMethods do
WriteAddr(LHook, LPair.Key, LPair.Value);
end;
FTransactions.Free;
end;
class function TMyMonitorHook.WriteAddr(const AHook: IIBSQLMonitorHook;
AMethodIdx: Integer; const ANewMethod: TTranProc): Pointer;
begin
Result := WriteAddr(AHook, AMethodIdx, TMethod(ANewMethod).Code);
end;
class function TMyMonitorHook.WriteAddr(const AHook: IIBSQLMonitorHook;
AMethodIdx: Integer; ANewMethod: Pointer): Pointer;
var
LOffset: Cardinal;
LMethodAddr: PPointer;
LOldProt: Cardinal;
begin
LOffset := (AMethodIdx + 3) * SizeOf(Pointer); // 3 - count of methods IUnknown
LMethodAddr := OffsetPtr(PPointer(AHook)^, LOffset);
Win32Check(VirtualProtect(LMethodAddr, SizeOf(LMethodAddr^), PAGE_READWRITE, LOldProt));
Result := LMethodAddr^;
LMethodAddr^ := ANewMethod;
Win32Check(VirtualProtect(LMethodAddr, SizeOf(LMethodAddr^), LOldProt, LOldProt));
end;
class procedure TMyMonitorHook.TRStart(tr: TIBTransaction);
var
LStr: string;
begin
if FTransactions.TryGetValue(tr, LStr) then
Msg(LStr)
else
FTransactions.Add(tr, Format(#13#10'Thread: %u', [GetCurrentThreadId]) + GetStackInfo());
end;
class procedure TMyMonitorHook.TRCommit(tr: TIBTransaction);
begin
FTransactions.Remove(tr);
end;
class procedure TMyMonitorHook.TRRollback(tr: TIBTransaction);
begin
FTransactions.Remove(tr);
end;
class procedure TMyMonitorHook.SendError(AMsg: String);
var
LMsg: string;
LTrans: TDictionary<TIBTransaction, string>;
LPair: TPair<TIBTransaction, string>;
begin
LMsg := Format('Thread: %u'#13#10, [GetCurrentThreadId]);
LTrans := FTransactions.BeginRead;
try
for LPair in LTrans do begin
LMsg := LMsg + LPair.Key.Name + LPair.Value + sLineBreak;
end;
finally
FTransactions.EndRead;
end;
ShowMessage(LMsg);
end;
class procedure TMyMonitorHook.Init;
var
LHook: IIBSQLMonitorHook;
LPair: TPair<Integer, Pointer>;
LErr: TErrProc;
begin
LHook := MonitorHook;
LPair.Key := 8;
LPair.Value := WriteAddr(LHook, LPair.Key, TRStart);
FOldMethods.Add(LPair);
LPair.Key := 9;
LPair.Value := WriteAddr(LHook, LPair.Key, TRCommit);
FOldMethods.Add(LPair);
LPair.Key := 11;
LPair.Value := WriteAddr(LHook, LPair.Key, TRRollback);
FOldMethods.Add(LPair);
LErr := SendError;
LPair.Key := 19;
LPair.Value := WriteAddr(LHook, LPair.Key, TMethod(LErr).Code);
FOldMethods.Add(LPair);
end;
Дисклаймер. Класс использовался для поиска конкретной ошибки. При использовании класса при завершении программы вылетает AV, но его я уже не искал
С уважением, Vasilisk
