basmain.bas

a Tiger Hash algorithmn code

Attribute VB_Name = "basMain"
' ***************************************************************************
' Module:        basMain
'
' Description:   This is a generic module I use to start and stop an
'                application
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' 29-APR-2001  Kenneth Ives  [e-mail]
' ***************************************************************************
Option Explicit

' ***************************************************************************
' Global constants
' ***************************************************************************
  Public Const AUTHOR_EMAIL          As String = "[e-mail]"
  Public Const PGM_NAME              As String = "Tiger2"
  Public Const MAX_SIZE              As Long = 260
  Public Const DUMMY_NUMBER          As Long = vbObjectError + 513

' ***************************************************************************
' Module Constants
' ***************************************************************************
  Private Const INVALID_HANDLE_VALUE As Long = -1
  Private Const ERROR_ALREADY_EXISTS As Long = 183
  Private Const MODULE_NAME          As String = "basMain"

' ***************************************************************************
' API Declarations
' ***************************************************************************
  ' The GetCurrentProcess function returns a pseudohandle for the current
  ' process. A pseudohandle is a special constant that is interpreted as
  ' the current process handle. The calling process can use this handle to
  ' specify its own process whenever a process handle is required. The
  ' pseudohandle need not be closed when it is no longer needed.
  Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
  
  ' The GetExitCodeProcess function retrieves the termination status of the
  ' specified process. If the function succeeds, the return value is nonzero.
  Private Declare Function GetExitCodeProcess Lib "kernel32" _
          (ByVal hProcess As Long, lpExitCode As Long) As Long
  
  ' The ExitProcess function ends a process and all its threads.
  ' ex:     ExitProcess GetExitCodeProcess(GetCurrentProcess, 0)
  Private Declare Sub ExitProcess Lib "kernel32" (ByVal uExitCode As Long)
  
  ' The CreateMutex function creates a named or unnamed mutex object.  Used
  ' to determine if an application is active.
  Private Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" _
          (lpMutexAttributes As Any, ByVal bInitialOwner As Long, _
          ByVal lpName As String) As Long
  
  ' This function releases ownership of the specified mutex object.
  ' Finished with the search.
  Private Declare Function ReleaseMutex Lib "kernel32" _
          (ByVal hMutex As Long) As Long

  ' The ShellExecute function opens or prints a specified file.  The file
  ' can be an executable file or a document file.
  Private Declare Function ShellExecute Lib "shell32.dll" _
          Alias "ShellExecuteA" (ByVal hwnd As Long, _
          ByVal lpOperation As String, ByVal lpFile As String, _
          ByVal lpParameters As String, ByVal lpDirectory As String, _
          ByVal nShowCmd As Long) As Long

  ' Always close a handle if not being used
  Private Declare Function CloseHandle Lib "kernel32" _
          (ByVal hObject As Long) As Long
  
  ' Retrieves a set of FAT file system attributes for a specified file
  ' or directory. Used here to determine if a path or file exist.
  Private Declare Function GetFileAttributes Lib "kernel32" _
          Alias "GetFileAttributesA" (ByVal lpSpec As String) As Long

  ' The GetWindowsDirectory function retrieves the path of the Windows
  ' directory. The Windows directory contains such files as Windows-based
  ' applications, initialization files, and Help files.
  Private Declare Function GetWindowsDirectory Lib "kernel32" _
          Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, _
          ByVal nSize As Long) As Long

  ' The GetSystemDirectory function retrieves the path of the Windows
  ' system directory. The system directory contains such files as Windows
  ' libraries, drivers, and font files.
  Private Declare Function GetSystemDirectory Lib "kernel32" _
          Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, _
          ByVal nSize As Long) As Long
  
  ' Retrieves the length of the specified wide string (not including the
  ' terminating null character).
  Private Declare Function lstrlenW Lib "kernel32" _
          (ByVal lpString As Long) As Long

' ***************************************************************************
' Global Variables
' ***************************************************************************
  Public gblnStopProcessing As Boolean
  Public gstrVersion        As String
  Public glngPasses         As Long     ' number of iterations to process data
  
' ***************************************************************************
' Module Variables
' ***************************************************************************
  Private mblnIDE_Environment As Boolean    ' Flag for debug mode
          
' ***************************************************************************
' Routine:       Main
'
' Description:   This is a generic routine to start an application
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' 29-APR-2001  Kenneth Ives  [e-mail]
'              Wrote routine
' ***************************************************************************
Sub Main()

    On Error GoTo Main_Error

    ChDrive App.Path
    ChDir App.Path
    
    ' See if there is another instance of this program
    ' running.  The parameter being passed is the name
    ' of this executable without the EXE extension.
    If AlreadyRunning(App.EXEName) Then
        GoTo Main_CleanUp
    End If
    
    InitComctl32                 ' Activate manifest file
    
    gstrVersion = PGM_NAME & " v" & App.Major & "." & App.Minor & "." & App.Revision
    gblnStopProcessing = False   ' preset global stop flag
    
    Load frmMain                 ' Load the main form

