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 Declare Function WaitForSingleObject Lib "kernel32" (ByVal _ hHandle As Long, ByVal dwMilliseconds As Long) As Long Private Declare Function CreateProcessA Lib "kernel32" (ByVal _ lpApplicationName As Long, 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 Long, _ lpStartupInfo As STARTUPINFO, lpProcessInformation As _ PROCESS_INFORMATION) 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 Const NORMAL_PRIORITY_CLASS = &H20& Private Const INFINITE = -1& Public Function ExecCmd(cmdline$) Dim proc As PROCESS_INFORMATION Dim start As STARTUPINFO ' Initialize the STARTUPINFO structure: start.cb = Len(start) ' Start the shelled application: ret& = CreateProcessA(0&, cmdline$, 0&, 0&, 1&, _ NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc) ' Wait for the shelled application to finish: ret& = WaitForSingleObject(proc.hProcess, INFINITE) Call GetExitCodeProcess(proc.hProcess, ret&) Call CloseHandle(proc.hThread) Call CloseHandle(proc.hProcess) ExecCmd = ret& End Function Sub Form_Click() Dim retval As Long retval = ExecCmd("notepad.exe") MsgBox "Process Finished, Exit Code " & retval End Sub
Option ExplicitDim ARJnumber As Integer Dim TRetry As Integer Dim TMaxtry As Integer Dim Parameter(3) As String Dim Unarj_code Dim f10str1 Dim tppp Private Const NORMAL_PRIORITY_CLASS = &H20& Private Const WAIT_INFINITE = -1&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 Long cbReserved2 As Long lpReserved2 As Long hStdInput As Long hStdOutput As Long hStdError As Long End TypePrivate Type PROCESS_INFORMATION hProcess As Long hThread As Long dwProcessId As Long dwThreadID As Long End TypePrivate Declare Function CreateProcess Lib "kernel32" _ Alias "CreateProcessA" _ (ByVal lpAppName As Long, _ 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 Long, _ 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 Function RunProcess(cmdline As String) As Boolean Dim proc As PROCESS_INFORMATION Dim start As STARTUPINFO On Error GoTo ProcErr RunProcess = True 'Initialize the STARTUPINFO structure by 'passing to start the size of the STARTUPINFO 'type. Setting the .cb member is the only 'item of the structure needed to launch the program start.cb = Len(start)
'Wait for the application to finish Call WaitForSingleObject(proc.hProcess, WAIT_INFINITE)
'Close the handle to the process Call CloseHandle(proc.hProcess) 'Close the handle to the thread created Call CloseHandle(proc.hThread)
'MsgBox "The Shelled process " & cmdline & " has ended." RunProcess = False Exit Function ProcErr: RunProcess = True Exit Function End Function在程序中我是用 ARJcode = RunProcess(Parameter(0) & "arj.exe x -y " & Parameter(1) & "*.arj" & " " & Parameter(2)) 和API联系的!
我记得发回复过你以下代码,不能用吗?用此过程可以同步执行外部程序的。 Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Public Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As LongSub ShellWait(sCommandLine As String) '等到外部程序执行完成 Dim hShell As Long, hProc As Long, lExit As Long hShell = Shell(sCommandLine, vbHide) '此处即隐藏命令窗口 hProc = OpenProcess(&H400, False, hShell) Do GetExitCodeProcess hProc, lExit DoEvents Loop While lExit = &H103 End Sub
而且我每次调用你的那段代码的时候都是 Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId 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 Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
hHandle As Long, ByVal dwMilliseconds As Long) As Long Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As Long, 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 Long, _
lpStartupInfo As STARTUPINFO, lpProcessInformation As _
PROCESS_INFORMATION) 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 Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1& Public Function ExecCmd(cmdline$)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO ' Initialize the STARTUPINFO structure:
start.cb = Len(start) ' Start the shelled application:
ret& = CreateProcessA(0&, cmdline$, 0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
' Wait for the shelled application to finish:
ret& = WaitForSingleObject(proc.hProcess, INFINITE)
Call GetExitCodeProcess(proc.hProcess, ret&)
Call CloseHandle(proc.hThread)
Call CloseHandle(proc.hProcess)
ExecCmd = ret&
End Function Sub Form_Click()
Dim retval As Long
retval = ExecCmd("notepad.exe")
MsgBox "Process Finished, Exit Code " & retval
End Sub
Dim TRetry As Integer
Dim TMaxtry As Integer
Dim Parameter(3) As String
Dim Unarj_code
Dim f10str1
Dim tppp
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const WAIT_INFINITE = -1&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 Long
cbReserved2 As Long
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End TypePrivate Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadID As Long
End TypePrivate Declare Function CreateProcess Lib "kernel32" _
Alias "CreateProcessA" _
(ByVal lpAppName As Long, _
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 Long, _
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 Function RunProcess(cmdline As String) As Boolean Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
On Error GoTo ProcErr
RunProcess = True
'Initialize the STARTUPINFO structure by
'passing to start the size of the STARTUPINFO
'type. Setting the .cb member is the only
'item of the structure needed to launch the program
start.cb = Len(start)
'Start the application
Call CreateProcess(0&, cmdline, 0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, 0&, 0&, _
start, proc)
'Wait for the application to finish
Call WaitForSingleObject(proc.hProcess, WAIT_INFINITE)
'Close the handle to the process
Call CloseHandle(proc.hProcess) 'Close the handle to the thread created
Call CloseHandle(proc.hThread)
'MsgBox "The Shelled process " & cmdline & " has ended."
RunProcess = False
Exit Function
ProcErr:
RunProcess = True
Exit Function
End Function在程序中我是用
ARJcode = RunProcess(Parameter(0) & "arj.exe x -y " & Parameter(1) & "*.arj" & " " & Parameter(2))
和API联系的!
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As LongSub ShellWait(sCommandLine As String) '等到外部程序执行完成
Dim hShell As Long, hProc As Long, lExit As Long
hShell = Shell(sCommandLine, vbHide) '此处即隐藏命令窗口
hProc = OpenProcess(&H400, False, hShell)
Do
GetExitCodeProcess hProc, lExit
DoEvents
Loop While lExit = &H103
End Sub
hProc=openprocess(&H400,False,hShell)
这里面好象不能用False,因为你定义的是Long啊!
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
这句话出错啊!