/jcl/experts/stacktraceviewer/APIExamples/FastMM/StackTraceViewerFastMMUnit.pas

  1unit StackTraceViewerFastMMUnit;
  2
  3interface
  4
  5uses
  6  SysUtils, Classes, Forms, Contnrs, FastMMParser, JclStackTraceViewerAPI;
  7
  8type
  9  TCustomTreeViewLinkClass = class of TCustomTreeViewLink;
 10
 11  TCustomTreeViewLink = class(TInterfacedObject, IJclStackTraceViewerTreeViewLink)
 12  private
 13    FItems: TInterfaceList;
 14    FText: string;
 15  public
 16    constructor Create(const AText: string);
 17    destructor Destroy; override;
 18    function Add(const AText: string; AClass: TCustomTreeViewLinkClass): TCustomTreeViewLink;
 19    procedure Clear;
 20    procedure DoShow(AFrame: TCustomFrame); virtual;
 21    function GetCount: Integer;
 22    function GetFrameClass: TCustomFrameClass; virtual;
 23    function GetItems(AIndex: Integer): IJclStackTraceViewerTreeViewLink;
 24    function GetText: string;
 25  end;
 26
 27  TRootTreeViewLink = class(TCustomTreeViewLink);
 28
 29  TDummyTreeViewLink = class(TCustomTreeViewLink);
 30
 31  TLeakTreeViewLink = class(TCustomTreeViewLink)
 32  private
 33    FLeakData: TFastMMLeak;
 34  public
 35    constructor Create(const AText: string);
 36    procedure DoShow(AFrame: TCustomFrame); override;
 37    function GetFrameClass: TCustomFrameClass; override;
 38    property LeakData: TFastMMLeak read FLeakData write FLeakData;
 39  end;
 40
 41  TLeakGroupTreeViewLink = class(TCustomTreeViewLink)
 42  private
 43    FLeakGroupData: TFastMMLeakGroup;
 44  public
 45    constructor Create(const AText: string);
 46    procedure DoShow(AFrame: TCustomFrame); override;
 47    function GetFrameClass: TCustomFrameClass; override;
 48    property LeakData: TFastMMLeakGroup read FLeakGroupData write FLeakGroupData;
 49  end;
 50
 51  TLeakSummaryTreeViewLink = class(TCustomTreeViewLink)
 52  private
 53    FReport: TFastMMReport;
 54  public
 55    constructor Create(const AText: string);
 56    procedure DoShow(AFrame: TCustomFrame); override;
 57    function GetFrameClass: TCustomFrameClass; override;
 58    property Report: TFastMMReport read FReport write FReport;
 59  end;
 60
 61  TFreedObjectTreeViewLink = class(TCustomTreeViewLink)
 62  private
 63    FFreedObjectData: TFastMMVMOnFreedObject;
 64  public
 65    constructor Create(const AText: string);
 66    procedure DoShow(AFrame: TCustomFrame); override;
 67    function GetFrameClass: TCustomFrameClass; override;
 68    property FreedObjectData: TFastMMVMOnFreedObject read FFreedObjectData write FFreedObjectData;
 69  end;
 70
 71  TFastMMReportData = class(TObject)
 72  private
 73    FReportList: TObjectList;
 74    FRootLink: TRootTreeViewLink;
 75    FRootLinkIntf: IJclStackTraceViewerTreeViewLink;
 76  public
 77    constructor Create;
 78    destructor Destroy; override;
 79    procedure LoadFastMMFile(const AFileName: string);
 80  end;
 81
 82implementation
 83
 84uses
 85  FastMMLeakFrame, FastMMLeakGroupFrame, FastMMLeakSummaryFrame, FastMMFreedObjectFrame;
 86
 87{ TTestTreeViewLink }
 88
 89constructor TCustomTreeViewLink.Create(const AText: string);
 90begin
 91  inherited Create;
 92  FItems := TInterfaceList.Create;
 93  FText := AText;
 94end;
 95
 96destructor TCustomTreeViewLink.Destroy;
 97begin
 98  //FStack.Free;
 99  FItems.Free;
