Error Handler: Logs Error and System Info to Disk

Category:

Miscellaneous

Type:

Snippets

Difficulty:

Intermediate

Author: Arvind Bhambhani

Version Compatibility: Visual Basic 6, Visual Basic 5

More information:

Here is a fantastic Error Handler routine. It creates a sophisticated error message and logs the errors to disk It also displays target System info so that you can trace under what configurations / settings the error occured.

The Main func ProcessError is very flexible in terms of args. By passing the ProcedureName args in function you always Know in what Sub/Func the error occured

FOR ANY COMMENTS/SUGGESTIONS PLS MAIL ME : bobby169@indiatimes.com 'Add This Code To A Module

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
Public Const PROCESSOR_INTEL_386 = 386 Public Const PROCESSOR_INTEL_486 = 486 Public Const PROCESSOR_INTEL_PENTIUM = 586 Public Const PROCESSOR_MIPS_R4000 = 4000 Public Const PROCESSOR_ALPHA_21064 = 21064 Public Const SPI_GETWORKAREA = 48 Type Rect Left As Long Top As Long Right As Long Bottom As Long End Type Type SYSTEM_INFO dwOemID As Long dwPageSize As Long lpMinimumApplicationAddress As Long lpMaximumApplicationAddress As Long dwActiveProcessorMask As Long dwNumberOrfProcessors As Long dwProcessorType As Long dwAllocationGranularity As Long dwReserved As Long End Type Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 End Type Type MEMORYSTATUS dwLength As Long dwMemoryLoad As Long dwTotalPhys As Long dwAvailPhys As Long dwTotalPageFile As Long dwAvailPageFile As Long dwTotalVirtual As Long dwAvailVirtual As Long End Type Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _ (LpVersionInformation As OSVERSIONINFO) As Long Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As _ MEMORYSTATUS) Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As _ SYSTEM_INFO) Declare Function SystemParametersInfo Lib "user32" _ Alias "SystemParametersInfoA" (ByVal uAction As Long, _ ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) _ As Long Const LineText As String = ""

Code:

Sub ProcessError(ObjErr As ErrObject, _
                 ProcedureName As String, _
                 Optional RecordLogFile As Boolean = True, _
                 Optional AdditionalInfo As String = "", _
                 Optional DisplaySysInfoInMessage As Boolean = True)

'Declarations
Dim Fnum As Single
Dim MsgText As String
Dim SolutionMessage As String
Dim SysInfo As String

'Build general info
MsgText = App.EXEName + " Exception" + vbCr + "An exception has occured.The requested command may not work as usual.Follow the solution given.If problem persists contact our team" + vbCr
MsgText = MsgText + "Exception Number : " + CStr(ObjErr.Number) + vbCr + "Offending Procedure: " + ProcedureName + vbCr
MsgText = MsgText + "Exception Details: " + ObjErr.Description
MsgText = MsgText + vbCr + AdditionalInfo

'Get system information....OS,resolution,etc...
SysInfo = GetSystemInformation

'Add your solution message here I suggest writing a select case which chooses Solutions on the basis of Err.Number
SolutionMessage = "No Solutions Found"
MsgText = MsgText + vbCr + "Solution : " + SolutionMessage
MsgText = MsgText + vbCr + "--We regret for the inconvenience"

'Set if you want System info to be dispyed in Message or not
If DisplaySysInfoInMessage = True Then
    MsgText = MsgText + vbCr + "System Information: " + vbCr + SysInfo
End If

'Create LogFile of error to Disk (By default a Log file is always created)
If RecordLogFile = True Then
    Fnum = FreeFile
    FlName = App.Path & "\" & Timer & ".err"
    Open FlName For Output As #Fnum
    Write #Fnum, "Error logged by application : " + App.EXEName + vbNewLine
    Write #Fnum, "Dated : " + Format(Date, "DD-MMM-YYYY") + vbNewLine
    Write #Fnum, "Time  : " + Format(Time, "HH:MM:SS") + vbNewLine
    Write #Fnum, "Error Number : " + CStr(ObjErr.Number) + vbNewLine
    Write #Fnum, "Error Description : " + ObjErr.Description + vbNewLine
    Write #Fnum, "Offending Procedure : " + ProcedureName + vbNewLine
    Write #Fnum, String(50, "-") + vbNewLine
    Write #Fnum, "System Info " + vbNewLine
    Write #Fnum, SysInfo
    Close #Fnum
