vb程序中打开另一个程序的问题

Question

这个问题大家可能认为很简单。
我用
ExecuteFile 
ShellExecute
WinExec
shell 三个函数都打不开，用这三个函数可以打开一些小程序（在CMD窗口下可以打开的程序），但是打不开大的（在CMD窗口打不开的程序）。
用CreateProcess()可能可以打开，不过参数太多了。太麻烦。会的说下。
我只要打一个程序，并正常显示出来就行了。知道的给我写个VB代码。。 

Answer 1

 不急。是不是用CreateProcess函数？？？

Answer 2

以下是我写的一段测试代码，希望能给你帮忙。
Private Const CREATE_NEW_CONSOLE = &H10 '控制台程序
Private Const NORMAL_PRIORITY_CLASS = &H20 '一般优先级
Private Declare Sub GetStartupInfo Lib "kernel32" Alias "GetStartupInfoA" (lpStartupInfo As STARTUPINFO)
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName 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 lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private 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 TypePrivate Type PROCESS_INFORMATION
        hProcess As Long
        hThread As Long
        dwProcessId As Long
        dwThreadId As Long
End TypeSub main()
    Dim stStartUp As STARTUPINFO
    Dim stProcInfo As PROCESS_INFORMATION
    
    stStartUp.cb = Len(STARTUPINFO)
    GetStartupInfo stStartUp
    CreateProcess vbNullString, "D:\WINDOWS\SYSTEM32\NOTEPAD.EXE", 0&, 0&, 0&, NORMAL_PRIORITY_CLASS, 0&, vbNullString, stStartUp, stProcInfo
End Sub

Answer 3

Const INFINITE = &HFFFF
Const STARTF_USESHOWWINDOW = &H1
Private Enum enSW
    SW_HIDE = 0
    SW_NORMAL = 1
    SW_MAXIMIZE = 3
    SW_MINIMIZE = 6
End Enum
Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId As Long
End Type
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 Byte
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type
Private Enum enPriority_Class
    NORMAL_PRIORITY_CLASS = &H20
    IDLE_PRIORITY_CLASS = &H40
    HIGH_PRIORITY_CLASS = &H80
End Enum
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As LongPrivate Sub Command1_Click()
   On Error GoTo errhandler
   With CommonDialog1
      .DialogTitle = "请选择一个文件"
      .CancelError = True
      .Filter = "EXEC-Files (*.exe)|*.exe|All files (*.*)|*.*"
      .ShowOpen
   End With
   SuperShell CommonDialog1.FileName, Left$(CommonDialog1.FileName, Len(CommonDialog1.FileName) - Len(CommonDialog1.FileTitle)), 0, SW_NORMAL, HIGH_PRIORITY_CLASS
errhandler:
   If Err > 0 Then Exit Sub
End SubPrivate Function SuperShell(ByVal App As String, ByVal WorkDir As String, dwMilliseconds As Long, ByVal start_size As enSW, ByVal Priority_Class As enPriority_Class) As Boolean
   Dim pclass As Long
   Dim sinfo As STARTUPINFO
   Dim pinfo As PROCESS_INFORMATION
   Dim sec1 As SECURITY_ATTRIBUTES
   Dim sec2 As SECURITY_ATTRIBUTES
   sec1.nLength = Len(sec1)
   sec2.nLength = Len(sec2)
   sinfo.cb = Len(sinfo)
   sinfo.dwFlags = STARTF_USESHOWWINDOW
   sinfo.wShowWindow = start_size
   pclass = Priority_Class
   If CreateProcess(vbNullString, App, sec1, sec2, False, pclass, 0&, WorkDir, sinfo, pinfo) Then
       WaitForSingleObject pinfo.hProcess, dwMilliseconds
       SuperShell = True
   Else
       SuperShell = False
   End If
End Function

Answer 4

