' ------------- Sam Spade, the Visual Basic runtime debugger -------------
' version 1.0
' 1995 KnowledgeWorks

' Used to diagnose Visual Basic runtime errors. See SAMSPADE.FRM for
' documentation.

' requires:
'   SAMSPADE.BAS
'   SAMSPADE.FRM
'   VBRUN300.DLL
'   BFVBHLPR.DLL

Declare Function GetFreeSystemResources Lib "User" (ByVal fuSysResource As Integer) As Integer
Declare Function GetFreeSpace Lib "Kernel" (ByVal wFlags As Integer) As Long
Declare Function bfFreeSpace& Lib "BFVBHLPR.DLL" (ByVal nDrv%)

Global Const CONST_SPADE$ = "You Bet"                   ' this file has been added to your app
Global Const GFSR_GDIRESOURCES = &H1                    ' get GDI resoucrces
Global Const GFSR_USERRESOURCES = &H2                   ' get user resources
Global Const CONST_SET = "Set"                          ' reset variables
Global Const CONST_CLOSE = "Done"                       ' Close

Global DebugLogNum%, Problem$, OldProblem$
Global L1$, P1$, L2$, P2$, L3$, P3$, L4$, P4$, L5$, P5$
Global L6$, P6$, L7$, P7$, L8$, P8$, L9$, P9$, L10$, P10$

Function DebugLog% (LogFileName$, markIt%, App$, Routine$, Process$, HD1Label$, HD2Label$, Iter%)
Dim MakeHeader%, res$, ValsChanged%, OldP1$, OldP2$, OldP3$, OldP4$, OldP5$, OldP6$, OldP7$, OldP8$, OldP9$, OldP10$
' Writes to the log file if command line argument(s) contain "DEBUG" or "PAUSE".
' Calls dialog box function if command line argument(s) contain "PAUSE".
' Case is insignificant.

' LogFileName$       the path and name of the Sam Spade debug log file
' markIt%            1 to put a line of dashes across the log as a demarcation, 0 to not mark
' App$               name of the application
' Routine$           name of the function or subroutine
' Process$           name of the process
' HD1Label$          the first drive ie. C:
' HD2Label$          the second drive ie. D:
' Iter%              the current iteration

' returns 1 if successful
'         0 if not

If Command$ = "" Then
    DebugLog% = 0
    Exit Function
End If

If InStr(UCase$(Command$), "DEBUG") Or InStr(UCase$(Command$), "PAUSE") Then
    'open the log file if necessary
    If DebugLogNum% = 0 Then
        DebugLogNum% = FreeFile
        Open LogFileName$ For Append As #DebugLogNum%
        MakeHeader% = 1
    End If
    
    User% = GetFreeSystemResources(GFSR_USERRESOURCES)
    GDI% = GetFreeSystemResources(GFSR_GDIRESOURCES)
    TotalMem& = Fix(GetFreeSpace(0) / 1024)
    
    DrvLetter$ = Left$(HD1Label$, 1)
    HD1& = bfFreeSpace&(getDriveNum%(DrvLetter$))
    HD1Label$ = UCase$(DrvLetter$) & ":"

    DrvLetter$ = Left$(HD2Label$, 1)
    HD2& = bfFreeSpace&(getDriveNum%(DrvLetter$))
    HD2Label$ = UCase$(DrvLetter$) & ":"
    
    If MakeHeader% = 1 Then
        Problem$ = InputBox$("Briefly describe the problem:", "Sam Spade Debug Log")   ' Get user input.
        OldProblem$ = Problem$
        Print #DebugLogNum%,
        Print #DebugLogNum%, "------------------- Sam Spade Debug Log --------------------"
        Print #DebugLogNum%, Format(Now, "dddd, mmmm dd, yyyy, hh:mm:ss AM/PM")
        Print #DebugLogNum%, "Problem: " & Problem$
        Print #DebugLogNum%,
    End If
    'write to the log file
    Print #DebugLogNum%,
    If markIt% = 1 Then Print #DebugLogNum%, "------------------------------------------------------------"
    If App$ <> "" Then Print #DebugLogNum%, "Application: " & Chr$(9) & App$
    If Routine$ <> "" Then Print #DebugLogNum%, "Function or Subroutine: " & Chr$(9) & Routine$
    If Process$ <> "" Then Print #DebugLogNum%, "Process: " & Chr$(9) & Process$
    If OldProblem$ <> Problem$ Then
        Print #DebugLogNum%, "Problem: " & Problem$
        OldProblem$ = Problem$
    End If
    Print #DebugLogNum%, "User Heap (% available): " & Chr$(9) & Str$(User%)
    Print #DebugLogNum%, "GDI Heap (% available): " & Chr$(9) & Str$(GDI%)
    Print #DebugLogNum%, "Total Memory Available (KB): " & Chr$(9) & Str$(TotalMem&)
    Print #DebugLogNum%, "Available Disk Space (KB):"
    Print #DebugLogNum%, HD1Label$ & Chr$(9) & Str$(HD1&)
    Print #DebugLogNum%, HD2Label$ & Chr$(9) & Str$(HD2&)
    Print #DebugLogNum%, "Iteration: " & Chr$(9) & Str$(Iter%)
    If L1$ <> "" Then Print #DebugLogNum%, L1$ & ":" & Chr$(9) & P1$
    If L2$ <> "" Then Print #DebugLogNum%, L2$ & ":" & Chr$(9) & P2$
    If L3$ <> "" Then Print #DebugLogNum%, L3$ & ":" & Chr$(9) & P3$
    If L4$ <> "" Then Print #DebugLogNum%, L4$ & ":" & Chr$(9) & P4$
    If L5$ <> "" Then Print #DebugLogNum%, L5$ & ":" & Chr$(9) & P5$
    If L6$ <> "" Then Print #DebugLogNum%, L6$ & ":" & Chr$(9) & P6$
    If L7$ <> "" Then Print #DebugLogNum%, L7$ & ":" & Chr$(9) & P7$
    If L8$ <> "" Then Print #DebugLogNum%, L8$ & ":" & Chr$(9) & P8$
    If L9$ <> "" Then Print #DebugLogNum%, L9$ & ":" & Chr$(9) & P9$
    If L10$ <> "" Then Print #DebugLogNum%, L10$ & ":" & Chr$(9) & P10$
    DebugLog% = 1
