一个困扰我好久的问题

[gbabadboy]

我的TreeView控件，在单击某一个node时，在MyTreeView_NodeClick过程里会用shell调用一个外部程序，并用此程序的结果去初始化一个form。
每次单击node时都是好的，但当双击的时候会出现问题。本来node没有双击事件，程序应该等第一击运行结束后才相应第二击。但我的程序第一击运行到shell的部分时，在几秒的外部程序运行的时间里，会开始对第二击的相应，等第二击的程序运行完后再从第一击shell之后的部分继续运行，部分代码重复运行，产生错误，请问有没有什么方法禁止shell的时候对第二击的相应，此问题困扰我好久，希望大家帮助解答，多谢啦。

[vbman2003]

不允许第二次响应，可以用一个Boolean类型的变量来控制啊

[bxf]

同意楼上的

[gbabadboy]

能说的具体点吗？
加Boolean的方法我也试过，如果使第2击的运行中断，会影响第一击以后初始化form的过程

[rainstormmaster]

//请问有没有什么方法禁止shell的时候对第二击的相应

呵呵,典型的shell & wait问题:

Shell & Wait 的程序怎么写？

　　希望某一 VB 程序利用 Shell 执行某一个外部程序(假设是 notepad.exe)之后，就一直等到此一程序结束执行时， 才回到 VB 程序继续执行， 该怎么办到呢？

　　当我们调用 Shell 时， 会传回一个数值， 此一数值称为 Process Id， 利用此一 Process Id， 我们可以调用 OpenProcess API 取得 Process Handle， 然后再利用 Process Handle 调用 WaitForSingleObject， 即可等待被 Shell 执行的程序执行完毕， 才继续向下执行。细节如下：

　　1. API 的声明：

　　Const SYNCHRONIZE = &H100000
　　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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
　　Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal 　　dwMilliseconds As Long) As Long

　　注：如果以上的声明放在「一般模块」底下， 应将 Declare 之前的 Private 保留字去掉， 并且在 Const 之前加上 Public 保留字。

　　2. 程序范例：(以执行 Notepad 程序为例)

　　Dim pId As Long, pHnd As Long ' 分别声明 Process Id 及 Process Handle 变数

　　pId = Shell("Notepad", vbNormalFocus) ' Shell 传回 Process Id

　　pHnd = OpenProcess(SYNCHRONIZE, 0, pId) ' 取得 Process Handle
　　If pHnd <> 0 Then
　　Call WaitForSingleObject(pHnd, INFINITE) ' 无限等待，直到程序结束
　　Call CloseHandle(pHnd)
　　End If

[wumylove1234]

'*************************μ÷ó???3ì****************************************
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
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" _
(ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function IsWindow Lib "user32" _
(ByVal hwnd As Long) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function CreateProcessA Lib "kernel32" (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 lpCurrentDirectory As String, _
lpStartupInfo As STARTUPINFO, lpProcessInformation As _
PROCESS_INFORMATION) As Long

Const PROCESS_QUERY_INFORMATION = &H400
Const STILL_ALIVE = &H103
Const INFINITE = &HFFFF
Const USEREXIT = &HC000013A
Public Const SW_SHOWNORMAL = 1
Const NORMAL_PRIORITY_CLASS = &H20&

Private ExitCode As Long
Private hProcess As Long
Private isDone As Long

Public 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

Public Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
'?óê?TEXT???t
Public Function ReceiveTxt(myBillKind As BillKind) As Boolean
On Error Resume Next
Dim s As String
Dim tmpFileName As String
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim ret As Long
start.cb = Len(start)
Select Case myBillKind
Case BillKind.ioIn
tmpFileName = MyAppPath & I_IOSTOREIN
If Dir(tmpFileName) <> "" Then Kill tmpFileName
tmpFileName = MyAppPath & I_IOSTOREDETAILIN
If Dir(tmpFileName) <> "" Then Kill tmpFileName
tmpFileName = MyAppPath & I_IOSTOREPLACEIN
If Dir(tmpFileName) <> "" Then Kill tmpFileName
Case BillKind.ioOut
tmpFileName = MyAppPath & I_IOSTOREOUT
If Dir(tmpFileName) <> "" Then Kill tmpFileName
tmpFileName = MyAppPath & I_IOSTOREDETAILOUT
If Dir(tmpFileName) <> "" Then Kill tmpFileName
tmpFileName = MyAppPath & I_IOSTOREPLACEOUT
If Dir(tmpFileName) <> "" Then Kill tmpFileName
Case BillKind.ioMoneyOut
tmpFileName = MyAppPath & I_IOSTOREOUTMONEY
If Dir(tmpFileName) <> "" Then Kill tmpFileName
tmpFileName = MyAppPath & I_IOSTOREDETAILOUTMONEY
If Dir(tmpFileName) <> "" Then Kill tmpFileName
tmpFileName = MyAppPath & I_IOSTOREPLACEOUTMONEY
If Dir(tmpFileName) <> "" Then Kill tmpFileName
Case BillKind.Check
tmpFileName = MyAppPath & CHECKFILENAME
If Dir(tmpFileName) <> "" Then Kill tmpFileName
Case BillKind.CheckBegin
tmpFileName = MyAppPath & CHECKBEGINFILENAME
If Dir(tmpFileName) <> "" Then Kill tmpFileName
End Select
s = MyAppPath & "Receive\"
s = MyAppPath & "Download.exe -p1 -b19200 -i123456 -s " & s
' Dim Pid As Long
' Pid = Shell(s, vbNormalFocus)
' hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, Pid)
' Do
' Call GetExitCodeProcess(hProcess, ExitCode)
' Debug.Print ExitCode
' DoEvents
' Loop While ExitCode = STILL_ALIVE
' Call CloseHandle(hProcess)
ret& = CreateProcessA(vbNullString, s, 0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc)
ret& = WaitForSingleObject(proc.hProcess, INFINITE)
Call GetExitCodeProcess(proc.hProcess, ExitCode)
Call CloseHandle(proc.hThread)
Call CloseHandle(proc.hProcess)
If ExitCode = 0 Then 'μèóú0,?y3￡?óê????t
ReceiveTxt = True
Else
ReceiveTxt = False
End If
End Function

对这个问题不是很清楚,当初做的时候也是Copy一些代码,加以修改.发出来希望对你有帮助.



================业精于勤荒于嬉,形成于思毁于随=================

如果再给我一次爱的机会,我会好好的珍惜!

[Tiger_Zhao]

记录上次 click 时当前节点的 Key（或 Path），如果两次 Click 的 Key 相同则忽略

[gbabadboy]

to rainstormmaster(暴风雨 v2.0)
这样的话，问题就解决了。还有一点疑问，
我的程序以前用的是FindWindow(),并加入DoEvent,如下：

pId = Shell("Notepad")
Do While FindWindow(..., ...)
DoEvent
Loop

我试过只有删掉DoEvent你的那些code才好用，那么是否有方法能使WaitForSingleObject的功能和DoEvent的功能并存呢，听起来好像有点矛盾，呵呵