多线程等待同步问题.

Question

我有一个自动压缩和上传到服务器的程序要写:
For n = 1 To 207 '这儿是把所有的文件都循环一下
  If Check1(n - 1).Visible And Check1(n - 1).Value = 1 Then  '这儿是被选定的文件
    rarpath = App.Path + "\winrar.exe"  'winrar的路径
    ShellEx rarpath & " a -r " & App.Path & "\" & Date & ".rar " & " " & App.Path & "\" & Check1(n - 1).ToolTipText & "\*.* "  '压缩选定的文件
  End If
Next
'这儿结束后有一个问题了,就是压缩会很慢,程序完成时压缩还在进行中,用什么样的等待让它往后的运行正常进行?
    path1 = App.Path & "\" & Date & ".rar" '需要上传的压缩文件路径
Set vDoc = WebBrowser1.Document
For i = 0 To vDoc.All.Length - 1 '检测所有标签
If UCase(vDoc.All(i).tagName) = "INPUT" Then '找到input标签
  Set vtag = vDoc.All(i)
  If vtag.Name = "file1" Then
    Clipboard.SetText path1
    vtag.Focus
    Call keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0)
    Call keybd_event(vbKeyV, MapVirtualKey(vbKeyV, 0), 0, 0)
    Call keybd_event(vbKeyV, MapVirtualKey(vbKeyV, 0), KEYEVENTF_KEYUP, 0)
    Call keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KEYEVENTF_KEYUP, 0) '这四句把文件复制到上传文件框中
  End If
End If
Next
'到这儿结束都没有问题,也就是差最后一步提交了,但如果把下面标记掉的语句打开,复制就不会完成,也就是提交时会是一个空的内容.用什么样的等待让它能提交掉?
'For i = 0 To vDoc.All.Length - 1 '检测所有标签
'If UCase(vDoc.All(i).tagName) = "INPUT" Then '找到input标签
'  Set vtag = vDoc.All(i)
'  If vtag.Name = "Submit" Then
'    vtag.Select '光标指定
'    vtag.Click '点击提交了
'  End If
'End If
'Next
'如果标记掉上面内容,文件框内有内容,如果不标记掉就没有内容.

Answer 1

 Set fs = CreateObject("Scripting.FileSystemObject")
  Set tsob = fs.CreateTextFile(App.Path + "\winrar.bat", True)
  lst = "cd\" + App.Path
  tsob.Writeline lst
For n = 1 To 207
  If Check1(n - 1).Visible And Check1(n - 1).Value = 1 Then
  lst = "winrar.exe a -r " & Date & ".rar " & Check1(n - 1).ToolTipText & "\zrsl.mdb"
  tsob.Writeline lst
  End If
Next
  Set tsob = Nothing
Set oScript = CreateObject("WSCRIPT.SHELL")
oScript.Run App.Path & "\winrar.bat"
mp = 0
    path1 = App.Path & "\" & Date & ".rar"
Do Until fs.fileExists(path1)
  Sleep (200)
  mp = mp + 1
  If mp > 50 Then Exit Do
Loop
  If Not fs.fileExists(path1) Then
    MsgBox "请先选中要上传的项目并压缩后再上传!" & Chr(13) & "或手动选择已有的压缩文件后上传!"
    Exit Sub
  End If
Set vDoc = WebBrowser1.Document
For i = 0 To vDoc.All.Length - 1 '检测所有标签
If UCase(vDoc.All(i).tagName) = "INPUT" Then '找到input标签
  Set vtag = vDoc.All(i)
  If vtag.Name = "file1" Then
    vtag.Focus
    vtag.Select
    Clipboard.Clear
    Clipboard.SetText path1
    Call keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0)
    Call keybd_event(vbKeyV, MapVirtualKey(vbKeyV, 0), 0, 0)
    Call keybd_event(vbKeyV, MapVirtualKey(vbKeyV, 0), KEYEVENTF_KEYUP, 0)
    Call keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KEYEVENTF_KEYUP, 0)
  End If
End If
Next我使用上述等待的方法,但是好怪,这个复制到上传文件框内的操作就是不执行!
但只要这个文件在压缩前已经存在,它就可以复制过去.
真的好怪!郁闷!

Answer 2

一般用createprocess来创建进程，并用waitforsingleobject指令来等待他结束，waitforsingleobject可以wait无限时间会造成主程序无响应，解决方法就是多次wait，每次wait一小段时间，比如50ms，并判断wait结果是否超时，如果超时表明进程没有结束，应该继续wait，并用doevents来响应系统。

Answer 3

真的好怪
话说你不要用复制粘贴
试试这个，我根据web开发的经验写的，不知道能不能成功
If   vtag.Name   =   "file1"   Then 
vtag.value=path1
End   If 
至于同步的问题，可以定义一个事件，在压缩完成的时候，cmd应该有写什么压缩完成之类的咯，这个时候捕捉到然后raiseevent，在没有发生事件时把所有控件的enable设置成false，等压缩完了再恢复

Answer 4

no1gentlebreeze:
哈哈,要能这样,我就不必画蛇添足了,你最好试一下,这样是行不通的.
因为我的是文件格式,不是text格式的inputjennyvenus:
可以给一个类似的例子吗?

Answer 5

       vtag.Focus 
        vtag.Select 
        Clipboard.Clear 
        Clipboard.SetText   path1 
        Call   keybd_event(VK_CONTROL,   MapVirtualKey(VK_CONTROL,   0),   0,   0) 
        Call   keybd_event(vbKeyV,   MapVirtualKey(vbKeyV,   0),   0,   0) 
        Call   keybd_event(vbKeyV,   MapVirtualKey(vbKeyV,   0),   KEYEVENTF_KEYUP,   0) 
        Call   keybd_event(VK_CONTROL,   MapVirtualKey(VK_CONTROL,   0),   KEYEVENTF_KEYUP,   0) 这个不就是把一个路径字符串复制到input标记里么
怎么是文件格式呢

Answer 6

vb的createprocess+waitforsingleobject例子你自己从网上找吧。

Answer 7

no1gentlebreeze :实践出真知.

Answer 8

<input type="file" name="file1" value="" size="40" onclick="this.select();"/>
没见过文件格式的input吗?给你一个例子吧.

Answer 9

input   type="file"的value是不能赋值的……lz不过你也没讲清楚……

Answer 10

doevents
'For   i   =   0   To   vDoc.All.Length   -   1   '检测所有标签 
'If   UCase(vDoc.All(i).tagName)   =   "INPUT"   Then   '找到input标签 
'     Set   vtag   =   vDoc.All(i) 
'     If   vtag.Name   =   "Submit"   Then 
'         vtag.Click   '点击提交了 
'     End   If 
'End   If 
'Next 
试一下
前面哪个用jennyvenus 说的吧