image
 
image
M007_Utils.bas


' ========================================================================================================================
'                                 ____,__,  __,  ____,_,  _,  ____ ____,__, ,____,____,
'                                (-/_|(-|  (-|  (-|_,(-|\ |  (-|__|-/_|( |_/(-|_,(-|__)
'                                _/  |,_|__,_|__,_|__,_| \|,  _|__)/  |,_| \,_|__,_|  \,
'
'                                             Copyright � 2008 Allen Baker
'
' ------------------------------------------------------------------------------------------------------------------------
' File:          M007_Utils
' Originator:    Allen Baker (2008.11.23 16:27)
' ------------------------------------------------------------------------------------------------------------------------
' $RCSfile$
' $Revision$
' $Date$
' ========================================================================================================================
'
Option Explicit



' ========================================================================================================================
' Description
'    This module provides miscellaneous utility routines and functions.
' ========================================================================================================================



' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[  External Declarations  ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================



' ==============================================================================================
' all these are used in applicationIsRunning()
' ----------------------------------------------------------------------------------------------
Private Declare Function EnumProcesses Lib "psapi.dll" _
   ( _
   ByRef lpidProcess As Long, _
   ByVal cb          As Long, _
   ByRef cbNeeded    As Long _
   ) As Long

Private Declare Function OpenProcess Lib "Kernel32.dll" _
   ( _
   ByVal dwDesiredAccessas As Long, _
   ByVal bInheritHandle    As Long, _
   ByVal dwProcId          As Long _
   ) As Long

Private Declare Function EnumProcessModules Lib "psapi.dll" _
   ( _
   ByVal hProcess  As Long, _
   ByRef lphModule As Long, _
   ByVal cb        As Long, _
   ByRef cbNeeded  As Long _
   ) As Long

Private Declare Function GetModuleFileNameExA Lib "psapi.dll" _
   ( _
   ByVal hProcess      As Long, _
   ByVal hModule       As Long, _
   ByVal strModuleName As String, _
   ByVal nSize         As Long _
   ) As Long

Private Declare Function CloseHandle Lib "Kernel32.dll" _
   ( _
   ByVal Handle As Long _
   ) As Long



' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[  Constants  ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================



' ==============================================================================================
' all these are used in applicationIsRunning()
' ----------------------------------------------------------------------------------------------
Private Const PROCESS_QUERY_INFORMATION = 1024
Private Const PROCESS_VM_READ           = 16
Private Const MAX_PATH                  = 260



' =====================================================================================================================
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@[  Public Routines  ]@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' =====================================================================================================================



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine is an easy way to raise an error that will terminate the program. Here are some examples of
' how to call it:
'    raiseException
'    raiseException "error message"
'    raiseException "error message", "nameOfCallingProcedureName"
'    raiseException "error message", "nameOfCallingProcedure", "nameOfModuleContainingCallingProcedure"
'    raiseException "error message", "nameOfCallingProcedure", "nameOfModuleContainingCallingProcedure", 515
'
' param (optional)
'    pErrorMessage is a String expression describing the error. If unspecified, the value in the pId
'    parameter is examined. If it can be mapped to a Visual Basic run-time error code, the string that would
'    be returned by the Error function is used as the Description property. If there is no Visual Basic error
'    corresponding to the Number property, the "Application-defined or object-defined error" message is used.
' param (optional)
'    pProcedureName is a String expression naming the procedure that called this subroutine to raise an
'    exception.If no argument is passed in through this optional parameter, its default value is set to the
'    empty String.
' param (optional)
'    pModuleName is a String expression naming the module containing the procedure that called this
'    subroutine to raise an exception.If no argument is passed in through this optional parameter, its
'    default value is set to the empty String.
' param (optional)
'    pId is a Long integer that identifies the error. Visual Basic errors are in the range 0�65535; the range
'    0�512 is reserved for system errors; the range 513�65535 is available for user-defined errors as well.
'    However, when you set the Number property for an error that you are creating, add your error code number
'    to the vbObjectError constant. For example, to generate the error number 1000, assign vbObjectError +
'    1000 to the Number property. If no argument is passed in through this optional parameter, its default
'    value is set to 513.
' -----------------------------------------------------------------------------------------------------------
Public Sub raiseException _
   ( _
   Optional pErrorMessage  As String = "", _
   Optional pProcedureName As String = "", _
   Optional pModuleName    As String = "", _
   Optional pID            As Long   = 513 _
   )
   Dim moduleProcedureNameDelimiter        As String
   Dim moduleProcedureNameMessageDelimiter As String
   If ((pProcedureName = "") And (pModuleName = "")) Then
      moduleProcedureNameDelimiter = ""
      moduleProcedureNameMessageDelimiter = ""
   Else
      moduleProcedureNameDelimiter = "::"
      moduleProcedureNameMessageDelimiter = " -- "
   End If
   Err.Raise _
      pID, _
      pModuleName & moduleProcedureNameDelimiter & pProcedureName, _
      pModuleName & moduleProcedureNameDelimiter & pProcedureName & moduleProcedureNameMessageDelimiter & pErrorMessage
