【问题标题】:ReadFile hangs when reading from pipe in VBA从 VBA 中的管道读取时,ReadFile 挂起
【发布时间】:2013-06-19 16:24:49
【问题描述】:

前提:使用 VBA (Access),运行 ftp 并使用 CreateProcess 和 Read/WriteFile 将命令传递给它。

目的:写入ftp进程stdIn发送命令,读取stdOut以确定ftp目录结构的信息,使用管道。此外,要了解在使用 Windows API 函数时格式化我的代码的正确方法,并确定另一种方法(使用 API 控制台命令)是否更合适。

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

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)

【问题讨论】:

  • 是否有特殊原因导致您生成外部 ftp.exe 进程而不是直接在代码中实现 FTP 协议?如果不想直接使用 WinSock,可以使用微软的 WinInet API,它本身就支持 FTP。
  • 我最初使用 WScriptExec 来运行它,但我不想看到该窗口,也不想将多个命令的结果输出到文件(使用 .Run)。我会给 WinInet API 一个机会。知道为什么上述失败了吗?
  • @RemyLebeau 我正在使用您不久前推荐的方法取得进展。这正是我所需要的。

标签: winapi vba readfile


【解决方案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

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2014-02-25
    相关资源
    最近更新 更多