' Launching a Website from Visual Basic
'
' How to launch the browser and point to a web site using Visual Basic.
'
' Jon Vote, Idioma Software Inc.
'
' 02/2000
'
' www.idioma-software.com
'
' 1) Create a new project. Form1 will be created by default.
' 2) Add a Textbox and Command Button to the Form.
' 3) Add a Module to the Project.
' 4) Paste the following code into the declarations section of Form1.
' --- Begin code for Form1
Option Explicit
Private Sub Command1_Click()
Dim rc As Long
rc = ShowURL(Text1.Text)
If rc < 32 Then
MsgBox WhatsThisError(rc)
End If
End Sub
Private Sub Form_Load()
Me.Caption = "How to Launch a Webpage from VB"
Text1.Text = "http://www.skycoder.com"
Command1.Caption = "ShowURL"
Command1.Default = True
End Sub
' --- End code for Form1 ---
' 6) Paste the following into Module1.
' --- Begin code for Module1 ---
' This sample code is presented as is.
' Although every reasonable effort has been
' made to insure the correctness of the example
' below, Idianna Software Inc. makes no warranty
' of any kind with regard to this program sample
' either implicitly or explicitly.
' This program example may be freely distributed for the
' use of writing computer programs only. Any other use of
' this material requires written permission from Idianna Software inc.
' (c) 2000 Idianna Software inc. All rights reserved.
' Title: Using VB to show a web page on the net.
' Platform: Visual Basic - 32 bit
' Author: Jon Vote
' Contact: jon@idioma-software.com
' Date: 02/00
'
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hWnd As Long, ByVal lpszOp As _
String, ByVal lpszFile As String, ByVal lpszParams As String, _
ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function InternetAttemptConnect _
Lib "Wininet" (ByVal dwReserved As Long) As Long
Const SW_SHOWNORMAL = 1
Const SE_ERR_FNF = 2&
Const SE_ERR_PNF = 3&
Const SE_ERR_ACCESSDENIED = 5&
Const SE_ERR_OOM = 8&
Const SE_ERR_DLLNOTFOUND = 32&
Const SE_ERR_SHARE = 26&
Const SE_ERR_ASSOCINCOMPLETE = 27&
Const SE_ERR_DDETIMEOUT = 28&
Const SE_ERR_DDEFAIL = 29&
Const SE_ERR_DDEBUSY = 30&
Const SE_ERR_NOASSOC = 31&
Const ERROR_BAD_FORMAT = 11&
Public Function OpenThisDoc(hWnd As Long, FileName As String) As Long
'Opens document. Returns device context. Error if 32 or less.
'See the SE_* constants for description of errors
On Error GoTo errOpenThisDoc
Dim rc As Long
rc = ShellExecute(hWnd, "Open", FileName, 0&, 0&, 1&)
OpenThisDoc = rc
Exit Function
errOpenThisDoc:
rc = -2
OpenThisDoc = rc
End Function
Function ShowURL(sURL2Show As String) As Long
'Connects if necesarry, invokes browser to show sURL2Show.
'Return values are as follows:
' -1 => failed to connect
' -2 => some unknown horrible thing happened
' >=0 and <=32 => shell error
' See SE_* constants for
' descriptions of shell errors
Dim rc As Long
Dim dwReserved As Long
Dim Scr_hDC As Long
dwReserved = 0
Scr_hDC = GetDesktopWindow()
rc = InternetAttemptConnect(dwReserved)
If rc = 0 Then
rc = OpenThisDoc(Scr_hDC, sURL2Show)
End If
ShowURL = rc
End Function
Function WhatsThisError(rc As Long) As String
' Returns error message
' an rc of -2 indicates
' a system error, so
' system error message
' is returned
Dim msg As String
Select Case rc
Case -1
msg = "Failed to connect"
Case -2
msg = Err.Description
Case SE_ERR_FNF
msg = "File not found"
Case SE_ERR_PNF
msg = "Path not found"
Case SE_ERR_ACCESSDENIED
msg = "Access denied"
Case SE_ERR_OOM
msg = "Out of memory"
Case SE_ERR_DLLNOTFOUND
msg = "DLL not found"
Case SE_ERR_SHARE
msg = "A sharing violation occurred"
Case SE_ERR_ASSOCINCOMPLETE
msg = "Incomplete or invalid file association"
Case SE_ERR_DDETIMEOUT
msg = "DDE Time out"
Case SE_ERR_DDEFAIL
msg = "DDE transaction failed"
Case SE_ERR_DDEBUSY
msg = "DDE busy"
Case SE_ERR_NOASSOC
msg = "No association for file extension"
Case ERROR_BAD_FORMAT
msg = "Invalid EXE file or error in EXE image"
Case Else
msg = "Unknown error"
End Select
WhatsThisError = msg
End Function
' --- End code for Module1 ---