Attribute VB_Name = "modSupport"
Attribute VB_Ext_KEY = "RVB_UniqueId" ,"39CA2B5801E4"

'CSEH: ErrMsgBox
Option Explicit

'Constants
Private Const LOCAL_ERRORLOG As String = "errorlog.txt"

'Private Data Members
Private mlngStartTime As Long

'Windows API Declarations
Public Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'CSEH: ErrMsgBox
Public Function AppPath() As String

    '<EhHeader>
    On Error GoTo PROC_ERR
    '- - - - - - - - - - - - - - - - - - - - - - - - - - -
    '</EhHeader>
   
    If VBA.Right$(App.Path, 1) = "\" Then
        
        AppPath = App.Path
        
    Else
        
        AppPath = App.Path & "\"
        
    End If

    '<EhFooter>
    '- - - - - - - - - - - - - - - - - - - - - - - - - - -
PROC_EXIT:
    Exit Function
PROC_ERR:
    Call MsgBox( _
       "An error has occured in Ether920Demo.modSupport.AppPath " & vbCrLf & vbCrLf & _
       "Error:" & Err.Number & vbCrLf & _
       "Description:" & Err.Description & vbCrLf & _
       "Line:" & Erl, _
       vbOKOnly + vbCritical + vbDefaultButton1)

    Resume PROC_EXIT
    '</EhFooter>

End Function

'CSEH: Skip
Public Function BenchmarkGetElapsedTime() As Long
    
    On Error GoTo 0
    BenchmarkGetElapsedTime = timeGetTime - mlngStartTime
    Call BenchmarkStartTime
    
End Function

'CSEH: Skip
Public Sub BenchmarkStartTime()
    
    On Error GoTo 0
    mlngStartTime = timeGetTime
    
End Sub

'CSEH: ErrResumeNext
Public Function DeleteLog() As Boolean

    '<EhHeader>
    On Error Resume Next
    '</EhHeader>
    
    If Len(Trim$(Dir$(AppPath & LOCAL_ERRORLOG))) <> 0 Then
        Kill AppPath & LOCAL_ERRORLOG

    End If

    DeleteLog = True    '   if previous line fails, then file didn't exist anyway
    
End Function

'CSEH: ErrResumeNext
Public Function DeleteLogEx(FileName As String) As Boolean

    '<EhHeader>
    On Error Resume Next
    '</EhHeader>
    
    If Len(Trim$(Dir$(FileName))) <> 0 Then
        Kill FileName

    End If

    DeleteLogEx = True    '   if previous line fails, then file didn't exist anyway
    
End Function

'CSEH: Skip
Public Function RunningFromIDE() As Boolean
    
    On Error Resume Next
    Debug.Print 1 / 0
    RunningFromIDE = (Err.Number <> 0)
    
End Function

'CSEH: ErrMsgBox
Public Sub WriteToErrorLog(TextToWrite As String)

    '<EhHeader>
    On Error GoTo PROC_ERR
    '- - - - - - - - - - - - - - - - - - - - - - - - - - -
    '</EhHeader>
    
    Dim intFile As Integer
    Dim strFileName As String
    
    strFileName = AppPath & LOCAL_ERRORLOG
    
    intFile = FreeFile
    Open strFileName For Append As #intFile
    Print #intFile, "--------------------------------------------------"
    Print #intFile, Format$(Date, "Long Date")
    Print #intFile, Format$(Time, "Long Time") & vbCrLf
    Print #intFile, TextToWrite & vbCrLf
    Print #intFile, "--------------------------------------------------"
    Close #intFile

    '<EhFooter>
    '- - - - - - - - - - - - - - - - - - - - - - - - - - -
PROC_EXIT:
    Exit Sub
PROC_ERR:
    Call MsgBox( _
       "An error has occured in Ether920Demo.modSupport.WriteToErrorLog " & vbCrLf & vbCrLf & _
       "Error:" & Err.Number & vbCrLf & _
       "Description:" & Err.Description & vbCrLf & _
       "Line:" & Erl, _
       vbOKOnly + vbCritical + vbDefaultButton1)

    Resume PROC_EXIT
    '</EhFooter>

End Sub

'CSEH: ErrMsgBox
Public Sub WriteToErrorLogEx(TextToWrite As String, FileName As String)

    '<EhHeader>
    On Error GoTo PROC_ERR
    '- - - - - - - - - - - - - - - - - - - - - - - - - - -
    '</EhHeader>
    
    Dim intFile As Integer
    
    intFile = FreeFile
    Open FileName For Append As #intFile
    Print #intFile, Date & "  - " & Time & " --- " & TextToWrite
    Close #intFile

    '<EhFooter>
    '- - - - - - - - - - - - - - - - - - - - - - - - - - -
PROC_EXIT:
    Exit Sub
PROC_ERR:
    Call MsgBox( _
       "An error has occured in Ether920Demo.modSupport.WriteToErrorLogEx " & vbCrLf & vbCrLf & _
       "Error:" & Err.Number & vbCrLf & _
       "Description:" & Err.Description & vbCrLf & _
       "Line:" & Erl, _
       vbOKOnly + vbCritical + vbDefaultButton1)

    Resume PROC_EXIT
    '</EhFooter>

End Sub

