Attribute VB_Name = "Module1"
Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As Any, ByVal nSize As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, 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 hHandle As Long) As Long

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'注釋: 用于獲取自windows啟動以來經歷的時間長度（毫秒） Long，返回值:以毫秒為單位的windows運行時間 2006-02-19
Public Declare Function GetTickCount Lib "kernel32" () As Long

Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

Private Type STARTUPINFO
    cb As Long
    lpReserved As Long
    lpDesktop As Long
    lpTitle As Long
    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

Public Function ExecuteCommand(CommandLine As String) As String
'管道方式執行DOS命令并返回執行結果
    Const BuffSize As Long = 1024
    Dim proc As PROCESS_INFORMATION
    Dim Ret As Long
    Dim start As STARTUPINFO
    Dim sa As SECURITY_ATTRIBUTES
    Dim hReadPipe As Long, hWritePipe As Long, lngBytesread As Long
    Dim strBuff As String * BuffSize, mOutputs As String
   
    sa.nLength = Len(sa)
    sa.bInheritHandle = 1&
    sa.lpSecurityDescriptor = 0&
    Ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)
   
    If Ret = 0 Then ExecuteCommand = "CreatePipe Failed. Error: " & Err.LastDllError & vbCrLf: Exit Function
   
    start.cb = Len(start)
    start.dwFlags = &H100 Or 1
    start.hStdOutput = hWritePipe
    start.hStdError = hWritePipe
    Ret& = CreateProcessA(0&, CommandLine, sa, sa, 1, &H20, 0, 0, start, proc)
    If Ret <> 1 Then ExecuteCommand = "錯誤: '" & CommandLine & "' 不是可運行的程序" & vbCrLf: Exit Function
    Ret = CloseHandle(hWritePipe)

    mOutputs = ""
    Do
        Ret = ReadFile(hReadPipe, strBuff, BuffSize, lngBytesread, 0&)
        If Ret = 0 Then Exit Do
        mOutputs = mOutputs & LeftB(StrConv(strBuff, vbFromUnicode), lngBytesread)
    Loop
   
    Ret = CloseHandle(proc.hProcess)
    Ret = CloseHandle(proc.hThread)
    Ret = CloseHandle(hReadPipe)
   
    ExecuteCommand = Replace(StrConv(mOutputs, vbUnicode), Chr(0), "")
End Function


Public Function ExeCMD(ByVal CmdLine As String) As String
'2006-7-27 by VB爬蟲
'以Shell方式執行Dos命令并輸出結果
    Const TmepFile As String = "C:\ExeDosCMD.tmp"
    Dim sOutPut As String, Temp As String
    Dim ErNum As Integer
    '刪除臨時文件 如果存在
    Shell "CMD /C Del " & TmepFile, vbMinimizedNoFocus
    '打開錯誤陷阱 以便捕捉錯誤
    On Error Resume Next
    '清除錯誤標記
    Err.Clear
    '檢測命令行
    ExeCMD = "您輸入的命令是: [" & CmdLine & "]" & vbCrLf & String(50, "-") & vbCrLf
    If InStr(LCase(CmdLine), "cmd ") > 0 Then
        CmdLine = CmdLine & " > " & TmepFile
    Else
        CmdLine = "CMD /C " & CmdLine & " > " & TmepFile
    End If
    '以Shell方式執行命令行,并把輸出結果重定向到臨時文件
    Call Shell(CmdLine, vbMinimizedNoFocus)
    
    If Err.Number <> 0 Then
        ExeCMD = ExeCMD & "錯誤: " & Err.Number & " - " & Err.Description
        Exit Function
    End If
    
    ErNum = 0
REOPEN:
    Err.Clear
    Open TmepFile For Input Lock Read Write As #1
    If Err.Number = 53 Or Err.Number = 70 Then ' 文件未找到 / 文件正在被其他程序打開(沒有權限)
        ErNum = ErNum + 1
        '記錄并判斷,防止程序無限期等待下去
        If ErNum > 65535 Then
            ExeCMD = "錯誤: 操作已超時!"
            Exit Function
        End If
        DoEvents
        Sleep 50
        GoTo REOPEN
    ElseIf Err.Number <> 0 Then
        ExeCMD = ExeCMD & "錯誤: " & Err.Number & " - " & Err.Description
        Exit Function
    End If
    Err.Clear
    '開始讀取臨時文件的內容(命令的輸出結果)
    While Not EOF(1)
        '讀取一行的內容
        Line Input #1, Temp
        sOutPut = sOutPut + Temp + vbCrLf
    Wend
    '關閉臨時文件
    Close #1
    '刪除臨時文件
    Shell "CMD /C Del " & TmepFile, vbMinimizedNoFocus

    If Err.Number <> 0 Then
        ExeCMD = ExeCMD & "錯誤: " & Err.Number & " - " & Err.Description
        Exit Function
    Else
        ExeCMD = ExeCMD & sOutPut
    End If
End Function