End Sub



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' Sometimes it's just nice to have a procedure that doesn't do anything at all
' -----------------------------------------------------------------------------------------------------------
Public Sub doNothing()
End Sub


Public Sub doNothingButton(Optional pMessage As String = "This Button Does Not Do Anything")
   MsgBox (pMessage)
End Sub


Public Sub doNothingButton2()
   Call doNothing
End Sub



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine searches the specified text file to see if it contains any of the specified substrings. It
' is not case sensitive.
'
' return
'    This function returns True if a the text file contains any of the given substrings, otherwise, it
'    returns False
'
' param
'    pFilePath is the pathname of the text file to search
' param
'    pSearchStrings is an array of the strings to search for
' -----------------------------------------------------------------------------------------------------------
Public Function textFileContainsSubstrings(pFilePath As String, pSearchStrings() As String) As Boolean
   gMsg(1) = ""
   textFileContainsSubstrings = False
   If fileExists(pFilePath) Then
      Dim fso        As Variant
      Dim fileReader As Variant
      Dim lineOfText As String
      Dim j          As Long
      Set fso = CreateObject("Scripting.FileSystemObject")
      Set fileReader = fso.OpenTextFile(pFilePath, 1, False)
      Do Until fileReader.AtEndOfStream = True
         lineOfText = fileReader.ReadLine
         For j = LBound(pSearchStrings) To UBound(pSearchStrings)
            If containsSubstring(lineOfText, pSearchStrings(j)) Then
               textFileContainsSubstrings = True
               fileReader.Close
               Exit Function
            End If
         Next j
      Loop
      fileReader.Close
   End If
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function tests to see if an array has been initialized.
'     This is an unitialized array:   Dim   array()  As String
'     This is an   itialized array:   Dim   array(5) As String
'     This is an   itialized array:   ReDim array(5) As String
'
' return
'    This function returns True if a the array is initialized, otherwise, it returns False
'
' param
'    pArray is the array to test
' -----------------------------------------------------------------------------------------------------------
Public Function arrayIsInitialized(pArray As Variant) As Boolean
    arrayIsInitialized = False
    If Not IsArray(pArray) Then Exit Function
    On Error Resume Next
    Dim V As Variant
    V = pArray(LBound(pArray))
    arrayIsInitialized = (Err.number = 0)
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine displays a message box with an error message and when the OK button is pressed on the box,
' This subroutine terminates the program.
'
' param
'    pMsg is the error message to display in the message box prior to terminating the program.
' -----------------------------------------------------------------------------------------------------------
Public Sub errorExit(pMsg As String)
   Call MsgBox(pMsg, vbOKOnly, "!! ERROR !!  TERMINATING")
   End
End Sub



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine displays a message box with an warning message.
'
' param
'    pMsg is the warning message to display in the message box.
' -----------------------------------------------------------------------------------------------------------
Public Sub warning(pMsg As String)
   Call MsgBox(pMsg, vbOKOnly, "WARNING")
