vb程序中打开另一个程序的问题
这个问题大家可能认为很简单。我用
ExecuteFile
ShellExecute
WinExec
shell 三个函数都打不开，用这三个函数可以打开一些小程序（在CMD窗口下可以打开的程序），但是打不开大的（在CMD窗口打不开的程序）。
用CreateProcess()可能可以打开，不过参数太多了。太麻烦。会的说下。
我只要打一个程序，并正常显示出来就行了。知道的给我写个VB代码。。 --------------------编程问答-------------------- 俺有个示例代码，不过在公司的机器上，不急的话明天早晨给你。
--------------------编程问答-------------------- 不急。是不是用CreateProcess函数？？？ --------------------编程问答-------------------- 什么程序用shell等打不开？ --------------------编程问答-------------------- 以下是我写的一段测试代码，希望能给你帮忙。
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 Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Sub 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
--------------------编程问答-------------------- 先过来看看！原来还有打不开的比较大的调用程序! --------------------编程问答-------------------- 看看 --------------------编程问答-------------------- 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 Long
Private 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 Sub
Private 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
--------------------编程问答--------------------
"在CMD窗口打不开的程序"这句我看了三遍,还是没明白你说的是什么样的程序.
除非这程序根本就不能执行,否则一定是可以打开的吧......
你这又不是初始目录的问题.
有点糊涂,还是帮顶吧. --------------------编程问答-------------------- ;这是一个用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--------------------编程问答-------------------- Dim Doub As Double
'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
Doub = Shell(程序路径+名字, vbNormalFocus) --------------------编程问答-------------------- 唉。还是不行。
cmd窗口。指系统命令：cmd
有些程序可以用这三个函数打开，有些就打不开。
我试过，打计算器，记事本之类的没问题。
我要打开的是：武林外传的客户端，用上面三个函数打出错。提示：
“无法创建gamesave目录，游戏无法运行！
请确保硬盘有足够的剩余空间再运行本游戏！”
大家说这是什么问题，
这个程序在CMD窗口下也可以打开，昨天我输入的全路径不行，要转换到游戏目录下，在运行就能打开了。
--------------------编程问答-------------------- 现在我先建个批处理文件，在批处理文件中打开游戏程序，在VB中调用SHELL打开这个批处理文件。。这样能凑合着用。
--------------------编程问答-------------------- 你这跟本不是 cmd 或 shell 打不开文件的问题, exe 那有打不开的道理 ? 这是你的代码路径设置访问出错的问题,而不是 cmd shell....等的错. --------------------编程问答-------------------- 亦或是缺少运行参数 --------------------编程问答--------------------
我汗!!!!!!!!!!!!!!!!!
你这根本就是程序初始目录的问题嘛!!!!!
问问题前说清楚点好不????
运行程序时传入初始目录就可以了!!!
倒塌~~~~~~~~~~ --------------------编程问答-------------------- path 环境有问题 ，你调用和appPath就变成了父进程的path，然后他就找不到北了，createProcess的时候记得设置程序的起始目录到程序目录下 --------------------编程问答-------------------- 谢谢各位：
我用“三春三月忆三巴”写的代码。
不过问题还是：barenx 说的清楚。
我太菜，大家不要笑话。。。。。。。。 --------------------编程问答-------------------- 老马来讲讲初始目录的知识吧。 --------------------编程问答-------------------- 没玩过这个游戏，请楼主查看一下执行文件的扩展名，如果是.EXE，则可以将我上面回复的示例代码中的有关语句修改如下：
CreateProcess vbNullString, "D:\WINDOWS\SYSTEM32\NOTEPAD.EXE", 0&, 0&, 0&, NORMAL_PRIORITY_CLASS, 0&, "D:\WINDOWS\SYSTEM", stStartUp, stProcInfo
即加上程序的当前路径。
如果是.BAT，则需要指向新的环境变量块。
请楼主看看扩展名究竟是什么。 --------------------编程问答-------------------- 有点难度哦
补充：VB , API
