Menu
▾
▴
[Jcl-checkins-diff] SF.net SVN: jcl:[2769] branches/jcl-stack-trace/jcl
|
From: <usc...@us...> - 2009-05-22 20:30:47
|
Revision: 2769
http://jcl.svn.sourceforge.net/jcl/?rev=2769&view=rev
Author: uschuster
Date: 2009-05-22 20:30:36 +0000 (Fri, 22 May 2009)
Log Message:
-----------
extension for FastMM
Modified Paths:
--------------
branches/jcl-stack-trace/jcl/experts/stacktraceviewer/JclStackTraceViewerClasses.pas
branches/jcl-stack-trace/jcl/source/windows/JclDebug.pas
Added Paths:
-----------
branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/
branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMFreedObjectFrame.dfm
branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMFreedObjectFrame.pas
branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMLeakFrame.dfm
branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMLeakFrame.pas
branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMLeakGroupFrame.dfm
branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMLeakGroupFrame.pas
branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMLeakSummaryFrame.dfm
branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMLeakSummaryFrame.pas
branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMMemoryFrame.dfm
branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMMemoryFrame.pas
branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMParser.pas
branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/StackTraceViewerFastMM.dpk
branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/StackTraceViewerFastMMReg.pas
branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/StackTraceViewerFastMMUnit.pas
Property changes on: branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM
___________________________________________________________________
Added: tsvn:projectlanguage
+ 1033
Added: bugtraq:url
+ http://homepages.codegear.com/jedi/issuetracker/view.php?id=%BUGID%
Added: bugtraq:message
+ (Mantis #%BUGID%)
Added: bugtraq:logregex
+ [Mm]antis #?(\d+)(,? ?#?(\d+))+
(\d+)
Added: branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMFreedObjectFrame.dfm
===================================================================
--- branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMFreedObjectFrame.dfm (rev 0)
+++ branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMFreedObjectFrame.dfm 2009-05-22 20:30:36 UTC (rev 2769)
@@ -0,0 +1,108 @@
+object frmFreedObject: TfrmFreedObject
+ Left = 0
+ Top = 0
+ Width = 415
+ Height = 240
+ TabOrder = 0
+ object pnlTop: TPanel
+ Left = 0
+ Top = 0
+ Width = 415
+ Height = 41
+ Align = alTop
+ BevelOuter = bvNone
+ TabOrder = 0
+ object Label1: TLabel
+ Left = 3
+ Top = 3
+ Width = 95
+ Height = 13
+ Caption = 'Freed Object Class:'
+ end
+ object Label2: TLabel
+ Left = 3
+ Top = 19
+ Width = 89
+ Height = 13
+ Caption = 'Allocation number:'
+ end
+ object Label3: TLabel
+ Left = 227
+ Top = 3
+ Width = 73
+ Height = 13
+ Caption = 'Virtual Method:'
+ end
+ object Label4: TLabel
+ Left = 227
+ Top = 19
+ Width = 115
+ Height = 13
+ Caption = 'Virtual Method Address:'
+ end
+ object lbVM: TLabel
+ Left = 348
+ Top = 3
+ Width = 22
+ Height = 13
+ Caption = 'lbVM'
+ end
+ object lbVMAddr: TLabel
+ Left = 348
+ Top = 19
+ Width = 45
+ Height = 13
+ Caption = 'lbVMAddr'
+ end
+ object lbFreedObjectClass: TLabel
+ Left = 104
+ Top = 3
+ Width = 27
+ Height = 13
+ Caption = 'lbSize'
+ end
+ object lbAllocationNumber: TLabel
+ Left = 104
+ Top = 19
+ Width = 91
+ Height = 13
+ Caption = 'lbAllocationNumber'
+ end
+ end
+ object pg: TPageControl
+ Left = 0
+ Top = 41
+ Width = 415
+ Height = 199
+ ActivePage = tsStack1
+ Align = alClient
+ TabOrder = 1
+ object tsStack1: TTabSheet
+ Caption = 'Stack (allocated by)'
+ end
+ object tsStack2: TTabSheet
+ Caption = 'Stack (freed by)'
+ ImageIndex = 1
+ ExplicitLeft = 0
+ ExplicitTop = 0
+ ExplicitWidth = 0
+ ExplicitHeight = 0
+ end
+ object tsStack3: TTabSheet
+ Caption = 'Stack (current)'
+ ImageIndex = 2
+ ExplicitLeft = 0
+ ExplicitTop = 0
+ ExplicitWidth = 0
+ ExplicitHeight = 0
+ end
+ object tsMemory: TTabSheet
+ Caption = 'Memory Dump'
+ ImageIndex = 3
+ ExplicitLeft = 0
+ ExplicitTop = 0
+ ExplicitWidth = 0
+ ExplicitHeight = 0
+ end
+ end
+end
Added: branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMFreedObjectFrame.pas
===================================================================
--- branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMFreedObjectFrame.pas (rev 0)
+++ branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMFreedObjectFrame.pas 2009-05-22 20:30:36 UTC (rev 2769)
@@ -0,0 +1,190 @@
+unit FastMMFreedObjectFrame;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, ComCtrls, ExtCtrls, JclStackTraceViewerAPI, FastMMParser,
+ FastMMMemoryFrame;
+
+type
+ TfrmFreedObject = class(TFrame, IJclStackTraceViewerPreparableStackFrame, IJclStackTraceViewerStackSelection)
+ pnlTop: TPanel;
+ pg: TPageControl;
+ tsStack1: TTabSheet;
+ tsStack2: TTabSheet;
+ tsStack3: TTabSheet;
+ Label1: TLabel;
+ Label2: TLabel;
+ Label3: TLabel;
+ Label4: TLabel;
+ lbVM: TLabel;
+ lbVMAddr: TLabel;
+ lbFreedObjectClass: TLabel;
+ lbAllocationNumber: TLabel;
+ tsMemory: TTabSheet;
+ private
+ FFreedObjectData: TFastMMVMOnFreedObject;
+ FStackFrame1: TCustomFrame;
+ FStackFrame2: TCustomFrame;
+ FStackFrame3: TCustomFrame;
+ FStackInterfaceList: TInterfaceList;
+ FMemoryFrame: TfrmMemory;
+ function GetSelected: IJclLocationInfo;
+ function GetPreparableLocationInfoListCount: Integer;
+ function GetPreparableLocationInfoList(AIndex: Integer): IJclPreparedLocationInfoList;
+ procedure UpdateViews;
+ procedure SetFreedObjectData(const Value: TFastMMVMOnFreedObject);
+ { Private-Deklarationen }
+ public
+ { Public-Deklarationen }
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ property FreedObjectData: TFastMMVMOnFreedObject write SetFreedObjectData;
+ end;
+
+implementation
+
+{$R *.dfm}
+
+{ TfrmFreedObject }
+
+constructor TfrmFreedObject.Create(AOwner: TComponent);
+var
+ StackFrameClass: TCustomFrameClass;
+begin
+ inherited Create(AOwner);
+ FFreedObjectData := nil;
+ if Assigned(StackTraceViewerStackServices) then
+ begin
+ StackFrameClass := StackTraceViewerStackServices.GetDefaultFrameClass(dfStack);
+ if Assigned(StackFrameClass) then
+ begin
+ FStackFrame1 := StackFrameClass.Create(Self);
+ FStackFrame1.Parent := tsStack1;
+ FStackFrame1.Align := alClient;
+ FStackFrame1.Name := 'StackFrame1';
+ FStackFrame2 := StackFrameClass.Create(Self);
+ FStackFrame2.Parent := tsStack2;
+ FStackFrame2.Align := alClient;
+ FStackFrame2.Name := 'StackFrame2';
+ FStackFrame3 := StackFrameClass.Create(Self);
+ FStackFrame3.Parent := tsStack3;
+ FStackFrame3.Align := alClient;
+ FStackFrame3.Name := 'StackFrame3';
+ end;
+ end;
+ FMemoryFrame := TfrmMemory.Create(Self);
+ FMemoryFrame.Parent := tsMemory;
+ FMemoryFrame.Align := alClient;
+ FStackInterfaceList := TInterfaceList.Create;
+end;
+
+destructor TfrmFreedObject.Destroy;
+begin
+ FStackInterfaceList := TInterfaceList.Create;
+ FStackFrame1.Free;
+ FStackFrame2.Free;
+ FStackFrame3.Free;
+ FMemoryFrame.Free;
+ inherited Destroy;
+end;
+
+function TfrmFreedObject.GetPreparableLocationInfoList(AIndex: Integer): IJclPreparedLocationInfoList;
+begin
+ if FStackInterfaceList[AIndex].QueryInterface(IJclPreparedLocationInfoList, Result) <> S_OK then
+ Result := nil;
+end;
+
+function TfrmFreedObject.GetPreparableLocationInfoListCount: Integer;
+begin
+ Result := FStackInterfaceList.Count;
+end;
+
+function TfrmFreedObject.GetSelected: IJclLocationInfo;
+var
+ StackTraceViewerStackSelection: IJclStackTraceViewerStackSelection;
+begin
+ if Assigned(FFreedObjectData) then
+ begin
+ if pg.Visible and (pg.ActivePage = tsStack1) and FStackFrame1.Visible and
+ (FStackFrame1.GetInterface(IJclStackTraceViewerStackSelection, StackTraceViewerStackSelection)) and
+ Assigned(StackTraceViewerStackSelection.Selected) then
+ Result := StackTraceViewerStackSelection.Selected
+ else
+ if pg.Visible and (pg.ActivePage = tsStack2) and FStackFrame2.Visible and
+ (FStackFrame2.GetInterface(IJclStackTraceViewerStackSelection, StackTraceViewerStackSelection)) and
+ Assigned(StackTraceViewerStackSelection.Selected) then
+ Result := StackTraceViewerStackSelection.Selected
+ else
+ if pg.Visible and (pg.ActivePage = tsStack3) and FStackFrame3.Visible and
+ (FStackFrame3.GetInterface(IJclStackTraceViewerStackSelection, StackTraceViewerStackSelection)) and
+ Assigned(StackTraceViewerStackSelection.Selected) then
+ Result := StackTraceViewerStackSelection.Selected
+ else
+ Result := nil;
+ end
+ else
+ Result := nil;
+end;
+
+procedure TfrmFreedObject.SetFreedObjectData(const Value: TFastMMVMOnFreedObject);
+var
+ StackTraceViewerStackFrame: IJclStackTraceViewerStackFrame;
+ PreparedLocationInfoList: IJclPreparedLocationInfoList;
+begin
+ FStackInterfaceList.Clear;
+ FFreedObjectData := Value;
+ pnlTop.Visible := Assigned(FFreedObjectData);
+ if Assigned(FFreedObjectData) then
+ begin
+ lbFreedObjectClass.Caption := FFreedObjectData.ObjectClass;
+ lbAllocationNumber.Caption := IntToStr(FFreedObjectData.AllocationNumber);
+ lbVM.Caption := FFreedObjectData.VirtualMethod;
+ lbVMAddr.Caption := Format('%.8x', [FFreedObjectData.VirtualMethodAddress]);
+ end;
+ tsStack1.TabVisible := Assigned(FStackFrame1) and Assigned(FFreedObjectData) and (FFreedObjectData.Stack1.Count > 0);
+ tsStack1.Caption := Format('Stack (allocated by thread %x)', [FFreedObjectData.Stack1Thread]);
+ if tsStack1.TabVisible and FFreedObjectData.Stack1.GetInterface(IJclPreparedLocationInfoList, PreparedLocationInfoList) then
+ FStackInterfaceList.Add(PreparedLocationInfoList);
+ if tsStack1.TabVisible and (FStackFrame1.GetInterface(IJclStackTraceViewerStackFrame, StackTraceViewerStackFrame)) then
+ StackTraceViewerStackFrame.SetStackList(FFreedObjectData.Stack1);
+ tsStack2.TabVisible := Assigned(FStackFrame2) and Assigned(FFreedObjectData) and (FFreedObjectData.Stack2.Count > 0);
+ tsStack2.Caption := Format('Stack (freed by thread %x)', [FFreedObjectData.Stack2Thread]);
+ if tsStack2.TabVisible and FFreedObjectData.Stack2.GetInterface(IJclPreparedLocationInfoList, PreparedLocationInfoList) then
+ FStackInterfaceList.Add(PreparedLocationInfoList);
+ if tsStack2.TabVisible and (FStackFrame2.GetInterface(IJclStackTraceViewerStackFrame, StackTraceViewerStackFrame)) then
+ StackTraceViewerStackFrame.SetStackList(FFreedObjectData.Stack2);
+ tsStack3.TabVisible := Assigned(FStackFrame3) and Assigned(FFreedObjectData) and (FFreedObjectData.Stack3.Count > 0);
+ tsStack3.Caption := Format('Stack (current thread %x)', [FFreedObjectData.Stack3Thread]);
+ if tsStack3.TabVisible and FFreedObjectData.Stack3.GetInterface(IJclPreparedLocationInfoList, PreparedLocationInfoList) then
+ FStackInterfaceList.Add(PreparedLocationInfoList);
+ if tsStack3.TabVisible and (FStackFrame3.GetInterface(IJclStackTraceViewerStackFrame, StackTraceViewerStackFrame)) then
+ StackTraceViewerStackFrame.SetStackList(FFreedObjectData.Stack3);
+ tsMemory.TabVisible := Assigned(FFreedObjectData) and FFreedObjectData.FoundMemory;
+ if Assigned(FFreedObjectData) and FFreedObjectData.FoundMemory then
+ begin
+ FMemoryFrame.Address := FFreedObjectData.Address;
+ FMemoryFrame.MemoryArray := FFreedObjectData.Memory;
+ end;
+ pg.Visible := tsStack1.TabVisible or tsStack2.TabVisible or tsStack3.TabVisible or tsMemory.TabVisible;
+ if pg.Visible then
+ pg.TabIndex := 0;
+end;
+
+procedure TfrmFreedObject.UpdateViews;
+var
+ StackTraceViewerPreparableStackFrame: IJclStackTraceViewerPreparableStackFrame;
+begin
+ if tsStack1.TabVisible and
+ (FStackFrame1.GetInterface(IJclStackTraceViewerPreparableStackFrame, StackTraceViewerPreparableStackFrame)) then
+ StackTraceViewerPreparableStackFrame.UpdateViews;
+ if tsStack2.TabVisible and
+ (FStackFrame2.GetInterface(IJclStackTraceViewerPreparableStackFrame, StackTraceViewerPreparableStackFrame)) then
+ StackTraceViewerPreparableStackFrame.UpdateViews;
+ if tsStack3.TabVisible and
+ (FStackFrame3.GetInterface(IJclStackTraceViewerPreparableStackFrame, StackTraceViewerPreparableStackFrame)) then
+ StackTraceViewerPreparableStackFrame.UpdateViews;
+end;
+
+end.
Added: branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMLeakFrame.dfm
===================================================================
--- branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMLeakFrame.dfm (rev 0)
+++ branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMLeakFrame.dfm 2009-05-22 20:30:36 UTC (rev 2769)
@@ -0,0 +1,106 @@
+object frmLeak: TfrmLeak
+ Left = 0
+ Top = 0
+ Width = 495
+ Height = 240
+ TabOrder = 0
+ object pnlTop: TPanel
+ Left = 0
+ Top = 0
+ Width = 495
+ Height = 33
+ Align = alTop
+ BevelOuter = bvNone
+ TabOrder = 0
+ object Label1: TLabel
+ Left = 3
+ Top = 3
+ Width = 55
+ Height = 13
+ Caption = 'Timestamp:'
+ end
+ object Label2: TLabel
+ Left = 163
+ Top = 3
+ Width = 23
+ Height = 13
+ Caption = 'Size:'
+ end
+ object Label3: TLabel
+ Left = 163
+ Top = 19
+ Width = 38
+ Height = 13
+ Caption = 'Thread:'
+ end
+ object lbTimestamp: TLabel
+ Left = 64
+ Top = 3
+ Width = 59
+ Height = 13
+ Caption = 'lbTimestamp'
+ end
+ object lbSize: TLabel
+ Left = 224
+ Top = 3
+ Width = 27
+ Height = 13
+ Caption = 'lbSize'
+ end
+ object lbThread: TLabel
+ Left = 224
+ Top = 19
+ Width = 42
+ Height = 13
+ Caption = 'lbThread'
+ end
+ object Label4: TLabel
+ Left = 320
+ Top = 3
+ Width = 29
+ Height = 13
+ Caption = 'Class:'
+ end
+ object Label5: TLabel
+ Left = 320
+ Top = 19
+ Width = 89
+ Height = 13
+ Caption = 'Allocation number:'
+ end
+ object lbClass: TLabel
+ Left = 415
+ Top = 3
+ Width = 33
+ Height = 13
+ Caption = 'lbClass'
+ end
+ object lbAllocationNumber: TLabel
+ Left = 415
+ Top = 19
+ Width = 91
+ Height = 13
+ Caption = 'lbAllocationNumber'
+ end
+ end
+ object pg: TPageControl
+ Left = 0
+ Top = 33
+ Width = 495
+ Height = 207
+ ActivePage = tsStack
+ Align = alClient
+ TabOrder = 1
+ object tsStack: TTabSheet
+ Caption = 'Stack'
+ ImageIndex = 1
+ end
+ object tsMemory: TTabSheet
+ Caption = 'Memory dump'
+ ExplicitLeft = 0
+ ExplicitTop = 0
+ ExplicitWidth = 0
+ ExplicitHeight = 0
+ end
+ end
+end
Added: branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMLeakFrame.pas
===================================================================
--- branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMLeakFrame.pas (rev 0)
+++ branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMLeakFrame.pas 2009-05-22 20:30:36 UTC (rev 2769)
@@ -0,0 +1,143 @@
+unit FastMMLeakFrame;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, ExtCtrls, Grids, ComCtrls, JclStackTraceViewerAPI, FastMMParser,
+ FastMMMemoryFrame;
+
+type
+ TfrmLeak = class(TFrame, IJclStackTraceViewerPreparableStackFrame, IJclStackTraceViewerStackSelection)
+ pnlTop: TPanel;
+ Label1: TLabel;
+ Label2: TLabel;
+ Label3: TLabel;
+ lbTimestamp: TLabel;
+ lbSize: TLabel;
+ lbThread: TLabel;
+ Label4: TLabel;
+ Label5: TLabel;
+ lbClass: TLabel;
+ lbAllocationNumber: TLabel;
+ pg: TPageControl;
+ tsMemory: TTabSheet;
+ tsStack: TTabSheet;
+ private
+ { Private-Deklarationen }
+ FLeakData: TFastMMLeak;
+ FStackFrame: TCustomFrame;
+ FMemoryFrame: TfrmMemory;
+ function GetSelected: IJclLocationInfo;
+ function GetPreparableLocationInfoListCount: Integer;
+ function GetPreparableLocationInfoList(AIndex: Integer): IJclPreparedLocationInfoList;
+ procedure UpdateViews;
+ procedure SetLeakData(const Value: TFastMMLeak);
+ public
+ { Public-Deklarationen }
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ property LeakData: TFastMMLeak write SetLeakData;
+ end;
+
+implementation
+
+{$R *.dfm}
+
+{ TfrmLeak }
+
+constructor TfrmLeak.Create(AOwner: TComponent);
+var
+ StackFrameClass: TCustomFrameClass;
+begin
+ inherited Create(AOwner);
+ FLeakData := nil;
+ if Assigned(StackTraceViewerStackServices) then
+ begin
+ StackFrameClass := StackTraceViewerStackServices.GetDefaultFrameClass(dfStack);
+ if Assigned(StackFrameClass) then
+ begin
+ FStackFrame := StackFrameClass.Create(Self);
+ FStackFrame.Parent := tsStack;
+ FStackFrame.Align := alClient;
+ end;
+ end;
+ FMemoryFrame := TfrmMemory.Create(Self);
+ FMemoryFrame.Parent := tsMemory;
+ FMemoryFrame.Align := alClient;
+end;
+
+destructor TfrmLeak.Destroy;
+begin
+ FMemoryFrame.Free;
+ FStackFrame.Free;
+ inherited Destroy;
+end;
+
+function TfrmLeak.GetPreparableLocationInfoList(AIndex: Integer): IJclPreparedLocationInfoList;
+begin
+ Result := FLeakData.Stack;
+end;
+
+function TfrmLeak.GetPreparableLocationInfoListCount: Integer;
+var
+ Dummy: IJclPreparedLocationInfoList;
+begin
+ if Assigned(FLeakData) and Assigned(FLeakData.Stack) and
+ (FLeakData.Stack.QueryInterface(IJclPreparedLocationInfoList, Dummy) = S_OK) then
+ Result := 1
+ else
+ Result := 0;
+end;
+
+function TfrmLeak.GetSelected: IJclLocationInfo;
+var
+ StackTraceViewerStackSelection: IJclStackTraceViewerStackSelection;
+begin
+ if pg.Visible and (pg.ActivePage = tsStack) and FStackFrame.Visible and
+ (FStackFrame.GetInterface(IJclStackTraceViewerStackSelection, StackTraceViewerStackSelection)) and
+ Assigned(StackTraceViewerStackSelection.Selected) then
+ Result := StackTraceViewerStackSelection.Selected
+ else
+ Result := nil;
+end;
+
+procedure TfrmLeak.SetLeakData(const Value: TFastMMLeak);
+var
+ StackTraceViewerStackFrame: IJclStackTraceViewerStackFrame;
+begin
+ FLeakData := Value;
+ pnlTop.Visible := Assigned(FLeakData);
+ if Assigned(FLeakData) then
+ begin
+ lbTimestamp.Caption := FLeakData.DateStr;
+ lbSize.Caption := IntToStr(FLeakData.LeakSize);
+ lbThread.Caption := Format('%x', [FLeakData.ThreadID]);
+ lbClass.Caption := FLeakData.BlockClass;
+ lbAllocationNumber.Caption := IntToStr(FLeakData.AllocationNumber);
+ end;
+ tsStack.TabVisible := Assigned(FStackFrame) and Assigned(FLeakData) and (FLeakData.Stack.Count > 0);
+ if tsStack.TabVisible and (FStackFrame.GetInterface(IJclStackTraceViewerStackFrame, StackTraceViewerStackFrame)) then
+ StackTraceViewerStackFrame.SetStackList(FLeakData.Stack);
+
+ tsMemory.TabVisible := Assigned(FLeakData) and FLeakData.FoundMemory;
+ pg.Visible := tsStack.TabVisible or tsMemory.TabVisible;
+ if pg.Visible then
+ pg.TabIndex := 0;
+ if Assigned(FLeakData) and FLeakData.FoundMemory then
+ begin
+ FMemoryFrame.Address := FLeakData.Address;
+ FMemoryFrame.MemoryArray := FLeakData.Memory;
+ end;
+end;
+
+procedure TfrmLeak.UpdateViews;
+var
+ StackTraceViewerPreparableStackFrame: IJclStackTraceViewerPreparableStackFrame;
+begin
+ if FStackFrame.Visible and
+ (FStackFrame.GetInterface(IJclStackTraceViewerPreparableStackFrame, StackTraceViewerPreparableStackFrame)) then
+ StackTraceViewerPreparableStackFrame.UpdateViews;
+end;
+
+end.
Added: branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMLeakGroupFrame.dfm
===================================================================
--- branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMLeakGroupFrame.dfm (rev 0)
+++ branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMLeakGroupFrame.dfm 2009-05-22 20:30:36 UTC (rev 2769)
@@ -0,0 +1,44 @@
+object frmLeakGroup: TfrmLeakGroup
+ Left = 0
+ Top = 0
+ Width = 320
+ Height = 240
+ TabOrder = 0
+ object pnlTop: TPanel
+ Left = 0
+ Top = 0
+ Width = 320
+ Height = 33
+ Align = alTop
+ BevelOuter = bvNone
+ TabOrder = 0
+ object Label1: TLabel
+ Left = 3
+ Top = 3
+ Width = 58
+ Height = 13
+ Caption = 'Leak Count:'
+ end
+ object Label2: TLabel
+ Left = 3
+ Top = 19
+ Width = 48
+ Height = 13
+ Caption = 'Leak Size:'
+ end
+ object lbLeakCount: TLabel
+ Left = 67
+ Top = 3
+ Width = 59
+ Height = 13
+ Caption = 'lbLeakCount'
+ end
+ object lbLeakSize: TLabel
+ Left = 67
+ Top = 19
+ Width = 49
+ Height = 13
+ Caption = 'lbLeakSize'
+ end
+ end
+end
Added: branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMLeakGroupFrame.pas
===================================================================
--- branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMLeakGroupFrame.pas (rev 0)
+++ branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMLeakGroupFrame.pas 2009-05-22 20:30:36 UTC (rev 2769)
@@ -0,0 +1,118 @@
+unit FastMMLeakGroupFrame;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, ExtCtrls, JclStackTraceViewerAPI, FastMMParser;
+
+type
+ TfrmLeakGroup = class(TFrame, IJclStackTraceViewerPreparableStackFrame, IJclStackTraceViewerStackSelection)
+ pnlTop: TPanel;
+ Label1: TLabel;
+ Label2: TLabel;
+ lbLeakCount: TLabel;
+ lbLeakSize: TLabel;
+ private
+ FLeakGroupData: TFastMMLeakGroup;
+ FStackFrame: TCustomFrame;
+ function GetSelected: IJclLocationInfo;
+ function GetPreparableLocationInfoListCount: Integer;
+ function GetPreparableLocationInfoList(AIndex: Integer): IJclPreparedLocationInfoList;
+ procedure UpdateViews;
+ procedure SetLeakGroupData(const Value: TFastMMLeakGroup);
+ { Private-Deklarationen }
+ public
+ { Public-Deklarationen }
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ property LeakGroupData: TFastMMLeakGroup write SetLeakGroupData;
+ end;
+
+implementation
+
+{$R *.dfm}
+
+{ TfrmLeakGroup }
+
+constructor TfrmLeakGroup.Create(AOwner: TComponent);
+var
+ StackFrameClass: TCustomFrameClass;
+begin
+ inherited Create(AOwner);
+ FLeakGroupData := nil;
+ if Assigned(StackTraceViewerStackServices) then
+ begin
+ StackFrameClass := StackTraceViewerStackServices.GetDefaultFrameClass(dfStack);
+ if Assigned(StackFrameClass) then
+ begin
+ FStackFrame := StackFrameClass.Create(Self);
+ FStackFrame.Parent := Self;
+ FStackFrame.Align := alClient;
+ end;
+ end;
+end;
+
+destructor TfrmLeakGroup.Destroy;
+begin
+ FStackFrame.Free;
+ inherited Destroy;
+end;
+
+function TfrmLeakGroup.GetPreparableLocationInfoList(AIndex: Integer): IJclPreparedLocationInfoList;
+begin
+ Result := FLeakGroupData[0].Stack;
+end;
+
+function TfrmLeakGroup.GetPreparableLocationInfoListCount: Integer;
+var
+ Dummy: IJclPreparedLocationInfoList;
+begin
+ if Assigned(FLeakGroupData) and (FLeakGroupData.Count > 0) and
+ (FLeakGroupData[0].Stack.QueryInterface(IJclPreparedLocationInfoList, Dummy) = S_OK) then
+ Result := 1
+ else
+ Result := 0;
+end;
+
+function TfrmLeakGroup.GetSelected: IJclLocationInfo;
+var
+ StackTraceViewerStackSelection: IJclStackTraceViewerStackSelection;
+begin
+ if FStackFrame.Visible and
+ (FStackFrame.GetInterface(IJclStackTraceViewerStackSelection, StackTraceViewerStackSelection)) and
+ Assigned(StackTraceViewerStackSelection.Selected) then
+ Result := StackTraceViewerStackSelection.Selected
+ else
+ Result := nil;
+end;
+
+procedure TfrmLeakGroup.SetLeakGroupData(const Value: TFastMMLeakGroup);
+var
+ StackTraceViewerStackFrame: IJclStackTraceViewerStackFrame;
+begin
+ FLeakGroupData := Value;
+ pnlTop.Visible := Assigned(FLeakGroupData);
+ if Assigned(FLeakGroupData) then
+ begin
+ lbLeakCount.Caption := IntToStr(FLeakGroupData.Count);
+ lbLeakSize.Caption := IntToStr(FLeakGroupData.LeakSize);
+ end;
+ if Assigned(FStackFrame) then
+ begin
+ FStackFrame.Visible := Assigned(FLeakGroupData) and (FLeakGroupData.Count > 0) and (FLeakGroupData[0].Stack.Count > 0);
+ if FStackFrame.Visible and (FStackFrame.GetInterface(IJclStackTraceViewerStackFrame, StackTraceViewerStackFrame)) then
+ StackTraceViewerStackFrame.SetStackList(FLeakGroupData[0].Stack);
+ end;
+end;
+
+procedure TfrmLeakGroup.UpdateViews;
+var
+ StackTraceViewerPreparableStackFrame: IJclStackTraceViewerPreparableStackFrame;
+begin
+ if FStackFrame.Visible and
+ (FStackFrame.GetInterface(IJclStackTraceViewerPreparableStackFrame, StackTraceViewerPreparableStackFrame)) then
+ StackTraceViewerPreparableStackFrame.UpdateViews;
+end;
+
+end.
Added: branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMLeakSummaryFrame.dfm
===================================================================
--- branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMLeakSummaryFrame.dfm (rev 0)
+++ branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMLeakSummaryFrame.dfm 2009-05-22 20:30:36 UTC (rev 2769)
@@ -0,0 +1,19 @@
+object frmLeakSummary: TfrmLeakSummary
+ Left = 0
+ Top = 0
+ Width = 320
+ Height = 240
+ TabOrder = 0
+ object memSummary: TMemo
+ Left = 0
+ Top = 0
+ Width = 320
+ Height = 240
+ Align = alClient
+ TabOrder = 0
+ ExplicitLeft = 72
+ ExplicitTop = 80
+ ExplicitWidth = 185
+ ExplicitHeight = 89
+ end
+end
Added: branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMLeakSummaryFrame.pas
===================================================================
--- branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMLeakSummaryFrame.pas (rev 0)
+++ branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMLeakSummaryFrame.pas 2009-05-22 20:30:36 UTC (rev 2769)
@@ -0,0 +1,36 @@
+unit FastMMLeakSummaryFrame;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, FastMMParser;
+
+type
+ TfrmLeakSummary = class(TFrame)
+ memSummary: TMemo;
+ private
+ { Private-Deklarationen }
+ FReport: TFastMMReport;
+ procedure SetReport(const Value: TFastMMReport);
+ public
+ { Public-Deklarationen }
+ property Report: TFastMMReport write SetReport;
+ end;
+
+implementation
+
+{$R *.dfm}
+
+{ TfrmLeakSummary }
+
+procedure TfrmLeakSummary.SetReport(const Value: TFastMMReport);
+begin
+ FReport := Value;
+ if Assigned(FReport) then
+ memSummary.Lines.Assign(FReport.LeakSummary)
+ else
+ memSummary.Lines.Clear;
+end;
+
+end.
Added: branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMMemoryFrame.dfm
===================================================================
--- branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMMemoryFrame.dfm (rev 0)
+++ branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMMemoryFrame.dfm 2009-05-22 20:30:36 UTC (rev 2769)
@@ -0,0 +1,44 @@
+object frmMemory: TfrmMemory
+ Left = 0
+ Top = 0
+ Width = 320
+ Height = 240
+ TabOrder = 0
+ object Panel2: TPanel
+ Left = 0
+ Top = 0
+ Width = 320
+ Height = 17
+ Align = alTop
+ BevelOuter = bvNone
+ TabOrder = 0
+ object lbMemoryAddr: TLabel
+ Left = 52
+ Top = 3
+ Width = 69
+ Height = 13
+ Caption = 'lbMemoryAddr'
+ end
+ object Label6: TLabel
+ Left = 3
+ Top = 3
+ Width = 43
+ Height = 13
+ Caption = 'Address:'
+ end
+ end
+ object sgMemory: TStringGrid
+ Left = 0
+ Top = 17
+ Width = 320
+ Height = 223
+ Align = alClient
+ ColCount = 32
+ DefaultColWidth = 18
+ DefaultRowHeight = 18
+ FixedCols = 0
+ RowCount = 16
+ FixedRows = 0
+ TabOrder = 1
+ end
+end
Added: branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMMemoryFrame.pas
===================================================================
--- branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMMemoryFrame.pas (rev 0)
+++ branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMMemoryFrame.pas 2009-05-22 20:30:36 UTC (rev 2769)
@@ -0,0 +1,50 @@
+unit FastMMMemoryFrame;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ Dialogs, FastMMParser, Grids, StdCtrls, ExtCtrls;
+
+type
+ TfrmMemory = class(TFrame)
+ Panel2: TPanel;
+ lbMemoryAddr: TLabel;
+ Label6: TLabel;
+ sgMemory: TStringGrid;
+ private
+ { Private-Deklarationen }
+ FMemoryArray: TFastMMMemoryArray;
+ procedure SetMemoryArray(const Value: TFastMMMemoryArray);
+ procedure SetAddress(const Value: Integer);
+ public
+ { Public-Deklarationen }
+ property Address: Integer write SetAddress;
+ property MemoryArray: TFastMMMemoryArray write SetMemoryArray;
+ end;
+
+implementation
+
+{$R *.dfm}
+
+{ TfrmMemory }
+
+procedure TfrmMemory.SetAddress(const Value: Integer);
+begin
+ lbMemoryAddr.Caption := Format('%.8x', [Value]);
+end;
+
+procedure TfrmMemory.SetMemoryArray(const Value: TFastMMMemoryArray);
+var
+ I, J: Integer;
+begin
+ FMemoryArray := Value;
+ for I := 0 to 7 do
+ for J := 0 to 31 do
+ sgMemory.Cells[J, I] := Format('%.2x', [FMemoryArray[I * 32 + J]]);
+ for I := 0 to 7 do
+ for J := 0 to 31 do
+ sgMemory.Cells[J, I + 8] := string(AnsiChar(Chr(FMemoryArray[I * 32 + J])));
+end;
+
+end.
Added: branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMParser.pas
===================================================================
--- branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMParser.pas (rev 0)
+++ branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/FastMMParser.pas 2009-05-22 20:30:36 UTC (rev 2769)
@@ -0,0 +1,826 @@
+unit FastMMParser;
+
+interface
+
+uses
+ SysUtils, Classes, Contnrs,
+ {$IFNDEF NOVIEW}
+ JclStackTraceViewerClasses,
+ {$ENDIF ~NOVIEW}
+ JclDebug;
+
+type
+ {$IFDEF NOVIEW}
+ TFastMMLocationInfoList = class(TJclCustomLocationInfoList)
+ private
+ function GetItems(AIndex: Integer): TJclLocationInfoEx;
+ public
+ constructor Create; override;
+ function Add(Addr: Pointer): TJclLocationInfoEx;
+ property Items[AIndex: Integer]: TJclLocationInfoEx read GetItems; default;
+ end;
+ {$ELSE ~NOVIEW}
+ TFastMMLocationInfoList = TJclStackTraceViewerLocationInfoList;
+ {$ENDIF ~NOVIEW}
+
+ TFastMMMemoryArray = array [0..255] of Byte;
+
+ TFastMMLeak = class(TObject)
+ private
+ FAddress: Integer;
+ FAllocationNumber: Integer;
+ FBlockClass: string;
+ FDateStr: string;
+ FMemory: TFastMMMemoryArray;
+ FFoundMemory: Boolean;
+ FLeakSize: Integer;
+ FThreadID: Integer;
+ FStack: TFastMMLocationInfoList;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ property Address: Integer read FAddress write FAddress;
+ property AllocationNumber: Integer read FAllocationNumber write FAllocationNumber;
+ property BlockClass: string read FBlockClass write FBlockClass;
+ property DateStr: string read FDateStr write FDateStr;
+ property Memory: TFastMMMemoryArray read FMemory write FMemory;
+ property FoundMemory: Boolean read FFoundMemory write FFoundMemory;
+ property LeakSize: Integer read FLeakSize write FLeakSize;
+ property Stack: TFastMMLocationInfoList read FStack;
+ property ThreadID: Integer read FThreadID write FThreadID;
+ end;
+
+ TFastMMLeakGroup = class(TObject)
+ private
+ FItems: TList;
+ FLeakSize: Integer;
+ FLeakSizeUpdate: Boolean;
+ function GetCount: Integer;
+ function GetItems(AIndex: Integer): TFastMMLeak;
+ function GetLeakSize: Integer;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Add(ALeak: TFastMMLeak);
+ property Count: Integer read GetCount;
+ property Items[AIndex: Integer]: TFastMMLeak read GetItems; default;
+ property LeakSize: Integer read GetLeakSize;
+ end;
+
+ TFastMMVMOnFreedObject = class(TObject)
+ private
+ FAddress: Integer;
+ FAllocationNumber: Integer;
+ FObjectClass: string;
+ FMemory: TFastMMMemoryArray;
+ FFoundMemory: Boolean;
+ FStack1: TFastMMLocationInfoList;
+ FStack1Thread: Integer;
+ FStack2: TFastMMLocationInfoList;
+ FStack2Thread: Integer;
+ FStack3: TFastMMLocationInfoList;
+ FStack3Thread: Integer;
+ FVirtualMethod: string;
+ FVirtualMethodAddress: Integer;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ property Address: Integer read FAddress write FAddress;
+ property AllocationNumber: Integer read FAllocationNumber write FAllocationNumber;
+ property ObjectClass: string read FObjectClass write FObjectClass;
+ property Memory: TFastMMMemoryArray read FMemory write FMemory;
+ property FoundMemory: Boolean read FFoundMemory write FFoundMemory;
+ property Stack1Thread: Integer read FStack1Thread write FStack1Thread;
+ property Stack1: TFastMMLocationInfoList read FStack1;
+ property Stack2Thread: Integer read FStack2Thread write FStack2Thread;
+ property Stack2: TFastMMLocationInfoList read FStack2;
+ property Stack3Thread: Integer read FStack3Thread write FStack3Thread;
+ property Stack3: TFastMMLocationInfoList read FStack3;
+ property VirtualMethod: string read FVirtualMethod write FVirtualMethod;
+ property VirtualMethodAddress: Integer read FVirtualMethodAddress write FVirtualMethodAddress;
+ end;
+
+ TFastMMReport = class(TObject)
+ private
+ FLeakGroups: TObjectList;
+ FLeaks: TObjectList;
+ FLeakSummary: TStringList;
+ FVMOnFreedObjects: TObjectList;
+ function GetLeakCount: Integer;
+ function GetLeaks(AIndex: Integer): TFastMMLeak;
+ function GetLeakGroupCount: Integer;
+ function GetLeakGroupItems(AIndex: Integer): TFastMMLeakGroup;
+ function SameStack(AStack1, AStack2: TFastMMLocationInfoList): Boolean;
+ function GetVMOnFreedObjectCount: Integer;
+ function GetVMOnFreedObjectItems(AIndex: Integer): TFastMMVMOnFreedObject;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ function AddLeak: TFastMMLeak;
+ function AddLeakGroup: TFastMMLeakGroup;
+ function AddVMOnFreedObject: TFastMMVMOnFreedObject;
+ procedure BuildGroups;
+ property LeakCount: Integer read GetLeakCount;
+ property LeakGroupCount: Integer read GetLeakGroupCount;
+ property LeakGroupItems[AIndex: Integer]: TFastMMLeakGroup read GetLeakGroupItems;
+ property LeakItems[AIndex: Integer]: TFastMMLeak read GetLeaks;
+ property LeakSummary: TStringList read FLeakSummary;
+ property VMOnFreedObjectCount: Integer read GetVMOnFreedObjectCount;
+ property VMOnFreedObjectItems[AIndex: Integer]: TFastMMVMOnFreedObject read GetVMOnFreedObjectItems;
+ end;
+
+ TFastMMFileParser = class(TObject)
+ public
+ function ParseFile(const AFileName: string; AReportList: TObjectList): Integer;
+ end;
+
+implementation
+
+{$IFDEF NOVIEW}
+function TFastMMLocationInfoList.Add(Addr: Pointer): TJclLocationInfoEx;
+begin
+ Result := InternalAdd(Addr);
+end;
+
+constructor TFastMMLocationInfoList.Create;
+begin
+ inherited Create;
+ FOptions := [];
+end;
+
+function TFastMMLocationInfoList.GetItems(AIndex: Integer): TJclLocationInfoEx;
+begin
+ Result := TJclLocationInfoEx(FItems[AIndex]);
+end;
+{$ENDIF NOVIEW}
+
+{ TFastMMLeak }
+
+constructor TFastMMLeak.Create;
+begin
+ inherited Create;
+ FAddress := -1;
+ FAllocationNumber := -1;
+ FBlockClass := '';
+ FFoundMemory := False;
+ FLeakSize := -1;
+ FThreadID := -1;
+ FStack := TFastMMLocationInfoList.Create;
+end;
+
+destructor TFastMMLeak.Destroy;
+begin
+ FStack.Free;
+ inherited Destroy;
+end;
+
+{ TFastMMLeakGroup }
+
+constructor TFastMMLeakGroup.Create;
+begin
+ inherited Create;
+ FItems := TList.Create;
+ FLeakSizeUpdate := True;
+end;
+
+destructor TFastMMLeakGroup.Destroy;
+begin
+ FItems.Free;
+ inherited Destroy;
+end;
+
+procedure TFastMMLeakGroup.Add(ALeak: TFastMMLeak);
+begin
+ FItems.Add(ALeak);
+end;
+
+function TFastMMLeakGroup.GetCount: Integer;
+begin
+ Result := FItems.Count
+end;
+
+function TFastMMLeakGroup.GetItems(AIndex: Integer): TFastMMLeak;
+begin
+ Result := TFastMMLeak(FItems[AIndex]);
+end;
+
+function TFastMMLeakGroup.GetLeakSize: Integer;
+var
+ I: Integer;
+begin
+ if FLeakSizeUpdate then
+ begin
+ FLeakSizeUpdate := False;
+ FLeakSize := 0;
+ for I := 0 to Count - 1 do
+ Inc(FLeakSize, Items[I].LeakSize);
+ end;
+ Result := FLeakSize;
+end;
+
+{ TFastMMVMOnFreedObject }
+
+constructor TFastMMVMOnFreedObject.Create;
+begin
+ inherited Create;
+ FAddress := -1;
+ FAllocationNumber := -1;
+ FFoundMemory := False;
+ FStack1 := TFastMMLocationInfoList.Create;
+ FStack1Thread := -1;
+ FStack2 := TFastMMLocationInfoList.Create;
+ FStack2Thread := -1;
+ FStack3 := TFastMMLocationInfoList.Create;
+ FStack3Thread := -1;
+end;
+
+destructor TFastMMVMOnFreedObject.Destroy;
+begin
+ FStack3.Free;
+ FStack2.Free;
+ FStack1.Free;
+ inherited Destroy;
+end;
+
+{ TFastMMReport }
+
+constructor TFastMMReport.Create;
+begin
+ inherited Create;
+ FLeakGroups := TObjectList.Create;
+ FLeaks := TObjectList.Create;
+ FLeakSummary := TStringList.Create;
+ FVMOnFreedObjects := TObjectList.Create;
+end;
+
+destructor TFastMMReport.Destroy;
+begin
+ FVMOnFreedObjects.Free;
+ FLeakSummary.Free;
+ FLeaks.Free;
+ FLeakGroups.Free;
+ inherited Destroy;
+end;
+
+function TFastMMReport.AddLeak: TFastMMLeak;
+begin
+ FLeaks.Add(TFastMMLeak.Create);
+ Result := TFastMMLeak(FLeaks.Last);
+end;
+
+function TFastMMReport.AddLeakGroup: TFastMMLeakGroup;
+begin
+ FLeakGroups.Add(TFastMMLeakGroup.Create);
+ Result := TFastMMLeakGroup(FLeakGroups.Last);
+end;
+
+function TFastMMReport.AddVMOnFreedObject: TFastMMVMOnFreedObject;
+begin
+ FVMOnFreedObjects.Add(TFastMMVMOnFreedObject.Create);
+ Result := TFastMMVMOnFreedObject(FVMOnFreedObjects.Last);
+end;
+
+procedure TFastMMReport.BuildGroups;
+var
+ I: Integer;
+ LeftLeaks: TList;
+ LeakGroup: TFastMMLeakGroup;
+ FirstLeak: TFastMMLeak;
+begin
+ FLeakGroups.Clear;
+ if LeakCount > 0 then
+ begin
+ LeftLeaks := TList.Create;
+ try
+ for I := 0 to LeakCount - 1 do
+ LeftLeaks.Add(LeakItems[I]);
+ while LeftLeaks.Count > 0 do
+ begin
+ LeakGroup := AddLeakGroup;
+ FirstLeak := TFastMMLeak(LeftLeaks[0]);
+ LeakGroup.Add(FirstLeak);
+ LeftLeaks.Delete(0);
+ for I := LeftLeaks.Count - 1 downto 0 do
+ if SameStack(FirstLeak.Stack, TFastMMLeak(LeftLeaks[I]).Stack) then
+ begin
+ LeakGroup.Add(TFastMMLeak(LeftLeaks[I]));
+ LeftLeaks.Delete(I);
+ end;
+ end;
+ finally
+ LeftLeaks.Free;
+ end;
+ end;
+end;
+
+function TFastMMReport.GetLeakCount: Integer;
+begin
+ Result := FLeaks.Count;
+end;
+
+function TFastMMReport.GetLeakGroupCount: Integer;
+begin
+ Result := FLeakGroups.Count
+end;
+
+function TFastMMReport.GetLeakGroupItems(AIndex: Integer): TFastMMLeakGroup;
+begin
+ Result := TFastMMLeakGroup(FLeakGroups[AIndex]);
+end;
+
+function TFastMMReport.GetLeaks(AIndex: Integer): TFastMMLeak;
+begin
+ Result := TFastMMLeak(FLeaks[AIndex]);
+end;
+
+function TFastMMReport.GetVMOnFreedObjectCount: Integer;
+begin
+ Result := FVMOnFreedObjects.Count;
+end;
+
+function TFastMMReport.GetVMOnFreedObjectItems(AIndex: Integer): TFastMMVMOnFreedObject;
+begin
+ Result := TFastMMVMOnFreedObject(FVMOnFreedObjects[AIndex]);
+end;
+
+function TFastMMReport.SameStack(AStack1, AStack2: TFastMMLocationInfoList): Boolean;
+var
+ I: Integer;
+begin
+ Result := Assigned(AStack1) and Assigned(AStack2) and (AStack1.Count = AStack2.Count);
+ if Result then
+ for I := 0 to AStack1.Count - 1 do
+ if AStack1[I].Address <> AStack2[I].Address then
+ begin
+ Result := False;
+ Break;
+ end;
+end;
+
+function GetLocationInfoFromFastMMLine(AStr: string; var ALocationInfo: TJclLocationInfoEx): Boolean;
+var
+ I: Integer;
+ BlockOpen, LastIsNumber: Boolean;
+ C: Char;
+ S: string;
+ Blocks: TStringList;
+begin
+ Result := False;
+ BlockOpen := False;
+ Blocks := TStringList.Create;
+ try
+ S := '';
+ for I := 1 to Length(AStr) do
+ begin
+ C := AStr[I];
+ if C = '[' then
+ begin
+ if BlockOpen then
+ begin
+ Blocks.Clear;
+ Break;
+ end
+ else
+ begin
+ BlockOpen := True;
+ S := '';
+ end;
+ end
+ else
+ if C = ']' then
+ begin
+ if BlockOpen then
+ begin
+ BlockOpen := False;
+ Blocks.Add(S);
+ end
+ else
+ begin
+ Blocks.Clear;
+ Break;
+ end;
+ end
+ else
+ S := S + C;
+ end;
+
+ if Blocks.Count > 0 then
+ begin
+ LastIsNumber := False;
+ S := Blocks[Blocks.Count - 1];
+ if S <> '' then
+ begin
+ LastIsNumber := True;
+ for I := 1 to Length(S) do
+ if not (S[I] in ['0'..'9']) then
+ begin
+ LastIsNumber := False;
+ Break;
+ end;
+ end;
+ if LastIsNumber then
+ begin
+ if Blocks.Count = 4 then
+ begin
+ ALocationInfo.SourceName := Blocks[0];
+ ALocationInfo.SourceUnitName := Blocks[1];
+ ALocationInfo.ProcedureName := Blocks[2];
+ ALocationInfo.LineNumber := StrToInt(Blocks[3]);
+ Result := True;
+ end
+ else
+ if Blocks.Count = 3 then
+ begin
+ ALocationInfo.SourceUnitName := Blocks[0];
+ ALocationInfo.ProcedureName := Blocks[1];
+ ALocationInfo.LineNumber := StrToInt(Blocks[2]);
+ Result := True;
+ end;
+ end
+ else
+ if Blocks.Count = 1 then
+ begin
+ ALocationInfo.ProcedureName := Blocks[0];
+ Result := True;
+ end
+ else
+ if Blocks.Count = 2 then
+ begin
+ ALocationInfo.SourceUnitName := Blocks[0];
+ ALocationInfo.ProcedureName := Blocks[1];
+ Result := True;
+ end;
+ if Result then
+ begin
+ S := '';
+ for I := 1 to Length(AStr) do
+ begin
+ C := AStr[I];
+ if C in ['0'..'9', 'A'..'F'] then
+ S := S + C
+ else
+ if C = ' ' then
+ begin
+ if S <> '' then
+ ALocationInfo.Address := Pointer(StrToInt('$' + S));
+ Break;
+ end
+ else
+ Break;
+ end;
+
+ end;
+ end;
+ finally
+ Blocks.Free;
+ end;
+end;
+
+{ TFastMMFileParser }
+
+function TFastMMFileParser.ParseFile(const AFileName: string; AReportList: TObjectList): Integer;
+type
+ TReportType = (rtUnknown, rtMemoryLeak, rtVMOnFreedObject);
+const
+ //Leak constants
+ cDateTime = '--------------------------------2';
+ cLeakSize = 'A memory block has been leaked. The size is: ';
+ cThread = 'This block was allocated by thread 0x';
+ cStack = 'the stack trace (return addresses) at the time was:';
+ cBlockClass = 'The block is currently used for an object of class: ';
+ cAllocNo = 'The allocation number is: ';
+ cMemory = 'Current memory dump of 256 bytes starting at pointer address ';
+ cReportEnd = 'This application has leaked memory.';
+ cReportSummaryPart = ' bytes: ';
+ //Virtual method call on freed object
+ cVMFOStart = 'FastMM has detected an attempt to call a virtual method on a freed object. An access violation will now be raised in order to abort the current operation.';
+ cVMFOClass = 'Freed object class: ';
+ cVMFOVirtualMethod = 'Virtual method: ';
+ cVMFOVirtualMethodAddress = 'Virtual method address: ';
+ cVMFOAllocNo = 'The allocation number was: ';
+ cVMFOStack1Thread = 'The object was allocated by thread 0x';
+ cVMFOStack1Stack = 'and the stack trace (return addresses) at the time was:';
+ cVMFOStack2Thread = 'The object was subsequently freed by thread 0x';
+ cVMFOStack2Stack = 'and the stack trace (return addresses) at the time was:';
+ cVMFOStack3Thread = 'The current thread ID is 0x';
+ cVMFOStack3Stack = 'and the stack trace (return addresses) leading to this error is:';
+ cVMFOMemory = 'Current memory dump of 256 bytes starting at pointer address ';
+var
+ TSL: TStringList;
+ I, J, K, P: Integer;
+ Report: TFastMMReport;
+ Leak: TFastMMLeak;
+ VMOnFreedObject: TFastMMVMOnFreedObject;
+ S, S2: string;
+ LI: TJclLocationInfoEx;
+ LocationInfoEx: TJclLocationInfoEx;
+ MemoryArray: TFastMMMemoryArray;
+ CreateNewReport: Boolean;
+ ReportType, LastReportType: TReportType;
+begin
+ Result := -1;
+ if FileExists(AFileName) and Assigned(AReportList) then
+ begin
+ TSL := TStringList.Create;
+ try
+ TSL.LoadFromFile(AFileName);
+ TSL.Text := AdjustLineBreaks(TSL.Text);
+ I := 0;
+ Leak := nil;
+ VMOnFreedObject := nil;
+ Report := nil;
+ CreateNewReport := True;
+ ReportType := rtUnknown;
+ LastReportType := rtUnknown;
+ while I < TSL.Count do
+ begin
+ S := TSL[I];
+ if Pos(cLeakSize, S) = 1 then
+ begin
+ ReportType := rtMemoryLeak;
+ if CreateNewReport or (LastReportType <> ReportType) then
+ begin
+ AReportList.Add(TFastMMReport.Create);
+ Report := TFastMMReport(AReportList.Last);
+ CreateNewReport := False;
+ end;
+ LastReportType := ReportType;
+ Leak := Report.AddLeak;
+ Delete(S, 1, Length(cLeakSize));
+ Leak.LeakSize := StrToIntDef(S, -1);
+ if (I > 1) then
+ begin
+ S := TSL[I - 1];
+ if Pos(cDateTime, S) = 1 then
+ begin
+ Delete(S, 1, Length(cDateTime) - 1);
+ P := Pos('-', S);
+ if P > 1 then
+ Leak.DateStr := Copy(S, 1, P - 1);
+ end;
+ end;
+ end
+ else
+ if Pos(cVMFOStart, S) = 1 then
+ begin
+ ReportType := rtVMOnFreedObject;
+ if CreateNewReport or (LastReportType <> ReportType) then
+ begin
+ AReportList.Add(TFastMMReport.Create);
+ Report := TFastMMReport(AReportList.Last);
+ CreateNewReport := False;
+ end;
+ LastReportType := ReportType;
+ VMOnFreedObject := Report.AddVMOnFreedObject;
+ end
+ else
+ if (ReportType = rtMemoryLeak) and Assigned(Leak) then
+ begin
+ if Pos(cThread, S) = 1 then
+ begin
+ Delete(S, 1, Length(cThread));
+ P := Pos(',', S);
+ if P > 1 then
+ Leak.ThreadID := StrToIntDef('$' + Copy(S, 1, P - 1), -1);
+ end;
+ if Pos(cStack, S) > 0 then
+ begin
+ Inc(I);
+
+ LI := TJclLocationInfoEx.Create(nil, nil);
+ try
+ while (Trim(TSL[I]) = '') or GetLocationInfoFromFastMMLine(TSL[I], LI) do
+ begin
+ if Trim(TSL[I]) <> '' then
+ begin
+ LocationInfoEx := Leak.Stack.Add(nil);
+ LocationInfoEx.Assign(LI);
+ LI.Clear;
+ end;
+ Inc(I);
+ end;
+ finally
+ LI.Free;
+ end;
+
+ Dec(I);
+ end;
+ if Pos(cBlockClass, S) = 1 then
+ begin
+ Delete(S, 1, Length(cBlockClass));
+ Leak.BlockClass := S;
+ end;
+ if Pos(cAllocNo, S) = 1 then
+ begin
+ Delete(S, 1, Length(cAllocNo));
+ Leak.AllocationNumber := StrToIntDef(S, -1);
+ end;
+ if Pos(cMemory, S) = 1 then
+ begin
+ Delete(S, 1, Length(cMemory));
+ P := Pos(':', S);
+ if P > 1 then
+ begin
+ Leak.Address := StrToIntDef('$' + Copy(S, 1, P - 1), -1);
+ Inc(I);
+ for J := 0 to 7 do
+ begin
+ S := Trim(TSL[I]);
+ if Length(S) = 95 then
+ begin
+ for K := 0 to 31 do
+ begin
+ S2 := Copy(S, K * 3 + 1, 2);
+ MemoryArray[J * 32 + K] := StrToIntDef('$' + S2, -1);
+ end;
+ end
+ else
+ Break;
+ Inc(I);
+ if J = 7 then
+ begin
+ Leak.FoundMemory := True;
+ Leak.Memory := MemoryArray;
+ end;
+ end;
+ Dec(I);
+ end;
+ end;
+ if Pos(cReportEnd, S) > 0 then
+ begin
+ Inc(I);
+ while (I < TSL.Count) and ((TSL[I]) = '') do
+ Inc(I);
+ while (I < TSL.Count) and (Pos(cReportSummaryPart, TSL[I]) > 0) do
+ begin
+ Report.LeakSummary.Add(TSL[I]);
+ Inc(I);
+ end;
+ CreateNewReport := True;
+ end;
+ end
+ else
+ if (ReportType = rtVMOnFreedObject) and Assigned(VMOnFreedObject) then
+ begin
+ if Pos(cVMFOClass, S) = 1 then
+ begin
+ Delete(S, 1, Length(cVMFOClass));
+ VMOnFreedObject.ObjectClass := S;
+ end
+ else
+ if Pos(cVMFOVirtualMethod, S) = 1 then
+ begin
+ Delete(S, 1, Length(cVMFOVirtualMethod));
+ VMOnFreedObject.VirtualMethod := S;
+ end
+ else
+ if Pos(cVMFOVirtualMethodAddress, S) = 1 then
+ begin
+ Delete(S, 1, Length(cVMFOVirtualMethodAddress));
+ VMOnFreedObject.VirtualMethodAddress := StrToIntDef('$' + S, -1);
+ end
+ else
+ if Pos(cVMFOAllocNo, S) = 1 then
+ begin
+ Delete(S, 1, Length(cVMFOAllocNo));
+ VMOnFreedObject.AllocationNumber := StrToIntDef(S, -1);
+ end
+ else
+ if Pos(cVMFOStack1Thread, S) = 1 then
+ begin
+ Delete(S, 1, Length(cVMFOStack1Thread));
+ P := Pos(',', S);
+ if P > 1 then
+ VMOnFreedObject.Stack1Thread := StrToIntDef('$' + Copy(S, 1, P - 1), -1);
+ if Pos(cVMFOStack1Stack, S) > 0 then
+ begin
+ Inc(I);
+
+ LI := TJclLocationInfoEx.Create(nil, nil);
+ try
+ while (Trim(TSL[I]) = '') or GetLocationInfoFromFastMMLine(TSL[I], LI) do
+ begin
+ if Trim(TSL[I]) <> '' then
+ begin
+ LocationInfoEx := VMOnFreedObject.Stack1.Add(nil);
+ LocationInfoEx.Assign(LI);
+ LI.Clear;
+ end;
+ Inc(I);
+ end;
+ finally
+ LI.Free;
+ end;
+
+ Dec(I);
+ end;
+ end
+ else
+ if Pos(cVMFOStack2Thread, S) = 1 then
+ begin
+ Delete(S, 1, Length(cVMFOStack2Thread));
+ P := Pos(',', S);
+ if P > 1 then
+ VMOnFreedObject.Stack2Thread := StrToIntDef('$' + Copy(S, 1, P - 1), -1);
+ if Pos(cVMFOStack2Stack, S) > 0 then
+ begin
+ Inc(I);
+
+ LI := TJclLocationInfoEx.Create(nil, nil);
+ try
+ while (Trim(TSL[I]) = '') or GetLocationInfoFromFastMMLine(TSL[I], LI) do
+ begin
+ if Trim(TSL[I]) <> '' then
+ begin
+ LocationInfoEx := VMOnFreedObject.Stack2.Add(nil);
+ LocationInfoEx.Assign(LI);
+ LI.Clear;
+ end;
+ Inc(I);
+ end;
+ finally
+ LI.Free;
+ end;
+
+ Dec(I);
+ end;
+ end
+ else
+ if Pos(cVMFOStack3Thread, S) = 1 then
+ begin
+ Delete(S, 1, Length(cVMFOStack3Thread));
+ P := Pos(',', S);
+ if P > 1 then
+ VMOnFreedObject.Stack3Thread := StrToIntDef('$' + Copy(S, 1, P - 1), -1);
+ if Pos(cVMFOStack3Stack, S) > 0 then
+ begin
+ Inc(I);
+
+ LI := TJclLocationInfoEx.Create(nil, nil);
+ try
+ while (Trim(TSL[I]) = '') or GetLocationInfoFromFastMMLine(TSL[I], LI) do
+ begin
+ if Trim(TSL[I]) <> '' then
+ begin
+ LocationInfoEx := VMOnFreedObject.Stack3.Add(nil);
+ LocationInfoEx.Assign(LI);
+ LI.Clear;
+ end;
+ Inc(I);
+ end;
+ finally
+ LI.Free;
+ end;
+
+ Dec(I);
+ end;
+ end
+ else
+ if Pos(cVMFOMemory, S) = 1 then
+ begin
+ Delete(S, 1, Length(cVMFOMemory));
+ P := Pos(':', S);
+ if P > 1 then
+ begin
+ VMOnFreedObject.Address := StrToIntDef('$' + Copy(S, 1, P - 1), -1);
+ Inc(I);
+ for J := 0 to 7 do
+ begin
+ while Trim(TSL[I]) = '' do
+ Inc(I);
+ S := Trim(TSL[I]);
+ if Length(S) = 95 then
+ begin
+ for K := 0 to 31 do
+ begin
+ S2 := Copy(S, K * 3 + 1, 2);
+ MemoryArray[J * 32 + K] := StrToIntDef('$' + S2, -1);
+ end;
+ end
+ else
+ Break;
+ Inc(I);
+ if J = 7 then
+ begin
+ VMOnFreedObject.FoundMemory := True;
+ VMOnFreedObject.Memory := MemoryArray;
+ end;
+ end;
+ Dec(I);
+ end;
+ end;
+
+ end;
+ Inc(I);
+ end;
+ finally
+ TSL.Free;
+ end;
+ for I := 0 to AReportList.Count - 1 do
+ TFastMMReport(AReportList[I]).BuildGroups;
+
+ Result := AReportList.Count;
+ end;
+end;
+
+end.
Added: branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/StackTraceViewerFastMM.dpk
===================================================================
--- branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/StackTraceViewerFastMM.dpk (rev 0)
+++ branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/StackTraceViewerFastMM.dpk 2009-05-22 20:30:36 UTC (rev 2769)
@@ -0,0 +1,49 @@
+package StackTraceViewerFastMM;
+
+{$R *.res}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO OFF}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ rtl,
+ designide,
+ Jcl,
+ vcl,
+ JclBaseExpert,
+ xmlrtl,
+ vclactnband,
+ vclx,
+ JclStackTraceViewerExpert;
+
+contains
+ StackTraceViewerFastMMReg in 'StackTraceViewerFastMMReg.pas',
+ StackTraceViewerFastMMUnit in 'StackTraceViewerFastMMUnit.pas',
+ FastMMParser in 'FastMMParser.pas',
+ FastMMLeakFrame in 'FastMMLeakFrame.pas' {frmLeak: TFrame},
+ FastMMLeakGroupFrame in 'FastMMLeakGroupFrame.pas' {frmLeakGroup: TFrame},
+ FastMMFreedObjectFrame in 'FastMMFreedObjectFrame.pas' {frmFreedObject: TFrame},
+ FastMMMemoryFrame in 'FastMMMemoryFrame.pas' {frmMemory: TFrame},
+ FastMMLeakSummaryFrame in 'FastMMLeakSummaryFrame.pas' {frmLeakSummary: TFrame};
+
+end.
Added: branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/StackTraceViewerFastMMReg.pas
===================================================================
--- branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/StackTraceViewerFastMMReg.pas (rev 0)
+++ branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/StackTraceViewerFastMMReg.pas 2009-05-22 20:30:36 UTC (rev 2769)
@@ -0,0 +1,82 @@
+unit StackTraceViewerFastMMReg;
+
+interface
+
+procedure Register;
+
+implementation
+
+uses
+ SysUtils, Forms, Dialogs, ToolsAPI, JclStackTraceViewerAPI, StackTraceViewerFastMMUnit;
+
+type
+ TIOTAProjectTestWizard = class(TNotifierObject, IOTAMenuWizard, IOTAWizard)
+ private
+ FFastMMReportData: TFastMMReportData;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Execute;
+ function GetIDString: string;
+ function GetMenuText: string;
+ function GetName: string;
+ function GetState: TWizardState;
+ end;
+
+procedure Register;
+begin
+ RegisterPackageWizard(TIOTAProjectTestWizard.Create);
+end;
+
+constructor TIOTAProjectTestWizard.Create;
+begin
+ inherited Create;
+ FFastMMReportData := TFastMMReportData.Create;
+end;
+
+destructor TIOTAProjectTestWizard.Destroy;
+begin
+ FFastMMReportData.Free;
+ inherited Destroy;
+end;
+
+procedure TIOTAProjectTestWizard.Execute;
+var
+ OpenDialog: TOpenDialog;
+ FastMMFile: string;
+begin
+ OpenDialog := TOpenDialog.Create(nil);
+ try
+ if OpenDialog.Execute then
+ FastMMFile := OpenDialog.FileName;
+ finally
+ OpenDialog.Free;
+ end;
+ if FastMMFile <> '' then
+ FFastMMReportData.LoadFastMMFile(FastMMFile);
+end;
+
+function TIOTAProjectTestWizard.GetIDString: string;
+begin
+ Result := 'PROJECT JEDI.JclStackTraceViewerFastMM';
+end;
+
+function TIOTAProjectTestWizard.GetMenuText: string;
+begin
+ Result := '&Load FastMM Logfile';
+end;
+
+function TIOTAProjectTestWizard.GetName: string;
+begin
+ Result := 'JCL Stack Trace Viewer Extension for FastMM';
+end;
+
+function TIOTAProjectTestWizard.GetState: TWizardState;
+begin
+ if Assigned(StackTraceViewerStackProcessorServices) then
+ Result := [wsEnabled]
+ else
+ Result := [];
+end;
+
+end.
Added: branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExamples/FastMM/StackTraceViewerFastMMUnit.pas
===================================================================
--- branches/jcl-stack-trace/jcl/experts/stacktraceviewer/APIExam...
[truncated message content] |