;这是一个用CreateProcess API创建一个进程，并将设置新进程窗口的示例Option Explicit      Private Type PROCESS_INFORMATION
         hProcess As Long
         hThread As Long
         dwProcessId As Long
         dwThreadId As Long
      End Type      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 Declare Function CreateProcess Lib "kernel32" _
         Alias "CreateProcessA" _
         (ByVal lpApplicationName As String, _
         ByVal lpCommandLine As String, _
         lpProcessAttributes As Any, _
         lpThreadAttributes As Any, _
         ByVal bInheritHandles As Long, _
         ByVal dwCreationFlags As Long, _
         lpEnvironment As Any, _
         ByVal lpCurrentDriectory As String, _
         lpStartupInfo As STARTUPINFO, _
         lpProcessInformation As PROCESS_INFORMATION) As Long      Private Declare Function OpenProcess Lib "kernel32.dll" _
         (ByVal dwAccess As Long, _
         ByVal fInherit As Integer, _
         ByVal hObject As Long) As Long      Private Declare Function TerminateProcess Lib "kernel32" _
         (ByVal hProcess As Long, _
         ByVal uExitCode As Long) As Long      Private Declare Function CloseHandle Lib "kernel32" _
         (ByVal hObject As Long) As Long      Const SYNCHRONIZE = 1048576
      Const NORMAL_PRIORITY_CLASS = &H20&
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Sub Command1_Click()
         Dim pInfo As PROCESS_INFORMATION
         Dim sInfo As STARTUPINFO
         Dim sNull As String
         Dim lSuccess As Long
         Dim lRetValue As Long
                  sInfo.cb = Len(sInfo)
         lSuccess = CreateProcess(sNull, _
                                 "c:\windows\system32\notepad.exe", _
                                 ByVal 0&, _
                                 ByVal 0&, _
                                 1&, _
                                 NORMAL_PRIORITY_CLASS, _
                                 ByVal 0&, _
                                 sNull, _
                                 sInfo, _
                                 pInfo)
        
        Dim s As Double
        s = Timer
        Do
            DoEvents
            'Debug.Print pInfo.dwProcessId; pInfo.dwThreadId;
        Loop While Timer - s < 0.4
        
        start = 0
                                 
        EnumThreadWindows pInfo.dwThreadId, AddressOf EnumThreadWndProc, 0
        
        'Debug.Print h
        'Debug.Print Hex$(thehwnd)
        
        SetWindowPos thehwnd, 0, 0, 0, 400, 100, 0
                                 
        'pinfo.         'MsgBox "Calculator has been launched!"         'lRetValue = TerminateProcess(pInfo.hProcess, 0&)
         'lRetValue = CloseHandle(pInfo.hThread)
         'lRetValue = CloseHandle(pInfo.hProcess)         'MsgBox "Calculator has terminated!"
End Sub
;模块中Option Explicit
'In a module
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Public Declare Function EnumThreadWindows Lib "user32" (ByVal dwThreadId As Long, ByVal lpfn As Long, ByVal lParam As Long) As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
'variable used to list all the classnames
Public sClasses As String
Public start As Long
Public thehwnd As Long
Public Function EnumThreadWndProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
    Dim Ret As Long, sText As String
    
    If start = 0 Then
        thehwnd = hWnd
    End If
    start = start + 1
    'create a string-buffer
    sText = Space(255)
    'get the classname of the window handle
    Ret = GetClassName(hWnd, sText, 255)
    'cut off the unnecessary part of Chr$(0)'s
    sText = Left$(sText, Ret)
    'add this classname to the list of classnames
    sClasses = sClasses + sText + vbCrLf
    'continue the enumeration
    EnumThreadWndProc = 1
End Function

Answer 5

 Dim Doub As Double
            Doub = Shell(程序路径+名字, vbNormalFocus)

Answer 6

唉。还是不行。
cmd窗口。指系统命令：cmd
有些程序可以用这三个函数打开，有些就打不开。
我试过，打计算器，记事本之类的没问题。
我要打开的是：武林外传的客户端，用上面三个函数打出错。提示：
“无法创建gamesave目录，游戏无法运行！
请确保硬盘有足够的剩余空间再运行本游戏！”大家说这是什么问题，
这个程序在CMD窗口下也可以打开，昨天我输入的全路径不行，要转换到游戏目录下，在运行就能打开了。

Answer 7

现在我先建个批处理文件，在批处理文件中打开游戏程序，在VB中调用SHELL打开这个批处理文件。。这样能凑合着用。

Answer 8

你这跟本不是 cmd 或 shell 打不开文件的问题, exe 那有打不开的道理 ? 这是你的代码路径设置访问出错的问题,而不是 cmd shell....等的错.

Answer 9

path 环境有问题 ，你调用和appPath就变成了父进程的path，然后他就找不到北了，createProcess的时候记得设置程序的起始目录到程序目录下

Answer 10

谢谢各位：
我用“三春三月忆三巴”写的代码。
不过问题还是：barenx 说的清楚。
我太菜，大家不要笑话。。

Answer 11

没玩过这个游戏，请楼主查看一下执行文件的扩展名，如果是.EXE，则可以将我上面回复的示例代码中的有关语句修改如下：
CreateProcess vbNullString, "D:\WINDOWS\SYSTEM32\NOTEPAD.EXE", 0&, 0&, 0&, NORMAL_PRIORITY_CLASS, 0&, "D:\WINDOWS\SYSTEM", stStartUp, stProcInfo
即加上程序的当前路径。
如果是.BAT，则需要指向新的环境变量块。
请楼主看看扩展名究竟是什么。