'CSEH: ErrMsgBox
Public Function ValidateArrayIndex(lngIndex As Long, vntArry As Variant) As Boolean

    '<EhHeader>
    On Error GoTo PROC_ERR
    '- - - - - - - - - - - - - - - - - - - - - - - - - - -
    '</EhHeader>
        
    ValidateArrayIndex = (lngIndex >= LBound(vntArry)) And (lngIndex <= UBound(vntArry))

    '<EhFooter>
    '- - - - - - - - - - - - - - - - - - - - - - - - - - -
PROC_EXIT:
    Exit Function
PROC_ERR:
    Call MsgBox( _
       "An error has occured in Ether920Demo.modSupport.ValidateArrayIndex " & vbCrLf & vbCrLf & _
       "Error:" & Err.Number & vbCrLf & _
       "Description:" & Err.Description & vbCrLf & _
       "Line:" & Erl, _
       vbOKOnly + vbCritical + vbDefaultButton1)

    Resume PROC_EXIT
    '</EhFooter>

End Function

'CSEH: ErrMsgBox
Public Sub DoEventsNice()

    '<EhHeader>
    On Error GoTo PROC_ERR
    '- - - - - - - - - - - - - - - - - - - - - - - - - - -
    '</EhHeader>
        
    Static s_intCount As Integer
    
    If s_intCount Mod 50 Then
        
        DoEvents
        s_intCount = 0
        
    Else
        
        s_intCount = s_intCount + 1
        
    End If

    '<EhFooter>
    '- - - - - - - - - - - - - - - - - - - - - - - - - - -
PROC_EXIT:
    Exit Sub
PROC_ERR:
    Call MsgBox( _
       "An error has occured in Ether920Demo.modSupport.DoEventsNice " & vbCrLf & vbCrLf & _
       "Error:" & Err.Number & vbCrLf & _
       "Description:" & Err.Description & vbCrLf & _
       "Line:" & Erl, _
       vbOKOnly + vbCritical + vbDefaultButton1)

    Resume PROC_EXIT
    '</EhFooter>

End Sub

'<CSCM>
Public Sub Wait(Milliseconds As Long)

    '<EhHeader>
    On Error GoTo PROC_ERR
    '- - - - - - - - - - - - - - - - - - - - - - - - - - -
    '</EhHeader>
    
    Dim lngStart As Long
    
    lngStart = timeGetTime
    
    Do Until timeGetTime >= lngStart + Milliseconds
    
        DoEventsNice
       
    Loop

    '<EhFooter>
    '- - - - - - - - - - - - - - - - - - - - - - - - - - -
PROC_EXIT:
    Exit Sub
PROC_ERR:
    Call MsgBox( _
       "An error has occured in Ether920Demo.modSupport.Wait " & vbCrLf & vbCrLf & _
       "Error:" & Err.Number & vbCrLf & _
       "Description:" & Err.Description & vbCrLf & _
       "Line:" & Erl, _
       vbOKOnly + vbCritical + vbDefaultButton1)

    Resume PROC_EXIT
    '</EhFooter>

End Sub

Public Sub WaitSleep(Milliseconds As Long)

    '<EhHeader>
    On Error GoTo PROC_ERR
    '- - - - - - - - - - - - - - - - - - - - - - - - - - -
    '</EhHeader>

    Call Sleep(Milliseconds)

    '<EhFooter>
    '- - - - - - - - - - - - - - - - - - - - - - - - - - -
PROC_EXIT:
    Exit Sub
PROC_ERR:
    Call MsgBox( _
       "An error has occured in Ether920Demo.modSupport.WaitSleep " & vbCrLf & vbCrLf & _
       "Error:" & Err.Number & vbCrLf & _
       "Description:" & Err.Description & vbCrLf & _
       "Line:" & Erl, _
       vbOKOnly + vbCritical + vbDefaultButton1)

    Resume PROC_EXIT
    '</EhFooter>

End Sub

'CSEH: ErrMsgBox
Public Function StripChars(strIn As String, _
                           strStrip As String) _
                           As String

    '<EhHeader>
    On Error GoTo PROC_ERR
    '- - - - - - - - - - - - - - - - - - - - - - - - - - -
    '</EhHeader>

    Dim lngCounter As Long
    Dim strTmp As String
    Dim chrTmp As String * 1

    ' Walk through the string
    For lngCounter = 1 To Len(strIn)

        ' Get the current character
        chrTmp = Mid$(strIn, lngCounter)
        If chrTmp <> strStrip Then
            ' It its not in the list of characters to remove, keep it
            strTmp = strTmp & chrTmp

        End If

    Next lngCounter

    ' Return the value
    StripChars = strTmp

    '<EhFooter>
    '- - - - - - - - - - - - - - - - - - - - - - - - - - -
PROC_EXIT:
    Exit Function
PROC_ERR:
    Call MsgBox( _
       "An error has occured in Ether920Demo.modSupport.StripChars " & vbCrLf & vbCrLf & _
       "Error:" & Err.Number & vbCrLf & _
       "Description:" & Err.Description & vbCrLf & _
       "Line:" & Erl, _
       vbOKOnly + vbCritical + vbDefaultButton1)

    Resume PROC_EXIT
    '</EhFooter>

End Function