[新4]用ACCESS向ｆｔｐ服务器上传文件

jzwwpp

不调用任何ｆｔｐ软件，只使用ACCESS编程实现。。。

CHENZHIRONG

用API调用：'声明：Private 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 LongPrivate Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _

    (ByVal hInternetSession 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

   

Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _

    (ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, _

    ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, _

    ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, _

    ByVal dwContext As Long) As BooleanPrivate Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" _

    (ByVal hFtpSession As Long, ByVal lpszLocalFile As String, _

    ByVal lpszRemoteFile As String, ByVal dwFlags As Long, _

    ByVal dwContext As Long) As Boolean

   

Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer'函数Private Function UpLoadFile(ByVal LocateFile As String, ByVal RemoteFile As String) As Boolean

Dim lngINet As Long, lngINetConn As Long, blnRC As Boolean

    'Me.lbMsg.Caption = "打开INTERNET句柄"

    'Me.Repaint

    lngINet = InternetOpen("FTP", 1, vbNullString, vbNullString, 0)

    If lngINet = 0 Then Exit Function

    'Me.lbMsg.Caption = "连接远程主机"

    'Me.Repaint

    lngINetConn = InternetConnect(lngINet, "IP地址", 端口, "用户", "密码", 1, 0, 0)

    If lngINetConn = 0 Then Exit Function

    'Me.lbMsg.Caption = "上传文件"

    'Me.Repaint

    blnRC = FtpPutFile(lngINetConn, LocateFile, RemoteFile, 1, 0)

    If blnRC = False Then Exit Function

    'Me.lbMsg.Caption = "上传成功"

    'Me.Repaint

    InternetCloseHandle lngINetConn

    InternetCloseHandle lngINet

    UpLoadFile = True

    'Me.lbMsg.Caption = ""

End Function

Private Function DownLoadFile(ByVal RemoteFile As String, ByVal LocateFile As String) As Boolean

Dim lngINet As Long, lngINetConn As Long, blnRC As Boolean

    'Me.lbMsg.Caption = "打开INTERNET句柄..."

    'Me.Repaint

    lngINet = InternetOpen("FTP", 1, vbNullString, vbNullString, 0)

    If lngINet = 0 Then Exit Function

    'Me.lbMsg.Caption = "连接远程主机..."

    'Me.Repaint

    lngINetConn = InternetConnect(lngINet, "IP地址", 端口, "帐号", "密码", 1, 0, 0)

    If lngINetConn = 0 Then Exit Function

    'Me.lbMsg.Caption = "正在下载文件..."

    'Me.Repaint

    blnRC = FtpGetFile(lngINetConn, RemoteFile, LocateFile, False, 0, 1, 0)

    If blnRC = False Then Exit Function

    'Me.lbMsg.Caption = "下载成功"

    'Me.Repaint

    InternetCloseHandle lngINetConn

    InternetCloseHandle lngINet

    DownLoadFile = True

End Function

llm4947

不错

gdjdyyj

学习

xjb_test

学习一下

kaka022

EZFTP控件？

guoya

可以使用Catalyst File Transfer Control 4.0 (SP3)控件

Private Sub Command6_Click() '上传
Dim strLocalFullName As String
Dim strRemoteFullName As String
Dim lResult As Long

strLocalFullName = Me.TxtLocalName
strRemoteFullName = FullName(TxtRemoteFolder, TxtRemoteFileName)

    FileTransfer2.ServerType = GetServerType
    FileTransfer2.ServerName = Me.TxtSeverName
    FileTransfer2.ServerPort = 21
    '以下根据需要决定
    'FileTransfer2.Timeout = CLng(Val(editTimeout.Text))
    'FileTransfer2.UserName = Trim(editUserName.Text)
    'FileTransfer2.Password = Trim(editPassword.Text)
    lResult = FileTransfer2.Connect
    If lResult <> 0 Then
            MsgBox "Connection failed" & vbCrLf & FileTransfer21.LastErrorString
    End If
   
lResult = FileTransfer2.PutFile(strLocalFullName, strRemoteFullName)

If lResult <> 0 Then
            MsgBox "Transfer failed" & vbCrLf & FileTransfer2.LastErrorString
End If

lResult = FileTransfer2.Disconnect
End Sub


Private Function FullName(strDir As String, strFile As String) As String
Dim strDelim As String
Dim strLastChar As String

    strDelim = "\"
    If InStr(strDir, "/") > 0 Then strDelim = "/"
    strLastChar = Right(strDir, 1)
    If strLastChar = strDelim Then
        FullName = strDir & strFile
    Else
        FullName = strDir & strDelim & strFile
    End If
End Function

paltt

高手啊。。。。。。。

milerzhang

有没有更好的方法!!!

fresh+men

好像可以用WINSOCK或EZFTP控件的，我没用过，但应该比WINAPI好写

MosesCao

要的就是它!太感谢了!