fmvbftpjr.frm

一款漂亮的控件。 快

    hConnection = 0
    ClearBag
    TreeView1.Nodes.Remove txtServer.Text
    bActiveSession = False
    EnableUI (True)
End Sub

Private Sub ClearTextBoxAndBag()
    txtServer.Text = ""
    txtUser.Text = ""
    txtPassword.Text = ""
    txtProxy.Text = ""
    ClearBag
End Sub

Private Sub ClearBag()
    Dim Num As Integer
    For Num = 1 To EnumItemNameBag.Count
        EnumItemNameBag.Remove 1
    Next Num
    For Num = 1 To EnumItemAttributeBag.Count
        EnumItemAttributeBag.Remove 1
    Next Num
End Sub

Private Sub FillTreeViewControl(strParentKey As String)
    Dim nodX As Node
    Dim strImg As String
    Dim nCount As Integer, i As Integer
    Dim nAttr As Integer
    Dim strItem As String
    
    If EnumItemNameBag.Count = 0 And strParentKey = txtServer.Text Then
        Set nodX = TreeView1.Nodes.Add(, tvwFirst, txtServer.Text, txtServer.Text, "root")
        Exit Sub
    End If
    nCount = EnumItemAttributeBag.Count
    If nCount = 0 Then Exit Sub
    For i = 1 To nCount
        nAttr = EnumItemAttributeBag.Item(i)
        strItem = EnumItemNameBag(i)
        If nAttr = FILE_ATTRIBUTE_DIRECTORY Then
            strImg = "closed"
        Else
            strImg = "leaf"
        End If
        Set nodX = TreeView1.Nodes.Add(strParentKey, tvwChild, strParentKey & "/" & strItem, _
            strParentKey & "/" & strItem, strImg)
    Next
    nodX.EnsureVisible
End Sub

Private Sub cmdGet_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 the item to GET!"
            Exit Sub
        End If
        szTempString = TreeView1.SelectedItem.Text
        szFileRemote = szTempString
        nPos = 0
        nTemp = 0
        Do
            nTemp = InStr(1, szTempString, "/", vbBinaryCompare)
            If nTemp = 0 Then Exit Do
            szTempString = Right(szTempString, Len(szTempString) - nTemp)
            nPos = nTemp + nPos
        Loop
        szDirRemote = Left(szFileRemote, nPos)
        szFileRemote = Right(szFileRemote, Len(szFileRemote) - nPos)
        szFileLocal = File1.Path
        rcd szDirRemote
        bRet = FtpGetFile(hConnection, szFileRemote, szFileLocal & "/" & szFileRemote, False, _
        INTERNET_FLAG_RELOAD, dwType, 0)
        File1.Refresh
        If bRet = False Then ErrorOut Err.LastDllError, "FtpGetFile"
    Else
        MsgBox "Not in session"
    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

Private Sub Dir1_Change()
    File1.Path = Dir1.Path
End Sub

Private Sub Drive1_Change()
    On Error GoTo ErrProc
    Dir1.Path = Drive1.Drive
    Exit Sub
ErrProc:
    Drive1.Drive = "c:"
    Dir1.Path = Drive1.Drive
End Sub

Private Sub rcd(pszDir As String)
    If pszDir = "" Then
        MsgBox "Please enter the directory to CD"
        Exit Sub
    Else
        Dim sPathFromRoot As String
        Dim bRet As Boolean
        If InStr(1, pszDir, txtServer.Text) Then
        sPathFromRoot = Mid(pszDir, Len(txtServer.Text) + 1, Len(pszDir) - Len(txtServer.Text))
        Else
        sPathFromRoot = pszDir
        End If
        If sPathFromRoot = "" Then sPathFromRoot = "/"
        bRet = FtpSetCurrentDirectory(hConnection, sPathFromRoot)
        If bRet = False Then ErrorOut Err.LastDllError, "rcd"
    End If
End Sub

