熱點推薦:
您现在的位置: 電腦知識網 >> 編程 >> .NET編程 >> 正文

VB Shell調用後 等待程序運行結束

2013-11-13 09:41:48  來源: .NET編程 

  

  Private Declare Function OpenProcess Lib kernel (ByVal dwDesiredAccess As Long ByVal bInheritHandle As Long ByVal dwProcessId As Long) As Long

  Private Declare Function GetExitCodeProcess Lib kernel (ByVal hProcess As Long lpExitCode As Long) As Long

  Private Declare Function CloseHandle Lib kernel (ByVal hObject As Long) As Long

  Const PROCESS_QUERY_INFORMATION = &H

  Const STILL_ALIVE = &H

  Private Sub Command_Click()

  Dim pid As Long

  pid = Shell(c:\abat vbNormalFocus)

  hProcess = OpenProcess(PROCESS_QUERY_INFORMATION pid)

  Do

  Call GetExitCodeProcess(hProcess ExitCode)

  DoEvents

  Loop While ExitCode = STILL_ALIVE

  Call CloseHandle(hProcess)

  MsgBox (運行結束)

  End Sub

  摘自原文如下
       
  VB啟動/結束另一程序(Shell 等待程序運行結束)
 
  VB 中常以Shell指令來執行外部程式然而它在Create該外部process 後立刻就會回到vb 的下一行程式無法做到等待該Process結束時才執行下一行指令或是說無法得知該Process是否已結束甚者該Process執行到一半又該如何中止其執行等等這些都不是Shell指令所能控制的因此我們需使API的幫助來完成
 

  第一個問題如何等待shell所Create的process結束後才往後執行vb的程式
 
  首先要知道的是每個Process有唯一的一個ProcessID這是OS給定的用來區別每個 Process這個Process ID(PID)主要可用來取得該Process相對應的一些資訊然而要對該Process的控制卻大多透過 Process Handle(hProcess)VB Shell指令的傳回值是PID而非hProcess所以我們需透過OpenProcess這個API來取得 hProcess而OpenProcess()的第一個三數指的是所取得的hProcess所具有的能力像 PROCESS_QUERY_INFORMATION 便是讓GetExitCode()可取得hProcess所指的process之狀態而PROCESS_TERMINATE便是讓TerminateProcess(hProcess……)
 
  的指令能夠生效也就是說不同三數設定使hProcess所具有的權限能力有所不同取得 hProcess後便可以使用WaitForSingleObject()來等待hProcess狀態的改變也就是說它會等待 hProcess所指的process執行完這個指令才結束它第二個三數所指的是 WaitForSingleObject()所要等待的時間(in milliseconds )
 
  如果超過所指的時間就TimeOut而結束WaitForSingleObject()的等待若要它無限的等下去就設定為INFINvE           pid = Shell(C:\tools\spe\peexe vbNormalFocus)
        hProcess = OpenProcess(PROCESS_QUERY_INFORMATION pid)
        ExitEvent = WaitForSingleObject(hProcess INFINvE)
        Call CloseHandle(hProcess)

  上例會無限等待shell指令create之process結束後才再做後面的vb指令有時覺得那會等太久所以有第二個解決方式等process結束時再通知vb 就好設定一個公用變數(isDone)當它變成True時代表Shell所Create的Process已結束當Process還在執行時GetExitCodeProcess會傳&H給其第二個三數直到結束時才傳另外的數值如果程式正常結束那Exitcode = 否則就得看它如何結束了或許有人在其他地方看到 loop的地方是Loop while Exitcode <> 那有一點危險如果以這程子來看您不是用F來離開pe而是用右上方 X 的結束dos window那麽會因為ExitCode的值永遠不會是而進入無窮的回圈

            Dim pid As Long
        pid = Shell(C:\tools\spe\peexe vbNormalFocus)
        hProcess = OpenProcess(PROCESS_QUERY_INFORMATION pid)
        isDone = False
        Do
        Call GetExitCodeProcess(hProcess ExitCode)
        DebugPrint ExitCode
        DoEvents
        Loop While ExitCode = STILL_ALIVE
        Call CloseHandle(hProcess)
        isDone = True

  另外如果您的shell所Create的程式有視窗且為立刻Focus者可另外用以
        下的方式

      Dim pid As Long
        Dim hwnd As Long
        pid = Shell(c:\tools\spe\peexe vbNormalFocus)
        hwnd = GetForegroundWindow()
        isDone = False
        Do While IsWindow(hwnd)
        DoEvents
        Loop
        isDone = True

  而如何強迫shell所Create的process結束呢那便是         Dim aa As Long
        If hProcess <> Then
        aa = TerminateProcess(hProcess )
        End If

  hProcess便是先前的例子中所取得的那個Process Handle 所指的是傳給GetExitCodeProcess()中的第二三數這是我們任意給的但最好不要是因為一般是代表正常結束當然這樣設也不會有錯當然不可設&H以這個例子來看如果程式正處於以下的LOOP          Do
        Call GetExitCodeProcess(hProcess ExitCode)
        DebugPrint ExitCode
        DoEvents
        Loop While ExitCode = STILL_ALIVE
        Debugprint ExitCode
   而執行了 TerminateProcess(hProcess )那會看到ExitCode = 然而這個方式在win沒問題在NT中可能您要在OpenProcess()的第一個三數要更改成 PROCESS_QUERY_INFORMATION Or PROCESS_TERMINATE 這樣才能Work不過良心的建議非到最後關頭不要使用TerminateProcess()因不正常的結束往往許多程式結束前所要做的事都沒有做可能造成Resource的浪費甚者下次再執行某些程式時會有問題例如本人常使用MSdos Shell Link 的方式執行一程式透過Com port與大電腦的聯結如果Msdos Shell Link 不正常結束下次再想Link時會發現too Many Opens這便是一例
 
  另外有人使用Shell來執行bat檔pid = Shell(c\aabat vbNormalFocus)
 
  可是卻遇上aabat結束了但msdos的Window卻仍活著那可以用以下的方式來做pid = Shell(c\ /c c\aabat vbNormalFocus)
 
  那是執行而指定執行c\aabat 而且結束時自動Close所有程式如下          Private Declare Function OpenProcess Lib kernel _
        (ByVal dwDesiredAccess As Long ByVal bInheritHandle As Long _
        ByVal dwProcessId As Long) As Long

  Private Declare Function WaitForSingleObject Lib kernel _
        (ByVal hHandle As Long ByVal dwMilliseconds As Long) As Long
        Private Declare Function CloseHandle Lib kernel _
        (ByVal hObject As Long) As Long
        Private Declare Function GetExitCodeProcess Lib kernel _
        (ByVal hProcess As Long lpExitCode As Long) As Long
        Private Declare Function TerminateProcess Lib kernel _
        (ByVal hProcess As Long ByVal uExitCode As Long) As Long
        Private Declare Function GetForegroundWindow Lib user () As Long
        Private Declare Function IsWindow Lib user _
        (ByVal hwnd As Long) As Long

  Const PROCESS_QUERY_INFORMATION = &H
        Const STILL_ALIVE = &H
        Const INFINvE = &HFFFF

  Private ExitCode As Long
        Private hProcess As Long
        Private isDone As Long
        Private Sub Command_Click()
        Dim pid As Long
        pid = Shell(C:\tools\spe\peexe vbNormalFocus)
        hProcess = OpenProcess(PROCESS_QUERY_INFORMATION pid)
        isDone = False
        Do
        Call GetExitCodeProcess(hProcess ExitCode)
        DebugPrint ExitCode
        DoEvents
        Loop While ExitCode = STILL_ALIVE
        Call CloseHandle(hProcess)
        isDone = True
        End Sub

  Private Sub Command_Click()
        Dim pid As Long
        Dim ExitEvent As Long
        pid = Shell(C:\tools\spe\peexe vbNormalFocus)
        hProcess = OpenProcess(PROCESS_QUERY_INFORMATION pid)
        ExitEvent = WaitForSingleObject(hProcess INFINvE)
        Call CloseHandle(hProcess)
        End Sub

  Private Sub Command_Click()
        Dim aa As Long
        If hProcess <> Then
        aa = TerminateProcess(hProcess )
        End If

  End Sub

  Private Sub Command_Click()
        Dim pid As Long
        Dim hwnd As Long
        pid = Shell(c:\tools\spe\peexe vbNormalFocus)
        hwnd = GetForegroundWindow()
        isDone = False
        Do While IsWindow(hwnd)
        DoEvents
        Loop
        isDone = True
        End Sub

  Private Sub Command_Click()
        Dim pid As Long
        pid = Shell(c:\windows\command\xcopy c:\aabat a: vbHide)
        pid = Shell(c:\ /c c:\aabat vbNormalFocus)
        End Sub


        

  「Modest」

  在使用shell後如何等待此程序完成後程序才繼續執行我們使用 shell 調用一個外部程序的時候通常 vb(a) 會在調用之後繼續下面的語句而不管此 shell 程序執行完成沒有有時我們需要在此 shell 執行完成之後才繼續又當如何呢?
 
  請看源程

            Public Declare Function OpenProcess Lib kernel Alias OpenProcess (ByVal dwDesiredAccess As Long ByVal bInheritHandle As Long ByVal dwProcessId As Long) As Long
        Public Declare Function WaitForSingleObject Lib kernel Alias WaitForSingleObject (ByVal hHandle As Long ByVal dwMilliseconds As Long) As Long
        Public Declare Function CloseHandle Lib kernel Alias CloseHandle (ByVal hObject As Long) As Long
        Dim lngPId As Long
        Dim lngPHandle As Long
        lngPId = Shell(Notepad vbNormalFocus)
        lngPHandle = OpenProcess(SYNCHRONIZE lngpId)
        If lngPHandle <> Then
            Call WaitForSingleObject(lngPHandle INFINITE) 無限等待 直到程式結束
            Call CloseHandle(lngPHandle)
        End If

  需要注意的是在 shell 程序未完成前你的程序不能做任何事請小心為之

  ?boardid=&ID=

  【laviewpbt】:          Private Declare Function WaitForSingleObject Lib kernel (ByVal hHandle As Long ByVal dwMilliseconds As Long) As Long
        Private Declare Function CloseHandle Lib kernel (ByVal hObject As Long) As Long
        Private Declare Function ShellExecuteEx Lib shelldll Alias ShellExecuteExA (lpInfo As Any) As Long

  Private Type SHELLEXECUTEINFO
               cbSize  As Long
               fMask  As Long
               hwnd  As Long
               lpVerb  As String
               lpFile  As String
               lpParameters  As String
               lpDirectory  As String
               nShow  As Long
               hInstApp  As Long
                 Optional  members
               lpIDList  As Long
               lpClass    As String
               hkeyClass  As Long
               dwHotKey  As Long
               hIcon_OR_Monitor  As Long
               hProcess  As Long
        End Type

  Private Sub Form_Load()
            Dim si   As SHELLEXECUTEINFO
            sicbSize = Len(si)
            silpVerb = open
            silpFile = notepadexe
            silpParameters =
            silpDirectory =
            sinShow =             SW_SHOW
            sifMask = &H      SEE_MASK_NOCLOSEPROCESS
            ShellExecuteEx si
            If sihProcess <> Then
                WaitForSingleObject sihProcess &HFFFFFFFF        無限等待  直到程式結束
                CloseHandle sihProcess
                MsgBox 程序運行完畢!
            End If
        End Sub


From:http://tw.wingwit.com/Article/program/net/201311/11359.html
    推薦文章
    Copyright © 2005-2013 電腦知識網 Computer Knowledge   All rights reserved.