Else
    DebugLog% = 0
    Exit Function
End If

If InStr(UCase$(Command$), "PAUSE") Then
    OldP1$ = P1$
    OldP2$ = P2$
    OldP3$ = P3$
    OldP4$ = P4$
    OldP5$ = P5$
    OldP6$ = P6$
    OldP7$ = P7$
    OldP8$ = P8$
    OldP9$ = P9$
    OldP10$ = P10$
    
    res$ = ShowDebugDialog$(App$, Routine$, Process$, Problem$, User%, GDI%, TotalMem&, HD1Label$, HD1&, HD2Label$, HD2&, Iter%)
    If res$ = CONST_SET Then
        If OldP1$ <> P1$ Then ValsChanged% = 1
        If OldP2$ <> P2$ Then ValsChanged% = 1
        If OldP3$ <> P3$ Then ValsChanged% = 1
        If OldP4$ <> P4$ Then ValsChanged% = 1
        If OldP5$ <> P5$ Then ValsChanged% = 1
        If OldP6$ <> P6$ Then ValsChanged% = 1
        If OldP7$ <> P7$ Then ValsChanged% = 1
        If OldP8$ <> P8$ Then ValsChanged% = 1
        If OldP9$ <> P9$ Then ValsChanged% = 1
        If OldP10$ <> P10$ Then ValsChanged% = 1
        If ValsChanged% = 1 Then
            Print #DebugLogNum%,
            Print #DebugLogNum%, "The Debug dialog box was shown and the following values were changed:"
            If OldP1$ <> P1$ Then Print #DebugLogNum%, L1$ & ":" & Chr$(9) & P1$
            If OldP2$ <> P2$ Then Print #DebugLogNum%, L2$ & ":" & Chr$(9) & P2$
            If OldP3$ <> P3$ Then Print #DebugLogNum%, L3$ & ":" & Chr$(9) & P3$
            If OldP4$ <> P4$ Then Print #DebugLogNum%, L4$ & ":" & Chr$(9) & P4$
            If OldP5$ <> P5$ Then Print #DebugLogNum%, L5$ & ":" & Chr$(9) & P5$
            If OldP6$ <> P6$ Then Print #DebugLogNum%, L6$ & ":" & Chr$(9) & P6$
            If OldP7$ <> P7$ Then Print #DebugLogNum%, L7$ & ":" & Chr$(9) & P7$
            If OldP8$ <> P8$ Then Print #DebugLogNum%, L8$ & ":" & Chr$(9) & P8$
            If OldP9$ <> P9$ Then Print #DebugLogNum%, L9$ & ":" & Chr$(9) & P9$
            If OldP10$ <> P10$ Then Print #DebugLogNum%, L10$ & ":" & Chr$(9) & P10$
        End If
    End If
End If

End Function

Function getDriveNum% (DrvLetter$)
Select Case UCase$(DrvLetter$)
    Case "A": getDriveNum% = 1
    Case "B": getDriveNum% = 2
    Case "C": getDriveNum% = 3
    Case "D": getDriveNum% = 4
    Case "E": getDriveNum% = 5
    Case "F": getDriveNum% = 6
    Case "G": getDriveNum% = 7
    Case "H": getDriveNum% = 8
    Case "I": getDriveNum% = 9
    Case "J": getDriveNum% = 10
    Case "K": getDriveNum% = 11
    Case "L": getDriveNum% = 12
    Case "M": getDriveNum% = 13
    Case "N": getDriveNum% = 14
    Case "O": getDriveNum% = 15
    Case "P": getDriveNum% = 16
    Case "Q": getDriveNum% = 17
    Case "R": getDriveNum% = 18
    Case "S": getDriveNum% = 19
    Case "T": getDriveNum% = 20
    Case "U": getDriveNum% = 21
    Case "V": getDriveNum% = 22
    Case "W": getDriveNum% = 23
    Case "X": getDriveNum% = 24
    Case "Y": getDriveNum% = 25
    Case "Z": getDriveNum% = 26
    Case Else:
        DrvLetter$ = Left$(CurDir$, 1)
        getDriveNum% = 0
