' ========================================================================================================================
' ____,__, __, ____,_, _, ____ ____,__, ,____,____,
' (-/_|(-| (-| (-|_,(-|\ | (-|__|-/_|( |_/(-|_,(-|__)
' _/ |,_|__,_|__,_|__,_| \|, _|__)/ |,_| \,_|__,_| \,
'
' 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
Facebook