vb.net用API写的FTP类,现与大家分享

这个博客分享了一个使用VB.NET API编写的FTP类,包括连接FTP服务器、更改目录、下载和上传文件、重命名及删除文件等核心功能。通过调用wininet.dll中的API函数,实现了与FTP服务器的交互。
摘要由CSDN通过智能技术生成

Public Class ftpApi
   
    Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" (ByVal hOutboundSession As Integer, ByVal lpszSearchFile As String, ByRef lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Integer, ByVal dwContent As Integer) As Integer

    Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" (ByVal hFind As Integer, ByRef lpvFindData As WIN32_FIND_DATA) As Integer
    Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" (ByVal hOutboundSession As Integer, ByVal lpszRemoteFile As String, ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Integer, ByVal dwFlags As Integer, ByVal dwContext As Integer) As Boolean
    Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hOutboundSession As Integer, ByVal lpszLocalFile As String, ByVal lpszRemoteFile As String, ByVal dwFlags As Integer, ByVal dwContext As Integer) As Boolean
    Private Declare Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" (ByVal hOutboundSession As Integer, ByVal sExistingName As String, ByVal sNewName As String) As Boolean
    Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" (ByVal hOutboundSession As Integer, ByVal lpszFileName As String) As Boolean
    Private Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" (ByVal hConnect As Integer, ByVal lpszCurrentDirectory As String, ByRef lpdwCurrentDirectory As Integer) As Integer
    Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hOutboundSession As Integer, ByVal lpszDirectory As String) As Boolean
    Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Integer, ByVal sServerName As String, ByVal nServerPort As Short, ByVal sUserName As String, ByVal sPassword As String, ByVal lService As Integer, ByVal lFlags As Integer, ByVal lContext As Integer) As Integer
    Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Integer, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Integer) As Integer
    Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Integer) As Integer
    Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" (ByRef lpdwError As Integer, ByVal lpszBuffer As String, ByRef lpdwBufferLength As Integer) As Boolean
  
    ' ---------------------------------------------------------
    ' -------------------   API Functions  --------------------
    ' ---------------------------------------------------------

    '文件创建时间
    Private Structure FILETIME
        Dim dwLowDateTime As Integer
        Dim dwHighDateTime As Integer
    End Structure

    '文件信息
    Private Structure WIN32_FIND_DATA
        Dim dwFileAttributes As Integer
        Dim ftCreationTime As FILETIME
        Dim ftLastAccessTime As FILETIME
        Dim ftLastWriteTime As FILETIME
        Dim nFileSizeHigh As Integer
        Dim nFileSizeLow As Integer
        Dim dwReserved0 As Integer
        Dim dwReserved1 As Integer
        <VBFixedString(260), System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=260)> Public cFileName As String
        <VBFixedString(14), System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=14)> Public cAlternate As String
    End Structure

    'Wininet.dll API's


    ' ---------------------------------------------------------
    ' ---------------- 功能块常量 -----------------
    ' ---------------------------------------------------------

    Private Const FAILURE As Integer = 0
    Private Const SUCCESS As Integer = 1

    '错误消息
    Private Const ERR_CHANGE_DIR As String = "Cannot change directory to <%s>. It either doesn't exist, or is protected"
    Private Const ERR_CONNECT_ERROR As String = "Cannot connect to FTP server <%s> using User and Password Parameters"
    Private Const ERR_ALREADY_CONNECTED As String = "Cannot change property while connected to FTP server"
    Private Const ERR_NO_CONNECTION As String = "Cannot connect to FTP server"
    Private Const ERR_DOWNLOAD As String = "Cannot get file <%s> from FTP server"
    Private Const ERR_RENAME As String = "Cannot rename file <%s>"
    Private Const ERR_DELETE As String = "Cannot delete file <%s> from FTP server"
    Private Const ERR_CRITICAL As String = "Cannot get connection to WinInet.dll!"

    'Type of service to access
    Private Const INTERNET_SERVICE_FTP As Short = 1

    'Flags
    Private Const INTERNET_FLAG_RELOAD As Integer = &H80000000
    Private Const INTERNET_FLAG_KEEP_CONNECTION As Integer = &H400000
    Private Const INTERNET_FLAG_MULTIPART As Integer = &H200000
    Private Const INTERNET_FLAG_PASSIVE As Integer = &H8000000
    Private Const INTERNET_FLAG_NO_CACHE_WRITE As Integer = &H4000000
    Private Const INTERNET_FLAG_EXISTING_CONNECT As Integer = &H20000000

    '文件传送模式
    Private Const FTP_TRANSFER_TYPE_UNKNOWN As Short = &H0S
    Private Const FTP_TRANSFER_TYPE_ASCII As Short = &H1S
    Private Const FTP_TRANSFER_TYPE_BINARY As Short = &H2S

    '其他的
    Private Const INTERNET_OPEN_TYPE_DIRECT As Short = 1
    Private Const INET_SESSION_NAME As String = "ICB FTP Sesh"
    Private Const ERROR_INTERNET_EXTENDED_ERROR As Short = 12003
    Private Const NO_CONNECTION As Integer = FAILURE
    Private Const FWDSLASH As String = "/"
    Private Const BACKSLASH As String = "/"

    ' ---------------------------------------------------------
    ' ---------------- 功能块变量 -----------------
    ' ---------------------------------------------------------

    'INET 句柄
    Private m_hInet As Integer

    'FTP 连接句柄
    Private m_hSession As Integer

    ' FTP 规则
    Private m_HostAddr As String
    Private m_HostPort As Integer
    Private m_User As String
    Private m_Password As String
    Private m_Dir As String

    ' ---------------------------------------------------------
    ' ------------------ 自定义类型 -------------------
    ' ---------------------------------------------------------

    Public Enum FtpError
        ERR_CANNOT_CONNECT = vbObjectError + 2001
        ERR_NO_DIR_CHANGE = vbObjectError + 2002
        ERR_CANNOT_RENAME = vbObjectError + 2003
        ERR_CANNOT_DELETE = vbObjectError + 2004
        ERR_NOT_CONNECTED_TO_SITE = vbObjectError + 2005
        ERR_CANNOT_GET_FILE = vbObjectError + 2006
        ERR_INVALID_PROPERTY = vbObjectError + 2007
        ERR_FATAL = vbObjectError + 2008
    End Enum

    '文件传送类型
    Public Enum FileTransferType
        fttUnknown = FTP_TRANSFER_TYPE_UNKNOWN
        fttAscii = FTP_TRANSFER_TYPE_ASCII
        fttBinary = FTP_TRANSFER_TYPE_BINARY
    End Enum
    '________________________________________________________________________

    Private Sub Class_Initialize_Renamed()

        '初始化变量
        m_hSession = NO_CONNECTION
        m_hInet = NO_CONNECTION
        m_HostAddr = vbNullString
        m_HostPort = FAILURE
        m_User = vbNullString
        m_Password = vbNullString
        m_Dir = vbNullString

    End Sub
    '________________________________________________________________________


    Private Sub Class_Terminate_Renamed()

        '关闭连接
        If m_hSession Then InternetCloseHandle(m_hSession)

        '关闭 API 句柄
        If m_hInet Then InternetCloseHandle(m_hInet)

        m_hSession = NO_CONNECTION
        m_hInet = NO_CONNECTION

    End Sub
    Protected Overrides Sub Finalize()
        Class_Terminate_Renamed()
        MyBase.Finalize()
    End Sub
    '________________________________________________________________________

    ' ---------------------------------------------------------
    ' ------------------- --------------------
    ' ---------------------------------------------------------

    '________________________________________________________________________

    Public Property Host() As String
        Get
            '得到主机地址

            Host = m_HostAddr

        End Get
        Set(ByVal Value As String)
            '设置主机地址

            If m_hSession = NO_CONNECTION Then
                m_HostAddr = Value
            Else
                Err.Raise(FtpError.ERR_INVALID_PROPERTY, "clsFTP:Host [Let]", ERR_ALREADY_CONNECTED)
            End If

        End Set
    End Property
    '________________________________________________________________________

    '________________________________________________________________________

    Public Property Port() As Integer
        Get
            '端口

            Port = m_HostPort

        End Get
        Set(ByVal Value As Integer)
            ''端口

            If m_hSession = NO_CONNECTION Then
                m_HostPort = Value
            Else
                Err.Raise(FtpError.ERR_INVALID_PROPERTY, "clsFTP:Port [Let]", ERR_ALREADY_CONNECTED)
            End If

        End Set
    End Property
    '________________________________________________________________________

    '________________________________________________________________________

    Public Property User() As String
        Get
            '用户名

            User = m_User

        End Get
        Set(ByVal Value As String)
            '用户名

            If m_hSession = NO_CONNECTION Then
                m_User = Value
            Else
                Err.Raise(FtpError.ERR_INVALID_PROPERTY, "clsFTP:User [Let]", ERR_ALREADY_CONNECTED)
            End If

        End Set
    End Property
    '________________________________________________________________________

    '________________________________________________________________________

    Public Property Password() As String
        Get
            '密码

            Password = m_Password

        End Get
        Set(ByVal Value As String)
            '密码

            If m_hSession = NO_CONNECTION Then
                m_Password = Value
            Else
                Err.Raise(FtpError.ERR_INVALID_PROPERTY, "clsFTP:Password [Let]", ERR_ALREADY_CONNECTED)
            End If

        End Set
    End Property
    '________________________________________________________________________

    '________________________________________________________________________

    Public Property Directory() As String
        Get
            '索引
            Dim TempDir As String

            If (GetDirName(TempDir) <> SUCCESS) Then
                TempDir = "<Unknown>"
            End If

            Directory = TempDir

        End Get
        Set(ByVal Value As String)
            '索引

            If m_hSession = NO_CONNECTION Then
                Err.Raise(FtpError.ERR_NOT_CONNECTED_TO_SITE, "clsFTP:Directory [Let]", ERR_NO_CONNECTION)
            Else
                ChangeDir(Value)
            End If

        End Set
    End Property
    '________________________________________________________________________

    Public ReadOnly Property IsConnected() As Boolean
        Get
            '是否连接
            Dim Temp As String

            IsConnected = (GetDirName(Temp) = SUCCESS)

        End Get
    End Property
    '________________________________________________________________________

    ' ---------------------------------------------------------
    ' --------------- 类函数 -------------------
    ' ---------------------------------------------------------

    Public Function Connect(Optional ByVal Host As String = vbNullString, Optional ByVal Port As Integer = 0, Optional ByVal User As String = vbNullString, Optional ByVal Password As String = vbNullString) As Integer

        '连接 FTP server
        On Error GoTo Handler
        Dim ErrMsg As String

        Connect = FAILURE

        If m_hInet = FAILURE Then
            '创建 internet 会话
            m_hInet = InternetOpen(INET_SESSION_NAME, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
            If m_hInet = FAILURE Then
                Err.Raise(FtpError.ERR_FATAL, "clsFTP:Class [Initialize]", ERR_CRITICAL)
            End If
        End If

        'If we already have an FTP session open then raise error
        If m_hSession Then
            Err.Raise(FtpError.ERR_INVALID_PROPERTY, "clsFTP:Connect", "You are already connected to FTP Server " & m_HostAddr)
        End If

        'Overwrite any existing properties if they were supplied in the
        'arguments to this method
        If Host <> vbNullString Then m_HostAddr = Host
        If Port <> 0 Then m_HostPort = Port
        If User <> vbNullString Then m_User = User
        If Password <> vbNullString Then m_Password = Password

        m_hSession = InternetConnect(m_hInet, m_HostAddr, m_HostPort, m_User, m_Password, INTERNET_SERVICE_FTP, 0, 0)

        'Check for connection errors
        If m_hSession = NO_CONNECTION Then
            ErrMsg = Replace(ERR_CONNECT_ERROR, "%s", m_HostAddr)
            ErrMsg = ErrMsg & vbCrLf & GetINETErrorMsg(Err.LastDllError)
            Err.Raise(FtpError.ERR_CANNOT_CONNECT, "clsFTP:Connect", ErrMsg)
        End If

        Connect = SUCCESS

ExitProc:
        Exit Function

Handler:
        Connect = Err.Number
        Resume ExitProc

    End Function
    '________________________________________________________________________

    Public Function Disconnect() As Integer
        'Attempt to disconnect

        On Error GoTo Handler

        Disconnect = FAILURE

        'Kill off API Handles
        If m_hInet Then InternetCloseHandle(m_hInet)
        If m_hSession Then InternetCloseHandle(m_hSession)

        m_hSession = NO_CONNECTION
        m_hInet = NO_CONNECTION

        m_HostAddr = vbNullString
        m_User = vbNullString
        m_Password = vbNullString
        m_Dir = vbNullString

        Disconnect = SUCCESS

ExitProc:
        Exit Function

Handler:
        Disconnect = Err.Number
        Resume ExitProc

    End Function
    '________________________________________________________________________

    Public Function GetFile(ByVal HostFile As String, ByVal ToLocalFile As String, Optional ByRef tt As FileTransferType = FileTransferType.fttUnknown) As Integer
        'Get the specified file and move to the desired location using
        '[optional] specified file transfer type

        On Error GoTo Handler
        Dim ReturnVal As Integer
        Dim RemoteFile As String
        Dim RemoteDir As String
        Dim LocalFile As String
        Dim Pos As Integer
        Dim ErrMsg As String

        GetFile = FAILURE

        'If not connected, raise an error
        If m_hSession = NO_CONNECTION Then
            Err.Raise(FtpError.ERR_NOT_CONNECTED_TO_SITE, "clsFTP:GetFile", ERR_NO_CONNECTION)
        End If

        'Get the file
        ReturnVal = FtpGetFile(m_hSession, HostFile, ToLocalFile, False, INTERNET_FLAG_RELOAD, tt, 0)

        If ReturnVal = FAILURE Then
            ErrMsg = Replace(ERR_DOWNLOAD, "%s", HostFile)
            Err.Raise(FtpError.ERR_CANNOT_GET_FILE, "clsFTP:GetFile", ErrMsg)
        End If

        GetFile = SUCCESS

ExitProc:
        Exit Function

Handler:
        GetFile = Err.Number
        Resume ExitProc

    End Function
    '________________________________________________________________________

    Public Function PutFile(ByVal LocalFile As String, ByVal ToHostFile As String, Optional ByRef tt As FileTransferType = FileTransferType.fttUnknown) As Integer

        On Error GoTo Handler
        Dim ReturnVal As Integer
        Dim Pos As Integer
        Dim ErrMsg As String

        PutFile = FAILURE

        'If not connected, raise an error
        If m_hSession = NO_CONNECTION Then
            Err.Raise(FtpError.ERR_NOT_CONNECTED_TO_SITE, "clsFTP:PutFile", ERR_NO_CONNECTION)
        End If

        ReturnVal = FtpPutFile(m_hSession, LocalFile, ToHostFile, tt, 0)

        If ReturnVal = FAILURE Then
            ErrMsg = Replace(ERR_DOWNLOAD, "%s", ToHostFile)
            ErrMsg = ErrMsg & vbCrLf & GetINETErrorMsg(Err.LastDllError)
            Err.Raise(FtpError.ERR_CANNOT_RENAME, "clsFTP:PutFile", ErrMsg)
        End If

        PutFile = SUCCESS

ExitProc:
        Exit Function

Handler:
        PutFile = Err.Number
        Resume ExitProc

    End Function
    '________________________________________________________________________

    Public Function GetDirListing(ByRef FileNames() As String, ByRef FileSizes() As Integer, Optional ByVal SubDir As String = vbNullString) As Integer
        On Error GoTo Handler

        Dim WFD As WIN32_FIND_DATA
        'UPGRADE_NOTE: Filter 已升级到 Filter_Renamed。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1061"”
        Dim Filter_Renamed As String
        Dim hFind, hFindConnect As Integer
        Dim FileSize As Integer
        Dim TempFileName As String
        Dim TempFileSize As Integer
        Dim FullDir As String
        Dim i As Short

        GetDirListing = FAILURE

        'UPGRADE_WARNING: Screen 属性 Screen.MousePointer 具有新的行为。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2065"”
        'System.Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.WaitCursor

        'Obtain the current FTP path
        Filter_Renamed = "*.*"

        FullDir = m_Dir & SubDir

        AddRemFwdSlash(FullDir, 1)

        'If not connected, raise an error
        If m_hSession = NO_CONNECTION Then
            Err.Raise(FtpError.ERR_NOT_CONNECTED_TO_SITE, "clsFTP:PutFile", ERR_NO_CONNECTION)
        End If

        'Connection handles used by the FtpFindFirstFile
        'API go out of scope once the files are
        'listed, therefore it can not be reused.
        'This restriction is handled by obtaining
        'a fresh connection handle each time a call
        'to FtpFindFirstFile is required, and releasing
        'it once finished.
        hFindConnect = GetInternetConnectHandle()

        hFind = FtpFindFirstFile(m_hSession, FullDir & Filter_Renamed, WFD, INTERNET_FLAG_RELOAD Or INTERNET_FLAG_NO_CACHE_WRITE, 0)

        If hFind Then
            i = 0
            Do
                ReDim Preserve FileNames(i)
                ReDim Preserve FileSizes(i)
                TempFileName = ClipNull(WFD.cFileName)
                If Len(TempFileName) Then
                    If WFD.dwFileAttributes And FileAttribute.Directory Then
                        TempFileName = TempFileName & FWDSLASH
                        TempFileSize = 0
                    Else
                        TempFileSize = WFD.nFileSizeLow
                    End If
                    FileNames(i) = TempFileName
                    FileSizes(i) = TempFileSize
                End If
                'Continue while valid
                i = i + 1
            Loop While InternetFindNextFile(hFind, WFD)

        End If 'If hFind&

        InternetCloseHandle(hFindConnect)
        InternetCloseHandle(hFind)

        'UPGRADE_WARNING: Screen 属性 Screen.MousePointer 具有新的行为。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2065"”
        'System.Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.Default
        GetDirListing = SUCCESS

ExitProc:
        Exit Function

Handler:
        GetDirListing = Err.Number
        Resume ExitProc

    End Function
    '________________________________________________________________________

    Public Function RenameFile(ByVal FileNameOld As String, ByVal FileNameNew As String) As Integer

        On Error GoTo Handler

        'The FTP rename command can be thought of as being more than just a simple host
        'file renaming facility. When invoking a rename command on a file in a sub-folder from
        'the current FTP folder, the file is essentially 'moved' to its new location
        'in one simple step. Actually, the file is NOT physically copied to a new location
        'and the old one deleted. Because the file on the FTP server is being renamed to
        'a target directory in the same file system, FTP is clever enough just
        'to change the file's directory pointer so the file never gets recopied. This
        'is critical in preserving file integity, and is of significant importance to
        'us in our use of buffer directories.


        Dim ReturnVal As Integer
        Dim ErrMsg As String

        RenameFile = FAILURE

        'If not connected, raise an error
        If m_hSession = NO_CONNECTION Then
            Err.Raise(FtpError.ERR_NOT_CONNECTED_TO_SITE, "clsFTP:RenameFile", ERR_NO_CONNECTION)
        End If

        ReturnVal = FtpRenameFile(m_hSession, FileNameOld, FileNameNew)

        'Raise an error if we couldn't rename the file (most likely that
        'a file with the new name already exists
        If ReturnVal = FAILURE Then
            ErrMsg = Replace(ERR_RENAME, "%s", FileNameOld)
            ErrMsg = ErrMsg & vbCrLf & GetINETErrorMsg(Err.LastDllError)
            Err.Raise(FtpError.ERR_CANNOT_RENAME, "clsFTP:RenameFile", ErrMsg)
        End If

        RenameFile = SUCCESS

ExitProc:
        Exit Function

Handler:
        RenameFile = Err.Number
        Resume ExitProc

    End Function
    '________________________________________________________________________

    Public Function DeleteFile(ByVal FileToDelete As String) As Integer
        On Error GoTo Handler

        Dim ReturnVal As Integer
        Dim ErrMsg As String

        DeleteFile = FAILURE

        'Check for a connection
        If m_hSession = NO_CONNECTION Then
            Err.Raise(FtpError.ERR_NOT_CONNECTED_TO_SITE, "clsFTP:DeleteFile", ERR_NO_CONNECTION)
        End If

        ReturnVal = FtpDeleteFile(m_hSession, FileToDelete)

        'Raise an error if the file couldn't be deleted
        If ReturnVal = FAILURE Then
            ErrMsg = Replace(ERR_DELETE, "%s", FileToDelete)
            Err.Raise(FtpError.ERR_CANNOT_DELETE, "clsFTP:DeleteFile", ErrMsg)
        End If

        DeleteFile = SUCCESS

ExitProc:
        Exit Function

Handler:
        DeleteFile = Err.Number
        Resume ExitProc

    End Function
    '________________________________________________________________________

    ' ---------------------------------------------------------
    ' ----------------- Private Functions ---------------------
    ' ---------------------------------------------------------

    Private Function GetDirName(ByRef FTPDir As String) As Integer
        On Error GoTo Handler

        Dim BufferLen As Integer
        Dim BufferStr As String
        Dim ReturnVal As Integer

        GetDirName = FAILURE
        FTPDir = vbNullString
        m_Dir = vbNullString

        'If not connected, raise an error
        If m_hSession = NO_CONNECTION Then
            Err.Raise(FtpError.ERR_NOT_CONNECTED_TO_SITE, "clsFTP:GetDirName", ERR_NO_CONNECTION)
        End If

        BufferStr = Space(256)
        BufferLen = Len(BufferStr)

        ReturnVal = FtpGetCurrentDirectory(m_hSession, BufferStr, BufferLen)

        If ReturnVal = SUCCESS Then
            'return a properly qualified path
            BufferStr = ClipNull(BufferStr)

            m_Dir = BufferStr
            FTPDir = m_Dir
            GetDirName = SUCCESS
        End If

ExitProc:
        Exit Function

Handler:
        GetDirName = Err.Number
        Resume ExitProc

    End Function
    '________________________________________________________________________

    Private Function ChangeDir(ByVal HostDir As String) As Integer
        On Error GoTo Handler

        Dim ReturnVal As Integer
        Dim ErrMsg As String

        ChangeDir = FAILURE

        'Ensure that rightmost character is a backslash
        AddRemSlash(HostDir, 1)

        'Replace all back-slashes with forward-slashes: Telnet standard
        HostDir = Replace(HostDir, BACKSLASH, FWDSLASH)

        'Check for a connection
        If m_hSession = NO_CONNECTION Then
            Err.Raise(FtpError.ERR_NOT_CONNECTED_TO_SITE, "clsFTP:ChangeDir", ERR_NO_CONNECTION)
        End If

        ReturnVal = FtpSetCurrentDirectory(m_hSession, HostDir)

        'If we can't change directory - raise an error
        If ReturnVal = FAILURE Then
            ErrMsg = ERR_CHANGE_DIR
            ErrMsg = Replace(ErrMsg, "%s", HostDir)
            Err.Raise(CInt(ERR_CHANGE_DIR), "clsFTP:ChangeDir", ErrMsg)
        End If

        ChangeDir = SUCCESS

ExitProc:
        Exit Function

Handler:
        ChangeDir = Err.Number
        Resume ExitProc

    End Function
    '________________________________________________________________________

    Private Function GetINETErrorMsg(ByVal ErrNum As Integer) As String
        Dim LenError, LenBuffer As Integer
        Dim Buffer As String

        'Get extra info from the WinInet.DLL
        If ErrNum = ERROR_INTERNET_EXTENDED_ERROR Then
            'Get message size and number
            InternetGetLastResponseInfo(LenError, vbNullString, LenBuffer)
            Buffer = New String(vbNullChar, LenBuffer + 1)
            'Get message
            InternetGetLastResponseInfo(LenError, Buffer, LenBuffer)
            GetINETErrorMsg = vbCrLf & Buffer
        End If

    End Function
    '________________________________________________________________________

    Private Function GetInternetConnectHandle() As Integer
        Dim sServerName As String
        Dim H As Integer

        'Obtains a new handle expressly for use with the
        'FtpFindFirstFile API.
        '
        'Care must be taken to close only the handle
        'returned by this function once the listing
        'of the directory has been obtained.

        If m_hInet Then
            H = InternetConnect(m_hInet, m_HostAddr, m_HostPort, m_User, m_Password, INTERNET_SERVICE_FTP, INTERNET_FLAG_EXISTING_CONNECT Or INTERNET_FLAG_PASSIVE, &H0S)
        End If

        GetInternetConnectHandle = H

    End Function
    '________________________________________________________________________

    Private Function AddRemFwdSlash(ByRef PathName As String, ByVal IsSlash As Byte) As Integer
        On Error GoTo Handler

        AddRemFwdSlash = FAILURE

        If IsSlash Then 'We want a "/" at end
            If Right(PathName, 1) <> FWDSLASH Then PathName = PathName & FWDSLASH

        Else 'We don't want a "/" at end
            If Right(PathName, 1) = FWDSLASH Then
                PathName = Mid(PathName, 1, Len(PathName) - 1)
            End If
        End If

        AddRemFwdSlash = SUCCESS

ExitProc:
        Exit Function

Handler:
        AddRemFwdSlash = Err.Number
        'MsgBox Err.Number & ": " & Err.Description, _
        'vbExclamation, "AddRemFwdSlash Error"
        Resume ExitProc

    End Function
    '________________________________________________________________________

    Public Function AddRemSlash(ByRef PathName As String, ByVal IsSlash As Byte) As Integer
        On Error GoTo Handler

        AddRemSlash = FAILURE

        If IsSlash Then 'We want a "/" at end
            If Right(PathName, 1) <> BACKSLASH Then PathName = PathName & BACKSLASH
        Else 'We don't want a "/" at end
            If Right(PathName, 1) = BACKSLASH Then
                PathName = Mid(PathName, 1, Len(PathName) - 1)
            End If
        End If

        AddRemSlash = SUCCESS

ExitProc:
        Exit Function

Handler:
        AddRemSlash = Err.Number
        'MsgBox Err.Number & ": " & Err.Description, _
        'vbExclamation, "AddRemSlash Error"
        Resume ExitProc

    End Function
    '________________________________________________________________________

    'UPGRADE_NOTE: str 已升级到 str_Renamed。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1061"”
    Private Function ClipNull(ByVal str_Renamed As String) As String
        Dim Pos As Short

        Pos = InStr(1, str_Renamed, vbNullChar)
        If Pos > 0 Then
            ClipNull = Left(str_Renamed, Pos - 1)
        End If

    End Function

End Class
 

评论 2
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值