Skip to content

Commit 68f92cf

Browse files
dzziedzzie
committed
EnumArrayVariables, dumping, and Run2Line
1 parent 611b4b2 commit 68f92cf

16 files changed

Lines changed: 619 additions & 1258 deletions

File tree

‎CVariable.cls‎

Lines changed: 35 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,39 @@ Attribute VB_Creatable = True
1212
Attribute VB_PredeclaredId = False
1313
Attribute VB_Exposed = False
1414
Public isGlobal As Boolean
15-
Public name As String
16-
Public value As Variant
15+
Private m_name As String
16+
Private m_value As Variant
1717
Public varType As String
18+
Public index As Long 'for arrays
19+
Public pAryElement As Long
20+
21+
Property Let name(v As String)
22+
23+
m_name = Replace(v, "main::", Empty)
24+
25+
' If InStr(v, "::") > 0 Then
26+
' tmp = Split(v, "::")
27+
' m_name = tmp(1)
28+
' namespace = tmp(0)
29+
' Else
30+
' m_name = v
31+
' End If
32+
End Property
33+
34+
Property Get name() As String
35+
name = m_name
36+
End Property
37+
38+
Property Let value(v As String)
39+
If Left(v, 5) = "ARRAY" And InStr(v, "@ 0x") > 0 Then
40+
tmp = Split(v, "@ 0x")
41+
m_value = tmp(0)
42+
pAryElement = CLng("&h" & tmp(1))
43+
Else
44+
m_value = v
45+
End If
46+
End Property
47+
48+
Property Get value() As String
49+
value = m_value
50+
End Property

‎Form1.frm‎

