VB 能不能让代码暂停执行一下,小问题求高手
问题描述:我调用一个程序进行计算,这个程序会计算一段时间,然后会生成若干文件Flac=Shell(appdisk&"FLAC3D3.0.261"&"\f3300.exe"...
问题描述:
我调用一个程序进行计算,这个程序会计算一段时间,然后会生成若干文件
Flac = Shell(appdisk & "FLAC3D3.0.261" & "\f3300.exe", vbNormalFocus)
然后我再读取生成的文件
Open appdisk & "jieguo" & CStr(f(i)) & ".txt" For Input As #h(i)
事实是当程序运行时,先调这个程序然后就开始读取文件,然而这个文件还么有生成,有没有办法让这个程序运行计算生成指定的文件后,再让他读取。就是如果不生成这个文件,就不进行下面代码的执行,,有没有好的办法 展开
我调用一个程序进行计算,这个程序会计算一段时间,然后会生成若干文件
Flac = Shell(appdisk & "FLAC3D3.0.261" & "\f3300.exe", vbNormalFocus)
然后我再读取生成的文件
Open appdisk & "jieguo" & CStr(f(i)) & ".txt" For Input As #h(i)
事实是当程序运行时,先调这个程序然后就开始读取文件,然而这个文件还么有生成,有没有办法让这个程序运行计算生成指定的文件后,再让他读取。就是如果不生成这个文件,就不进行下面代码的执行,,有没有好的办法 展开
展开全部
shell是异步运行的,就是说它运行后不会等待被调用的程序执行完毕,而是继续执行下面的其他程序。这样就会使下面的语句无法同步获得被调用程序的运行结果。
建议不要用shell,改用下面的,就可以实现同步运行:
CreateObject("WScript.Shell").run appdisk & "FLAC3D3.0.261" & "\f3300.exe",0,True
Open appdisk & "jieguo" & CStr(f(i)) & ".txt" For Input As #h(i)
建议不要用shell,改用下面的,就可以实现同步运行:
CreateObject("WScript.Shell").run appdisk & "FLAC3D3.0.261" & "\f3300.exe",0,True
Open appdisk & "jieguo" & CStr(f(i)) & ".txt" For Input As #h(i)
展开全部
给你完善了一下,在f3300.exe生成的同时处理文件,不必完全等运行完再处理,可节省时间,代码如下,请自行按情况完善
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const STILL_ALIVE = &H103
Private Sub Command1_Click()
ReadFiles '启动代码,开始执行并读取文件
End Sub
Function ReadFiles()
Dim hProcess As Long, i As Long
hProcess = MyShell(appdisk & "FLAC3D3.0.261" & "\f3300.exe") '调用程序并获得进程句柄
Do While Not IsCallEnd(hProcess) '如果外部程序正在运行,则同步依次读取文件
ReadFileWait i '按文件编号读取文件直到读取成功
i = i + 1 '读取下一个文件,文件编号递增,不知道你是不是这个意思
Loop
Call CloseHandle(hProcess)
End Function
Function MyShell(ByVal CallExe As String) As Long '调用程序并获得进程句柄
Dim pid As Long
pid = shell(CallExe, vbNormalFocus) '你原来的shell语句放在这里了
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid)
End Function
Function IsCallEnd(hProcess) As Boolean '检测程序是否结束,结束返回ture
Call GetExitCodeProcess(hProcess, ExitCode)
IsCallEnd = (ExitCode = STILL_ALIVE)
End Function
Private Sub ReadFileWait(ByVal i As Long) '读取文件直到读取成功
On Error Resume Next
ReadStar:
Err.Clear
'不明白为什么你要打开所有文件后操作,vb 最多只能同时打开255个文件句柄
Open appdisk & "jieguo" & CStr(f(i)) & ".txt" For Input As #h(i) '你原来的读取语句
'完成一个再一个不好吗,类似改成下面的
'Open appdisk & "jieguo" & CStr(f(i)) & ".txt" For Input As #1
'Input #1, mydata
'Close #1
If Err.Number <> 0 Then '打开失败
For i = 1 To 10: Sleep 100: DoEvents: Next '延时1000毫秒,避免频繁读取磁盘
GoTo ReadStar '如果打开失败表示文件没有生成或正在生成,跳转到开始重试打开文件
End If
On Error GoTo 0
End Sub
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const STILL_ALIVE = &H103
Private Sub Command1_Click()
ReadFiles '启动代码,开始执行并读取文件
End Sub
Function ReadFiles()
Dim hProcess As Long, i As Long
hProcess = MyShell(appdisk & "FLAC3D3.0.261" & "\f3300.exe") '调用程序并获得进程句柄
Do While Not IsCallEnd(hProcess) '如果外部程序正在运行,则同步依次读取文件
ReadFileWait i '按文件编号读取文件直到读取成功
i = i + 1 '读取下一个文件,文件编号递增,不知道你是不是这个意思
Loop
Call CloseHandle(hProcess)
End Function
Function MyShell(ByVal CallExe As String) As Long '调用程序并获得进程句柄
Dim pid As Long
pid = shell(CallExe, vbNormalFocus) '你原来的shell语句放在这里了
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid)
End Function
Function IsCallEnd(hProcess) As Boolean '检测程序是否结束,结束返回ture
Call GetExitCodeProcess(hProcess, ExitCode)
IsCallEnd = (ExitCode = STILL_ALIVE)
End Function
Private Sub ReadFileWait(ByVal i As Long) '读取文件直到读取成功
On Error Resume Next
ReadStar:
Err.Clear
'不明白为什么你要打开所有文件后操作,vb 最多只能同时打开255个文件句柄
Open appdisk & "jieguo" & CStr(f(i)) & ".txt" For Input As #h(i) '你原来的读取语句
'完成一个再一个不好吗,类似改成下面的
'Open appdisk & "jieguo" & CStr(f(i)) & ".txt" For Input As #1
'Input #1, mydata
'Close #1
If Err.Number <> 0 Then '打开失败
For i = 1 To 10: Sleep 100: DoEvents: Next '延时1000毫秒,避免频繁读取磁盘
GoTo ReadStar '如果打开失败表示文件没有生成或正在生成,跳转到开始重试打开文件
End If
On Error GoTo 0
End Sub
本回答被提问者采纳
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
参看这段代码
Private Const SYNCHRONIZE = &H100000
Private Const INFINITE = &HFFFFFFFF
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Dim lngPId As Long
Dim lngPHandle As Long
lngPId = Shell("notepad.exe", vbHide)
lngPHandle = OpenProcess(SYNCHRONIZE, 0, lngPId)
If lngPHandle <> 0 Then
Call WaitForSingleObject(lngPHandle, INFINITE) '无限等待,直到程式结束
Call CloseHandle(lngPHandle)
End If
参见:blog.csdn.net/zhongyhc/article/details/6613494
追问
使用这样的方法会导致程序么有响应,调用的exe程序可以继续运行,自己编写的那个程序出现么有响应,这是怎么回事
追答
它在等待你的程序结束,你调用的程序结束了,他就会恢复响应。
如果你觉得这种不合理,那你可以将你后续打开结果文件的操作放置在 timer 里,shellexcute 启动后,你启动 timer ,然后 timer 判定结果文件是否生成是否符号要求,符合要求处理完了再把自己 disable 。
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
这就是shell函数的敝端了,改用createprocess,判断返回值不等于0。
但是看上去,貌仅你的f(i).txt是由f3300.exe生成的?这样的话,只能加延时并循环判断了。
dim n as long
do until n>10 '循环的延时的时间
if dir(appdisk & "\jieguo\" & CStr(f(i)) & ".txt")="" then '这里注意斜杠
sleep 1000 ‘每次延时1秒
end if
n=n+1
loop
但是看上去,貌仅你的f(i).txt是由f3300.exe生成的?这样的话,只能加延时并循环判断了。
dim n as long
do until n>10 '循环的延时的时间
if dir(appdisk & "\jieguo\" & CStr(f(i)) & ".txt")="" then '这里注意斜杠
sleep 1000 ‘每次延时1秒
end if
n=n+1
loop
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
直接
sleep 30000 30秒够了吗
sleep 30000 30秒够了吗
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询