Main_CleanUp:
    On Error GoTo 0
    Exit Sub

Main_Error:
    ErrorMsg MODULE_NAME, "Main", Err.Description
    Resume Main_CleanUp
    
End Sub

' ***************************************************************************
' Routine:       TerminateProgram
'
' Description:   This routine will perform the shutdown process for this
'                application.  If there are any global object/class (not
'                forms) they will be listed below and set to NOTHING so as
'                to free them from memory.  The last task is to unload
'                all form objects.  Then terminate this application.
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' 29-APR-2001  Kenneth Ives  [e-mail]
'              Wrote routine
' ***************************************************************************
Public Sub TerminateProgram()

    ' Set all global objects to nothing, if they were used in this application
    ' EXAMPLE:    Set gobjFSO = Nothing
    
    CloseAllFiles   ' Close all files opened by this application
    UnloadAllForms  ' Unload any forms from memory

    ' While in the IDE, do not call the ELSE statement (ExitProcess).
    ' If you do, the associated processes include the VB developement
    ' environment.  ExitProcess will close the IDE immediately and not
    ' save any changes that were not previously saved.
    If mblnIDE_Environment Then
        End  ' Force this application to terminate while in the VB IDE
    Else
        ' The ExitProcess function ends a process and all its threads.
        ExitProcess GetExitCodeProcess(GetCurrentProcess, 0)
    End If

End Sub
 
' ***************************************************************************
' Routine:       CloseAllFiles
'
' Description:   Closes any files that were opened within this application.
'                The FreeFile() function returns an integer representing the
'                next file handle opened by this appication.
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' 29-APR-2001  Kenneth Ives  [e-mail]
'              Wrote routine
' ***************************************************************************
Public Function CloseAllFiles() As Boolean

    While FreeFile > 1
        Close #FreeFile - 1
    Wend
    
End Function

' ***************************************************************************
' Routine:       UnloadAllForms
'
' Description:   Unload all active forms associated with this application.
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' 29-APR-2001  Kenneth Ives  [e-mail]
'              Wrote routine
' ***************************************************************************
Private Sub UnloadAllForms()

    Dim frm As Form
    Dim ctl As Control

    ' Loop thru all the active forms
    ' associated with this application
    For Each frm In Forms
        
        frm.Hide            ' hide the form
        
        ' free all controls from memory
        For Each ctl In frm.Controls
            Set ctl = Nothing
        Next
        
        Unload frm          ' deactivate the form object
        Set frm = Nothing   ' free form object from memory
                            ' (prevents memory fragmentation)
    Next

End Sub

' ***************************************************************************
' Routine:       RemoveTrailingNulls
'
' Description:   Receives a data string and looks for the first null.  If
'                found, the string is truncated at that point and returned.
'
' Parameters:    strData - Input string to be inspected
'
' Returns:       Data string without the trailing nulls
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' Unknown      Randy Birch http://vbnet.mvps.org/index.html
'              Wrote routine routine
' ***************************************************************************
Public Function RemoveTrailingNulls(ByVal strData As String) As String

    RemoveTrailingNulls = Left$(strData, lstrlenW(StrPtr(strData)))

End Function

' ***************************************************************************
' Routine:       FindRequiredFile
'
' Description:   Test to see if a required file is in the applications,
'                windows or windows system folder.
'
' Parameters:    strFilename - name of the file without path information
'                strFullPath - Optional - If found then the fully qualified
'                     path and filename are returned
'
' Returns:       TRUE  - Found the required file
'                FALSE - File could not be found
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 04-FEB-2003  Kenneth Ives  [e-mail]
'              Original
' 15-Nov-2006  Kenneth Ives  [e-mail]
'              Modified the search criteria to use PATH environment variable
' 10-Sep-2007  Kenneth Ives  [e-mail]
'              Changed search criteria to inspect 3 specific folders.
'              Found examples where some applications changed the PATH
'              environment variable.
' ***************************************************************************
Public Function FindRequiredFile(ByVal strFileName As String, _
                        Optional ByRef strFullPath As String = "") As Boolean

    Dim strPath    As String  ' Fully qualified search path
    Dim strAppPath As String  ' Description needed in error message
    Dim strWinPath As String  ' Description needed in error message
    Dim strSysPath As String  ' Description needed in error message
    Dim blnFoundIt As Boolean

    On Error GoTo FindRequiredFile_Error

    strFullPath = ""    ' Empty return variable
    blnFoundIt = False  ' Preset flag
    
    ' See if file is in application folder
    strAppPath = QualifyPath(App.Path)