Question

前提：使用VBA（Access），运行ftp并使用CreateProcess和Read / WriteFile将命令传递给它。

目标：写入ftp进程stdIn以发送命令并读取stdOut以使用管道确定来自ftp目录结构的信息。另外，要了解在使用Windows API函数时格式化代码的正确方法，并确定是否有其他方法（使用API控制台命令）可能更合适。

我尝试过的：以下代码在ReadFile或WriteFile调用中挂起。我不确定我是否应该使用同步或异步以及在哪里发送我正在发送的命令。我将ReadFile调用放在等待循环中，如参考文献[2]中所述。

Public Sub ExecCmd(cmdline As String)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim hReadPipe1 As Long, hReadPipe2 As Long
Dim hWritePipe1 As Long, hWritePipe2 As Long
Dim ret As Integer, buff As String, lngBytes As Long
Dim lpCurrentDirectory As String

'Create pipes for reading/writing to console
If CreatePipe(hReadPipe1, hWritePipe1, vbNull, 0&) = 0 Then _
    MsgBox "createpipe failed" 'Stdout
If CreatePipe(hReadPipe2, hWritePipe2, vbNull, 0&) = 0 Then _
    MsgBox "createpipe failed" 'Stdin

' Initialize structures etc
start.cb = Len(start)
start.lpTitle = "CBase Console"
start.wShowWindow = 0
start.hStdOutput = hWritePipe1
start.hStdError = hWritePipe1
start.hStdInput = hReadPipe2
lpCurrentDirectory = "H:\"
buff = Space(260)

If CreateProcess(0&, cmdline, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, _
    lpCurrentDirectory, start, proc) = 0 Then _
    MsgBox "createprocess failed"

buff = "echo hello world" & vbCrLf
ret = WriteFile(hWritePipe2, buff, Len(buff), lngBytes, vbNull) 'code hangs here

Do 'or code hangs on readfile if writefile is removed
    If ReadFile(hReadPipe1, buff, Len(buff), lngBytes, vbNull) = 0 Then _
        MsgBox "readfile failed"
    ret = WaitForSingleObject(proc.hProcess, 0)
    DoEvents
Loop Until ret <> 258

ret = CloseHandle(proc.hProcess)
ret = CloseHandle(proc.hThread)
ret = CloseHandle(hReadPipe1)
ret = CloseHandle(hWritePipe2)
End Sub

相关文章（由于我无法转换代码格式，我无法收集答案）：
[1]：cmd.exe will not terminate under certain conditions when launched with the CreateProcess function
[2]：Win32 ReadFile hangs when reading from pipe
[3]：broken pipe in win32 (WinAPI)

Answer 1

以下代码可以解决问题。这一切都是在MS Access 2007中完成的。感谢@RemyLebeau使用WinInet API指引我正确的方向。

'Declare wininet.dll API Functions
Public Declare Function FtpCommand Lib "wininet.dll" Alias "FtpCommandA" (ByVal hConnect As Long, ByVal fExpectResponse As Boolean, ByVal dwFlags As Long, ByVal lpszCommand As String, dwContext As Long, phFtpCommand As Long) As Boolean
Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Public Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hFTP As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUsername As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long

Public Sub ftpUpdateP()
Const NUMBYTES As Long = 1020
Const MAX_PATH As Long = 256
Dim hOpen As Long, hConn As Long, hOutConn As Long
Dim buffer As String, bytesRead As Long
Dim iUnit As Integer, sCode As Variant
Dim strOut As String, arrOut() As String

'Open internet connection
hOpen = InternetOpen(vbNullString, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
DoEvents
If hOpen = 0 Then Exit Sub

'Connect to ftp
hConn = InternetConnect(hOpen, "ipaddress", INTERNET_DEFAULT_FTP_PORT, "user", "password", INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0)
DoEvents
If hConn = 0 Then GoTo ErrorConnectToFTP

For iUnit = 1 To 2
    For Each sCode In Array("I", "P")
        strOut = ""

        'Get directory contents
        Call FtpCommand(hConn, True, FTP_TRANSFER_TYPE_ASCII, "NLST /p/u" & iUnit & "/CY" & getCurrentCycle(iUnit) & "/" & sCode & "/d.*", 0, hOutConn)
        DoEvents
        If hOutConn = 0 Then GoTo ErrorDirList

        'Read the FTP response to listing the target directory contents
        Do
            buffer = Space$(NUMBYTES + 4)
            Call InternetReadFile(hOutConn, buffer, NUMBYTES, bytesRead)
            strOut = strOut & TrimNull(buffer)
        Loop Until bytesRead = 0

        'Close handle to dirlist; create date from directory name
        InternetCloseHandle hOutConn
        arrOut = Split(strOut, Chr(13))
        strOut = Mid(arrOut(UBound(arrOut) - 1), InStrRev(arrOut(UBound(arrOut) - 1), "/") + 1)
        strOut = Eval("#" & Mid(strOut, 5, 2) & "/" & Mid(strOut, 7, 2) & "/" & Mid(strOut, 3, 2) & " " & Mid(strOut, 10, 2) & ":" & Mid(strOut, 12, 2) & "#")

        If sCode = "I" Then dateLastI(iUnit) = strOut Else dateLastP(iUnit) = strOut
    Next
Next

dateLastPUpdate = Now
ErrorDirList:  InternetCloseHandle hConn
ErrorConnectToFTP: InternetCloseHandle hOpen
End Sub

从VBA中的管道读取时，ReadFile挂起

1 个答案: