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

https://github.com/the-Arioch/jcl · Pascal · 330 lines · 277 code · 46 blank · 7 comment · 19 complexity · a3ef85e4e30ab352ea668ed683be3381 MD5 · raw file

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