Question

我有这个api例程，我经常使用它来捕获dos输出。最近发现了一个奇怪的错误，它似乎不允许dns调用。例如，nslookup将返回Server：UnKnown的“服务器无响应”错误。如果您提供IP地址，Ping将起作用，但如果必须进行DNS调用则不行。此问题与此代码完全隔离。

对此问题的任何见解将不胜感激。 Winapi不是我最强的领域。

编辑：很抱歉添加了所有的常量和类型，但我将其制作成可以粘贴到模块中的内容并运行以自行测试，以便更容易解决问题。

' STARTUPINFO flags
Private Const STARTF_USESHOWWINDOW = &H1
Private Const STARTF_USESTDHANDLES = &H100

' ShowWindow flag
Private Const SW_HIDE = 0

'CreatePipe buffer size
Private Const BUFSIZE = 1024

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

Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function CreatePipe Lib "kernel32.dll" (ByRef phReadPipe As Long, ByRef phWritePipe As Long, ByRef lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long
Private Declare Function CreateProcess Lib "kernel32.dll" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByRef lpProcessAttributes As SECURITY_ATTRIBUTES, ByRef lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByRef lpEnvironment As Any, ByVal lpCurrentDriectory As String, ByRef lpStartupInfo As STARTUPINFO, ByRef lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Sub GetStartupInfo Lib "kernel32.dll" Alias "GetStartupInfoA" (ByRef lpStartupInfo As STARTUPINFO)
Private Declare Function PeekNamedPipe Lib "kernel32.dll" (ByVal hNamedPipe As Long, ByRef lpBuffer As Any, ByVal nBufferSize As Long, ByRef lpBytesRead As Long, ByRef lpTotalBytesAvail As Long, ByRef lpBytesLeftThisMessage 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, lpOverlapped As Any) As Long

Sub CreateprocessApiTest()
    On Error GoTo errHandler
    Dim pa As SECURITY_ATTRIBUTES
    Dim pra As SECURITY_ATTRIBUTES
    Dim tra As SECURITY_ATTRIBUTES
    Dim si As STARTUPINFO
    Dim pi As PROCESS_INFORMATION
    Dim retVal As Long
    Dim command As String
    Dim ErrorDesc As String
    Dim hRead As Long     ' stdout + stderr
    Dim hWrite As Long
    Dim bAvail As Long    ' pipe bytes available (PeekNamedPipe)
    Dim bRead As Long     ' pipe bytes fetched   (ReadFile)
    Dim bString As String    ' our buffer
    Dim s As String

    command = "nslookup google.com"

    pa.nLength = Len(pa)
    pa.bInheritHandle = 1

    pra.nLength = Len(pra)
    tra.nLength = Len(tra)

    retVal = CreatePipe(hRead, hWrite, pa, BUFSIZE)

    With si
        .cb = Len(si)
        GetStartupInfo si
        .dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES
        .wShowWindow = SW_HIDE
        .hStdOutput = hWrite
        .hStdError = hWrite
    End With

    retVal = CreateProcess(vbNullString, command, pra, tra, 1, 0&, 0&, vbNullString, si, pi)

    Do While PeekNamedPipe(hRead, ByVal 0, 0, ByVal 0, bAvail, ByVal 0)
        DoEvents
        If bAvail Then
            bString = String(bAvail, 0)
            ReadFile hRead, bString, bAvail, bRead, ByVal 0&
            bString = Left(bString, bRead)
            s = s & bString
            CloseHandle hWrite
        End If
    Loop
    CloseHandle hRead
    CloseHandle pi.hThread
    CloseHandle pi.hProcess

    MsgBox s

exitRoutine:
    Exit Sub
errHandler:
    Debug.Print Err.Number, Err.Description
    Resume exitRoutine
End Sub

Answer 1

错误的lpEnvironment As Any参数。像这样添加ByVal

retVal = CreateProcess(vbNullString, command, pra, tra, 1, 0&, ByVal 0&, vbNullString, si, pi)

CreateProcess和奇怪的nslookup错误

1 个答案: