Visual Basic Internet Routines
CreateProcess: Start Separate Instances of the Default Browser
     
Posted:   Monday October 18, 1999
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows NT4
OS restrictions:   None
Author:   VBnet - Randy Birch
     

Related:  

FindExecutable: Obtain Exe of the Default Browser
FindExecutable: Find Exe Associated with a Registered Extension
RegSetValueEx: Create a Registered File Association
ShellExecute: Simulate a Hyperlink with a Label Control
ShellExecute: ShellExecute Madness

ShellExecute: Send Large Emails in Outlook Express
     
 Prerequisites
None.

While ShellExecute will reliably display a specified URL in the default browser, whether or not the call to ShellExecute will reuse an existing browser session or open a new session is always unknown to the developer. The code presented here uses the FindExecutable method detailed in FindExecutable: Obtain Exe of the Default Browser, and the CreateProcess API to force a new instance of the browser to be created for every call to the start routine..

Note however that this code can not guarantee the associated application returned is a browser, only that *some* application is associated with the specified extension. While in most cases this will be the default browser, it is possible that another browser or application has hijacked the html extension.  One reported case indicated MS Word was associated with the html file extension.  Therefore it may be justified to check the returned string from this call for "iexplore.exe" or the name of the browser of your choice, and if not the expected value to prompt the user to select their default browser, which you'd then save as your own setting for future reference. Another alternative would be to present the user with the list of installed browsers contained under the registry key:

    HKEY_LOCAL_MACHINE\SOFTWARE\Clients\StartMenuInternet

... or to retrieve the application related to the http:// command listed under:

    HKEY_LOCAL_MACHINE\SOFTWARE\Classes\http\shell\open\command

 
Revision history

July 2004      Added BuildCommandLine function to correctly prepare the CreateProcess command line argument to handle Netscape 4.x, Netscape 7.x, and Internet Explorer
   

 BAS Module Code
None.

 Form Code
Drop a command button onto a form and add the following:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const CREATE_NEW_CONSOLE As Long = &H10
Private Const NORMAL_PRIORITY_CLASS As Long = &H20
Private Const INFINITE As Long = -1
Private Const STARTF_USESHOWWINDOW As Long = &H1
Private Const SW_SHOWNORMAL As Long = 1

Private Const MAX_PATH As Long = 260
Private Const ERROR_FILE_NO_ASSOCIATION As Long = 31
Private Const ERROR_FILE_NOT_FOUND As Long = 2
Private Const ERROR_PATH_NOT_FOUND As Long = 3
Private Const ERROR_FILE_SUCCESS As Long = 32 'my constant
Private Const ERROR_BAD_FORMAT As Long = 11

Private Type STARTUPINFO
  cb As Long
  lpReserved As String
  lpDesktop As String
  lpTitle As String
  dwX As Long
  dwY As Long
  dwXSize As Long
  dwYSize As Long
  dwXCountChars As Long
  dwYCountChars As Long
  dwFillAttribute As Long
  dwFlags As Long
  wShowWindow As Integer
  cbReserved2 As Integer
  lpReserved2 As Long
  hStdInput As Long
  hStdOutput As Long
  hStdError As Long
End Type

Private Type PROCESS_INFORMATION
  hProcess As Long
  hThread As Long
  dwProcessId As Long
  dwThreadID As Long
End Type

Private Declare Function CreateProcess Lib "kernel32" _
   Alias "CreateProcessA" _
  (ByVal lpAppName As String, _
   ByVal lpCommandLine As String, _
   ByVal lpProcessAttributes As Long, _
   ByVal lpThreadAttributes As Long, _
   ByVal bInheritHandles As Long, _
   ByVal dwCreationFlags As Long, _
   ByVal lpEnvironment As Long, _
   ByVal lpCurrentDirectory As Long, _
   lpStartupInfo As STARTUPINFO, _
   lpProcessInformation As PROCESS_INFORMATION) As Long
     
Private Declare Function CloseHandle Lib "kernel32" _
  (ByVal hObject As Long) As Long

