一个FTP上传文件的问题

inet用得不爽,经常拖死程序，建议用winnet api，－－－－谁用谁知道

多谢，winnet api没用过，麻烦给一个例子好吗

Option ExplicitPrivate Const MAX_PATH = 260Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End TypePrivate Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type
Private Const ERROR_NO_MORE_FILES = 18
Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _
    (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long

Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" _
    (ByVal hFtpSession As Long, ByVal lpszSearchFile As String, _
      lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As LongPrivate 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 Boolean
Private 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 BooleanPrivate Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
    (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
' 初始化WIN32的INTERNET服务
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 Long' 设置注册信息
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_OPEN_TYPE_PROXY = 3
Private Const INTERNET_INVALID_PORT_NUMBER = 0Private Const FTP_TRANSFER_TYPE_ASCII = &H1
Private Const FTP_TRANSFER_TYPE_BINARY = &H1
Private Const INTERNET_FLAG_PASSIVE = &H8000000Private 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 Const ERROR_INTERNET_EXTENDED_ERROR = 12003Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" ( _
    lpdwError As Long, _
    ByVal lpszBuffer As String, _
    lpdwBufferLength As Long) As Boolean' 服务类型
Private Const INTERNET_SERVICE_FTP = 1
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Private Const INTERNET_FLAG_MULTIPART = &H200000Private Declare Function FtpOpenFile Lib "wininet.dll" Alias _
        "FtpOpenFileA" (ByVal hFtpSession As Long, _
        ByVal sFileName As String, ByVal lAccess As Long, _
        ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function FtpDeleteFile Lib "wininet.dll" _
    Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, _
    ByVal lpszFileName As String) As Boolean

Private Declare Function FtpRenameFile Lib "wininet.dll" Alias _
    "FtpRenameFileA" (ByVal hFtpSession As Long, _
    ByVal sExistingName As String, _
    ByVal sNewName As String) As Boolean

'关闭一个INTERNET句柄或者INTERNET子树的句柄
Private Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer' 自定义错误
Public Enum errFtpErrors
    errCannotConnect = vbObjectError + 2001
    errNoDirChange = vbObjectError + 2002
    errCannotRename = vbObjectError + 2003
    errCannotDelete = vbObjectError + 2004
    errNotConnectedToSite = vbObjectError + 2005
    errGetFileError = vbObjectError + 2006
    errInvalidProperty = vbObjectError + 2007
    errFatal = vbObjectError + 2008
End Enum' 文件传输类型
Public Enum FileTransferType
    ftAscii = FTP_TRANSFER_TYPE_ASCII
    ftBinary = FTP_TRANSFER_TYPE_BINARY
End Enum' 错误信息'
Private Const ERRCHANGEDIRSTR As String = "不能更换目录到 %s. 该目录可能不存在或者被写保护！"
Private Const ERRCONNECTERROR As String = "用提供的用户名和密码不能连接到 %s ！"
Private Const ERRNOCONNECTION As String = "不能连接到服务器！"
Private Const ERRNODOWNLOAD As String = "不能从服务器上取得文件 %s ！"
Private Const ERRNORENAME As String = "不能重命名文件 %s！"
Private Const ERRNODELETE As String = "不能从服务器上删除文件 %s ！"
Private Const ERRALREADYCONNECTED As String = "当连接到服务器上的时候，您不能改变该属性！"
Private Const ERRFATALERROR As String = "不能连接WinInet.dll !"
Private Const ERRTAKEFILE As String = "不能把文件%s上传到远程服务器上！"
' 对窗口的Session标识符
Private Const SESSION As String = "CGFtp Instance"' INET句柄
Private mlINetHandle As Long' 连接句柄
Private mlConnection As Long' 该类的标准FTP属性
Private msHostAddress As String
Private msUser As String
Private msPassword As String
Private msDirectory As String

Private Sub Class_Initialize()
On Error GoTo Err_Handle:
'创建INTERNET SESSION句柄
    mlINetHandle = InternetOpen(SESSION, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)

    If mlINetHandle = 0 Then
        mlConnection = 0
        GoTo Err_Handle
    End If

    mlConnection = 0
    Exit Sub
Err_Handle:
    MsgBox ERRFATALERROR, vbExclamation + vbInformation, "日志查询"
    'Err.Raise errFatal, "CGFTP::Class_Initialise", ERRFATALERROR
End Sub
Private Sub Class_Terminate()' 关闭所有连接
    If mlConnection <> 0 Then
        InternetCloseHandle mlConnection
    End If' 关闭所有API连接    If mlINetHandle <> 0 Then
        InternetCloseHandle mlINetHandle
    End If
    mlConnection = 0
    mlINetHandle = 0

End SubPublic Property Let Host(ByVal sHostName As String)
On Error GoTo Err_Handle:
'设置主机名称
    If mlConnection <> 0 Then
        GoTo Err_Handle
    End If
    msHostAddress = sHostName
    Exit Property
Err_Handle:
    MsgBox ERRALREADYCONNECTED, vbExclamation + vbInformation, "日志查询"
End PropertyPublic Property Get Host() As String
'获得主机名称
    Host = msHostAddress
End PropertyPublic Property Let USER(ByVal sUserName As String)
On Error GoTo Err_Handle
'设置用户名
    If mlConnection <> 0 Then
        GoTo Err_Handle
    End If
    msUser = sUserName
    Exit Property
Err_Handle:
    MsgBox ERRALREADYCONNECTED, vbExclamation + vbInformation, "日志查询"
End PropertyPublic Property Get USER() As String
'获取用户信息
    USER = msUser
End PropertyPublic Property Let Password(ByVal sPassword As String)
On Error GoTo Err_Handle
' 设置密码    If mlConnection <> 0 Then
        GoTo Err_Handle
    End If
    msPassword = sPassword
    Exit Property
Err_Handle:
    MsgBox ERRALREADYCONNECTED, vbExclamation + vbInformation, "日志查询"
End PropertyPublic Property Get Password() As String
'获取密码
    Password = msPassword
End PropertyPublic Property Get Directory() As String
'获取目录名称
    Directory = msDirectory
End PropertyPublic Property Let Directory(ByVal sDirectory As String)
' 设置目录名称
On Error GoTo vbErrorHandler    Dim sError As String

    If Not (mlConnection = 0) Then
        RemoteChDir sDirectory
        msDirectory = sDirectory
    Else
        On Error GoTo 0
        GoTo vbErrorHandler
    End If    Exit PropertyvbErrorHandler:
    MsgBox ERRNOCONNECTION, vbExclamation + vbInformation, "日志查询"
'    Err.Raise errNoDirChange, "CGFTP::Directory[Let]", Err.DescriptionEnd PropertyPublic Property Get Connected() As Boolean
    Connected = (mlConnection <> 0)
End PropertyPublic Function Connect(Optional Host As String, _
    Optional USER As String, _
    Optional Password As String) As Boolean
'连接远程服务器
On Error GoTo vbErrorHandler    Dim sError As String
' 如果已经连接，提示出错
    If mlConnection <> 0 Then
        On Error GoTo 0
        GoTo vbErrorHandler
'        Err.Raise errInvalidProperty, "CGFTP::Connect", "You are already connected to FTP Server " & msHostAddress
        '远程主机已经连接
        Exit Function
    End If
'重新取得连接信息
    If Len(Host) > 0 Then
        msHostAddress = Host
    End If

    If Len(USER) > 0 Then
        msUser = USER
    End If

    If Len(Password) > 0 Then
        msPassword = Password
    End If'远程服务器的连接
    If Len(msHostAddress) = 0 Then
        GoTo vbErrorHandler
'        Err.Raise errInvalidProperty, "CGFTP::Connect", "No Host Address Specified!"
        '没有指定主机名
    End If

    mlConnection = InternetConnect(mlINetHandle, msHostAddress, INTERNET_INVALID_PORT_NUMBER, _
        msUser, msPassword, INTERNET_SERVICE_FTP, 0, 0)

'检测连接错误
    If mlConnection = 0 Then
        sError = Replace(ERRCONNECTERROR, "%s", msHostAddress)
        On Error GoTo 0
        sError = sError & vbCrLf & GetINETErrorMsg(Err.LastDllError)
        GoTo vbErrorHandler
'        Err.Raise errCannotConnect, "CGFTP::Connect", sError
        '用提供的用户名和密码不能连接到远程主机
    End If

    Connect = True    Exit FunctionvbErrorHandler:
    MsgBox "远程主机的连接发生错误！", vbExclamation + vbInformation, "日志查询"
'    Err.Raise Err.Number, "cFTP::Connect", Err.Description
    '用提供的用户名和密码不能连接到远程主机
End FunctionPublic Function Disconnect() As Boolean
On Error GoTo Err_Handle
'如果服务器已经连接，则断开
    If mlConnection <> 0 Then
        InternetCloseHandle mlConnection
        mlConnection = 0
    Else
        GoTo Err_Handle
    End If
    msHostAddress = ""
    msUser = ""
    msPassword = ""
    msDirectory = ""
    Exit Function
Err_Handle:
    MsgBox ERRNOCONNECTION, vbExclamation + vbInformation, "日志查询"
End Function
Public Function GetDirectoryList(Optional Directory As String, Optional FilterString As String) As ADOR.Recordset
'返回经过过滤过后的文件夹和文件On Error GoTo vbErrorHandler    Dim oFileColl As Collection
    Dim lFind As Long
    Dim lLastError As Long
    Dim lPtr As Long
    Dim pData As WIN32_FIND_DATA
    Dim sFilter As String
    Dim lError As Long
    Dim bRet As Boolean
    Dim sItemName As String
    Dim oRS As ADOR.Recordset

' 判断是否已经连接，如果没有，出现出错提示
    If mlConnection = 0 Then
        GoTo vbErrorHandler
'        Err.Raise errNotConnectedToSite, "CGFTP::GetDirectoryList", ERRNOCONNECTION
        '不能连接到服务器
    End If'设置断开连接的记录集    Set oRS = New ADOR.Recordset
    oRS.CursorLocation = adUseClient
    oRS.Fields.Append "Name", adBSTR
    oRS.Open' 如果不符合目录结构，更改目录名
    If Len(Directory) > 0 Then
        RemoteChDir Directory
    End If

    pData.cFileName = String$(MAX_PATH, vbNullChar)

    If Len(FilterString) > 0 Then
        sFilter = FilterString
    Else
        sFilter = "*.*"
    End If
'获取制定目录下的第一个文件    lFind = FtpFindFirstFile(mlConnection, sFilter, pData, 0, 0)
    lLastError = Err.LastDllError
'制定目录下没有文件存在，返回空记录集
    If lFind = 0 Then
        If lLastError = ERROR_NO_MORE_FILES Then
        ' 空目录的情况
            Set GetDirectoryList = oRS
            Exit Function
        Else
            On Error GoTo 0
            GoTo vbErrorHandler
        End If
        Exit Function
    End If
'把目录下找到的第一个文件加到记录集中
    sItemName = Left$(pData.cFileName, InStr(1, pData.cFileName, vbNullChar, vbBinaryCompare) - 1)
    oRS.AddNew "Name", sItemName
'把剩下得文件加入到列表中    Do
        pData.cFileName = String(MAX_PATH, vbNullChar)
        bRet = InternetFindNextFile(lFind, pData)
        If Not (bRet) Then
            lLastError = Err.LastDllError
            If lLastError = ERROR_NO_MORE_FILES Then
                Exit Do
            Else
                InternetCloseHandle lFind
                On Error GoTo 0
                GoTo vbErrorHandler
                Exit Function
            End If
        Else
            sItemName = Left$(pData.cFileName, InStr(1, pData.cFileName, vbNullChar, vbBinaryCompare) - 1)
            oRS.AddNew "Name", sItemName
        End If
    Loop
'关闭查找句柄
    InternetCloseHandle lFind

    On Error Resume Next
    oRS.MoveFirst
    Err.Clear
    On Error GoTo 0

    Set GetDirectoryList = oRS

    Exit FunctionvbErrorHandler:
    '出错得情况下，清空文件查找句柄，产生错误提示
    If lFind <> 0 Then
        InternetCloseHandle lFind
    End If
    Set GetDirectoryList = oRS
    MsgBox "在远程主机上不存在该文件夹或者文件，请确认！", vbExclamation + vbInformation, "日志查询"
'    Err.Raise Err.Number, "cFTP::GetDirectoryList", Err.DescriptionEnd Function

Public Function GetFile(ByVal ServerFileAndPath As String, ByVal DestinationFileAndPath As String, Optional TransferType As FileTransferType = ftAscii) As Boolean
'用特定的文件传输类型得到希望得到的制定的文件
    Dim bRet As Boolean
    Dim sFileRemote As String
    Dim sDirRemote As String
    Dim sFileLocal As String
    Dim sTemp As String
    Dim lPos As Long
    Dim sError As StringOn Error GoTo vbErrorHandler
'判断是否连接到远程主机
    If mlConnection = 0 Then
        On Error GoTo 0
        GoTo vbErrorHandler
    End If

'获取文件

    bRet = FtpGetFile(mlConnection, ServerFileAndPath, DestinationFileAndPath, False, INTERNET_FLAG_RELOAD, TransferType, 0)

    If bRet = False Then
        sError = ERRNODOWNLOAD
        sError = Replace(sError, "%s", ServerFileAndPath)
        On Error GoTo 0
        GetFile = False
        GoTo vbErrorHandler
    End If

    GetFile = True    Exit FunctionvbErrorHandler:
    GetFile = False
    MsgBox sError, vbCritical + vbExclamation, "日志查询"
'    Err.Raise errGetFileError, "cFTP::GetFile", Err.DescriptionEnd FunctionPublic Function PutFile(ByVal LocalFileAndPath As String, ByVal ServerFileAndPath As String, Optional TransferType As FileTransferType) As Boolean
    Dim bRet As Boolean
    Dim sFileRemote As String
    Dim sDirRemote As String
    Dim sFileLocal As String
    Dim sTemp As String
    Dim lPos As Long
    Dim sError As StringOn Error GoTo vbErrorHandler
'判断远程主机的连接是否已经建立
    If mlConnection = 0 Then
        On Error GoTo 0
        GoTo vbErrorHandler
    End If    bRet = FtpPutFile(mlConnection, LocalFileAndPath, ServerFileAndPath, _
        TransferType, 0)

    If bRet = False Then
        sError = ERRTAKEFILE
        sError = Replace(sError, "%s", ServerFileAndPath)
        On Error GoTo 0
        PutFile = False
        sError = sError & vbCrLf & GetINETErrorMsg(Err.LastDllError)
        GoTo vbErrorHandler
    End If

    PutFile = True    Exit FunctionvbErrorHandler:
     MsgBox sError, vbCritical + vbExclamation, "日志查询"End FunctionPublic Function RenameFile(ByVal ExistingName As String, ByVal NewName As String) As Boolean
    Dim bRet As Boolean
    Dim sError As StringOn Error GoTo vbErrorHandler
'判断远程主机的连接是否已经建立
    If mlConnection = 0 Then
        On Error GoTo 0
        GoTo vbErrorHandler
    End If

    bRet = FtpRenameFile(mlConnection, ExistingName, NewName)
'不能重命名文件的时候，产生错误提示
    If bRet = False Then
        sError = ERRNORENAME
        sError = Replace(sError, "%s", ExistingName)
        On Error GoTo 0
        RenameFile = False
        sError = sError & vbCrLf & GetINETErrorMsg(Err.LastDllError)
        GoTo vbErrorHandler
    End If

    RenameFile = True
    Exit FunctionvbErrorHandler:
    MsgBox sError, vbCritical + vbExclamation, "日志查询"End FunctionPublic Function DeleteFile(ByVal ExistingName As String) As Boolean
    Dim bRet As Boolean
    Dim sError As StringOn Error GoTo vbErrorHandler
'判断远程主机的连接是否已经建立
    If mlConnection = 0 Then
        On Error GoTo 0
        GoTo vbErrorHandler
    End If

    bRet = FtpDeleteFile(mlConnection, ExistingName)
'文件不能删除的话，产生错误提示
    If bRet = False Then
        sError = ERRNODELETE
        sError = Replace(sError, "%s", ExistingName)
        On Error GoTo 0
        GoTo vbErrorHandler
    End If

    DeleteFile = True    Exit FunctionvbErrorHandler:
    MsgBox sError, vbExclamation + vbInformation, "日志查询"End FunctionPrivate Sub RemoteChDir(ByVal sDir As String)
On Error GoTo vbErrorHandler
'远程目录的改变
    Dim sPathFromRoot As String
    Dim bRet As Boolean
    Dim sError As String
'切换成标准的UNIX目录结构
    sDir = Replace(sDir, "\", "/")
'判断远程主机的连接是否建立
    If mlConnection = 0 Then
        On Error GoTo 0
        GoTo vbErrorHandler
        Exit Sub
    End If

    If Len(sDir) = 0 Then
        Exit Sub
    Else
        sPathFromRoot = sDir
        If Len(sPathFromRoot) = 0 Then
            sPathFromRoot = "/"
        End If
        bRet = FtpSetCurrentDirectory(mlConnection, sPathFromRoot)

'不能更改目录结构的情况下，产生错误提示
        If bRet = False Then
            sError = ERRCHANGEDIRSTR
            sError = Replace(sError, "%s", sDir)
            On Error GoTo 0
            GoTo vbErrorHandler
        End If
    End If    Exit SubvbErrorHandler:
'    MsgBox sError, vbInformation + vbExclamation, "日志查询"
    MsgBox "没有找到相应的POS日志！", vbExclamation + vbInformation, "日志查询"
    frmConditionInput.txtPos = ""
    frmConditionInput.txtPos.SetFocus
    strPOSErr = "Err"
End SubPrivate Function GetINETErrorMsg(ByVal ErrNum As Long) As String
    Dim lError As Long
    Dim lLen As Long
    Dim sBuffer As String

    If ErrNum = ERROR_INTERNET_EXTENDED_ERROR Then
'获取提示长度和错误号
        InternetGetLastResponseInfo lError, vbNullString, lLen
        sBuffer = String$(lLen + 1, vbNullChar)
'获取错误内容
        InternetGetLastResponseInfo lError, sBuffer, lLen
        GetINETErrorMsg = vbCrLf & sBuffer
    End If
End Function
一个 FTP的类，里边的代码，可以足足，基本可以满足你FTP上的要求

我也给个例子，不过是e文注析：
模块：
Option ExplicitDeclare Function GetProcessHeap Lib "kernel32" () As Long
Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
Public Const HEAP_ZERO_MEMORY = &H8
Public Const HEAP_GENERATE_EXCEPTIONS = &H4Declare Sub CopyMemory1 Lib "kernel32" Alias "RtlMoveMemory" ( _
         hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Declare Sub CopyMemory2 Lib "kernel32" Alias "RtlMoveMemory" ( _
         hpvDest As Long, hpvSource As Any, ByVal cbCopy As Long)Public Const MAX_PATH = 260
Public Const NO_ERROR = 0
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
Public Const FILE_ATTRIBUTE_OFFLINE = &H1000
Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End TypeType WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type
Public Const ERROR_NO_MORE_FILES = 18Public Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _
    (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long

Public Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" _
(ByVal hFtpSession As Long, ByVal lpszSearchFile As String, _
      lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As LongPublic 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 BooleanPublic 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 BooleanPublic Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
    (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
' Initializes an application's use of the Win32 Internet functions
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' User agent constant.
Public Const scUserAgent = "vb wininet"' Use registry access settings.
Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Public Const INTERNET_OPEN_TYPE_DIRECT = 1
Public Const INTERNET_OPEN_TYPE_PROXY = 3
Public Const INTERNET_INVALID_PORT_NUMBER = 0Public Const FTP_TRANSFER_TYPE_ASCII = &H1
Public Const FTP_TRANSFER_TYPE_BINARY = &H1
Public Const INTERNET_FLAG_PASSIVE = &H8000000' Opens a HTTP session for a given site.
Public 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

Public Const ERROR_INTERNET_EXTENDED_ERROR = 12003
Public Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" ( _
    lpdwError As Long, _
    ByVal lpszBuffer As String, _
    lpdwBufferLength As Long) As Boolean' Number of the TCP/IP port on the server to connect to.
Public Const INTERNET_DEFAULT_FTP_PORT = 21
Public Const INTERNET_DEFAULT_GOPHER_PORT = 70
Public Const INTERNET_DEFAULT_HTTP_PORT = 80
Public Const INTERNET_DEFAULT_HTTPS_PORT = 443
Public Const INTERNET_DEFAULT_SOCKS_PORT = 1080Public Const INTERNET_OPTION_CONNECT_TIMEOUT = 2
Public Const INTERNET_OPTION_RECEIVE_TIMEOUT = 6
Public Const INTERNET_OPTION_SEND_TIMEOUT = 5Public Const INTERNET_OPTION_USERNAME = 28
Public Const INTERNET_OPTION_PASSWORD = 29
Public Const INTERNET_OPTION_PROXY_USERNAME = 43
Public Const INTERNET_OPTION_PROXY_PASSWORD = 44' Type of service to access.
Public Const INTERNET_SERVICE_FTP = 1
Public Const INTERNET_SERVICE_GOPHER = 2
Public Const INTERNET_SERVICE_HTTP = 3

' Opens an HTTP request handle.
Public Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" _
(ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, _
ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long' Brings the data across the wire even if it locally cached.
Public Const INTERNET_FLAG_RELOAD = &H80000000
Public Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Public Const INTERNET_FLAG_MULTIPART = &H200000Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000' Sends the specified request to the HTTP server.
Public Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal _
hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal sOptional As _
String, ByVal lOptionalLength As Long) As Integer
' Queries for information about an HTTP request.
Public Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" _
(ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, _
ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer' The possible values for the lInfoLevel parameter include:
Public Const HTTP_QUERY_CONTENT_TYPE = 1
Public Const HTTP_QUERY_CONTENT_LENGTH = 5
Public Const HTTP_QUERY_EXPIRES = 10
Public Const HTTP_QUERY_LAST_MODIFIED = 11
Public Const HTTP_QUERY_PRAGMA = 17
Public Const HTTP_QUERY_VERSION = 18
Public Const HTTP_QUERY_STATUS_CODE = 19
Public Const HTTP_QUERY_STATUS_TEXT = 20
Public Const HTTP_QUERY_RAW_HEADERS = 21
Public Const HTTP_QUERY_RAW_HEADERS_CRLF = 22
Public Const HTTP_QUERY_FORWARDED = 30
Public Const HTTP_QUERY_SERVER = 37
Public Const HTTP_QUERY_USER_AGENT = 39
Public Const HTTP_QUERY_SET_COOKIE = 43
Public Const HTTP_QUERY_REQUEST_METHOD = 45
Public Const HTTP_STATUS_DENIED = 401
Public Const HTTP_STATUS_PROXY_AUTH_REQ = 407' Add this flag to the about flags to get request header.
Public Const HTTP_QUERY_FLAG_REQUEST_HEADERS = &H80000000
Public Const HTTP_QUERY_FLAG_NUMBER = &H20000000
' Reads data from a handle opened by the HttpOpenRequest function.
Public Declare Function InternetReadFile Lib "wininet.dll" _
(ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, _
lNumberOfBytesRead As Long) As IntegerPublic Declare Function InternetWriteFile Lib "wininet.dll" _
        (ByVal hFile As Long, ByVal sBuffer As String, _
        ByVal lNumberOfBytesToRead As Long, _
        lNumberOfBytesRead As Long) As IntegerPublic Declare Function FtpOpenFile Lib "wininet.dll" Alias _
        "FtpOpenFileA" (ByVal hFtpSession As Long, _
        ByVal sFileName As String, ByVal lAccess As Long, _
        ByVal lFlags As Long, ByVal lContext As Long) As Long
Public Declare Function FtpDeleteFile Lib "wininet.dll" _
    Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, _
    ByVal lpszFileName As String) As Boolean
Public Declare Function InternetSetOption Lib "wininet.dll" Alias "InternetSetOptionA" _
(ByVal hInternet As Long, ByVal lOption As Long, ByRef sBuffer As Any, ByVal lBufferLength As Long) As Integer
Public Declare Function InternetSetOptionStr Lib "wininet.dll" Alias "InternetSetOptionA" _
(ByVal hInternet As Long, ByVal lOption As Long, ByVal sBuffer As String, ByVal lBufferLength As Long) As Integer' Closes a single Internet handle or a subtree of Internet handles.
Public Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer' Queries an Internet option on the specified handle
Public Declare Function InternetQueryOption Lib "wininet.dll" Alias "InternetQueryOptionA" _
(ByVal hInternet As Long, ByVal lOption As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long) As Integer' Returns the version number of Wininet.dll.
Public Const INTERNET_OPTION_VERSION = 40' Contains the version number of the DLL that contains the Windows Internet
' functions (Wininet.dll). This structure is used when passing the
' INTERNET_OPTION_VERSION flag to the InternetQueryOption function.
Public Type tWinInetDLLVersion
    lMajorVersion As Long
    lMinorVersion As Long
End Type' Adds one or more HTTP request headers to the HTTP request handle.
Public Declare Function HttpAddRequestHeaders Lib "wininet.dll" Alias "HttpAddRequestHeadersA" _
(ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, _
ByVal lModifiers As Long) As Integer' Flags to modify the semantics of this function. Can be a combination of these values:' Adds the header only if it does not already exist; otherwise, an error is returned.
Public Const HTTP_ADDREQ_FLAG_ADD_IF_NEW = &H10000000' Adds the header if it does not exist. Used with REPLACE.
Public Const HTTP_ADDREQ_FLAG_ADD = &H20000000' Replaces or removes a header. If the header value is empty and the header is found,
' it is removed. If not empty, the header value is replaced
Public Const HTTP_ADDREQ_FLAG_REPLACE = &H80000000

输好地址后的连接过程：
Private Sub cmdConnect_Click()
    If Not bActiveSession And hOpen <> 0 Then
        If txtServer.Text = "" Then
            MsgBox "Please enter a server name!"
            Exit Sub
        End If
        Dim nFlag As Long
        If chkPassive.Value Then
            nFlag = INTERNET_FLAG_PASSIVE
        Else
            nFlag = 0
        End If
        hConnection = InternetConnect(hOpen, txtServer.Text, INTERNET_INVALID_PORT_NUMBER, _
        txtUser, txtPassword, INTERNET_SERVICE_FTP, nFlag, 0)
        If hConnection = 0 Then
            bActiveSession = False
            ErrorOut Err.LastDllError, "InternetConnect"
        Else
            bActiveSession = True
            EnableUI (CBool(hOpen))
            FillTreeViewControl (txtServer.Text)
            FtpEnumDirectory ("")
            If EnumItemNameBag.Count = 0 Then Exit Sub
            FillTreeViewControl (txtServer.Text)
       End If
    End If
End Sub文件上传事件：
Private Sub cmdPut_Click()
    Dim bRet As Boolean
    Dim szFileRemote As String, szDirRemote As String, szFileLocal As String
    Dim szTempString As String
    Dim nPos As Long, nTemp As Long
    Dim nodX As Node
    Set nodX = TreeView1.SelectedItem

    If bActiveSession Then
        If nodX Is Nothing Then
            MsgBox "Please select a remote directory to PUT to!"
            Exit Sub
        End If
        If nodX.Image = "leaf" Then
            MsgBox "Please select a remote directory to PUT to!"
            Exit Sub
        End If
        If File1.FileName = "" Then
            MsgBox "Please select a local file to put"
            Exit Sub
        End If
        szTempString = nodX.Text
        szDirRemote = Right(szTempString, Len(szTempString) - Len(txtServer.Text))
        szFileRemote = File1.FileName
        szFileLocal = File1.Path & "\" & File1.FileName
        If (szDirRemote = "") Then szDirRemote = "\"
        rcd szDirRemote

        bRet = FtpPutFile(hConnection, szFileLocal, szFileRemote, _
         dwType, 0)
        If bRet = False Then
            ErrorOut Err.LastDllError, "FtpPutFile"
            Exit Sub
        End If

        Dim nodChild As Node, nodNextChild As Node
        Set nodChild = nodX.Child
        Do
          If nodChild Is Nothing Then Exit Do
          Set nodNextChild = nodChild.Next
            TreeView1.Nodes.Remove nodChild.Index
            If nodNextChild Is Nothing Then Exit Do
            Set nodChild = nodNextChild
        Loop
        If nodX.Image = "closed" Then
            nodX.Image = "open"
        End If
        FtpEnumDirectory (nodX.Text)
        FillTreeViewControl (nodX.Text)
   End If
End Sub

调试易

一个FTP上传文件的问题

解决方案 »