Following debugger source was altered for debugging DLLs:
'original code by Gary Peek (05/14/2004)
'modified by Heber Jorge da Silva & Charles Dietz & Norbert Doerre
'http://www.powerbasic.com/support/forums/Forum7/HTML/002320.html
I changed the source to an .inc file to be included in a DLL source code. There were following additions done:
1. A keyboard hook was attached to be able to trigger the debugger by key press. Normally, in a larger application all keys are already used by the program itself. The numpad keys are usable depending from the num key state. Numbers exist twice on the keyboard, so you can press the num key to use the numbers of the main keybord. All keys of the num pad are usable to trigger the debugger with 17 different tasks. You don't need to break Your fingers Alt-Ctrl-Shift-F1 or similiar.
Currently, I simply programmed the debugger to stop by pressing one of the 17 num pad keys and continue by pressing again one of the keys. But You can easily add conditions for each of the num pad keys and Your special debugging options.
'original code by Gary Peek (05/14/2004)
'modified by Heber Jorge da Silva & Charles Dietz & Norbert Doerre
'http://www.powerbasic.com/support/forums/Forum7/HTML/002320.html
I changed the source to an .inc file to be included in a DLL source code. There were following additions done:
1. A keyboard hook was attached to be able to trigger the debugger by key press. Normally, in a larger application all keys are already used by the program itself. The numpad keys are usable depending from the num key state. Numbers exist twice on the keyboard, so you can press the num key to use the numbers of the main keybord. All keys of the num pad are usable to trigger the debugger with 17 different tasks. You don't need to break Your fingers Alt-Ctrl-Shift-F1 or similiar.
Currently, I simply programmed the debugger to stop by pressing one of the 17 num pad keys and continue by pressing again one of the keys. But You can easily add conditions for each of the num pad keys and Your special debugging options.
Code:
'include file for adding debug messages ---------------------------------------------
'original code by Gary Peek (05/14/2004)
'modified by Heber Jorge da Silva & Charles Dietz & Norbert Doerre
'http://www.powerbasic.com/support/forums/Forum7/HTML/002320.html
'
'Name this file "debug.inc" (I keep it in my WinAPI folder)
'This version was concepted as an .inc file to be used with debugging DLLs.
'To use, just include "DebugWin.inc" and add debug statements where ever needed:
'
' In the DLL source code write: debug v1 [, v2, ... , v6]
'
' first debug statement creates the debug window
' where vn can be any string type, integer type, or float type
' set v1 = "cls" --> clear dialog box
' = "file" --> begin writing to a new file named "debug.txt"
' ('clear' and 'To File' also from system menu)
' stop or restart the list to be continuously filled by pressing a NumPad number key
' this way the debugger can be triggerd by a number from 0 to 9 for any task
' the sys menue was extended by On/Off menu command also stopping/continuing the list
' for cases when NumPad must be used by another operation.
'The specified debug items are posted to a resizable dialog box
'and optionally written to a file named "debug.txt"
'------------------------------------------------------------------------------------
Declare Function GetSystemMenu Lib "USER32.DLL" Alias "GetSystemMenu" (ByVal hWnd As Dword, ByVal bRevert As Long) As Long
Declare Function AppendMenu Lib "USER32.DLL" Alias "AppendMenuA" (ByVal hMenu As Dword, ByVal uFlags As Dword, ByVal uIDNewItem As Dword, lpNewItem As Asciiz) As Long
Declare Function DrawMenuBar Lib "USER32.DLL" Alias "DrawMenuBar" (ByVal hWnd As Dword) As Long
Declare Function GetSystemMetrics Lib "USER32.DLL" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
Declare Function GetActiveWindow Lib "USER32.DLL" Alias "GetActiveWindow" () As Long
Declare Function SetActiveWindow Lib "USER32.DLL" Alias "SetActiveWindow" (ByVal hWnd As Dword) As Long
Declare Function InsertMenu Lib "USER32.DLL" Alias "InsertMenuA" (ByVal hMenu As Dword, ByVal dwPosition As Dword, ByVal dwFlags As Dword, ByVal dwIDNewItem As Dword, lpNewItem As Asciiz) As Long
Declare Function RemoveMenu Lib "USER32.DLL" Alias "RemoveMenu" (ByVal hMenu As Dword, ByVal nPosition As Long, ByVal wFlags As Dword) As Long
Declare Function WindowMessage Lib "WINMSG.DLL" Alias "WindowMessageA" (ByVal MsgNum As Long) As String
Declare Function KeyboardHook(ByVal iCode As Integer, ByVal wParam As Long, ByVal lParam As Long) As Dword
Declare Sub AddDebug()
Declare CallBack Function AddDebugProc()
Declare Sub Debug(Optional ByVal v1 As VARIANT, Opt ByVal v2 As VARIANT, Opt ByVal v3 As VARIANT, Opt ByVal v4 As VARIANT, Opt ByVal v5 As VARIANT, Opt ByVal v6 As VARIANT)
Global ghKbrdHook As Long
Global lpfnKbrdHook As Long
%MF_SEPARATOR = &H800
%MF_STRING = &H0
%SM_CXSCREEN = &H0
%SM_CYSCREEN = &H1
%WS_SYSMENU = &H00080000
%WS_THICKFRAME = &H00040000
%WS_VSCROLL = &H00200000
%LBS_NOSEL = &H00004000
%WM_USER = &H400
%WM_SIZE = &H5
%WM_SYSCOMMAND = &H112
%MF_BYPOSITION = &H400
#If Not %Def(%SC_CLOSE)
%SC_CLOSE = &HF060&
#EndIf
%ID_Debug = %WM_USER + 1
%ID_Button = %WM_USER + 2
Global StopDebug As Long
GLOBAL hDebugDlg AS LONG
GLOBAL hDebugCalled AS LONG
GLOBAL hDebugMenu AS LONG
GLOBAL debugCount AS LONG
GLOBAL debugFile AS STRING
DECLARE SUB debug(OPTIONAL BYVAL v1 AS VARIANT, _
OPTIONAL BYVAL v2 AS VARIANT, _
OPTIONAL BYVAL v3 AS VARIANT, _
OPTIONAL BYVAL v4 AS VARIANT, _
OPTIONAL BYVAL v5 AS VARIANT, _
OPTIONAL BYVAL v6 AS VARIANT)
Sub AddDebug()
'Create dialog box for debugging info
Local nStyle As Long, wi As Long, ht As Long, x As Long, y As Long
hDebugCalled = GetActiveWindow
wi = CLng(GetSystemMetrics(%SM_CXSCREEN) \ 4) 'make dlg 1/4 screen width
ht = CLng(GetSystemMetrics(%SM_CYSCREEN) \ 6) 'and 1/6 screen height
nStyle = %WS_SYSMENU Or %WS_THICKFRAME
Dialog New 0, "I B D Debug Info", 0, 0, wi, ht, nStyle To hDebugDlg
Dialog Pixels hDebugDlg, wi, ht To Units wi, ht
Dialog Set Size hDebugDlg, wi, ht
Dialog Get Client hDebugDlg To x, y
nStyle = %WS_VSCROLL Or %LBS_NOSEL
Control Add ListBox, hDebugDlg, %ID_Debug, , 0, 0, x, y, nStyle
hDebugMenu = GetSystemMenu(hDebugDlg, 0)
InsertMenu hDebugMenu, 5, %MF_BYPOSITION Or %MF_SEPARATOR, -1, "-"
InsertMenu hDebugMenu, 6, %MF_BYPOSITION Or %MF_STRING, %ID_Debug + 1, "&Clear"
InsertMenu hDebugMenu, 7, %MF_BYPOSITION Or %MF_STRING, %ID_Debug + 2, "&ToFile"
InsertMenu hDebugMenu, 8, %MF_BYPOSITION Or %MF_STRING, %ID_Debug + 3, "&On/Off"
RemoveMenu hDebugMenu, 4, %MF_BYPOSITION
RemoveMenu hDebugMenu, 3, %MF_BYPOSITION
RemoveMenu hDebugMenu, 0, %MF_BYPOSITION
DrawMenuBar hDebugDlg
Dialog Show Modeless hDebugDlg, Call addDebugProc
End Sub
'-------------------------------------------------------------------------------------------------------
' CALLBACK FUNCTION AddDebugProc
'-------------------------------------------------------------------------------------------------------
CallBack Function AddDebugProc()
Local i As Long, x As Long, y As Long, fileNo As Long, msg As String
Select Case CbMsg
Case %WM_SIZE
Dialog Get Client CbHndl To x, y
Control Set Size CbHndl, %ID_Debug, x, y
SetActiveWindow hDebugCalled
Case %WM_SYSCOMMAND
If CbWParam = %SC_CLOSE Then
hDebugDlg = 0: debugCount = 0
ElseIf CbWParam = %ID_Debug + 1 Then
ListBox Reset hDebugDlg, %ID_Debug: debugCount = 0
ElseIf CbWParam = %ID_Debug + 2 Then
debugFile = "debug.txt": Kill debugFile
Open debugFile For Output As fileNo
For i = 1 To debugCount
ListBox Select CbHndl, %ID_Debug, i
ListBox Get Text CbHndl, %ID_Debug To msg
Print #fileNo, msg
Next i
Close #fileNo
ElseIf CbWParam = %ID_Debug +3 Then
StopDebug = 1 - StopDebug
End If
End Select
Select Case CbMsg
Case %WM_INITDIALOG
ghKbrdHook = SetWindowsHookEx(%WH_KEYBOARD, CodePtr(KeyboardHook), 0, GetCurrentThreadId)
Case %WM_DESTROY
UnhookWindowsHookEx ghKbrdHook
End Select
End Function
'-------------------------------------------------------------------------------------------------------
' FUNCTION Debug
'-------------------------------------------------------------------------------------------------------
Sub Debug(Optional ByVal v1 As VARIANT, _
Optional ByVal v2 As VARIANT, _
Optional ByVal v3 As VARIANT, _
Optional ByVal v4 As VARIANT, _
Optional ByVal v5 As VARIANT, _
Optional ByVal v6 As VARIANT)
Local Msg As String, i As Long, n As Long
Static fileNo As Long
Dim v(6) As VARIANT
If hDebugDlg = 0 Then addDebug
v(1) = v1 : v(2) = v2 : v(3) = v3 : v(4) = v4 : v(5) = v5 : v(6) = v6
For i = 1 To 6
n = VariantVT(v(i))
If n = 8 Then
If i = 1 And UCase$(Variant$(v(i))) = "CLS" Then 'clear window
ListBox Reset hDebugDlg, %ID_Debug: msg = "": debugCount = 0
ElseIf i = 1 And UCase$(Variant$(v(i))) = "FILE" Then 'write to debug file
debugFile = "c:\IBD_DEBUG.LOG": Kill debugFile: msg = ""
Else
msg = msg + Variant$(v(i)) + ", "
End If
ElseIf n <> 0 Then
msg = msg + Str$(Variant#(v(i))) + ", "
End If
Next
If StopDebug = 0 Then
msg = RTrim$(msg, Any ", ")
If Len(msg) = 0 Then Exit Sub
If Len(debugFile) Then
Open debugFile For Append As fileNo
Print #fileNo, msg: Close #fileNo
End If
ListBox Add hDebugDlg, %ID_Debug, msg: Incr debugCount
ListBox Select hDebugDlg, %ID_Debug, debugCount
End If
End Sub
'-------------------------------------------------------------------------------------------------------
' FUNCTION KeyboardHook
'-------------------------------------------------------------------------------------------------------
Function KeyboardHook(ByVal iCode As Integer, ByVal wParam As Long, ByVal lParam As Long) As Dword
'KeyBoardHook looks For one of the NumPad number keys beeing pressed.
'Each key press stops or restarts the debugger list to be continuously filled.
Local ScanCode As Long, t As String, Enhanced As Long
If iCode = %HC_ACTION Then
If (lParam And &H80000000) = 0 Then ' Pressed
Enhanced = IsTrue(lParam And &H01000000)
ScanCode = Asc(Mkl$(lParam), 3)
Select Case ScanCode
Case &H52: t$ = "Numpad 0"
Case &H4F: t$ = "Numpad 1"
'
'
'
Case &H48: t$ = "Numpad 8"
Case &H49: t$ = "Numpad 9"
End Select
If EnHanced Then t$ = "" 'do not really use as input
'Add here Your special debugging extension conditions
StopDebug = 1 - StopDebug
End If
End If
Function = CallNextHookEx(ghKbrdHook, iCode, wParam, lParam)
End Function