100  inherited Destroy;
101end;
102
103function TCustomTreeViewLink.Add(const AText: string; AClass: TCustomTreeViewLinkClass): TCustomTreeViewLink;
104begin
105  Result := AClass.Create(AText);
106  FItems.Add(Result);
107end;
108
109procedure TCustomTreeViewLink.Clear;
110begin
111  FItems.Clear;
112end;
113
114procedure TCustomTreeViewLink.DoShow(AFrame: TCustomFrame);
115begin
116end;
117
118function TCustomTreeViewLink.GetCount: Integer;
119begin
120  Result := FItems.Count;
121end;
122
123function TCustomTreeViewLink.GetFrameClass: TCustomFrameClass;
124begin
125  Result := nil;
126end;
127
128function TCustomTreeViewLink.GetItems(AIndex: Integer): IJclStackTraceViewerTreeViewLink;
129begin
130  if FItems[AIndex].QueryInterface(IJclStackTraceViewerTreeViewLink, Result) <> S_OK then
131    Result := nil;
132end;
133
134function TCustomTreeViewLink.GetText: string;
135begin
136  Result := FText;
137end;
138
139{ TLeakTreeViewLink }
140
141constructor TLeakTreeViewLink.Create(const AText: string);
142begin
143  inherited Create(AText);
144  FLeakData := nil;
145end;
146
147procedure TLeakTreeViewLink.DoShow(AFrame: TCustomFrame);
148begin
149  inherited DoShow(AFrame);
150  if (AFrame is TfrmLeak) and Assigned(FLeakData) then
151  begin
152    if FLeakData.Stack.Count > 0 then
153      StackTraceViewerStackProcessorServices.PrepareLocationInfoList(FLeakData.Stack, False);
154    TfrmLeak(AFrame).LeakData := FLeakData;
155  end;
156end;
157
158function TLeakTreeViewLink.GetFrameClass: TCustomFrameClass;
159begin
160  Result := TfrmLeak;
161end;
162
163{ TLeakGroupTreeViewLink }
164
165constructor TLeakGroupTreeViewLink.Create(const AText: string);
166begin
167  inherited Create(AText);
168  FLeakGroupData := nil;
169end;
170
171procedure TLeakGroupTreeViewLink.DoShow(AFrame: TCustomFrame);
172begin
173  inherited DoShow(AFrame);
174  if (AFrame is TfrmLeakGroup) and Assigned(FLeakGroupData) then
175  begin
176    if (FLeakGroupData.Count > 0) and (FLeakGroupData[0].Stack.Count > 0) then
177      StackTraceViewerStackProcessorServices.PrepareLocationInfoList(FLeakGroupData[0].Stack, False);
178    TfrmLeakGroup(AFrame).LeakGroupData := FLeakGroupData;
179  end;
180end;
181
182function TLeakGroupTreeViewLink.GetFrameClass: TCustomFrameClass;
183begin
184  Result := TfrmLeakGroup;
185end;
186
187{ TLeakSummaryTreeViewLink }
188
189constructor TLeakSummaryTreeViewLink.Create(const AText: string);
190begin
191  inherited Create(AText);
192  FReport := nil;
193end;
194
195procedure TLeakSummaryTreeViewLink.DoShow(AFrame: TCustomFrame);
196begin
197  inherited DoShow(AFrame);
198  if (AFrame is TfrmLeakSummary) and Assigned(FReport) then
199    TfrmLeakSummary(AFrame).Report := FReport;
200end;
201
202function TLeakSummaryTreeViewLink.GetFrameClass: TCustomFrameClass;
203begin
204  Result := TfrmLeakSummary;
205end;
206
207{ TFreedObjectTreeViewLink }
208
209constructor TFreedObjectTreeViewLink.Create(const AText: string);
210begin
211  inherited Create(AText);
212  FFreedObjectData := nil;
213end;
214
215procedure TFreedObjectTreeViewLink.DoShow(AFrame: TCustomFrame);
216begin
217  inherited DoShow(AFrame);
218  if (AFrame is TfrmFreedObject) and Assigned(FFreedObjectData) then
219  begin
220    if FFreedObjectData.Stack1.Count > 0 then
221      StackTraceViewerStackProcessorServices.PrepareLocationInfoList(FFreedObjectData.Stack1, False);
222    if FFreedObjectData.Stack2.Count > 0 then
223      StackTraceViewerStackProcessorServices.PrepareLocationInfoList(FFreedObjectData.Stack2, False);
224    if FFreedObjectData.Stack3.Count > 0 then
225      StackTraceViewerStackProcessorServices.PrepareLocationInfoList(FFreedObjectData.Stack3, False);
226    TfrmFreedObject(AFrame).FreedObjectData := FFreedObjectData;
227  end;
228end;
229
230function TFreedObjectTreeViewLink.GetFrameClass: TCustomFrameClass;
231begin
232  Result := TfrmFreedObject;
233end;
234
235{ TFastMMReportData }
236
237constructor TFastMMReportData.Create;
238begin
239  inherited Create;
240  FReportList := TObjectList.Create;
241  FRootLink := TRootTreeViewLink.Create('');
242  FRootLinkIntf := FRootLink;
243end;
244
245destructor TFastMMReportData.Destroy;
246begin
247  FRootLinkIntf := nil;
248  FReportList.Free;
249  inherited Destroy;
250end;
251
252procedure TFastMMReportData.LoadFastMMFile(const AFileName: string);
253var
254  I, J, K: Integer;
255  FastMMFileParser: TFastMMFileParser;
256  FastMMReport: TFastMMReport;
257  ReportLink: TDummyTreeViewLink;
258  LeakGroup: TLeakGroupTreeViewLink;
259  Leak: TLeakTreeViewLink;
260  Summary: TLeakSummaryTreeViewLink;
261  FreedObject: TFreedObjectTreeViewLink;
262begin
263  if Assigned(StackTraceViewerStackServices) then
264  begin
265    StackTraceViewerStackServices.UnregisterFrameClass(TfrmLeak);
266    StackTraceViewerStackServices.UnregisterFrameClass(TfrmLeakGroup);
267    StackTraceViewerStackServices.UnregisterFrameClass(TfrmLeakSummary);
268    StackTraceViewerStackServices.UnregisterFrameClass(TfrmFreedObject);
269    StackTraceViewerStackServices.ShowTree(nil);
270  end;
271  FReportList.Clear;
272  FRootLink.Clear;
273  FastMMFileParser := TFastMMFileParser.Create;
274  try
275    FastMMFileParser.ParseFile(AFileName, FReportList);
276  finally
277    FastMMFileParser.Free;
278  end;
279  if Assigned(StackTraceViewerStackServices) then
280  begin
281    for I := 0 to FReportList.Count - 1 do
282    begin
283      FastMMReport := TFastMMReport(FReportList[I]);
284      ReportLink := TDummyTreeViewLink(FRootLink.Add(Format('Report %d', [I + 1]), TDummyTreeViewLink));
285      if FastMMReport.LeakSummary.Count > 0 then
286      begin
287        Summary := TLeakSummaryTreeViewLink(ReportLink.Add('Leak Summary', TLeakSummaryTreeViewLink));
288        Summary.Report := FastMMReport;
289      end;
290      for J := 0 to FastMMReport.LeakGroupCount - 1 do
291      begin
292        if FastMMReport.LeakGroupItems[J].Count = 1 then
293        begin
294          Leak := TLeakTreeViewLink(ReportLink.Add(Format('Leak %d', [J + 1]), TLeakTreeViewLink));
295          Leak.LeakData := FastMMReport.LeakGroupItems[J][0];
296        end
297        else
298        begin
299          LeakGroup := TLeakGroupTreeViewLink(ReportLink.Add(Format('Leak Group %d', [J + 1]), TLeakGroupTreeViewLink));
300          LeakGroup.LeakData := FastMMReport.LeakGroupItems[J];
301          for K := 0 to FastMMReport.LeakGroupItems[J].Count - 1 do
302          begin
303            Leak := TLeakTreeViewLink(LeakGroup.Add(Format('Leak %d', [K + 1]), TLeakTreeViewLink));
304            Leak.LeakData := FastMMReport.LeakGroupItems[J][K];
305          end;
306        end;
307      end;
308      for J := 0 to FastMMReport.VMOnFreedObjectCount - 1 do
309      begin
310        FreedObject := TFreedObjectTreeViewLink(ReportLink.Add(Format('Freed Object %d', [J + 1]), TFreedObjectTreeViewLink));
311        FreedObject.FreedObjectData := FastMMReport.VMOnFreedObjectItems[J];
312      end;
313    end;
314    StackTraceViewerStackServices.ShowTree(FRootLinkIntf);
315  end;
316end;
317
318initialization
319
320finalization
321  if Assigned(StackTraceViewerStackServices) then
322  begin
323    StackTraceViewerStackServices.UnregisterFrameClass(TfrmLeak);
324    StackTraceViewerStackServices.UnregisterFrameClass(TfrmLeakGroup);
325    StackTraceViewerStackServices.UnregisterFrameClass(TfrmLeakSummary);
326    StackTraceViewerStackServices.UnregisterFrameClass(TfrmFreedObject);
327    StackTraceViewerStackServices.ShowTree(nil);
328  end;
329
330end.