Visual Basic Programmer's Resources/Examples:

Using VB to Show a Page on the Net:

    
' Instructions:

' 1) Create a new project with one form and one module.
' 2) Add a text box and a button to the form.
' 3) Paste the following code as indicated.
' 4) Run the project and click the button.
'    The program will prompt for a dial-up
'    connection if appropriate, and then
'    invoke the default browser to connect
'    to the URL entered in the text box.


'  ------------- Paste this code into Module1 -------------

'  This sample code is presented as is.
'  Although every reasonable effort has been
'  made to insure the correctness of the example
'  below, Idioma 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 Idioma Software inc.
'  (c) 2000 Idioma 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 -------------




'  ------------- Paste this code into 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()

    Text1.Text = "http://www.idioma-software.com"
    
End Sub



'  ------------- End code for Form1 -------------



 
 
 
 
 

Powered by
Guatemalan Dark Roast