david
13eee3f7f4
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.jcl@20 c37d764d-f447-7644-a108-883140d013fb
761 lines
27 KiB
ObjectPascal
761 lines
27 KiB
ObjectPascal
{**************************************************************************************************}
|
|
{ }
|
|
{ Project JEDI Code Library (JCL) }
|
|
{ }
|
|
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
|
|
{ you may not use this file except in compliance with the License. You may obtain a copy of the }
|
|
{ License at http://www.mozilla.org/MPL/ }
|
|
{ }
|
|
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
|
|
{ ANY KIND, either express or implied. See the License for the specific language governing rights }
|
|
{ and limitations under the License. }
|
|
{ }
|
|
{ The Original Code is JclStackTraceViewerMainFrame.pas. }
|
|
{ }
|
|
{ The Initial Developer of the Original Code is Uwe Schuster. }
|
|
{ Portions created by Uwe Schuster are Copyright (C) 2009 Uwe Schuster. All rights reserved. }
|
|
{ }
|
|
{ Contributor(s): }
|
|
{ Uwe Schuster (uschuster) }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
{ }
|
|
{ Last modified: $Date:: 2009-09-14 18:00:50 +0200 (lun., 14 sept. 2009) $ }
|
|
{ Revision: $Rev:: 3012 $ }
|
|
{ Author: $Author:: outchy $ }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
|
|
unit JclStackTraceViewerMainFrame;
|
|
|
|
{$I jcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|
Docktoolform, StdCtrls, ComCtrls, Menus,
|
|
ActnList, ToolWin, ExtCtrls, IniFiles, ToolsAPI,
|
|
{$IFDEF UNITVERSIONING}
|
|
JclUnitVersioning,
|
|
{$ENDIF UNITVERSIONING}
|
|
JclDebug, JclDebugSerialization, Contnrs, JclStackTraceViewerStackFrame, JclStackTraceViewerModuleFrame,
|
|
JclStackTraceViewerClasses, JclStackTraceViewerStackCodeUtils, JclStackTraceViewerExceptInfoFrame, JclStackTraceViewerThreadFrame,
|
|
JclStackTraceViewerOptions,
|
|
JclStackTraceViewerAPIImpl, JclOtaUtils
|
|
, JclStrings, JclDebugXMLDeserializer, JclStackTraceViewerStackUtils, JclStackTraceViewerAPI
|
|
;
|
|
|
|
type
|
|
TfrmMain = class(TFrame, IJclStackTraceViewerStackServices)
|
|
ActionList1: TActionList;
|
|
acJumpToCodeLine: TAction;
|
|
acLoadStack: TAction;
|
|
OpenDialog1: TOpenDialog;
|
|
tv: TTreeView;
|
|
acOptions: TAction;
|
|
acUpdateLocalInfo: TAction;
|
|
Splitter2: TSplitter;
|
|
StatusBar: TStatusBar;
|
|
PB: TProgressBar;
|
|
procedure acJumpToCodeLineExecute(Sender: TObject);
|
|
procedure acLoadStackExecute(Sender: TObject);
|
|
procedure tvChange(Sender: TObject; Node: TTreeNode);
|
|
procedure acOptionsExecute(Sender: TObject);
|
|
procedure acUpdateLocalInfoExecute(Sender: TObject);
|
|
procedure acJumpToCodeLineUpdate(Sender: TObject);
|
|
procedure acUpdateLocalInfoUpdate(Sender: TObject);
|
|
procedure FrameResize(Sender: TObject);
|
|
private
|
|
{ Private declarations }
|
|
FTreeViewLinkList: TObjectList;
|
|
FRootLink: IJclStackTraceViewerTreeViewLink;
|
|
FThreadInfoList: TJclStackTraceViewerThreadInfoList;
|
|
FExceptionInfo: TJclStackTraceViewerExceptionInfo;
|
|
FStackFrame: TfrmStack;
|
|
FModuleFrame: TfrmModule;
|
|
FExceptionFrame: TfrmException;
|
|
FThreadFrame: TfrmThread;
|
|
FFrameList: TList;
|
|
FLastControl: TControl;
|
|
FLocationInfoProcessor: TJclLocationInfoProcessor;
|
|
FOptions: TExceptionViewerOption;
|
|
FRootDir: string;
|
|
procedure AddItemsToTree(ANode: TTreeNode; ALink: IJclStackTraceViewerTreeViewLink);
|
|
procedure DoProgress(AStatus: TLocationInfoProcessorProgressStatus; APos, AMax: Integer; const AText: string);
|
|
procedure SetOptions(const Value: TExceptionViewerOption);
|
|
public
|
|
{ Public declarations }
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure LoadWindowState(ADesktop: TCustomIniFile);
|
|
procedure SaveWindowState(ADesktop: TCustomIniFile; AIsProject: Boolean);
|
|
property Options: TExceptionViewerOption read FOptions write SetOptions;
|
|
property RootDir: string read FRootDir write FRootDir;
|
|
{ IJclStackTraceViewerStackServices }
|
|
function GetDefaultFrameClass(const AFrameClassID: Integer): TCustomFrameClass;
|
|
procedure ShowTree(ARootLink: IJclStackTraceViewerTreeViewLink);
|
|
procedure UnregisterFrameClass(AFrameClass: TCustomFrameClass);
|
|
end;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
const
|
|
UnitVersioning: TUnitVersionInfo = (
|
|
RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-2.1-Build3536/jcl/experts/stacktraceviewer/JclStackTraceViewerMainFrame.pas $';
|
|
Revision: '$Revision: 3012 $';
|
|
Date: '$Date: 2009-09-14 18:00:50 +0200 (lun., 14 sept. 2009) $';
|
|
LogPath: 'JCL\experts\stacktraceviewer';
|
|
Extra: '';
|
|
Data: nil
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
implementation
|
|
|
|
uses
|
|
JclOtaConsts, JclOtaResources,
|
|
JclStackTraceViewerImpl;
|
|
|
|
{$R *.dfm}
|
|
|
|
type
|
|
TCustomTreeViewLink = class(TObject, IJclStackTraceViewerTreeViewLink)
|
|
private
|
|
function GetInternalItems(AIndex: Integer): TCustomTreeViewLink;
|
|
protected
|
|
FData: TObject;
|
|
FItems: TObjectList;
|
|
FOwnsData: Boolean;
|
|
FParent: TCustomTreeViewLink;
|
|
public
|
|
constructor Create(AParent: TCustomTreeViewLink);
|
|
destructor Destroy; override;
|
|
procedure Show(AFrame: TCustomFrame);
|
|
property Data: TObject read FData write FData;
|
|
property OwnsData: Boolean read FOwnsData write FOwnsData;
|
|
property Parent: TCustomTreeViewLink read FParent;
|
|
{ IInterface }
|
|
function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
|
|
function _AddRef: Integer; stdcall;
|
|
function _Release: Integer; stdcall;
|
|
{ IJclStackTraceViewerTreeViewLink }
|
|
procedure DoShow(AFrame: TCustomFrame); virtual;
|
|
function GetCount: Integer;
|
|
function GetFrameClass: TCustomFrameClass; virtual;
|
|
function GetItems(AIndex: Integer): IJclStackTraceViewerTreeViewLink;
|
|
function GetText: string; virtual;
|
|
property Count: Integer read GetCount;
|
|
property FrameClass: TCustomFrameClass read GetFrameClass;
|
|
property Items[AIndex: Integer]: TCustomTreeViewLink read GetInternalItems; default;
|
|
property Text: string read GetText;
|
|
end;
|
|
|
|
TThreadData = class(TObject)
|
|
private
|
|
FException: TJclSerializableException;
|
|
FModuleList: TJclStackTraceViewerModuleInfoList;
|
|
FThreadInfo: TJclStackTraceViewerThreadInfo;
|
|
public
|
|
property Exception: TJclSerializableException read FException write FException;
|
|
property ModuleList: TJclStackTraceViewerModuleInfoList read FModuleList write FModuleList;
|
|
property ThreadInfo: TJclStackTraceViewerThreadInfo read FThreadInfo write FThreadInfo;
|
|
end;
|
|
|
|
TStackData = class(TObject)
|
|
private
|
|
FModuleList: TJclStackTraceViewerModuleInfoList;
|
|
FStack: TJclStackTraceViewerLocationInfoList;
|
|
public
|
|
property ModuleList: TJclStackTraceViewerModuleInfoList read FModuleList write FModuleList;
|
|
property Stack: TJclStackTraceViewerLocationInfoList read FStack write FStack;
|
|
end;
|
|
|
|
TTreeViewLinkKind = (tvlkException, tvlkModuleList, tvlkThread, tvlkThreadStack, tvlkThreadCreationStack, tvlkRoot);
|
|
|
|
TDefaultTreeViewLink = class(TCustomTreeViewLink)
|
|
private
|
|
FKind: TTreeViewLinkKind;
|
|
protected
|
|
procedure DoShow(AFrame: TCustomFrame); override;
|
|
function GetFrameClass: TCustomFrameClass; override;
|
|
function GetText: string; override;
|
|
public
|
|
constructor Create(AParent: TCustomTreeViewLink; AKind: TTreeViewLinkKind);
|
|
function Add(AKind: TTreeViewLinkKind): TDefaultTreeViewLink;
|
|
property Kind: TTreeViewLinkKind read FKind;
|
|
end;
|
|
|
|
TRootTreeViewLink = class(TDefaultTreeViewLink)
|
|
constructor Create;
|
|
end;
|
|
|
|
constructor TCustomTreeViewLink.Create(AParent: TCustomTreeViewLink);
|
|
begin
|
|
inherited Create;
|
|
FData := nil;
|
|
FItems := TObjectList.Create;
|
|
FOwnsData := False;
|
|
FParent := AParent;
|
|
end;
|
|
|
|
destructor TCustomTreeViewLink.Destroy;
|
|
begin
|
|
if FOwnsData then
|
|
FData.Free;
|
|
FItems.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TCustomTreeViewLink.DoShow(AFrame: TCustomFrame);
|
|
begin
|
|
//
|
|
end;
|
|
|
|
function TCustomTreeViewLink.GetCount: Integer;
|
|
begin
|
|
Result := FItems.Count;
|
|
end;
|
|
|
|
function TCustomTreeViewLink.GetFrameClass: TCustomFrameClass;
|
|
begin
|
|
Result := nil;
|
|
end;
|
|
|
|
function TCustomTreeViewLink.GetInternalItems(AIndex: Integer): TCustomTreeViewLink;
|
|
begin
|
|
Result := TCustomTreeViewLink(FItems[AIndex]);
|
|
end;
|
|
|
|
function TCustomTreeViewLink.GetItems(AIndex: Integer): IJclStackTraceViewerTreeViewLink;
|
|
begin
|
|
Result := Items[AIndex];
|
|
end;
|
|
|
|
function TCustomTreeViewLink.GetText: string;
|
|
begin
|
|
Result := '';
|
|
end;
|
|
|
|
function TCustomTreeViewLink.QueryInterface(const IID: TGUID; out Obj): HRESULT;
|
|
begin
|
|
if GetInterface(IID, Obj) then
|
|
Result := S_OK
|
|
else
|
|
Result := E_NOINTERFACE;
|
|
end;
|
|
|
|
procedure TCustomTreeViewLink.Show(AFrame: TCustomFrame);
|
|
begin
|
|
DoShow(AFrame);
|
|
end;
|
|
|
|
function TCustomTreeViewLink._AddRef: Integer;
|
|
begin
|
|
Result := -1;
|
|
end;
|
|
|
|
function TCustomTreeViewLink._Release: Integer;
|
|
begin
|
|
Result := -1;
|
|
end;
|
|
|
|
constructor TDefaultTreeViewLink.Create(AParent: TCustomTreeViewLink; AKind: TTreeViewLinkKind);
|
|
begin
|
|
inherited Create(AParent);
|
|
FKind := AKind;
|
|
end;
|
|
|
|
function TDefaultTreeViewLink.Add(AKind: TTreeViewLinkKind): TDefaultTreeViewLink;
|
|
begin
|
|
FItems.Add(TDefaultTreeViewLink.Create(Self, AKind));
|
|
Result := TDefaultTreeViewLink(FItems.Last);
|
|
end;
|
|
|
|
procedure TDefaultTreeViewLink.DoShow(AFrame: TCustomFrame);
|
|
var
|
|
StackData: TStackData;
|
|
ThreadFrame: TfrmThread;
|
|
ThreadInfo: TJclStackTraceViewerThreadInfo;
|
|
ThreadData: TThreadData;
|
|
begin
|
|
case FKind of
|
|
tvlkModuleList: if AFrame is TfrmModule then
|
|
TfrmModule(AFrame).ModuleList := TJclSerializableModuleInfoList(Data);
|
|
tvlkThread: if AFrame is TfrmThread then
|
|
begin
|
|
ThreadData := TThreadData(Data);
|
|
ThreadFrame := TfrmThread(AFrame);
|
|
ThreadInfo := ThreadData.ThreadInfo;
|
|
StackTraceViewerStackProcessorServices.ModuleList := ThreadData.ModuleList;
|
|
StackTraceViewerStackProcessorServices.PrepareLocationInfoList(ThreadInfo.CreationStack, False);
|
|
if tioCreationStack in ThreadInfo.Values then
|
|
ThreadFrame.CreationStackList := ThreadInfo.CreationStack
|
|
else
|
|
ThreadFrame.CreationStackList := nil;
|
|
ThreadFrame.Exception := ThreadData.Exception;
|
|
StackTraceViewerStackProcessorServices.PrepareLocationInfoList(ThreadInfo.Stack, False);
|
|
if tioStack in ThreadInfo.Values then
|
|
ThreadFrame.StackList := ThreadInfo.Stack
|
|
else
|
|
ThreadFrame.StackList := nil;
|
|
end;
|
|
tvlkException: if AFrame is TfrmException then
|
|
TfrmException(AFrame).Exception := TJclSerializableException(Data);
|
|
tvlkThreadStack, tvlkThreadCreationStack: if AFrame is TfrmStack then
|
|
begin
|
|
StackData := TStackData(Data);
|
|
StackTraceViewerStackProcessorServices.ModuleList := StackData.ModuleList;
|
|
StackTraceViewerStackProcessorServices.PrepareLocationInfoList(StackData.Stack, False);
|
|
TfrmStack(AFrame).StackList := StackData.Stack;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDefaultTreeViewLink.GetFrameClass: TCustomFrameClass;
|
|
begin
|
|
case FKind of
|
|
tvlkModuleList: Result := TfrmModule;
|
|
tvlkThread: Result := TfrmThread;
|
|
tvlkException: Result := TfrmException;
|
|
tvlkThreadStack, tvlkThreadCreationStack: Result := TfrmStack;
|
|
else
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
|
|
function TDefaultTreeViewLink.GetText: string;
|
|
begin
|
|
Result := '';
|
|
case FKind of
|
|
tvlkModuleList: if Data is TJclStackTraceViewerModuleInfoList then
|
|
Result := Format('Module List [%d]', [TJclStackTraceViewerModuleInfoList(Data).GetModuleCount]);
|
|
tvlkThread: if Data is TThreadData then
|
|
begin
|
|
if tioIsMainThread in TThreadData(Data).ThreadInfo.Values then
|
|
Result := '[MainThread]'
|
|
else
|
|
Result := '';
|
|
Result := Format('ID: %d %s', [TThreadData(Data).ThreadInfo.ThreadID, Result]);
|
|
end;
|
|
tvlkException: Result := 'Exception';
|
|
tvlkThreadStack: if Data is TStackData then
|
|
Result := Format('Stack [%d]', [TStackData(Data).Stack.Count]);
|
|
tvlkThreadCreationStack: if Data is TStackData then
|
|
Result := Format('CreationStack [%d]', [TStackData(Data).Stack.Count]);
|
|
end;
|
|
end;
|
|
|
|
constructor TRootTreeViewLink.Create;
|
|
begin
|
|
inherited Create(nil, tvlkRoot);
|
|
end;
|
|
|
|
procedure TfrmMain.LoadWindowState(ADesktop: TCustomIniFile);
|
|
begin
|
|
if Assigned(ADesktop) then
|
|
begin
|
|
FStackFrame.LoadState(ADesktop, JclStackTraceViewerDesktopIniSection, 'StackFrameSingle');
|
|
FModuleFrame.LoadState(ADesktop, JclStackTraceViewerDesktopIniSection);
|
|
FThreadFrame.LoadState(ADesktop, JclStackTraceViewerDesktopIniSection);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.SaveWindowState(ADesktop: TCustomIniFile; AIsProject: Boolean);
|
|
begin
|
|
if Assigned(ADesktop) then
|
|
begin
|
|
FStackFrame.SaveState(ADesktop, JclStackTraceViewerDesktopIniSection, 'StackFrameSingle');
|
|
FModuleFrame.SaveState(ADesktop, JclStackTraceViewerDesktopIniSection);
|
|
FThreadFrame.SaveState(ADesktop, JclStackTraceViewerDesktopIniSection);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.SetOptions(const Value: TExceptionViewerOption);
|
|
var
|
|
OldOptions: TExceptionViewerOption;
|
|
begin
|
|
OldOptions := TExceptionViewerOption.Create;
|
|
try
|
|
OldOptions.Assign(FOptions);
|
|
FOptions.Assign(Value);
|
|
if FOptions.ModuleVersionAsRevision <> OldOptions.ModuleVersionAsRevision then
|
|
begin
|
|
{ TODO -oUSc : Update stack views }
|
|
end;
|
|
finally
|
|
OldOptions.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.ShowTree(ARootLink: IJclStackTraceViewerTreeViewLink);
|
|
begin
|
|
FRootLink := ARootLink;
|
|
FStackFrame.StackList := nil;
|
|
FThreadFrame.CreationStackList := nil;
|
|
FThreadFrame.StackList := nil;
|
|
tv.Selected := nil;
|
|
tv.Items.Clear;
|
|
if Assigned(FLastControl) then
|
|
begin
|
|
FLastControl.Hide;
|
|
FLastControl := nil;
|
|
end;
|
|
if Assigned(ARootLink) then
|
|
AddItemsToTree(nil, ARootLink);
|
|
end;
|
|
|
|
procedure TfrmMain.tvChange(Sender: TObject; Node: TTreeNode);
|
|
var
|
|
TreeViewLink: IJclStackTraceViewerTreeViewLink;
|
|
NewControl: TControl;
|
|
I: Integer;
|
|
Frame: TCustomFrame;
|
|
begin
|
|
inherited;
|
|
NewControl := nil;
|
|
if Assigned(tv.Selected) and Assigned(tv.Selected.Data) and
|
|
(IUnknown(tv.Selected.Data).QueryInterface(IJclStackTraceViewerTreeViewLink, TreeViewLink) = S_OK) then
|
|
begin
|
|
if Assigned(TreeViewLink.FrameClass) then
|
|
begin
|
|
for I := 0 to FFrameList.Count - 1 do
|
|
if TObject(FFrameList[I]).ClassType = TreeViewLink.FrameClass then
|
|
begin
|
|
NewControl := TControl(FFrameList[I]);
|
|
Break;
|
|
end;
|
|
if not Assigned(NewControl) then
|
|
begin
|
|
FFrameList.Add(TreeViewLink.FrameClass.Create(Self));
|
|
Frame := TCustomFrame(FFrameList.Last);
|
|
Frame.Parent := Self;
|
|
Frame.Align := alClient;
|
|
Frame.Visible := False;
|
|
NewControl := Frame;
|
|
end;
|
|
end;
|
|
if Assigned(NewControl) and (NewControl is TCustomFrame) then
|
|
TreeViewLink.DoShow(TCustomFrame(NewControl));
|
|
end;
|
|
if Assigned(NewControl) then
|
|
NewControl.Show;
|
|
if Assigned(FLastControl) and (FLastControl <> NewControl) then
|
|
FLastControl.Hide;
|
|
if FLastControl <> NewControl then
|
|
FLastControl := NewControl;
|
|
end;
|
|
|
|
procedure TfrmMain.UnregisterFrameClass(AFrameClass: TCustomFrameClass);
|
|
var
|
|
I, Idx: Integer;
|
|
Frame: TCustomFrame;
|
|
begin
|
|
Idx := -1;
|
|
for I := 0 to FFrameList.Count - 1 do
|
|
if TObject(FFrameList[I]).ClassType = AFrameClass then
|
|
begin
|
|
Idx := I;
|
|
Break;
|
|
end;
|
|
if Idx <> -1 then
|
|
begin
|
|
Frame := TCustomFrame(FFrameList[Idx]);
|
|
Frame.Free;
|
|
FFrameList.Delete(Idx);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.acJumpToCodeLineExecute(Sender: TObject);
|
|
var
|
|
StackTraceViewerStackSelection: IJclStackTraceViewerStackSelection;
|
|
begin
|
|
if Assigned(FLastControl) and
|
|
(FLastControl.GetInterface(IJclStackTraceViewerStackSelection, StackTraceViewerStackSelection)) then
|
|
JumpToCode(StackTraceViewerStackSelection.Selected);
|
|
end;
|
|
|
|
constructor TfrmMain.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
acJumpToCodeLine.Caption := LoadResString(@RsJumpToCodeLine);
|
|
acLoadStack.Caption := LoadResString(@RsLoadStack);
|
|
acOptions.Caption := LoadResString(@RsOptions);
|
|
acUpdateLocalInfo.Caption := LoadResString(@RsUpdateLocalInfo);
|
|
|
|
FExceptionInfo := TJclStackTraceViewerExceptionInfo.Create;
|
|
FThreadInfoList := FExceptionInfo.ThreadInfoList;
|
|
FTreeViewLinkList := TObjectList.Create;
|
|
FRootLink := nil;
|
|
FFrameList := TList.Create;
|
|
FStackFrame := TfrmStack.Create(Self);
|
|
FFrameList.Add(FStackFrame);
|
|
FStackFrame.Name := 'StackFrameSingle';
|
|
FStackFrame.Parent := Self;
|
|
FStackFrame.Align := alClient;
|
|
FStackFrame.Visible := False;
|
|
|
|
FModuleFrame := TfrmModule.Create(Self);
|
|
FFrameList.Add(FModuleFrame);
|
|
FModuleFrame.Parent := Self;
|
|
FModuleFrame.Align := alClient;
|
|
FModuleFrame.Visible := False;
|
|
|
|
FExceptionFrame := TfrmException.Create(Self);
|
|
FFrameList.Add(FExceptionFrame);
|
|
FExceptionFrame.Name := 'ExceptionFrameSingle';
|
|
FExceptionFrame.Parent := Self;
|
|
FExceptionFrame.Align := alClient;
|
|
FExceptionFrame.Visible := False;
|
|
|
|
FThreadFrame := TfrmThread.Create(Self);
|
|
FFrameList.Add(FThreadFrame);
|
|
FThreadFrame.Parent := Self;
|
|
FThreadFrame.Align := alClient;
|
|
FThreadFrame.Visible := False;
|
|
|
|
PB.Parent := StatusBar;
|
|
PB.SetBounds(StatusBar.Panels[0].Width + 2, 3, 96, 14);
|
|
|
|
FOptions := TExceptionViewerOption.Create;
|
|
if Assigned(StackTraceViewerExpert) then
|
|
begin
|
|
Options := StackTraceViewerExpert.Options;
|
|
RootDir := StackTraceViewerExpert.RootDir;
|
|
end;
|
|
|
|
FLocationInfoProcessor := TJclLocationInfoProcessor.Create;
|
|
FLocationInfoProcessor.OnProgress := DoProgress;
|
|
FLocationInfoProcessor.Options := Options;
|
|
FLocationInfoProcessor.RootDir := RootDir;
|
|
StackTraceViewerStackProcessorServices := FLocationInfoProcessor;
|
|
StackTraceViewerStackServices := Self;
|
|
|
|
FLastControl := nil;
|
|
end;
|
|
|
|
destructor TfrmMain.Destroy;
|
|
begin
|
|
StackTraceViewerStackServices := nil;
|
|
StackTraceViewerStackProcessorServices := nil;
|
|
FStackFrame.StackList := nil;
|
|
FLocationInfoProcessor.Free;
|
|
FOptions.Free;
|
|
FTreeViewLinkList.Free;
|
|
FRootLink := nil;
|
|
FFrameList.Free;
|
|
FExceptionInfo.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TfrmMain.acJumpToCodeLineUpdate(Sender: TObject);
|
|
var
|
|
StackTraceViewerStackSelection: IJclStackTraceViewerStackSelection;
|
|
begin
|
|
acJumpToCodeLine.Enabled := Assigned(FLastControl) and
|
|
(FLastControl.GetInterface(IJclStackTraceViewerStackSelection, StackTraceViewerStackSelection)) and
|
|
Assigned(StackTraceViewerStackSelection.Selected);
|
|
end;
|
|
|
|
procedure TfrmMain.acLoadStackExecute(Sender: TObject);
|
|
var
|
|
SS: TStringStream;
|
|
{$IFNDEF COMPILER12_UP}
|
|
FS: TFileStream;
|
|
{$ENDIF ~COMPILER12_UP}
|
|
I: Integer;
|
|
ThreadTreeViewLink, TreeViewLink: TDefaultTreeViewLink;
|
|
XMLDeserializer: TJclXMLDeserializer;
|
|
SerializeExceptionInfo: TJclSerializableExceptionInfo;
|
|
RootTreeViewLink: TRootTreeViewLink;
|
|
ThreadData: TThreadData;
|
|
StackData: TStackData;
|
|
begin
|
|
inherited;
|
|
if OpenDialog1.Execute then
|
|
begin
|
|
FStackFrame.StackList := nil;
|
|
FThreadFrame.CreationStackList := nil;
|
|
FThreadFrame.StackList := nil;
|
|
FRootLink := nil;
|
|
tv.Selected := nil;
|
|
tv.Items.Clear;
|
|
FTreeViewLinkList.Clear;
|
|
SS := TStringStream.Create('');
|
|
try
|
|
{$IFDEF COMPILER12_UP}
|
|
SS.LoadFromFile(OpenDialog1.FileName);
|
|
{$ELSE ~COMPILER12_UP}
|
|
FS := TFileStream.Create(OpenDialog1.FileName, fmOpenRead);
|
|
try
|
|
SS.CopyFrom(FS, 0);
|
|
finally
|
|
FS.Free;
|
|
end;
|
|
{$ENDIF ~COMPILER12_UP}
|
|
SerializeExceptionInfo := TJclSerializableExceptionInfo.Create;
|
|
try
|
|
XMLDeserializer := TJclXMLDeserializer.Create('ExceptInfo');
|
|
try
|
|
XMLDeserializer.LoadFromString(SS.DataString);
|
|
SerializeExceptionInfo.Deserialize(XMLDeserializer);
|
|
finally
|
|
XMLDeserializer.Free;
|
|
end;
|
|
FExceptionInfo.AssignExceptionInfo(SerializeExceptionInfo);
|
|
finally
|
|
SerializeExceptionInfo.Free;
|
|
end;
|
|
|
|
RootTreeViewLink := TRootTreeViewLink.Create;
|
|
|
|
TreeViewLink := RootTreeViewLink.Add(tvlkModuleList);
|
|
TreeViewLink.Data := FExceptionInfo.Modules;
|
|
|
|
if FThreadInfoList.Count > 0 then
|
|
begin
|
|
for I := 0 to FThreadInfoList.Count - 1 do
|
|
begin
|
|
//FTreeViewLinkList.Add(TDefaultTreeViewLink.Create(tvlkThread));//TODO
|
|
ThreadTreeViewLink := RootTreeViewLink.Add(tvlkThread);
|
|
ThreadTreeViewLink.OwnsData := True;
|
|
ThreadTreeViewLink.Data := TThreadData.Create;
|
|
ThreadData := TThreadData(ThreadTreeViewLink.Data);
|
|
ThreadData.Exception := FExceptionInfo.Exception;
|
|
ThreadData.ModuleList := FExceptionInfo.Modules;
|
|
ThreadData.ThreadInfo := FThreadInfoList[I];
|
|
|
|
if I = 0 then
|
|
begin
|
|
TreeViewLink := ThreadTreeViewLink.Add(tvlkException);
|
|
TreeViewLink.Data := FExceptionInfo.Exception;
|
|
end;
|
|
|
|
if tioStack in FThreadInfoList[I].Values then
|
|
begin
|
|
TreeViewLink := ThreadTreeViewLink.Add(tvlkThreadStack);
|
|
TreeViewLink.OwnsData := True;
|
|
TreeViewLink.Data := TStackData.Create;
|
|
StackData := TStackData(TreeViewLink.Data);
|
|
StackData.ModuleList := FExceptionInfo.Modules;
|
|
StackData.Stack := FThreadInfoList[I].Stack;
|
|
end;
|
|
|
|
if tioCreationStack in FThreadInfoList[I].Values then
|
|
begin
|
|
TreeViewLink := ThreadTreeViewLink.Add(tvlkThreadCreationStack);
|
|
TreeViewLink.OwnsData := True;
|
|
TreeViewLink.Data := TStackData.Create;
|
|
StackData := TStackData(TreeViewLink.Data);
|
|
StackData.ModuleList := FExceptionInfo.Modules;
|
|
StackData.Stack := FThreadInfoList[I].CreationStack;
|
|
end;
|
|
end;
|
|
end;
|
|
FRootLink := RootTreeViewLink;
|
|
AddItemsToTree(nil, RootTreeViewLink);
|
|
finally
|
|
SS.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.acOptionsExecute(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
TJclOTAExpertBase.ConfigurationDialog(LoadResString(@RsStackTraceViewerOptionsPageName));
|
|
end;
|
|
|
|
procedure TfrmMain.acUpdateLocalInfoExecute(Sender: TObject);
|
|
var
|
|
I: Integer;
|
|
PreparableStackFrame: IJclStackTraceViewerPreparableStackFrame;
|
|
PreparedLocationInfoList: IJclPreparedLocationInfoList;
|
|
UpdateView: Boolean;
|
|
begin
|
|
inherited;
|
|
if Assigned(StackTraceViewerStackProcessorServices) and Assigned(FLastControl) and
|
|
(FLastControl.GetInterface(IJclStackTraceViewerPreparableStackFrame, PreparableStackFrame)) then
|
|
begin
|
|
UpdateView := False;
|
|
for I := 0 to PreparableStackFrame.PreparableLocationInfoListCount - 1 do
|
|
begin
|
|
PreparedLocationInfoList := PreparableStackFrame.PreparableLocationInfoList[I];
|
|
if Assigned(PreparedLocationInfoList) then
|
|
begin
|
|
StackTraceViewerStackProcessorServices.ModuleList := PreparedLocationInfoList.ModuleInfoList;
|
|
StackTraceViewerStackProcessorServices.PrepareLocationInfoList(PreparedLocationInfoList, True);
|
|
UpdateView := True;
|
|
end;
|
|
end;
|
|
if UpdateView then
|
|
PreparableStackFrame.UpdateViews;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmMain.acUpdateLocalInfoUpdate(Sender: TObject);
|
|
var
|
|
PreparableStackFrame: IJclStackTraceViewerPreparableStackFrame;
|
|
begin
|
|
acUpdateLocalInfo.Enabled := Assigned(StackTraceViewerStackProcessorServices) and Assigned(FLastControl) and
|
|
(FLastControl.GetInterface(IJclStackTraceViewerPreparableStackFrame, PreparableStackFrame)) and
|
|
(PreparableStackFrame.PreparableLocationInfoListCount > 0);
|
|
end;
|
|
|
|
procedure TfrmMain.AddItemsToTree(ANode: TTreeNode; ALink: IJclStackTraceViewerTreeViewLink);
|
|
var
|
|
I: Integer;
|
|
ChildNode: TTreeNode;
|
|
begin
|
|
for I := 0 to ALink.Count - 1 do
|
|
begin
|
|
if ANode = nil then
|
|
ChildNode := tv.Items.Add(nil, ALink[I].Text)
|
|
else
|
|
ChildNode := tv.Items.AddChild(ANode, ALink[I].Text);
|
|
ChildNode.Data := Pointer(ALink[I]);
|
|
if ALink[I].Count > 0 then
|
|
AddItemsToTree(ChildNode, ALink[I]);
|
|
end;
|
|
if FOptions.ExpandTreeView and Assigned(ANode) then
|
|
ANode.Expanded := True;
|
|
end;
|
|
|
|
procedure TfrmMain.DoProgress(AStatus: TLocationInfoProcessorProgressStatus; APos, AMax: Integer; const AText: string);
|
|
begin
|
|
if AStatus = lippsStart then
|
|
PB.Visible := True
|
|
else
|
|
if AStatus = lippsFinished then
|
|
PB.Visible := False;
|
|
PB.Max := AMax;
|
|
PB.Position := APos;
|
|
StatusBar.Panels[0].Text := AText;
|
|
StatusBar.Update;
|
|
end;
|
|
|
|
procedure TfrmMain.FrameResize(Sender: TObject);
|
|
begin
|
|
StatusBar.Panels[0].Width := Width - 100;
|
|
PB.SetBounds(StatusBar.Panels[0].Width + 2, 3, 96, 14);
|
|
end;
|
|
|
|
function TfrmMain.GetDefaultFrameClass(const AFrameClassID: Integer): TCustomFrameClass;
|
|
begin
|
|
case AFrameClassID of
|
|
dfStack: Result := TfrmStack;
|
|
else
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
initialization
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
|
|
finalization
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
end.
|