Private Declare Function FindExecutable Lib "shell32" _
   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 Sub Command1_Click()

   Dim sURL As String
   
  'the URL to open, of course!
   sURL = "http://vbnet.mvps.org/"
   
  'if the call returns false, display a message
   If Not StartNewBrowser(sURL) Then
   
      MsgBox "No dice!"
      
   End If
   
End Sub


Private Function StartNewBrowser(sURL As String) As Boolean
       
  'start a new instance of the user's browser
  'at the page passed as sURL
   Dim success As Long
   Dim hProcess As Long
   Dim sBrowser As String
   Dim start As STARTUPINFO
   Dim proc As PROCESS_INFORMATION
   Dim sCmdLine As String
   
   sBrowser = GetBrowserName(success)
   
  'did sBrowser get correctly filled?
   If success >= ERROR_FILE_SUCCESS Then
   
      sCmdLine = BuildCommandLine(sBrowser)
      
     'prepare STARTUPINFO members
      With start
         .cb = Len(start)
         .dwFlags = STARTF_USESHOWWINDOW
         .wShowWindow = SW_SHOWNORMAL
      End With
      
     'start a new instance of the default
     'browser at the specified URL. The
     'lpCommandLine member (second parameter)
     'requires a leading space or the call
     'will fail to open the specified page.
      success = CreateProcess(sBrowser, _
                              sCmdLine & sURL, _
                              0&, 0&, 0&, _
                              NORMAL_PRIORITY_CLASS, _
                              0&, 0&, start, proc)
                                  
     'if the process handle is valid, return success
      StartNewBrowser = proc.hProcess <> 0
     
     'don't need the process
     'handle anymore, so close it
      Call CloseHandle(proc.hProcess)

     'and close the handle to the thread created
      Call CloseHandle(proc.hThread)

   End If

End Function


Private Function GetBrowserName(dwFlagReturned As Long) As String

  'find the full path and name of the user's
  'associated browser
   Dim hFile As Long
   Dim sResult As String
   Dim sTempFolder As String
        
  'get the user's temp folder
   sTempFolder = GetTempDir()
   
  'create a dummy html file in the temp dir
   hFile = FreeFile
      Open sTempFolder & "dummy.html" For Output As #hFile
   Close #hFile

  'get the file path & name associated with the file
   sResult = Space$(MAX_PATH)
   dwFlagReturned = FindExecutable("dummy.html", sTempFolder, sResult)
  
  'clean up
   Kill sTempFolder & "dummy.html"
   
  'return result
   GetBrowserName = TrimNull(sResult)
   
End Function


Private Function BuildCommandLine(ByVal sBrowser As String) As String

  'just in case the returned string is mixed case 
   sBrowser = lcase$(sBrowser)
   
  'try for internet explorer
   If InStr(sBrowser, "iexplore.exe") > 0 Then
      BuildCommandLine = " -nohome "
   
  'try for netscape 4.x
   ElseIf InStr(sBrowser, "netscape.exe") > 0 Then
      BuildCommandLine = " "
   
  'try for netscape 7.x
   ElseIf InStr(sBrowser, "netscp.exe") > 0 Then
      BuildCommandLine = " -url "
   
   Else
   
     'not one of the usual browsers, so
     'either determine the appropriate
     'command line required through testing
     'and adding to ElseIf conditions above,
     'or just return a default 'empty'
     'command line consisting of a space
     '(to separate the exe and command line
     'when CreateProcess assembles the string)
      BuildCommandLine = " "
      
   End If
   
End Function


Private Function TrimNull(item As String)

  'remove string before the terminating null(s)
   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

  'retrieve the user's system temp folder
   Dim tmp As String
   
   tmp = Space$(MAX_PATH)
   Call GetTempPath(Len(tmp), tmp)
   
   GetTempDir = TrimNull(tmp)
    
End Function
 Comments
See FindExecutable: Obtain Exe of the Default Browser if you need to trap the error messages returned from the FindExecutable call.

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter