Domanda

Ho questa routine API che uso regolarmente per la cattura dos uscita. Recentemente uno strano bug è stato trovato in cui non sembra permettere dns chiamate. Per esempio nslookup restituirà l'errore "Nessuna risposta dal server" con il server: sconosciuto. Ping funziona se si fornisce un indirizzo IP, ma non se si deve effettuare una chiamata DNS. Questo problema è completamente isolata a questo codice.

Tutta la comprensione in questo problema sarebbe apprezzato. Winapi non è la mia area di più forte.

Modifica:. Ci scusiamo per l'aggiunta di tutte le costanti e tipologie, ma ho fatto questo in qualcosa che si può incollare in un modulo e correre a testare per voi stessi, nel tentativo di rendere il problema più facile da risolvere

' 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
È stato utile?

Soluzione

parametro lpEnvironment As Any sbagliato. Add ByVal come questo

retVal = CreateProcess(vbNullString, command, pra, tra, 1, 0&, ByVal 0&, vbNullString, si, pi)
Autorizzato sotto: CC-BY-SA insieme a attribuzione
Non affiliato a StackOverflow
scroll top