问一下关于API的问题，请高手。。。

[clxiao]

请大家帮一忙，我遇到的这样一个问题，OpenProcess总是得不到句柄，得到的始终是0。请斑竹帮一下忙。
源程序如下。
Rarexe = "C:\Program Files\WinRAR\WinRaR"
Source = "c:\test.txt"
Target = "c:\test.rar"

FileString = Rarexe & " A -pxcl.net " & Target & " " & Source
Result = Shell(FileString, vbHide)
While IsRunning(Result)
DoEvents
Wend
FileCopy "c:\test.rar", "d:\test.rar"
MsgBox "ok"

Function IsRunning(ByVal ProgramID) As Boolean '传入进程标识ID

Dim hProgram As Long '被检测的程序进程句柄
hProgram = OpenProcess(SYNCHRONIZE, False, ProgramID)

If hProgram <> 0 Then

IsRunning = True

Else

IsRunning = False

End If

CloseHandle hProgram

End Function

[supergreenbean]

Private Const SYNCHRONIZE = &H100000
写了么

[clxiao]

写了的呀？
再问一句这一句是有什么作用？

[goodname008]

楼主是想等文件压缩完以后再进行文件复制。
应该使用CreateProcess函数创建进程，这是标准的作法。
然后用WaitForSingleObject等待内核对象的signaled状态，在这里也就是说等待rar进程的结束。

[winehero]

楼上的不错，支持！

[goodname008]

Option Explicit

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 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 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 Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type

Private Const SW_SHOW = 5
Private Const STARTF_USESHOWWINDOW = &H1
Private Const INFINITE = &HFFFF ' Infinite timeout

Private Sub Command1_Click()
Dim stProcessInfo As PROCESS_INFORMATION
Dim stStartInfo As STARTUPINFO
stStartInfo.cb = LenB(stStartInfo)
stStartInfo.wShowWindow = SW_SHOW
stStartInfo.dwFlags = STARTF_USESHOWWINDOW

Dim strExe As String
strExe = "notepad.exe"

If False = CreateProcess(ByVal vbNullString, ByVal strExe, ByVal 0, ByVal 0, False, ByVal 0, ByVal 0, ByVal vbNullString, stStartInfo, stProcessInfo) Then
CloseHandle stProcessInfo.hThread
CloseHandle stProcessInfo.hProcess
MsgBox "启动进程失败!"
Exit Sub
End If

CloseHandle stProcessInfo.hThread
WaitForSingleObject stProcessInfo.hProcess, INFINITE
MsgBox ("记事本已经关闭!")

CloseHandle stProcessInfo.hProcess
End Sub

[goodname008]

调试时，会发现记事本运行起来以后，你的VB进程（也包括IDE环境）都不会再有任何响应了，因为调用进程的主线程被WaitForSingleObject阻塞住了。此时只有当关闭记事本以后，调用进程才会继续运行。
实际上最好的方法应该是在调用进程中创建一个线程，让该线程等待rar进程的结束，这样调用进程还可以响应用户操作。
但要用到多线程，而这却不是适合VB的。
所以......

[lbkbox]

楼主的这样的课题我也做过，楼主的问题，我也碰到过，我一开始也是用进程做，可是问题太多，最会出部问题，丢开线程吧。
但是我用如下的方法很地解决了：
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal ClassName As String, ByVal lpWindowName As String) As Long
Public Result As Long
Rarexe = "C:\Program Files\WinRAR\WinRaR.exe"
Source = "c:\test.txt"
Target = "c:\test.rar"
Result = 0
DoEvents
FileString = RarExe & " A " & Target & " " & Source
Result = Shell(FileString, vbHide)
'''开始在压缩吗？还未开始是就等待，否则就继承执行判断是否压缩完毕
Do Until Result <> 0
Sleep(1000)
Loop
'''以下是判断是否压缩完毕？？
If Result <> 0 Then ''如果Result=0说明压缩完成
Do Until Result = 0
Sleep (1000)
Result = FindWindow(vbNullString, "WinRAR")
Loop
End If

FileCopy "c:\test.rar", "d:\test.rar"
MsgBox "数据拷贝完毕"

[j_x_y]

同意 goodname008(卢培培，充电中．．．．．．)

[clxiao]

非常感谢，
谢谢