End If
'Display MessageBox with all the info Collected
MsgBox MsgText, vbApplicationModal + vbInformation, App.EXEName
End Sub
Public Function GetSystemInformation() As String
Dim Msg As String
Dim Nl As String
Nl = vbNewLine + Chr(10)

'Get operating system and version.
Dim verinfo As OSVERSIONINFO
verinfo.dwOSVersionInfoSize = Len(verinfo)
ret1 = GetVersionEx(verinfo)

Select Case verinfo.dwPlatformId
    Case 0
        Msg = Msg + "Windows 32"
    Case 1
        If verinfo.dwMinorVersion = 0 Then
            Msg = Msg + "Windows 95 "
        Else
            Msg = Msg + "Windows 98 "
        End If
    Case 2
        Msg = Msg + "Windows NT "
End Select
    
Msg = Msg + CStr(verinfo.dwMajorVersion) + "." + CStr(verinfo.dwMinorVersion)
Msg = Msg + "Build " + CStr(verinfo.dwBuildNumber)

'CPU Info...
Dim SysInfo As SYSTEM_INFO
GetSystemInfo SysInfo
Msg = Msg + "CPU: "
Select Case SysInfo.dwProcessorType
    Case PROCESSOR_INTEL_386
        Msg = Msg + "Intel 386" + Nl
    Case PROCESSOR_INTEL_486
        Msg = Msg + "Intel 486" + Nl
    Case PROCESSOR_INTEL_PENTIUM
        Msg = Msg + "Intel Pentium" + Nl
    Case PROCESSOR_MIPS_R4000
        Msg = Msg + "MIPS R4000" + Nl
    Case PROCESSOR_ALPHA_21064
        Msg = Msg + "DEC Alpha 21064" + Nl
    Case Else
        Msg = Msg + "(unknown)" + Nl
End Select
Msg = Msg + Nl
'free memory.
Dim memsts As MEMORYSTATUS, memory As Long
GlobalMemoryStatus memsts
memory = memsts.dwTotalPhys
Msg = Msg + "Total Physical Memory: "
Msg = Msg + Format$(memory \ 1024, "###,###,###") + "K" + Nl
memory& = memsts.dwAvailPhys
Msg = Msg + "Available Physical Memory: "
Msg = Msg + Format$(memory \ 1024, "###,###,###") + "K" + Nl
memory& = memsts.dwTotalVirtual
Msg = Msg + "Total Virtual Memory: "
Msg = Msg + Format$(memory \ 1024, "###,###,###") + "K" + Nl
memory& = memsts.dwAvailVirtual
Msg = Msg + "Available Virtual Memory: "
Msg = Msg + Format$(memory \ 1024, "###,###,###") + "K" + Nl + Nl
'System parameters info
Dim lRet As Long
Dim apiRECT As Rect
lRet = SystemParametersInfo(SPI_GETWORKAREA, vbNull, apiRECT, 0)
If lRet Then
  Msg = Msg & "WorkAreaLeft: " & apiRECT.Left & vbNewLine
  Msg = Msg & "WorkAreaTop: " & apiRECT.Top & vbNewLine
  Msg = Msg & "WorkAreaWidth: " & apiRECT.Right - apiRECT.Left & vbNewLine
  Msg = Msg & "WorkAreaHeight: " & apiRECT.Bottom - apiRECT.Top & vbNewLine
End If
GetSystemInformation = Msg
End Function

'///////////////////////////////////////////////////////////
'ADD THIS CODE TO A FORM
'PLACE A COMMAND BUTTON ON A FORM
Private Sub Command1_Click()
On Error GoTo x
a = a / 0
x:
ProcessError Err, "FrmErr.Command1_Click", , , True

'uncomment to try diff ARGS
'ProcessError Err, "FrmErr.Command1_Click", False, "Div By 0", False
'ProcessError Err, "FrmErr.Command1_Click", False, , False
End Sub