|
-
Dec 16th, 2004, 02:39 AM
#1
Thread Starter
Member
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
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|