Function ErrorOut(dError As Long, szCallFunction As String)
    Dim dwIntError As Long, dwLength As Long
    Dim strBuffer As String
    If dError = ERROR_INTERNET_EXTENDED_ERROR Then
        InternetGetLastResponseInfo dwIntError, vbNullString, dwLength
        strBuffer = String(dwLength + 1, 0)
        InternetGetLastResponseInfo dwIntError, strBuffer, dwLength
        
        MsgBox szCallFunction & " Extd Err: " & dwIntError & " " & strBuffer
       
        
    End If
    If MsgBox(szCallFunction & " Err: " & dError & _
        vbCrLf & "Close Connection and Session?", vbYesNo) = vbYes Then
        If hConnection Then InternetCloseHandle hConnection
        If hOpen Then InternetCloseHandle hOpen
        hConnection = 0
        hOpen = 0
        If bActiveSession Then TreeView1.Nodes.Remove txtServer.Text
        bActiveSession = False
        ClearTextBoxAndBag
        EnableUI (False)
    End If
End Function

Private Sub EnableUI(bEnabled As Boolean)
    txtServer.Enabled = bEnabled
    txtUser.Enabled = bEnabled
    txtPassword.Enabled = bEnabled
    cmdConnect.Enabled = bEnabled And Not bActiveSession
    cmdDisconnect.Enabled = bEnabled And bActiveSession
    chkPassive.Enabled = bEnabled
    cmdClosehOpen.Enabled = bEnabled
    cmdInternetOpen.Enabled = Not bEnabled
    txtProxy.Enabled = Not bEnabled
    optBin.Enabled = bEnabled
    optAscii.Enabled = bEnabled
    cmdGet.Enabled = bEnabled And bActiveSession
    cmdPut.Enabled = bEnabled And bActiveSession
End Sub

Private Sub FtpEnumDirectory(strDirectory As String)
    
    ClearBag
    Dim hFind As Long
    Dim nLastError As Long
    Dim dError As Long
    Dim ptr As Long
    Dim pData As WIN32_FIND_DATA
    
    If Len(strDirectory) > 0 Then rcd (strDirectory)
    pData.cFileName = String(MAX_PATH, 0)
    hFind = FtpFindFirstFile(hConnection, "*.*", pData, 0, 0)
    nLastError = Err.LastDllError
    
    If hFind = 0 Then
        If (nLastError = ERROR_NO_MORE_FILES) Then
            MsgBox "This directory is empty!"
        Else
            ErrorOut nLastError, "FtpFindFirstFile"
        End If
        Exit Sub
    End If
    
    dError = NO_ERROR
    Dim bRet As Boolean
    Dim strItemName As String
    
    EnumItemAttributeBag.Add pData.dwFileAttributes
    strItemName = Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
    EnumItemNameBag.Add strItemName
    Do
        pData.cFileName = String(MAX_PATH, 0)
        bRet = InternetFindNextFile(hFind, pData)
        If Not bRet Then
            dError = Err.LastDllError
            If dError = ERROR_NO_MORE_FILES Then
                Exit Do
            Else
                ErrorOut dError, "InternetFindNextFile"
                InternetCloseHandle (hFind)
               Exit Sub
            End If
        Else
            EnumItemAttributeBag.Add pData.dwFileAttributes
            strItemName = Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
            EnumItemNameBag.Add strItemName
       End If
    Loop
    
    InternetCloseHandle (hFind)
End Sub


Private Sub optAscii_Click()
    dwType = FTP_TRANSFER_TYPE_ASCII
End Sub

Private Sub optBin_Click()
    dwType = FTP_TRANSFER_TYPE_BINARY
End Sub

Private Sub TreeView1_DblClick()
    Dim nodX As Node
    Set nodX = TreeView1.SelectedItem
    If Not bActiveSession Then
        MsgBox "No in session!"
        Exit Sub
    End If
    If nodX Is Nothing Then
        MsgBox "no Selection to enumerate"
    End If
    If nodX.Image = "closed" Then
        nodX.Image = "open"
        FtpEnumDirectory (nodX.Text)
        FillTreeViewControl (nodX.Text)
    Else
        If nodX.Image = "open" Then
            nodX.Image = "closed"
            Dim nodChild As Node, nodNextChild As Node
            Set nodChild = nodX.Child
            Do
            Set nodNextChild = nodChild.Next
                TreeView1.Nodes.Remove nodChild.Index
                If nodNextChild Is Nothing Then Exit Do
                Set nodChild = nodNextChild
            Loop
        End If
    End If
End Sub