End Select
End Function

Function ShowDebugDialog$ (App$, Routine$, Process$, Problem$, User%, GDI%, TotalMem&, HD1Label$, HD1&, HD2Label$, HD2&, Iter%)
' Displays values in SamSpade dialog box if command line argument(s) contain "PAUSE".
' Case is insignificant.

' App$               name of the application
' Routine$           name of the function or subroutine
' Process$           name of the process
' Problem$           the problem as identified by the user
' User%              percentage of User Heap left
' GDI%               percentage of GDI Heap left
' TotalMem&          total memory in bytes
' HD1Label$          the first drive ie. C:
' HD1&               space on the first drive in bytes
' HD2Label$          the second drive ie. D:
' HD2&               space on the second drive in bytes
' Iter%              the current iteration

' returns CONST_SET
'      or CONST_CLOSE

If InStr(UCase$(Command$), "PAUSE") = 0 Then
    ShowDebugDialog$ = ""
    Exit Function
End If

Screen.MousePointer = 11    ' Change pointer to hourglass.

' pass parameters to form's code
' SamSpade!TheFormVariable =

' pass parameters to form's controls
SamSpade.Left = (Screen.Width - SamSpade.Width)
SamSpade.Top = 0

SamSpade.Caption = "Sam Spade, the Visual Basic runtime debugger"
SamSpade!LabelApp.Caption = "Application:"
SamSpade!LabelProb.Caption = "Problem:"
SamSpade!LabelRoutine.Caption = "Routine:"
SamSpade!LabelProc.Caption = "Process:"
SamSpade!LabelIter.Caption = "Iteration:"
SamSpade!FrameSysInfo.Caption = "System Info:"
SamSpade!LabelUser.Caption = "User Heap (% remaining):"
SamSpade!LabelGDIheap.Caption = "GDI Heap (% remaining):"
SamSpade!LabelTotalMem.Caption = "Total Memory (KB):"
SamSpade!LabelDisks.Caption = "Disk Space Remaining (KB):"
SamSpade!SetButt.Caption = "Set New Values"
SamSpade!CloseButt.Caption = "&Continue"
SamSpade!EndTheApp.Caption = "End Application"

SamSpade!TheApplication.Caption = App$
SamSpade!Routine.Caption = Routine$
SamSpade!Process.Caption = Process$
SamSpade!Problem.Text = Problem$
SamSpade!Iteration.Caption = Str$(Iter%)
SamSpade!UserHeap.Caption = User%
SamSpade!GDIheap.Caption = GDI%
SamSpade!TotalMem.Caption = TotalMem&
SamSpade!LabelHD1.Caption = HD1Label$
SamSpade!HD1.Caption = HD1&
SamSpade!LabelHD2.Caption = HD2Label$
SamSpade!HD2.Caption = HD2&
SamSpade!L1.Caption = L1$
SamSpade!P1.Text = P1$
SamSpade!L2.Caption = L2$
SamSpade!P2.Text = P2$
SamSpade!L3.Caption = L3$
SamSpade!P3.Text = P3$
SamSpade!L4.Caption = L4$
SamSpade!P4.Text = P4$
SamSpade!L5.Caption = L5$
SamSpade!P5.Text = P5$
SamSpade!L6.Caption = L6$
SamSpade!P6.Text = P6$
SamSpade!L7.Caption = L7$
SamSpade!P7.Text = P7$
SamSpade!L8.Caption = L8$
SamSpade!P8.Text = P8$
SamSpade!L9.Caption = L9$
SamSpade!P9.Text = P9$
SamSpade!L10.Caption = L10$
SamSpade!P10.Text = P10$

Screen.MousePointer = 0 ' Return pointer to normal.

SamSpade.Show 1  ' show the form and stop code here

' check exit state
Select Case SamSpade!TheFormVariable
    Case CONST_SET:
        Problem$ = SamSpade!Problem.Text
        P1$ = SamSpade!P1.Text
        P2$ = SamSpade!P2.Text
        P3$ = SamSpade!P3.Text
        P4$ = SamSpade!P4.Text
        P5$ = SamSpade!P5.Text
        P6$ = SamSpade!P6.Text
        P7$ = SamSpade!P7.Text
        P8$ = SamSpade!P8.Text
        P9$ = SamSpade!P9.Text
        P10$ = SamSpade!P10.Text
    Case CONST_CLOSE:
    Case Else: SamSpade!TheFormVariable = CONST_CLOSE
End Select

ShowDebugDialog$ = SamSpade!TheFormVariable 'return the exit state

Unload SamSpade ' unload the form

byeShowDebugDialog:

End Function

