*VBで外部コマンドの標準出力取得
 #contents
 **コード
  Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" _
     (ByVal lpApplicationName As String, _
      ByVal lpCommandLine As String, _
      lpProcessAttributes As SECURITY_ATTRIBUTES, _
      lpThreadAttributes As SECURITY_ATTRIBUTES, _
      ByVal bInheritHandles As Long, _
      ByVal dwCreationFlags As Long, _
      lpEnvironment As Any, _
      ByVal lpCurrentDirectory As String, _
      lpStartupInfo As STARTUPINFO, _
      lpProcessInformation As PROCESS_INFORMATION) As Long
  Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
  Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, _
      lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, _
      lpOverlapped As Long) As Long
  Private Declare Function WaitForSingleObject Lib "kernel32" _
      (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
  Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, _
      phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, _
      ByVal nSize As Long) As Long
  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 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
  Private Type SECURITY_ATTRIBUTES
          nLength As Long
          lpSecurityDescriptor As Long
          bInheritHandle As Long
  End Type
  Private Const NORMAL_PRIORITY_CLASS As Long = &H20&
  Private Const STARTF_USESTDHANDLES As Long = &H100&
  Private Const STARTF_USESHOWWINDOW As Long = &H1&
  Private Const SW_HIDE As Long = 0&
  
  Private Const INFINITE As Long = &HFFFF&
  
  Public Function RunCommand(CommandLine As String) As String
      Dim si As STARTUPINFO
      Dim pi As PROCESS_INFORMATION
      Dim retval As Long
      Dim hRead As Long
      Dim hWrite As Long
      Dim sBuffer(0 To 63) As Byte
      Dim lgSize As Long
      Dim sa As SECURITY_ATTRIBUTES
      Dim strResult As String
      
      With sa
          .nLength = Len(sa)
          .bInheritHandle = 1& 'inherit, needed for this to work
          .lpSecurityDescriptor = 0&
      End With
      
      retval = CreatePipe(hRead, hWrite, sa, 0&)
      If retval = 0 Then
          Debug.Print "CreatePipe Failed"
          RunCommand = ""
          Exit Function
      End If
      
      With si
          .cb = Len(si)
          .dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW 'tell it to use (not ignore) the values below
          .wShowWindow = SW_HIDE
          .hStdOutput = hWrite 'pass the write end of the pipe as the processes standard output
      End With
      
      retval = CreateProcess(vbNullString, _
                              CommandLine & vbNullChar, _
                              sa, _
                              sa, _
                              1&, _
                              NORMAL_PRIORITY_CLASS, _
                              ByVal 0&, _
                              vbNullString, _
                              si, _
                              pi)
      If retval Then
          WaitForSingleObject pi.hProcess, INFINITE
          
          Do While ReadFile(hRead, sBuffer(0), 64, lgSize, ByVal 0&)
              strResult = strResult & StrConv(sBuffer(), vbUnicode)
              Erase sBuffer()
              If lgSize <> 64 Then Exit Do
          Loop
          
          CloseHandle pi.hProcess
          CloseHandle pi.hThread
      Else
          Debug.Print "CreateProcess Failed" & vbCrLf
      End If
     
      CloseHandle hRead
      CloseHandle hWrite
      
      RunCommand = Replace(strResult, vbNullChar, "")
  End Function
 **使い方
  Function test()
 	Debug.Print RunCommand("ipconfig")
  End Function
 **補足
 -元ネタは海外のBBSです
 -微妙に不安定です
 
 ~
 ~
 CENTER:&amazon(zaurus,key,Windows VisualBasic VisualC VisualStudio,books software);


トップ   新規 一覧 単語検索 最終更新   ヘルプ   最終更新のRSS