CreateProcess プロセスの起動
CloseHandle オープンされているオブジェクトハンドルをクローズ
FindExecutable ファイル名に関連付けられている実行可能ファイル名とハンドルを取得
GetTempPath 一時フォルダ(テンポラリフォルダ)を取得

'================================================================
'= Webの起動
'=    (CreateProcess.bas)
'================================================================
#include "Windows.bi"

#define CREATE_NEW_CONSOLE &H10
#define NORMAL_PRIORITY_CLASS &H20      '通常クラス(一般的なプロセス)
#define INFINITE &HFFFF                 '無限に中断
#define STARTF_USESHOWWINDOW &H1        'wShowWindowを使用する
#define SW_SHOWNORMAL 1                 'SW_RESTOREと同じ
#define MAX_PATH 260
#define ERROR_FILE_NO_ASSOCIATION 31
#define ERROR_FILE_NOT_FOUND &H2        '指定されたファイルが見つからない
#define ERROR_PATH_NOT_FOUND &H3        '指定されたパスが見つからない
#define ERROR_FILE_SUCCESS 32
#define ERROR_BAD_FORMAT &HB            '間違ったフォーマットのプログラムを読み込もうとした

Type STARTUPINFO
    cb              As Long
    lpReserved      As Long
    lpDesktop       As Long
    lpTitle         As Long
    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

Type PROCESS_INFORMATION
    hProcess    As Long
    hThread     As Long
    dwProcessId As Long
    dwThreadId  As Long
End Type

' プロセスの起動
Declare Function Api_CreateProcess& Lib "kernel32" Alias "CreateProcessA" (ByVal Name$, ByVal Cmd$, pAtr&, tAtr&, ByVal iHand&, ByVal Flg&, ByVal Env&, ByVal Dir&, sInf As STARTUPINFO, pInf As PROCESS_INFORMATION)

' オープンされているオブジェクトハンドルをクローズ
Declare Function Api_CloseHandle& Lib "Kernel32" Alias "CloseHandle" (ByVal hObject&)

' ファイル名に関連付けられている実行可能ファイル名とハンドルを取得
Declare Function Api_FindExecutable& Lib "shell32" Alias "FindExecutableA" (ByVal lpFile$, ByVal lpDirectory$, ByVal lpResult$)

' 一時フォルダ(テンポラリフォルダ)を取得
Declare Function Api_GetTempPath& Lib "Kernel32" Alias "GetTempPathA" (ByVal nBufferLength&, ByVal lpBuffer$)

Var Shared Edit1 As Object
Var Shared Button1 As Object

Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 12
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

'================================================================
'=
'================================================================
Declare Function TrimNull(item As String) As String
Function TrimNull(item As String) As String
    Var epos As Integer

    epos = InStr(item, Chr$(0))

    If epos Then
        TrimNull = Left$(item, epos - 1)
    Else
        TrimNull = item
    End If
End Function

'================================================================
'=
'================================================================
Declare Function GetTempDir() As String
Function GetTempDir() As String
    Var tmp As String
    Var Ret As Long
   
    tmp = Space$(MAX_PATH)
    Ret = Api_GetTempPath(Len(tmp), tmp)

    GetTempDir = TrimNull(tmp)
End Function

'================================================================
'=
'================================================================
Declare Function GetBrowserName(dwFlagReturned As Long) As String
Function GetBrowserName(dwFlagReturned As Long) As String
    Var hFile As Long
    Var sResult As String
    Var sTempFolder As String
        
    'tmpフォルダを取得
    sTempFolder = GetTempDir()

    'ダミーのhtmlファイルを作成
    hFile = FreeFile
        Open sTempFolder & "dummy.html" For Output As #hFile
    Close #hFile

    '関連ファイルパスを取得
    sResult = Space$(MAX_PATH)
    dwFlagReturned = Api_FindExecutable("dummy.html", sTempFolder, sResult)
  
    '削除
    Kill sTempFolder & "dummy.html"
   
    GetBrowserName = TrimNull(sResult)
End Function

'================================================================
'=
'================================================================
Declare Function BuildCommandLine(sBrowser As String) As String
Function BuildCommandLine(sBrowser As String) As String
    sBrowser = LCase$(sBrowser)

    'internet explorer
    If InStr(sBrowser, "iexplore.exe") > 0 Then
        BuildCommandLine = " -nohome "
   
    'netscape 4.x
    Else If InStr(sBrowser, "netscape.exe") > 0 Then
        BuildCommandLine = " "

    'netscape 7.x
    Else If InStr(sBrowser, "netscp.exe") > 0 Then
        BuildCommandLine = " -url "
    Else
        BuildCommandLine = " "
    End If
End Function

'================================================================
'=
'================================================================
Declare Function StartNewBrowser(sURL As String) As Integer
Function StartNewBrowser(sURL As String) As Integer
    Var success As Long
    Var hProcess As Long
    Var sBrowser As String
    Var si As STARTUPINFO
    Var pi As PROCESS_INFORMATION
    Var sCmdLine As String

    sBrowser = GetBrowserName(success)

    If success >= ERROR_FILE_SUCCESS Then
        sCmdLine = BuildCommandLine(sBrowser)

        si.cb = Len(si)
        si.dwFlags = STARTF_USESHOWWINDOW
        si.wShowWindow = SW_SHOWNORMAL

        success = Api_CreateProcess(sBrowser, sCmdLine & sURL, ByVal 0, ByVal 0, ByVal 0, NORMAL_PRIORITY_CLASS, ByVal 0, ByVal 0, si, pi)

        StartNewBrowser = pi.hProcess <> 0
        Ret = Api_CloseHandle(pi.hProcess)
        Ret = Api_CloseHandle(pi.hThread)
    End If
End Function

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var sURL As String
   
    sURL = Edit1.GetWindowText

    If Not StartNewBrowser(sURL) Then
        A% = MessageBox("", "見つかりません！", 0, 2)
    End If
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End