Visual Basic > Internet Web Mail Stuff

Another way to start an URL in VB (works with MSIE & Netscape)

Another way to start an URL in VB (works with MSIE & Netscape)

'open URL http://example in MSIE or Netscape

Const LAUAdress = "http://example"

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey as Long) as Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" alias "RegOpenKeyExA" (ByVal hKey as Long, ByVal lpSubKey as String, ByVal ulOptions as Long, ByVal samDesired as Long, phkResult as Long) as Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" alias "RegQueryValueExA" (ByVal hKey as Long, ByVal lpValueName as String, ByVal lpReserved as Long, lpType as Long, lpData as Any, lpcbData as Long) as Long
Const HKEY_CLASSES_ROOT = &H80000000
Const ERROR_SUCCESS = 0&
Const REG_OPTION_NON_VOLATILE = &O0
Const KEY_ALL_CLASSES as long = &HF0063
Const KEY_ALL_ACCESS = &H3F
Const REG_SZ as long = 1

Private sub Form_Load()
    mdiMain.Hide

    If Command = "" Then
        Call ConnectHTML(LAUAdress)
    Else
        Call ConnectHTML(Command)
    end If
    End
    
End Sub

Function RegGetString$(hInKey as Long, ByVal subkey$, ByVal valname$)
    dim RetVal$, hSubKey as Long, dwType as Long, SZ as Long, v$, r as Long
    
    RetVal$ = ""
    
    r = RegOpenKeyEx(hInKey, subkey$, 0, KEY_ALL_CLASSES, hSubKey)
    If r <> ERROR_SUCCESS Then GoTo Quit_Now
    SZ = 256: v$ = String$(SZ, 0)
    r = RegQueryValueEx(hSubKey, valname$, 0, dwType, ByVal v$, SZ)
    If r = ERROR_SUCCESS And dwType = REG_SZ Then
        RetVal$ = Left(v$, SZ - 1)
    Else
        RetVal$ = ""
    end If
    If hInKey = 0 Then r = RegCloseKey(hSubKey)
Quit_Now:
    RegGetString$ = RetVal$

End Function

Sub ConnectHTML(URL as String)

    dim strProgram$
    dim p as Integer
    
    On Error GoTo ErrOpenURL
    
    'msie
    strProgram = RegGetString(HKEY_CLASSES_ROOT, "http\shell\open\command", "")
    'netscape
    If strProgram = "" Then _
        strProgram = RegGetString(HKEY_CLASSES_ROOT, "NetscapeMarkup\shell\open\command", "")
    
    p% = InStr(strProgram, " ")
    strProgram = Left$(strProgram, p%)
    strProgram = strProgram & URL$
    Call Shell(strProgram, 1)
    exit Sub
    
ErrOpenURL:
    MsgBox CStr(Err) & " " & Error
    Resume Next
    
End Sub


Return