1

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

Objective: 使用管道写入 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]:使用 CreateProcess 函数启动时,cmd.exe 在某些情况下不会终止
[2]:Win32 ReadFile 挂起时
从管道 [3]读取: win32 (WinAPI) 中的管道损坏

4

1 回答 1

0

下面的代码成功了。这一切都是在 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
于 2013-09-06T18:56:48.427 回答