basmain.bas

a Tiger Hash algorithmn code

    strPath = strAppPath & strFileName
    
    ' Check application folder
    If FileExists(strPath) Then
        blnFoundIt = True
    End If
        
    If Not blnFoundIt Then
        
        ' Get the path to the Windows folder
        ' (Winnt, Windows, etc.)
        strWinPath = Space$(MAX_SIZE)                     ' Pad with spaces
        GetWindowsDirectory strWinPath, MAX_SIZE          ' Make API call
        strWinPath = RemoveTrailingNulls(strWinPath)      ' Save just the return data
        strPath = QualifyPath(strWinPath) & strFileName   ' Append filename
        
        ' Check Windows folder
        If FileExists(strPath) Then
            blnFoundIt = True
        End If
    End If
    
    If Not blnFoundIt Then
    
        ' Get the path to the Windows System folder
        strSysPath = Space$(MAX_SIZE)                     ' Pad with spaces
        GetSystemDirectory strSysPath, MAX_SIZE           ' Make API call
        strSysPath = RemoveTrailingNulls(strSysPath)      ' Save just the return data
        strPath = QualifyPath(strSysPath) & strFileName   ' Append filename
        
        ' Check Windows System folder
        If FileExists(strPath) Then
            blnFoundIt = True
        End If
    End If
   
    
FindRequiredFile_CleanUp:
    If blnFoundIt Then
        strFullPath = strPath       ' Return full path/filename
    Else
        InfoMsg "A required file that supports this application cannot be found." & _
                vbCrLf & vbCrLf & _
                Chr$(34) & StrConv(strFileName, vbUpperCase) & Chr$(34) & _
                " is not in any of these folders:" & vbCrLf & vbCrLf & _
                strAppPath & vbCrLf & _
                strWinPath & vbCrLf & _
                strSysPath, "File not found"
    End If
    
    FindRequiredFile = blnFoundIt   ' Set status flag
    On Error GoTo 0                 ' Nullify this error trap
    Exit Function

FindRequiredFile_Error:
    ErrorMsg MODULE_NAME, "FindRequiredFile", Err.Description
    blnFoundIt = False
    Resume FindRequiredFile_CleanUp
  
End Function

' ***************************************************************************
' Routine:       FileExists
'
' Description:   Test to see if a file exists.
'
' Syntax:        FileExists("C:\Program Files\Desktop.ini")
'
' Parameters:    strFilename - Path\filename to be queried.
'
' Returns:       True or False
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' dd-mmm-1997  Bruce McKinney "Hardcore Visual Basic"
'              http://vb.mvps.org/hardweb/mckinney.htm
' ***************************************************************************
Public Function FileExists(ByVal strFileName As String) As Boolean
    
    Dim lngAttrib As Long
    
    On Error GoTo FileExists_Exit
    
    lngAttrib = GetFileAttributes(strFileName)

    If (lngAttrib <> INVALID_HANDLE_VALUE) Then
        FileExists = CBool((lngAttrib And vbDirectory) <> vbDirectory)
    End If

FileExists_Exit:

End Function

' ***************************************************************************
' Routine:       PathExists
'
' Description:   Does a path exists.  A trailing backslash is ignored.
'
' Syntax:        PathExists("C:\Program Files")
'
' Parameters:    strPath - Path to be queried.
'
' Returns:       True or False
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' dd-mmm-1997  Bruce McKinney "Hardcore Visual Basic"
'              http://vb.mvps.org/hardweb/mckinney.htm
' ***************************************************************************
Public Function PathExists(ByVal strPath As String) As Boolean

    Dim lngAttrib As Long
    
    On Error GoTo PathExists_Exit
    
    lngAttrib = GetFileAttributes(strPath)

    If (lngAttrib <> INVALID_HANDLE_VALUE) Then
        PathExists = CBool((lngAttrib And vbDirectory) = vbDirectory)
    End If

PathExists_Exit:

End Function

