form1.frm

这个源代码主要模仿了一个类似 深度操作系统安装程序中的一个软件自动安装管理器AutoIt v3

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   6135
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   9570
   LinkTopic       =   "Form1"
   ScaleHeight     =   6135
   ScaleWidth      =   9570
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command4 
      Caption         =   "Command4"
      Height          =   495
      Left            =   3180
      TabIndex        =   3
      Top             =   5280
      Width           =   1350
   End
   Begin VB.CommandButton Command3 
      Caption         =   "Command3"
      Height          =   555
      Left            =   885
      TabIndex        =   2
      Top             =   5280
      Width           =   1680
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Command2"
      Height          =   720
      Left            =   705
      TabIndex        =   1
      Top             =   3975
      Width           =   1770
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   1305
      Left            =   4095
      TabIndex        =   0
      Top             =   2340
      Width           =   2715
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const PROCESS_ALL_ACCESS& = &H1F0FFF
Const STILL_ACTIVE& = &H103&
Const INFINITE& = &HFFFF


Private Declare Function GetWindowsDirectory _
    Lib "kernel32" _
    Alias "GetWindowsDirectoryA" ( _
    ByVal lpBuffer As String, _
    ByVal nSize As Long _
    ) As Long


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 GetExitCodeProcess _
    Lib "kernel32" ( _
    ByVal hProcess As Long, _
    lpExitCode As Long _
    ) As Long


Private Declare Function CloseHandle _
    Lib "kernel32" ( _
    ByVal hObject As Long _
    ) As Long

Dim Check As Boolean

Private Sub Command1_Click()
    Dim sCmdLine As String
    Dim idProg As Long, iExit As Long
    sCmdLine = fGetWinDir & "\notepad.exe"   'App.Path & "\soft\WinRAR371.exe /s"   '
    idProg = Shell(sCmdLine)
    iExit = fWait(idProg)

     Debug.Print iExit

    If iExit Then
    
       Debug.Print "open"
        MsgBox "Something very, very bad just happened."
    Else
       Debug.Print "close"
        MsgBox "Finished processing Notepad."
    End If
End Sub


Function fWait(ByVal lProgID As Long) As Long
    ' Wait until proggie exit code <>
    '     STILL_ACTIVE&
    Dim lExitCode As Long, hdlProg As Long
    ' Get proggie handle
    hdlProg = OpenProcess(PROCESS_ALL_ACCESS, False, lProgID)
    ' Get current proggie exit code
    GetExitCodeProcess hdlProg, lExitCode


    Do While lExitCode = STILL_ACTIVE&


        DoEvents
            GetExitCodeProcess hdlProg, lExitCode
        Loop
        CloseHandle hdlProg
        fWait = lExitCode
    End Function


Private Function fGetWinDir() As String
    ' Wrapper to return OS Path
    Dim lRet As Long, lSize As Long, sBuf As String * 512
    lSize = 512
    lRet = GetWindowsDirectory(sBuf, lSize)
    fGetWinDir = Left(sBuf, InStr(1, sBuf, Chr(0)) - 1)
End Function




Private Sub Command2_Click()
Dim Counter
Counter = 0   ' 设置变量初值。
While Counter < 20   ' 测试计数器的值。
   Counter = Counter + 1   ' 将计数器的值加一。
Wend   ' 当 Counter > 19 时则循环终止。
Debug.Print Counter   ' 在“立即”窗口中显示数字 20。


End Sub

Private Sub Command3_Click()
Dim Counter
Check = True: Counter = 0   ' 设置变量初始值。
Do   ' 外层循环。
   Do While Counter < 20   ' 内层循环。
      Counter = Counter + 1   ' 计数器加一。
      'If Counter = 10 Then   ' 如果条件成立。
      '   Check = False   ' 将标志值设成 False。
      '   Exit Do   ' 退出内层循环。
      'End If
      Debug.Print Counter
   Loop
   DoEvents
Loop Until Check = False   ' 退出外层循环。

Debug.Print "ok"

End Sub

Private Sub Command4_Click()
  Check = False
End Sub