Lines changed: 73 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ Begin VB.Form Form1
55
Caption = "Form1"
66
ClientHeight = 12000
77
ClientLeft = 60
8-
ClientTop = 345
8+
ClientTop = 630
99
ClientWidth = 13905
1010
KeyPreview = -1 'True
1111
LinkTopic = "Form1"
@@ -284,20 +284,22 @@ Begin VB.Form Form1
284284
ImageKey = "Step Out"
285285
EndProperty
286286
BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628}
287-
Key = "Set Next"
288-
Object.ToolTipText = "Set Next Statement"
287+
Key = "Run to Cursor"
288+
Object.ToolTipText = "Run to Cursor"
289289
ImageKey = "Set Next"
290290
EndProperty
291291
BeginProperty Button13 {66833FEA-8583-11D1-B16A-00C0F0283628}
292292
Style = 3
293293
EndProperty
294294
BeginProperty Button14 {66833FEA-8583-11D1-B16A-00C0F0283628}
295+
Object.Visible = 0 'False
295296
Key = "Immediate"
296297
Object.ToolTipText = "Immediate Window"
297298
ImageKey = "Immediate"
298299
Style = 1
299300
EndProperty
300301
BeginProperty Button15 {66833FEA-8583-11D1-B16A-00C0F0283628}
302+
Object.Visible = 0 'False
301303
Key = "Callstack"
302304
Object.ToolTipText = "Callstack"
303305
ImageKey = "Callstack"
@@ -379,6 +381,12 @@ Begin VB.Form Form1
379381
Top = 6525
380382
Width = 1860
381383
End
384+
Begin VB.Menu mnuCallStackPopup
385+
Caption = "mnuCallStackPopup"
386+
Begin VB.Menu mnuExecuteTillReturn
387+
Caption = "Execute Until Return"
388+
End
389+
End
382390
End
383391
Attribute VB_Name = "Form1"
384392
Attribute VB_GlobalNameSpace = False
@@ -397,14 +405,20 @@ Private Declare Sub SetCallBacks Lib "sb_engine" (ByVal msgProc As Long, ByVal d
397405

398406
Dim loadedFile As String
399407
Dim hsbLib As Long
408+
Dim lastEIP As Long
400409

401-
402-
410+
Const SC_MARK_CIRCLE = 0
411+
Const SC_MARK_ARROW = 2
412+
Dim selCallStackItem As ListItem
413+
Dim selVariable As ListItem
403414

404415
Private Sub cmdManual_Click()
405-
txtDebug.Text = Empty
406-
dbg_cmd = txtCmd.Text
407-
readyToReturn = True
416+
'txtDebug.Text = Empty
417+
'dbg_cmd = txtCmd.Text
418+
'readyToReturn = True
419+
420+
MsgBox GetVariableValue(txtCmd.Text)
421+
408422
End Sub
409423

410424
Private Sub RefreshVariables()
@@ -421,6 +435,7 @@ Private Sub RefreshVariables()
421435
li.SubItems(1) = v.name
422436
li.SubItems(2) = v.varType
423437
li.SubItems(3) = v.value
438+
If v.varType = "array" Then li.Tag = v.pAryElement
424439
Next
425440

426441
End Sub
@@ -441,13 +456,43 @@ Private Sub RefreshCallStack()
441456

442457
End Sub
443458

459+
Private Sub lvCallStack_ItemClick(ByVal Item As MSComctlLib.ListItem)
460+
scivb.GotoLine CLng(Item.Text)
461+
Set selCallStackItem = Item
462+
End Sub
463+
464+
Private Sub lvVars_DblClick()
465+
If selVariable Is Nothing Then Exit Sub
466+
If selVariable.SubItems(2) <> "array" Then Exit Sub
467+
468+
Dim c As Collection
469+
Dim varName As String
470+
471+
varName = selVariable.SubItems(1)
472+
Set c = EnumArrayVariables(varName)
473+
If c.Count > 0 Then
474+
frmAryDump.DumpArrayValues varName, c
475+
End If
476+
477+
End Sub
478+
479+
Private Sub lvVars_ItemClick(ByVal Item As MSComctlLib.ListItem)
480+
Set selVariable = Item
481+
End Sub
482+
483+
Private Sub mnuExecuteTillReturn_Click()
484+
MsgBox "todo: disable all breakpoints,run to line selCallStackItem.text + 1, reenable breakpoints", vbInformation
485+
End Sub
486+
444487
Private Sub scivb_KeyDown(KeyCode As Long, Shift As Long)
445-
Debug.Print KeyCode & " " & Shift
488+
489+
'Debug.Print KeyCode & " " & Shift
446490
Select Case KeyCode
447491
Case vbKeyF2: ToggleBreakPoint scivb.CurrentLine
448492
Case vbKeyF5: If running Then DebuggerCmd "R" Else ExecuteScript True
449-
Case vbKeyF7: DebuggerCmd "s"
450-
Case vbKeyF8: DebuggerCmd "S"
493+
Case vbKeyF7: DebuggerCmd "s" 'step into
494+
Case vbKeyF8: DebuggerCmd "S" 'step over
495+
Case vbKeyF9: DebuggerCmd "o" 'step out
451496
End Select
452497

453498
End Sub
@@ -475,10 +520,10 @@ Private Sub tbarDebug_ButtonClick(ByVal Button As MSComctlLib.Button)
475520
Case "Stop": DebuggerCmd "q"
476521
Case "Step In": DebuggerCmd "s"
477522
Case "Step Over": DebuggerCmd "S"
478-
Case "Step Out": DebuggerCmd "u"
479-
Case "Set Next":
480-
Case "Immediate"
481-
Case "Callstack"
523+
Case "Step Out": DebuggerCmd "o"
524+
Case "Run to Cursor": RunToLine scivb.CurrentLine + 1
525+
'Case "Immediate"
526+
'Case "Callstack"
482527
Case "Breakpoint":
483528
Case "Clear Breakpoints":
484529
End Select
@@ -511,12 +556,14 @@ Private Sub ExecuteScript(Optional withDebugger As Boolean)
511556
running = False
512557
scivb.ReadOnly = False
513558
scivb.HighLightActiveLine = False
514-
559+
scivb.DeleteMarker lastEIP, 1
515560

516561
End Sub
517562

518563
Private Sub Form_Load()
519564

565+
mnuCallStackPopup.Visible = False
566+
520567
hsbLib = LoadLibrary(App.Path & "\engine\sb_engine.dll")
521568

522569
If hsbLib = 0 Then
@@ -527,9 +574,15 @@ Private Sub Form_Load()
527574
scivb.LoadHighlighter App.Path & "\dependancies\vb.bin"
528575

529576
scivb.DirectSCI.HideSelection False
577+
scivb.DirectSCI.MarkerDefine 2, SC_MARK_CIRCLE
530578
scivb.DirectSCI.MarkerSetFore 2, vbRed 'set breakpoint color
531579
scivb.DirectSCI.MarkerSetBack 2, vbRed
532580

581+
scivb.DirectSCI.MarkerDefine 1, SC_MARK_ARROW
582+
scivb.DirectSCI.MarkerSetFore 1, vbBlack 'current eip
583+
scivb.DirectSCI.MarkerSetBack 1, vbYellow
584+
585+
533586
lvCallStack.ColumnHeaders(2).Width = lvCallStack.Width - lvCallStack.ColumnHeaders(2).Left - 100
534587
lvVars.ColumnHeaders(lvVars.ColumnHeaders.Count).Width = lvVars.Width - lvVars.ColumnHeaders(lvVars.ColumnHeaders.Count).Left - 100
535588

@@ -566,8 +619,11 @@ Public Sub SyncUI()
566619

567620
Dim curLine As Long
568621

622+
scivb.DeleteMarker lastEIP, 1
623+
569624
curLine = GetCurrentDebugLine(hDebugObject)
570-
Me.Caption = "Current Line: " & curLine
625+
scivb.SetMarker curLine, 1
626+
lastEIP = curLine
571627

572628
scivb.GotoLine curLine
573629
scivb.HighLightActiveLine = True

‎Module1.bas‎

Lines changed: 53 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,9 @@ Private Declare Function dbg_getVarVal Lib "sb_engine" (ByVal hDebug As Long, By
1111
'enumerate global and local variable names (uses vbstdOut callback)
1212
Private Declare Sub dbg_EnumVars Lib "sb_engine" (ByVal hDebug As Long)
1313

14+
Private Declare Sub dbg_EnumAryVarsByName Lib "sb_engine" (ByVal hDebug As Long, ByRef varName As Byte)
15+
Private Declare Sub dbg_EnumAryVarsByPointer Lib "sb_engine" (ByVal hDebug As Long, ByVal pVar As Long)
16+
1417
Private Declare Function dbg_VarTypeFromName Lib "sb_engine" (ByVal hDebug As Long, ByRef varName As Byte) As Long
1518

1619
'set or remove a breakpoint on a line
@@ -22,6 +25,10 @@ Public Declare Function dbg_LineCount Lib "sb_engine" (ByVal hDebug As Long) As
2225
Private Declare Function dbg_isBpSet Lib "sb_engine" (ByVal hDebug As Long, ByVal lineNo As Long) As Long
2326

2427
Private Declare Sub dbg_EnumCallStack Lib "sb_engine" (ByVal hDebug As Long)
28+
Private Declare Sub dbg_RunToLine Lib "sb_engine" (ByVal hDebug As Long, ByVal lineNo As Long)
29+
30+
31+
2532

2633
Public hDebugObject As Long 'handle to the current debug object - pDO
2734
Public readyToReturn As Boolean
@@ -47,6 +54,11 @@ Enum sb_VarTypes
4754
VTYPE_UNDEF = 5
4855
End Enum
4956

57+
Public Sub RunToLine(lineNo As Long)
58+
dbg_RunToLine hDebugObject, lineNo
59+
DebuggerCmd "m"
60+
End Sub
61+
5062
Public Function EnumCallStack() As Collection
5163

5264
Set callStack = Nothing
@@ -108,21 +120,26 @@ Private Sub InitDebuggerBpx()
108120
Next
109121
End Sub
110122

123+
Public Function VariableTypeToString(x As sb_VarTypes) As String
124+
125+
types = Array("LONG", "DOUBLE", "STRING", "ARRAY", "REF", "UNDEF")
126+
127+
If x < 0 Or x > 5 Then
128+
VariableTypeToString = "???"
129+
Else
130+
VariableTypeToString = LCase(types(x))
131+
End If
132+
133+
End Function
134+
111135
Public Function VariableType(varName As String) As String
112136

113137
Dim x As sb_VarTypes
114138
Dim v() As Byte
115139

116140
v() = StrConv(varName & Chr(0), vbFromUnicode)
117141
x = dbg_VarTypeFromName(hDebugObject, v(0))
118-
119-
types = Array("LONG", "DOUBLE", "STRING", "ARRAY", "REF", "UNDEF")
120-
121-
If x < 0 Or x > 5 Then
122-
VariableType = "???"
123-
Else
124-
VariableType = LCase(types(x))
125-
End If
142+
VariableType = VariableTypeToString(x)
126143

127144
End Function
128145

@@ -131,8 +148,24 @@ Public Sub DebuggerCmd(cmd As String)
131148
readyToReturn = True
132149
End Sub
133150

134-
Public Function EnumVariables() As Collection
151+
Public Function EnumArrayVariables(varNameOrPointer As Variant) As Collection
152+
153+
Dim v() As Byte
154+
Set variables = Nothing
155+
156+
If TypeName(varNameOrPointer) = "String" Then
157+
v() = StrConv(varNameOrPointer & Chr(0), vbFromUnicode)
158+
dbg_EnumAryVarsByName hDebugObject, v(0) 'this goes into syncronous set of callbacks
159+
Else
160+
dbg_EnumAryVarsByPointer hDebugObject, CLng(varNameOrPointer) 'this goes into syncronous set of callbacks
161+
End If
162+
163+
Set EnumArrayVariables = variables
135164

165+
End Function
166+
167+
Public Function EnumVariables() As Collection
168+
136169
Set variables = Nothing
137170
dbg_EnumVars hDebugObject 'this goes into syncronous set of callbacks
138171
Set EnumVariables = variables
@@ -157,7 +190,7 @@ Public Function GetVariableValue(varName As String) As String
157190
GetVariableValue = StrConv(buf, vbUnicode)
158191
i = InStr(GetVariableValue, Chr(0))
159192
If i > 1 Then
160-
GetVariableValue = Left(GetVariableValue, i)
193+
GetVariableValue = Left(GetVariableValue, i - 1)
161194
End If
162195
ElseIf ret = 1 Then
163196
GetVariableValue = "[ > 1024 chars ]"
@@ -207,6 +240,8 @@ Public Sub HandleDebugMessage(msg As String)
207240

208241
If Left(msg, 10) = "Call-Stack" Then
209242
cmd = Split(msg, ":", 3)
243+
ElseIf Left(msg, 14) = "Array-Variable" Then
244+
cmd = Split(msg, ":", 4)
210245
Else
211246
cmd = Split(msg, ":", 2)
212247
End If
@@ -244,6 +279,14 @@ Public Sub HandleDebugMessage(msg As String)
244279
callStack.Add c
245280
handled = True
246281

282+
Case "Array-Variable" 'Array-Variable:%d:%d:%s", i, TYPE(v2), buf);
283+
Set v = New CVariable
284+
v.index = CLng(cmd(1))
285+
v.varType = VariableTypeToString(CLng(cmd(2)))
286+
v.value = cmd(3) 'if is array then aryPointer will be parsed from value..
287+
variables.Add v
288+
handled = True
289+
247290
'Source-File: %s\r\n
248291
'Current-Line: %u\r\n
249292
'Break-Point: %s\r\n = 1/0

0 commit comments

Comments
 (0)