/jcl/experts/stacktraceviewer/APIExamples/FastMM/StackTraceViewerFastMMUnit.pas
Pascal | 330 lines | 277 code | 46 blank | 7 comment | 19 complexity | a3ef85e4e30ab352ea668ed683be3381 MD5 | raw file
Possible License(s): BSD-3-Clause
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.