Как с VB запустить браузер?
Формулировка задачи:
Help me please!!!
How to open browser from VB?
Решение задачи: «Как с VB запустить браузер?»
textual
Листинг программы
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const ERROR_SUCCESS = 0&
Public Const REG_SZ = 1
Public Const reg_SHELL_OPEN = 'shellopen'
Public Const reg_SHELL_OPEN_COMMAND = reg_SHELL_OPEN & 'command'
Public Declare Function RegOpenKey Lib 'advapi32.dll' Alias 'RegOpenKeyA' (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function OSRegCloseKey Lib 'advapi32' Alias 'RegCloseKey' (ByVal hKey As Long) As Long
Public Declare Function OSRegQueryValueEx Lib 'advapi32' Alias 'RegQueryValueExA' (ByVal hKey As Long, ByVal lpszValueName As String, ByVal dwReserved As Long, lpdwType As Long, lpbData As Any, cbData As Long) As Long
''=================================================================================================
Public Function StripTerminator(ByVal strString As String, Optional CharCod As Variant) As String
Dim intZeroPos As Integer
Dim sCC As String * 1
sCC = Chr$(0)
If Not IsMissing(CharCod) Then sCC = CharCod
intZeroPos = InStr(strString, sCC)
If intZeroPos > 0 Then
StripTerminator = Left$(strString, intZeroPos - 1)
Else
StripTerminator = strString
End If
End Function
Function RegCloseKey(ByVal hKey As Long) As Boolean
Dim lResult As Long
On Error GoTo 0
lResult = OSRegCloseKey(hKey)
RegCloseKey = (lResult = ERROR_SUCCESS)
End Function
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String, strData As String) As Boolean
Dim lResult As Long
Dim lValueType As Long
Dim strBuf As String
Dim lDataBufSize As Long
RegQueryStringValue = False
On Error GoTo 0
lResult = OSRegQueryValueEx(hKey, strValueName, 0&, lValueType, ByVal 0&, lDataBufSize)
If lResult = ERROR_SUCCESS Then
If lValueType = REG_SZ Then
strBuf = String(lDataBufSize, ' ')
lResult = OSRegQueryValueEx(hKey, strValueName, 0&, 0&, ByVal strBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
RegQueryStringValue = True
strData = StripTerminator(strBuf)
End If
End If
End If
End Function
''====================================================================================
Public Function RegQueryShellOpenCommandByType(ByVal strFileType As String) As String
Dim hRegKey As Long
Dim TMPstr As String
Dim lTV As Variant
RegQueryShellOpenCommandByType = ''
On Error GoTo 0
If RegOpenKey(HKEY_CLASSES_ROOT, strFileType, hRegKey) Then Exit Function
TMPstr = ''
If RegQueryStringValue(hRegKey, '', TMPstr) Then
lTV = RegCloseKey(hRegKey)
If RegOpenKey(HKEY_CLASSES_ROOT, strFileType & reg_SHELL_OPEN_COMMAND, hRegKey) Then Exit Function
TMPstr = ''
RegQueryStringValue(hRegKey, '', TMPstr)
RegQueryShellOpenCommandByType = TMPstr
End If
If hRegKey <> 0 Then lTV = RegCloseKey(hRegKey)
End Function
''========================================================
''Пример использования
''Dim strCMD$
'' strCMD$ = RegQueryShellOpenCommandByType('http')
'' If strCMD$ <> '' Then ''- Полный путь к броузеру
'' strCMD$ = RegQueryShellOpenCommandByType('mailto')
'' If strCMD$ <> '' Then ''- Полный путь к мылу
'' и так далее....