Classic VB Error Handling !

Hi,

I thought this vbscript might be handy for you VB programmers out there who want to debug their project without having to manually add Error Handling functions and/or line numbers to the project. It takes any vbp or bas or ctl file and converts it to another vbp/bas/ctl, but with an error handler around every function or procedure, writing out where the possible error happened and on what line it happened (it also adds line numbers)

Code:

---

Option Explicit

'CONSTANTS
Const ForReading = 1
Const ForWriting = 2

Dim fso 'FileSystemObject
Dim f
Dim input
Dim output
Dim lijn
Dim functionHeader
Dim nErr
Dim nLine

If WScript.Arguments.Count <> 2 Then
        WScript.StdErr.WriteLine "Usage: " & WScript.ScriptName & " <sourcefile> <destinationfile>"
        WScript.Quit(1)
End If

Set fso = CreateObject("Scripting.FileSystemObject")

If fso.FileExists(WScript.Arguments(0)) Then

        Set f = fso.getFile(WScript.Arguments(0))
        Set input  = f.OpenAsTextStream(ForReading)
        'WScript.StdOut.WriteLine "Creating: " & WScript.Arguments(0) & " --> " & WScript.Arguments(1)
        Set output = fso.CreateTextFile(WScript.Arguments(1),True)
       
        nErr = 0
        nLine = 0
       
        functionHeader = GoToSubOrFunction(input,output)
        Do While functionHeader <> vbNullString
                'WScript.StdOut.WriteLine functionHeader
                WriteErrorHandlerBegin output,nErr
                lijn = GoToEndOfSubOrFunction(input,output,nLine)
                WriteErrorHandlerEnd output,nErr,lijn,functionHeader,f.Name
                functionHeader = GoToSubOrFunction(input,output)
        Loop

        output.Close
        input.Close
        Set input = Nothing
        Set output = Nothing
        Set f = Nothing
Else
        WScript.StdErr.WriteLine "File not found: " & WScript.Arguments(0)
End If

Set fso = Nothing


Function GoToSubOrFunction(inputstream,outputstream)
        Dim gevonden
        Dim l
        Dim re
        Dim result
        Dim match
       
        Set re = new RegExp
       
        're.Pattern = "(public|private) (sub|function|property) (let)? ([^\(]+\([^\)]*\))"
        re.Pattern = "^(public|private) (sub|function|property) (let)?([^\(]+\([^\)]*\))"
        re.IgnoreCase = True
        re.Global = False
       
        gevonden = False
        Do While Not inputstream.AtEndOfStream = True And Not gevonden = True
                l = inputstream.ReadLine()
                Set result = re.Execute(l)
                If result.Count > 0 Then
                        match =  result(0).Value
                        gevonden = True
                End If
                outputstream.WriteLine l
        Loop
       
        Set result = Nothing
        Set re = Nothing
       
        If gevonden Then
                GoToSubOrFunction = match
        Else
                GoToSubOrFunction = vbNullString
        End If
End Function

Function GoToEndOfSubOrFunction(inputstream,outputstream,num)
        Dim gevonden
        Dim l
        Dim re
        Dim result
        Dim match
        Dim comment
        Dim label
        Dim noEol 'no end of line
        Dim eol
       
        Set re = new RegExp
        Set comment = new RegExp
        Set label = new RegExp
        Set noEol = new RegExp
       
        re.Pattern = "^End (sub|function|property)"
        re.IgnoreCase = True
        re.Global = False
       
        comment.Pattern = "^ *\'.*"
        comment.IgnoreCase = True
        comment.Global = False
       
        label.Pattern = "[^:]*:.*"
        label.IgnoreCase = True
        label.Global = False
       
        noEol.Pattern = ".*_$"
        noEol.IgnoreCase = True
        noEol.Global = False
       
        gevonden = False
        eol = True
        Do While Not inputstream.AtEndOfStream = True And Not gevonden = True
                l = inputstream.ReadLine()
                If Len(Trim(l)) > 0 Then
                        Set result = re.Execute(l)
                        If result.Count > 0 Then
                                match =  result(0).Value
                                gevonden = True
                        else
                                Set result = comment.Execute(l)
                                If result.Count = 0 Then
                                        Set result = label.Execute(l)
                                        If result.Count = 0 And eol = True Then
                                                If Not InStr(l,"Case") > 0 And Not InStr(l,"Select") > 0 Then
                                                        outputstream.WriteLine num & ": " & l
                                                        num = num + 1
                                                Else
                                                        outputstream.WriteLine l
                                                End If
                                        Else
                                                outputstream.WriteLine l
                                        End If
                                End If
                                Set result = noEol.Execute(l)
                                If result.Count > 0 Then
                                        eol = False
                                Else
                                        eol = True
                                End If
                        End If
                End If
        Loop
       
        Set result = Nothing
        Set re = Nothing
       
        If gevonden Then
                GoToEndOfSubOrFunction = Right(match,Len(Match)-InStrRev(match," "))
        Else
                GoToEndOfSubOrFunction = vbNullString
        End If
End Function

Sub WriteErrorHandlerBegin(outputstream,num)
        outputstream.WriteLine "On Error Goto ErrorHandler" & num
End Sub

Sub WriteErrorHandlerEnd(outputstream,num,t,header,filename)
       
        Dim hulp
       
        hulp = "MsgBox ""UnExpected Error:"" & vbCrLf & ""File:" & filename & """ & vbCrLf & "
        hulp = hulp & """Function: " & header & """ & vbCrLf & "
        hulp = hulp & """Line Number: "" & Erl & vbCrLf & "
        hulp = hulp & """Error Number: "" & Err.Number & vbCrLf & "
        hulp = hulp & """Description: "" & Err.Description"
       
        With outputstream
                .WriteLine "Exit " & t
                .WriteLine "ErrorHandler" & num & ":"       
                .WriteLine hulp
                .WriteLine "End " & t
        End With
        num = num + 1
       
End Sub

---

I hope this helps some ppl debugging their vb project...

Greetz,

RaKKeR