Zjištění jména a cesty defaultního prohlížeče HTML

Option Explicit

Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String,  ByVal sResult As String) As Long
Private Declare Function GetTempPath Lib "kernel32"  Alias "GetTempPathA" (ByVal nSize As Long, ByVal lpBuffer As String) As Long

Private Const MAX_PATH = 260
Private Const ERROR_FILE_NO_ASSOCIATION = 31&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_FILE_SUCCESS = 32& 
Private Const ERROR_BAD_FORMAT = 11&

Private Function GetBrowserName(dwFlagReturned As Long) As String

   Dim hFile As Long
   Dim sResult As String
   Dim sTempFolder As String
        
  'dočasný adresář
   sTempFolder = GetTempDir()
   
  'vytvoření prázdného html  souboru v temp adresáři
   hFile = FreeFile
      Open sTempFolder & "dummy.html" For Output As #hFile
   Close #hFile

  'zjištění jména a cesty souboru asociovaného s html
   sResult = Space$(MAX_PATH)
   dwFlagReturned = FindExecutable("dummy.html", sTempFolder, sResult)
  
  'odstranění dočasného html
   Kill sTempFolder & "dummy.html"
   
   GetBrowserName = TrimNull(sResult)
   
End Function


Private Function TrimNull(item As String)

    Dim pos As Integer
   
    pos = InStr(item, Chr$(0))
    
    If pos Then
          TrimNull = Left$(item, pos - 1)
    Else: TrimNull = item
    End If
  
End Function


Public Function GetTempDir() As String

    Dim nSize As Long
    Dim tmp As String
    
    tmp = Space$(256)
    nSize = Len(tmp)
    Call GetTempPath(nSize, tmp)
    
    GetTempDir = TrimNull(tmp)
    
End Function

Na formulář přidejte tlačítko. Na událost click:

Private Sub Command1_Click()

   Dim success As Long
   Dim sBrowser As String
   
   sBrowser = GetBrowserName(success)
   
  'možné návratové hodnoty
   Select Case success
      
     'volání bylo úspěšné
      Case Is >= ERROR_FILE_SUCCESS
      
         MsgBox sBrowser
         Exit Sub
         
     'další možné návratové hodnoty
      Case ERROR_FILE_NO_ASSOCIATION
      Case ERROR_FILE_NOT_FOUND
      Case ERROR_PATH_NOT_FOUND
      Case ERROR_BAD_FORMAT
      Case Else:
   End Select
      
   
  'Pokud nebyl browser nalezen
   MsgBox "Nenalezeno!"
   
End Sub

Zpět