CreateProcess和奇怪的nslookup错误

3
我有一个API例程,经常用来捕获DOS输出。最近发现了一个奇怪的bug,它似乎不允许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

你确定你的DNS缓存没有被污染吗?如果你从命令行使用IP地址和服务器名称进行ping测试,会发生什么? - Mitch Wheat
这是VB6。我可以从命令提示符中ping和nslookup,并且这些工具正常工作。这已经在不同位置的许多机器上进行了测试,每次都得到相同的结果。即使我使用“nslookup google.com server”设置dns服务器,它仍然无法工作。问题肯定出在进程创建的方式上。我无法弄清楚... - dmaruca
1个回答

2

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

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

非常好用,我简直不敢相信这么简单。谢谢! - dmaruca

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接