crunandwait.cls

文件自动解压缩程序

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CrunAndWait"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'----------------------------------------------------------
'StartUp Info
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 Byte
        hStdInput As Long
        hStdOutput As Long
        hStdError As Long
End Type
'Process Info
Private Type PROCESS_INFORMATION
        hProcess As Long
        hThread As Long
        dwProcessId As Long
        dwThreadId As Long
End Type
'----------------------------------------------------------
Public Enum RAWOptions
  RAW_RunMinimized = 0
  RAW_RunMaximized = 1
  RAW_RunNormal = 2
  RAW_RunHidden = 3
  RAW_CloseOnExit = 4
  RAW_StayOpen = 5
End Enum
'----------------------------------------------------------
Public Enum STARTFOptions
    STARTF_FORCEOFFFEEDBACK = &H80
    STARTF_FORCEONFEEDBACK = &H40
    STARTF_RUNFULLSCREEN = &H20
    STARTF_USECOUNTCHARS = &H8
    STARTF_USEFILLATTRIBUTE = &H10
    STARTF_USEHOTKEY = &H200
    STARTF_USEPOSITION = &H4
    STARTF_USESHOWWINDOW = &H1
    STARTF_USESIZE = &H2
    STARTF_USESTDHANDLES = &H100
End Enum
Public Enum SWOptions
    SW_ERASE = &H4
    SW_HIDE = 0
    SW_INVALIDATE = &H2
    SW_MAX = 10
    SW_MAXIMIZE = 3
    SW_MINIMIZE = 6
    SW_NORMAL = 1
    SW_OTHERUNZOOM = 4
    SW_OTHERZOOM = 2
    SW_PARENTCLOSING = 1
    SW_PARENTOPENING = 3
    SW_RESTORE = 9
    SW_SCROLLCHILDREN = &H1
    SW_SHOW = 5
    SW_SHOWDEFAULT = 10
    SW_SHOWMAXIMIZED = 3
    SW_SHOWMINIMIZED = 2
    SW_SHOWMINNOACTIVE = 7
    SW_SHOWNA = 8
    SW_SHOWNOACTIVATE = 4
    SW_SHOWNORMAL = 1
End Enum
'----------------------------------------------------------
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 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 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 RunWinAndWait(ByVal CmdStr As String, _
                Optional tRunOpt As SWOptions = SW_MINIMIZE) As Boolean
    Dim RetVal                    As Long
    Dim Process                   As PROCESS_INFORMATION
    Dim StartInfo                 As STARTUPINFO
    Const NORMAL_PRIORITY_CLASS   As Long = &H20
    Const INFINITE                As Long = -1
    Dim tStr                      As String
    Dim rVal                      As Long

    If CBool(Len(Trim$(CmdStr))) Then
    ' Don't do it if no CmdStr or just space(s)
      CmdStr = CmdStr  '
      With StartInfo
        .cb = Len(CmdStr)
        .wShowWindow = tRunOpt
        .dwFlags = STARTF_USESHOWWINDOW
      End With

      RetVal = CreateProcessA(0&, CmdStr, 0&, 0&, 1&, _
                NORMAL_PRIORITY_CLASS, 0&, 0&, StartInfo, Process)
      ' RetVal = 0 => Failed
      If RetVal > 0 Then
        rVal = WaitForSingleObject(Process.hProcess, INFINITE)
        GetExitCodeProcess Process.hProcess, rVal
        CloseHandle Process.hProcess
      End If
    End If
    RunWinAndWait = CBool(RetVal)

End Function
'----------------------------------------------------------
Public Function RunDosAndWait(ByVal CmdStr As String, _
                Optional tRunOpt As SWOptions = SW_HIDE, _
                Optional tCloseOpt As RAWOptions = RAW_CloseOnExit) _
                 As Boolean
'Run process until finished
'i.e. using pkzip -> CmdStr = Environ("COMSPEC") & " /c pkzip.exe filename...."

    Dim RetVal                    As Long
    Dim Process                   As PROCESS_INFORMATION
    Dim StartInfo                 As STARTUPINFO
    Const NORMAL_PRIORITY_CLASS   As Long = &H20
    Const INFINITE                As Long = -1
    Dim tStr                      As String
    Dim rVal                      As Long
    
    If CBool(Len(Trim$(CmdStr))) Then
    ' Don't do it if no CmdStr or just space(s)
      tStr = GetCmdSpec(tCloseOpt)
      CmdStr = tStr & CmdStr '
      With StartInfo
        .cb = Len(CmdStr)
        .wShowWindow = tRunOpt
        .dwFlags = STARTF_USESHOWWINDOW
      End With
      
      RetVal = CreateProcessA(0&, CmdStr, 0&, 0&, 1&, _
                NORMAL_PRIORITY_CLASS, 0&, 0&, StartInfo, Process)
      ' RetVal = 0 => Failed
      If RetVal > 0 Then
        rVal = WaitForSingleObject(Process.hProcess, INFINITE)
        GetExitCodeProcess Process.hProcess, rVal
        CloseHandle Process.hProcess
      End If
    End If
    RunDosAndWait = CBool(RetVal)

End Function
'----------------------------------------------------------
Private Function GetCmdSpec( _
        Optional tCloseOpt As RAWOptions = RAW_CloseOnExit) As String
  Dim tStr As String
  Dim RStr As String
  
  If tCloseOpt = RAW_CloseOnExit Then
    RStr = " /C "
  ElseIf tCloseOpt = RAW_StayOpen Then
    RStr = " /K "
  End If
  
  tStr = Environ$("COMSPEC")
  
  tStr = tStr & RStr
  
  GetCmdSpec = tStr
  
End Function