-
Notifications
You must be signed in to change notification settings - Fork 10
/
Copy pathfrmCallStack.frm
148 lines (127 loc) · 6.35 KB
/
frmCallStack.frm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
VERSION 5.00
Begin VB.Form frmCallStack
BackColor = &H00302D2D&
BorderStyle = 0 'None
Caption = "调用堆栈"
ClientHeight = 3645
ClientLeft = 0
ClientTop = 0
ClientWidth = 5775
LinkTopic = "Form1"
ScaleHeight = 3645
ScaleWidth = 5775
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin DragControlsIDE.DarkListView lvCallStack
Height = 2655
Left = 480
TabIndex = 0
Top = 240
Width = 3615
_ExtentX = 6376
_ExtentY = 4683
End
End
Attribute VB_Name = "frmCallStack"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'====================================================
'描述: 调用堆栈窗口，在中断状态下显示调用堆栈
'作者: 冰棍
'文件: frmCallStack.frm
'====================================================
Option Explicit
Dim CallStackInfo() As CallStackInfoStruct '所有调用堆栈信息
'描述: 清空所有东西，为下一次调试做准备
Public Sub ClearEverything()
Me.lvCallStack.Clear
ReDim CallStackInfo(0)
End Sub
'描述: 获取调用堆栈列表
Public Sub GetCallStack()
On Error Resume Next
Dim PipeOutput As String '管道的输出
Dim OutputLines() As String '输出的每一行
Dim NewListItem As Long '新添加的ListView列表项索引
Dim rtnInfo As CallStackInfoStruct '分析得到的调用堆栈信息
Dim i As Long
Me.lvCallStack.Clear
frmMain.DockingPane.Panes(10).Title = Lang_CallStack_Caption & Lang_DebugWindow_Retrieving_Caption
frmMain.GdbPipe.ClearPipe '清空管道里的内容
frmMain.GdbPipe.DosInput "info stack" & vbCrLf '向gdb发送获取调用堆栈命令
frmMain.GdbPipe.DosOutput PipeOutput, "(gdb) ", 2000 '获取gdb输出
OutputLines = Split(PipeOutput, vbCrLf) '逐行分割开输出
ReDim CallStackInfo(UBound(OutputLines) - 1) '分配信息列表元素
For i = 0 To UBound(OutputLines) '逐行进行分析
If Trim(OutputLines(i)) <> "(gdb)" Then '去掉无用输出“(gdb) ”
rtnInfo = ParseCallStackString(OutputLines(i))
CallStackInfo(i) = rtnInfo
NewListItem = Me.lvCallStack.AddItem(rtnInfo.Address) '添加新列表项
If rtnInfo.Args <> "" Then
Me.lvCallStack.SetItemText rtnInfo.Args, NewListItem, 1
Else
rtnInfo.Args = Lang_CallStack_NoArg
Me.lvCallStack.SetItemText Lang_CallStack_NoArg, NewListItem, 1
End If
If rtnInfo.File <> "" Then
Me.lvCallStack.SetItemText rtnInfo.File, NewListItem, 2
Else
rtnInfo.File = Lang_CallStack_NoArg
Me.lvCallStack.SetItemText Lang_CallStack_NoArg, NewListItem, 2
End If
If rtnInfo.Line > 0 Then
Me.lvCallStack.SetItemText CStr(rtnInfo.Line), NewListItem, 3
Else
Me.lvCallStack.SetItemText Lang_CallStack_NoArg, NewListItem, 3
End If
End If
Next i
frmMain.DockingPane.Panes(10).Title = Lang_CallStack_Caption
End Sub
Private Sub Form_Load()
Me.Caption = Lang_CallStack_Caption
Me.lvCallStack.Move 0, 0
Me.lvCallStack.AddColumnHeader Lang_Breakpoints_ListViewHeader_Address, 300
Me.lvCallStack.AddColumnHeader Lang_CallStack_Args, 300
Me.lvCallStack.AddColumnHeader Lang_Breakpoints_ListViewHeader_File, 150
Me.lvCallStack.AddColumnHeader Lang_Breakpoints_ListViewHeader_Line
ReDim CallStackInfo(0) '初始化调用堆栈信息列表
End Sub
Private Sub Form_Resize()
On Error Resume Next
Me.lvCallStack.Width = Me.ScaleWidth
Me.lvCallStack.Height = Me.ScaleHeight
End Sub
Private Sub lvCallStack_Click(iItem As Long, iSubItem As Long, X As Long, Y As Long)
On Error Resume Next
If CallStackInfo(iItem).File <> "" Then
CtlAddToolTip Me.lvCallStack.ListViewHwnd, Lang_Breakpoints_ListViewHeader_Address & ": " & CallStackInfo(iItem).Address & vbCrLf & _
Lang_CallStack_Args & ": " & CallStackInfo(iItem).Args & vbCrLf & _
Lang_Breakpoints_ListViewHeader_File & ": " & CallStackInfo(iItem).File & ":" & CallStackInfo(iItem).Line, _
Lang_CallStack_Tooltip_Title, TTI_INFO
Else
CtlAddToolTip Me.lvCallStack.ListViewHwnd, Lang_Breakpoints_ListViewHeader_Address & ": " & CallStackInfo(iItem).Address & vbCrLf & _
Lang_CallStack_Args & ": " & CallStackInfo(iItem).Args & vbCrLf & _
Lang_CallStack_Tooltip_Title, TTI_INFO
End If
End Sub
Private Sub lvCallStack_DoubleClick(iItem As Long, iSubItem As Long, X As Long, Y As Long)
On Error Resume Next
If CallStackInfo(iItem).File <> "" Then '如果有对应的文件
If CallStackInfo(iItem).Line <> -1 Then '切换到对应的代码行
Dim NewCodeWindow As frmCodeWindow
'切换到对应的窗口
Set NewCodeWindow = frmMain.ShowCodeWindow(, CallStackInfo(iItem).File)
If NewCodeWindow Is Nothing Then
NoSkinMsgBox Lang_Main_Debug_OpenSourceFailure & CallStackInfo(iItem).File, vbExclamation, Lang_Msgbox_Error
Else
NewCodeWindow.SyntaxEdit.CurrPos.Row = CallStackInfo(iItem).Line
NewCodeWindow.SyntaxEdit.SetFocus
End If
Else '若行号为-1，则说明是要从文件浏览器打开文件位置
Shell "explorer.exe /select,""" & CallStackInfo(iItem).File & """", vbNormalFocus
End If
End If
End Sub