会员: 密码:  免费注册 | 忘记密码 | 会员登录 网页功能: 加入收藏 设为首页 网站搜索  
技术文档 > VB文档 > API函数
shell函数能以同步方式打开一个exe文件
发表日期:2003-12-09 00:00:00作者: 出处:  

方法一:

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 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

 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(vbNullString, cmdline$, 0&, 0&, 1&, _

    NORMAL_PRIORITY_CLASS, 0&, vbNullString, 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 "notepad Process Finished, Exit Code " & retval

   retval = ExecCmd("calc.exe")

   MsgBox "calc Process Finished, Exit Code " & retval

 End Sub

方法二:

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

Private Const SYNCHRONIZE = &H100000

Private Const INFINITE = &HFFFF   ' Infinite timeout

Private Const WAIT_TIMEOUT = &H102&

Public Function ShellForWait(sAppName As String, Optional ByVal lShowWindow As VbAppWinStyle = vbMinimizedFocus, Optional ByVal lWaitTime As Long = 0) As Boolean

  Dim lID As Long, lHnd As Long, lRet As Long

  On Error Resume Next

  lID = Shell(sAppName, lShowWindow)

  If lID > 0 Then

    lHnd = OpenProcess(SYNCHRONIZE, 0, lID)

    If lHnd <> 0 Then

      Do

        lRet = WaitForSingleObject(lHnd, lWaitTime)

        DoEvents

      Loop While lRet = WAIT_TIMEOUT

      CloseHandle lHnd

      ShellForWait = True

    Else

      ShellForWait = False

    End If

  Else

    ShellForWait = False

  End If

End Function

ShellForWait("notepad.exe",,&HFFFF)

方法三:

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

Private Const SYNCHRONIZE = &H100000  '进程同步

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

Private Const INFINITE = &HFFFFFFFF

Private Sub cmdOpen_Click()

  OpenFileWait "C;\windows\HH.exe ", "Help.chm"

End Sub

Private Sub OpenFileWait(tkShellFile As String, tkFileName As String)

  wndID = Shell(tkFileName, vbNormalFocus)

  wnd = OpenProcess(SYNCHRONIZE, 0, wndID)

  WaitForSingleObject wnd, INFINITE

  CloseHandle wnd

End Sub

返回顶部】 【打印本页】 【关闭窗口

关于我们 / 给我留言 / 版权举报 / 意见建议 / 网站编程QQ群   
Copyright ©2003- 2024 Lihuasoft.net webmaster(at)lihuasoft.net 加载时间 0.00461