' ***************************************************************************
' Routine:       AlreadyRunning
'
' Description:   This routine will determine if an application is already
'                active, whether it be hidden, minimized, or displayed.
'
' Parameters:    strTitle - partial/full name of application
'
' Returns:       TRUE  - Currently active
'                FALSE - Inactive
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' 19-DEC-2004  Kenneth Ives  [e-mail]
'              Wrote routine
' ***************************************************************************
Public Function AlreadyRunning(ByVal strTitle As String) As Boolean

    Dim hMutex As Long

    On Error GoTo AlreadyRunning_Error

    AlreadyRunning = False  ' preset flag to FALSE
    SetDebugMode            ' attempt to set the debug flag
     
    ' if in the VB IDE we do not care
    ' about multiple versions executing.
    If mblnIDE_Environment Then
        Exit Function   ' allows restarting of this application
    End If

    ' Try to create a new Mutex handle
    hMutex = CreateMutex(ByVal 0&, 1, strTitle)

    ' Did the mutex already exist?
    If (Err.LastDllError = ERROR_ALREADY_EXISTS) Then
         
        ReleaseMutex hMutex     ' Release Mutex handle from memory
        CloseHandle hMutex      ' Close the Mutex handle
        Err.Clear               ' Clear any errors
        AlreadyRunning = True   ' prior version already active
    
    Else
        AlreadyRunning = False  ' no prior versions are active
    End If

AlreadyRunning_CleanUp:
    On Error GoTo 0             ' Nullify this error trap
    Exit Function

AlreadyRunning_Error:
    ErrorMsg MODULE_NAME, "AlreadyRunning", Err.Description
    Resume AlreadyRunning_CleanUp

End Function

Private Sub SetDebugMode()
    
    ' Set the DebugMode flag. This will only
    ' execute while in the VB IDE environment
    Debug.Assert InDebugMode

End Sub

Private Function InDebugMode() As Boolean
    
    ' Set mblnIDE_Environment to true. This happens only
    ' if the Debug.Assert call is successful.  It will
    ' only happen in the IDE environment.
    
    mblnIDE_Environment = True
    InDebugMode = True

End Function

' ***************************************************************************
' Routine:       QualifyPath
'
' Description:   Adds a trailing backslash to the path, if missing
'
' Parameters:    strPath - Current folder being processed.
'
' Returns:       Fully qualified path with trailing backslash
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' Unknown      Randy Birch http://vbnet.mvps.org/index.htmll
'              Original routine
' 14-MAY-2002  Kenneth Ives  [e-mail]
'              Modified/documented
' ***************************************************************************
Public Function QualifyPath(ByVal strPath As String) As String

    strPath = Trim$(strPath)    ' remove all leading and trailing blanks
    
    ' check for a trailing backslash
    If Right$(strPath, 1) <> "\" Then
        QualifyPath = strPath & "\"     ' add a backslash
    Else
        QualifyPath = strPath                   ' already has a backslash
    End If
      
End Function

' ***************************************************************************
' Routine:       UnQualifyPath
'
' Description:   Removes a trailing backslash to the path
'
' Parameters:    strPath - Current folder being processed.
'
' Returns:       Fully qualified path without a trailing backslash
'
' ===========================================================================
'    DATE      NAME / DESCRIPTION
' -----------  --------------------------------------------------------------
' Unknown      Randy Birch http://vbnet.mvps.org/index.htmll
'              Original routine
' 14-MAY-2002  Kenneth Ives  [e-mail]
'              Modified/documented
' ***************************************************************************
Public Function UnQualifyPath(ByVal strPath As String) As String

  'removes any trailing slash from the path
   strPath = Trim$(strPath)
   
   If Right$(strPath, 1) = "\" Then
       UnQualifyPath = Left$(strPath, Len(strPath) - 1)
   Else
       UnQualifyPath = strPath
   End If
   
End Function

' ***************************************************************************
' Routine:       SendEmail
'
' Description:   When the email hyperlink is clicked, this routine will fire.
'                It will create a new email message with the author's name in
'                the "To:" box and the name and version of the application
'                on the "Subject:" line.
'
' ===========================================================================
'    DATE      NAME / eMAIL
'              DESCRIPTION
' -----------  --------------------------------------------------------------
' 23-FEB-2000  Kenneth Ives  [e-mail]
'              Routine created
' ***************************************************************************
Public Sub SendEmail()

    Dim strMail As String

    On Error GoTo SendEmail_Error

    ' open the URL using the default browser
    strMail = "mailto:" & AUTHOR_EMAIL & "?subject=" & PGM_NAME & gstrVersion

    ' Send an email to the author by calling the ShellExecute API
    ShellExecute 0&, vbNullString, strMail, _
                 vbNullString, vbNullString, vbNormalFocus

SendEmail_CleanUp:
    On Error GoTo 0
    Exit Sub

SendEmail_Error:
    ErrorMsg MODULE_NAME, "SendEmail", Err.Description
    Resume SendEmail_CleanUp

End Sub