home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Power Pack / Visual_Basic4_Power_Pack.bin / vb4files / imexvb32 / errors.cl_ / errors.cl
Encoding:
Text File  |  1996-11-20  |  3.7 KB  |  114 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "Errors"
  6. Attribute VB_Creatable = False
  7. Attribute VB_Exposed = False
  8. ' Simple Errors Class Module
  9. ' Keeps Track of Errors for any System
  10.  
  11. Option Explicit
  12. Option Compare Text
  13.  
  14. Private Type tErrs                  ' Error Trap Structure.
  15.  
  16.     Number      As Long             ' Error Number.
  17.     Source      As String           ' Source of Error.
  18.     Description As String           ' Description or Error.
  19.     Action      As String           ' Action being carried out.
  20.     
  21. End Type
  22.  
  23. Public ErrCount     As Integer          ' External Error Counter
  24. Private ColErrs     As New Collection   ' Internal Error Collection.
  25. Private tErrs       As tErrs            ' Localise the Structure.
  26. Public Property Get Number() As Long                   ' Returns the current errors Number.
  27.     If ColErrs.Count Then Number& = tErrs.Number
  28. End Property
  29. Public Property Get Description() As String             ' Returns the current errors Description.
  30.     If ColErrs.Count Then Description$ = tErrs.Description
  31. End Property
  32. Public Property Get Source() As String                  ' Returns the current errors Source.
  33.     If ColErrs.Count Then Source$ = tErrs.Source
  34. End Property
  35. Public Property Get Action() As String                  ' Returns the current errors Action.
  36.     If ColErrs.Count Then Action$ = tErrs.Action
  37. End Property
  38. Public Property Get Count() As Integer                  ' Returns the current error Count.
  39.     Count% = ColErrs.Count
  40. End Property
  41.  
  42. ' Returns an array for all errors since the last refresh.
  43.  
  44. Public Function Errors() As Variant
  45.     
  46.     Dim vError() As Variant
  47.     Dim vErr As Variant
  48.     Dim x As Integer
  49.     Dim y As Integer
  50.     
  51.     ReDim vError(0 To ColErrs.Count, 4) As Variant
  52.     
  53.     If ColErrs.Count > 0 Then                ' Only if Errors Exist.
  54.         For x% = 1 To UBound(vError)
  55.             vErr = ColErrs(x%)
  56.             If IsArray(vErr) Then
  57.                 vError(y%, 0) = vErr(0)   ' Set the Error Number.
  58.                 vError(y%, 1) = vErr(1)   ' Set the Error Description.
  59.                 vError(y%, 2) = vErr(2)   ' Set the Error Source.
  60.                 vError(y%, 3) = vErr(3)   ' Set the Error Action.
  61.                 y% = y% + 1
  62.             End If
  63.         Next x%
  64.         If IsArray(vError) Then Errors = vError ' Set the Complete Return Value.
  65.     End If
  66.     
  67. End Function
  68.  
  69. ' Adds a Member to the 'ColErrs' Collection
  70.  
  71. Public Function Add(Num As Long, Desc As String, Optional Source, Optional Action) As Variant
  72.  
  73.     Dim vArray(4) As Variant
  74.         
  75.     On Error Resume Next
  76.     
  77.     tErrs.Number = Num&
  78.     tErrs.Description = IIf(IsEmpty(Desc), "", Desc)
  79.     tErrs.Source = IIf(IsMissing(Source) Or IsEmpty(Source) Or CStr(Source) <= "", "ImeXOle", Source)
  80.     tErrs.Action = IIf(IsMissing(Action) Or IsEmpty(Action) Or CStr(Action) <= "", "?", Action)
  81.     
  82.     ' Log Errors to File if a Valid Log Filename has been set.
  83.     
  84.     If LogOpen Then
  85.         LogFile "Error : " & Num& & " Desc : " & Desc & " Action : " & CStr(Action)
  86.     End If
  87.     
  88.     vArray(0) = tErrs.Number
  89.     vArray(1) = tErrs.Description
  90.     vArray(2) = tErrs.Source
  91.     vArray(3) = tErrs.Action
  92.   
  93.     Inc ErrCount%                       ' One more error.
  94.   
  95.     ColErrs.Add Item:=vArray(), Key:=Trim$(CStr(ErrCount%))
  96.     
  97.     Add = CVar(vArray)                  ' Return  the Array.
  98.     
  99. End Function
  100.  
  101. ' Clears all Errors from the ColErrs Collection.
  102.  
  103. Public Sub Refresh()
  104.  
  105.     On Error Resume Next
  106.     
  107. RefreshAgain:   Do While ColErrs.Count > 0
  108.                     ColErrs.Remove 1
  109.                 Loop
  110.     
  111.     If ColErrs.Count = 0 Then ErrCount% = 0 Else GoTo RefreshAgain
  112.     
  113. End Sub
  114.