vb6 运行一个今天并返回值

vb6 运行一个今天并返回值

 Option Explicit
    
  Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long
  Private Declare Sub GetStartupInfo Lib "kernel32" Alias "GetStartupInfoA" (lpStartupInfo As STARTUPINFO)
  Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
  Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
  Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
  Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    
  Private Type SECURITY_ATTRIBUTES
      nLength   As Long
      lpSecurityDescriptor   As Long
      bInheritHandle   As Long
  End Type
    
  Private Type PROCESS_INFORMATION
      hProcess   As Long
      hThread   As Long
      dwProcessId   As Long
      dwThreadId   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 Byte
      hStdInput   As Long
      hStdOutput   As Long
      hStdError   As Long
  End Type
    
  Private Type OVERLAPPED
          ternal   As Long
          ternalHigh   As Long
          offset   As Long
          OffsetHigh   As Long
          hEvent   As Long
  End Type
    
  Private Const STARTF_USESHOWWINDOW = &H1
  Private Const STARTF_USESTDHANDLES = &H100
  Private Const SW_HIDE = 0
  Private Const EM_SETSEL = &HB1
  Private Const EM_REPLACESEL = &HC2
    
  Public Function ExcuComm(ByVal strCommand As String, ByRef objBuffer As Object) As Boolean
          '*   ------------------------------------------------------------------------------
          '*   目的   :               用于执行Saprouter的命令
          '*   传值参数   :       要执行的命令（变量中包括路经、命令、参数）
          '*   传地址参数   :   将命令的执行结果传回
          '*   返回值   :           布尔型值，表明函数是否成功处理
          '*   输出   :
          '*   注解   :
          '*   用法   :
          '*   修订版   :           2003-09-16   崔迪明   -   原始
          '*   ------------------------------------------------------------------------------
          On Error GoTo ErrorHandler
          Dim i%, t$
          Dim pa     As SECURITY_ATTRIBUTES
          Dim pra     As SECURITY_ATTRIBUTES
          Dim tra     As SECURITY_ATTRIBUTES
          Dim pi     As PROCESS_INFORMATION
          Dim sui     As STARTUPINFO
          Dim hRead     As Long
          Dim hWrite     As Long
          Dim bRead     As Long
          Dim lpBuffer(1024)     As Byte
            
          ExcuComm = False
            
          pa.nLength = Len(pa)
          pa.lpSecurityDescriptor = 0
          pa.bInheritHandle = True
            
          pra.nLength = Len(pra)
          tra.nLength = Len(tra)
            
          If CreatePipe(hRead, hWrite, pa, 0) <> 0 Then
                  sui.cb = Len(sui)
                  GetStartupInfo sui
                  sui.hStdOutput = hWrite
                  sui.hStdError = hWrite
                  sui.dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES
                  sui.wShowWindow = SW_HIDE
                    
                  '*   执行命令,并将结果放入文件中
                  If CreateProcess(vbNullString, strCommand, pra, tra, True, 0, Null, vbNullString, sui, pi) <> 0 Then
    
                          '*   读取文件，并写入缓存对象中
                          SetWindowText objBuffer.hwnd, ""
                          Do
                              Erase lpBuffer()
                              If ReadFile(hRead, lpBuffer(0), 1023, bRead, ByVal 0&) Then
                                  SendMessage objBuffer.hwnd, EM_SETSEL, -1, 0
                                  SendMessage objBuffer.hwnd, EM_REPLACESEL, False, lpBuffer(0)
                                  DoEvents
                              Else
                                  CloseHandle pi.hThread
                                  CloseHandle pi.hProcess
                                  Exit Do
                              End If
                              CloseHandle hWrite
                          Loop
                          CloseHandle hRead
                  End If
          End If
          ExcuComm = True
CleanExit:
          Exit Function
ErrorHandler:
          GoTo CleanExit
  End Function
    
  Private Sub Command1_Click()
          Text2.Text = ""
          Call ExcuComm(Text1.Text, Text2)
  End Sub
    
    
  Private Sub Form_Load()
    Text1.Text = "cmd /c dir c:"
  End Sub