*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です
-微妙に不安定です



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