End Sub



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function increments pNum and returns the original (pre-incremented) value of pNum.
'
' return
'    this function returns the original (pre-incremented) value of pNum.
'
' param (input / output)
'    pNum is the number to return and increment
' -----------------------------------------------------------------------------------------------------------
Public Function autoIncrementDeferred(ByRef pNum As Long) As Long
   autoIncrementDeferred = pNum
   pNum = pNum + 1
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine assigns a value to a variable and handles the determination of whether or not the value is
' an Object requiring the "Set" keyword for assignment.
'
' param (input / output)
'    pVariable is the variable which is assigned the value
' param
'    pValue is the value that is assigned to the variable
' -----------------------------------------------------------------------------------------------------------
Public Sub assignVariable(ByRef pVariable As Variant, pValue As Variant)
   If IsObject(pValue) Then
      Set pVariable = pValue
   Else
      Let pVariable = pValue
   End If
End Sub



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function determines if an application is running on this computer.
'
' return
'    This function returns True if the application is running, otherwise it returns False.
'
' param
'    pExeName is the name of the executable to look for a running instance of. this is just the file name,
'    not the entire path name of the application. For example, to check to see if if an instance of the
'    executable program file located at:
'
'       "C:\Program Files (x86)\Color_Cop\ColorCop.exe"
'
'    is running, you would pass in just the file name like this:
'
'       If applicationIsRunning("ColorCop.exe") Then doSomething ...
' -----------------------------------------------------------------------------------------------------------
Public Function applicationIsRunning(pExeName As String) As Boolean
   Dim cb                     As Long
   Dim cbNeeded               As Long
   Dim numElements            As Long
   Dim lProcessIDs()          As Long
   Dim cbNeeded2              As Long
   Dim lNumElements2          As Long
   Dim modulesArray(1 To 500) As Long
   Dim lRet                   As Long
   Dim strModuleName          As String
   Dim modulesArraySize       As Long
   Dim processHandle          As Long
   Dim i                      As Long

   applicationIsRunning = False

   On Error Resume Next
   '
   ' ==============================================================================================
   ' Get the array containing the process id's for each process object
   ' ----------------------------------------------------------------------------------------------
   cb = 8
   cbNeeded = 96
   Do While cb <= cbNeeded
      cb = cb * 2
      ReDim lProcessIDs(cb / 4) As Long
      lRet = EnumProcesses(lProcessIDs(1), cb, cbNeeded)
   Loop
   modulesArraySize = 500
   numElements = cbNeeded / 4
   For i = 1 To numElements
      '
      ' ==============================================================================================
      ' Get a handle to the Process
      ' ----------------------------------------------------------------------------------------------
      processHandle = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lProcessIDs(i))
      '
      ' ==============================================================================================
      ' Got a Process handle
      ' ----------------------------------------------------------------------------------------------
      If processHandle <> 0 Then
         '
         ' ==============================================================================================
         ' Get an array of the module handles for the specified process
         ' ----------------------------------------------------------------------------------------------
         lRet = EnumProcessModules(processHandle, modulesArray(1), modulesArraySize, cbNeeded2)
         '
         ' ==============================================================================================
         ' If the Module Array is retrieved, Get the ModuleFileName
         ' ----------------------------------------------------------------------------------------------
         If lRet <> 0 Then
            strModuleName = Space(MAX_PATH)
            lRet = GetModuleFileNameExA(processHandle, modulesArray(1), strModuleName, modulesArraySize)
            strModuleName = Left(strModuleName, lRet)
            '
            ' ==============================================================================================
            ' Check for the client application running
            ' ----------------------------------------------------------------------------------------------
            If InStr(UCase(strModuleName), UCase(pExeName)) Then
               applicationIsRunning = True
               Exit Function
            Else
               applicationIsRunning = False
            End If
         End If
      End If
      '
      ' ==============================================================================================
      ' Close the handle to the process
      ' ----------------------------------------------------------------------------------------------
      lRet = CloseHandle(processHandle)
   Next
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function determines if a string is all upper case
'
' return
'    This function returns True if the string is all upper case, otherwise it returns False.
'
' param
'    pStr is the string to check
' -----------------------------------------------------------------------------------------------------------
Public Function isUpper(pStr As String) As Boolean
   isUpper = (pStr = UCase(pStr))
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function determines if a string is all lower case
'
' return
'    This function returns True if the string is all lower case, otherwise it returns False.
'
' param
'    pStr is the string to check
' -----------------------------------------------------------------------------------------------------------
Public Function isLower(pStr As String) As Boolean
   isLower = (pStr = LCase(pStr))
End Function