frmmain.frm

本书源码主要针对目前流行的FTP、HTTP、E-mail、Telnet、ICMP、Modem串口通信编程、拨号网络编程等内容进行详细的讲解

                    If intRetVal = vbYes Then
                        m_FtpConnection.CancelTransfer
                    End If
                End If
            Else
                Call tvTreeView.Nodes.Clear
                Call lvListView.ListItems.Clear
            End If
        '刷新
        Case "Refresh"
            Call RefreshDirectory
        '下载
        Case "Download"
            Call mnuDownload_Click
        '上载
        Case "Upload"
            Call mnuUpload_Click
        '创建目录
        Case "CreateDirectory"
            Call mnuCreateDir_Click
        '删除文件
        Case "Delete"
            Call mnuDelete_Click
        '更名
        Case "Rename"
            Call mnuRename_Click
        '大图标查看
        Case "View Large Icons"
            lvListView.View = lvwIcon
        '小图标查看
        Case "View Small Icons"
            lvListView.View = lvwSmallIcon
        '列表查看
        Case "View List"
            lvListView.View = lvwList
        '报表查看
        Case "View Details"
            lvListView.View = lvwReport
    End Select
End Sub

Private Sub mnuHelpAbout_Click()
    frmAbout.Show vbModal
End Sub

Private Sub mnuViewStatusBar_Click()
'显示或者隐藏状态栏
    mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked
    sbStatusBar.Visible = mnuViewStatusBar.Checked
    SizeControls imgSplitter.Left
End Sub

Private Sub mnuViewToolbar_Click()
'显示或者隐藏工具栏
    mnuViewToolbar.Checked = Not mnuViewToolbar.Checked
    CoolBar1.Visible = mnuViewToolbar.Checked
    SizeControls imgSplitter.Left
End Sub

Private Sub mnuFileClose_Click()
    '卸载窗体
    Unload Me
End Sub

Public Function GetImageNumber(strFileName As String) As Integer
'获得文件类型
    Dim iPos As Integer
    Dim strExt As String
    
    strExt = Mid$(strFileName, InStrRev(strFileName, ".") + 1)
    
    On Error Resume Next
    
    Select Case LCase(strExt)
        Case "txt", "htm", "html", "lst", "log", "ini", "inf", ""
            GetImageNumber = 1
        Case Else
            GetImageNumber = 2
    End Select
        
End Function

Public Function FormatFileSize(lFileSize As Long) As String
'格式化文件大小的显示形式
    On Error GoTo ERROR_HANDLER
    
    If lFileSize >= 1024 Then
        FormatFileSize = Format$(CStr(lFileSize / 1024), "###,###,###KB")
    Else
        FormatFileSize = CStr(lFileSize) & "bytes"
    End If

    Exit Function
    
ERROR_HANDLER:
    Debug.Print Err.Number & " " & Err.Description
    
End Function

Private Sub tvTreeView_DragDrop(Source As Control, x As Single, y As Single)
'tvTreeView控件的拖放事件
    If Source = imgSplitter Then
        SizeControls x
    End If
End Sub

Private Sub tvTreeView_NodeClick(ByVal Node As MSComctlLib.Node)
'tvTreeView节点单击事件
With m_FtpConnection
    If .Busy Then
        Set tvTreeView.SelectedItem = m_LastNode
        Exit Sub
    End If
    
    Set m_LastNode = Node
    
TryAgain:
    Debug.Print "Node.Key: " & Node.Key, "Node.FullPath: " & Node.FullPath
    If .SetCurrentDirectory(Replace$(Mid$(Node.FullPath, InStr(1, Node.FullPath, "/")), "//", "/")) Then
        Call ListFiles(Node)
    Else
        If .FtpGetLastError = ERROR_FTP_WINSOCK_BadState Then
            If .Connect Then
                GoTo TryAgain
            End If
        Else
        
        End If
    End If
    
End With
    
End Sub

Private Sub AddFileToListView(oFtpFile As CFtpFile)

    Dim intIcon     As Integer
    Dim strFileName As String
    
    strFileName = oFtpFile.FileName
    
    intIcon = GetImageNumber(strFileName)
    Set lvItem = lvListView.ListItems.Add(, strFileName, strFileName, intIcon, intIcon)
    lvItem.SubItems(1) = Format$(CStr(oFtpFile.FileSize), "###,##0")  'oFtpFile.FileSize 'FormatFileSize(oFtpFile.FileSize)
    lvItem.SubItems(2) = oFtpFile.LastWriteTime
    lvItem.SubItems(3) = oFtpFile.Permissions
    lvItem.SubItems(4) = oFtpFile.Owner
    lvItem.SubItems(5) = oFtpFile.Group
    
End Sub

Private Sub DownloadFile()
    
    On Error Resume Next
    
    Dim sFileSize           As String
    Dim lStartPoint         As Long
    Dim bForceDownload      As Boolean
    Dim vTransferMode       As FtpTransferModes
    
    With dlgCommonDialog

        .DialogTitle = "Download file and save as..."
        .CancelError = True
        .Filter = "All Files (*.*)|*.*"
        .FileName = lvListView.SelectedItem.Text
        .ShowSave
        If Err = 0 Then
            If Len(.FileName) = 0 Then
                
                Exit Sub
            End If
            '获得远程文件名
            m_strFile = lvListView.SelectedItem.Text
            '获得远程文件名大小
            m_lFileSize = CLng(lvListView.SelectedItem.SubItems(1))
            '
            '获得传输模式
            If CBool(Option1(0).Value) Then
                vTransferMode = FTP_ASCII_MODE
            Else
                vTransferMode = FTP_IMAGE_MODE
            End If
                        
            If FileExists(.FileName) Then
                '
                Dim strQuestion As String
                Dim intRetVal   As Integer
                
                If FileLen(.FileName) < m_lFileSize Then
                '如果本地文件小于服务器上的文件
                    intRetVal = MsgBox("文件 " & .FileName & " 已经存在!" & vbCrLf & _
                                  "远程服务器文件的大小为 - " & m_lFileSize & " 字节" & vbCrLf & _
                                  "本地文件的大小为  - " & FileLen(.FileName) & " 字节" & vbCrLf & vbCrLf & _
                                  " 你想只下载不全的数据吗？" & vbclf & vbCrLf & _
                                  "注意: 如果选择no，将会创建一个新的文件!", _
                                  vbYesNoCancel + vbQuestion, "文件已经存在")
                    If intRetVal = vbYes Then
                        lStartPoint = FileLen(.FileName)
                    ElseIf intRetVal = vbCancel Then
                        Exit Sub
                    End If
                Else
                '如果本地文件大于服务器上的文件
                    intRetVal = MsgBox("文件 " & .FileName & " 已经存在!" & vbCrLf & _
                                  "远程服务器文件的大小为 - " & m_lFileSize & " 字节" & vbCrLf & _
                                  "本地文件的大小为  - " & FileLen(.FileName) & " 字节" & vbCrLf & vbCrLf & _
                                  "你需要取消文件下载吗?" & vbclf & vbCrLf & _
                                  "注意: 如果选择no，则将会创建一个新文件.", _
                                  vbYesNo + vbQuestion, "文件已经存在!")
                    If intRetVal = vbYes Then
                        Exit Sub
                    End If
                End If
            End If
           
TryAgain:
            If Not m_FtpConnection.DownloadFile(m_strFile, .FileName, _
                        vTransferMode, lStartPoint) Then
                If m_FtpConnection.FtpGetLastError = ERROR_FTP_WINSOCK_BadState Then
                    '失去控制连接
                    intRetVal = MsgBox("连接已经断开，你还希望继续连接吗?", vbQuestion + vbYesNo)
                    If intRetVal = vbYes Then
                    '如果选择yes，则继续连接
                        If m_FtpConnection.Connect Then
                            If m_FtpConnection.SetCurrentDirectory(tvTreeView.SelectedItem.FullPath) Then
                                GoTo TryAgain
                            End If
                        Else
                            MsgBox "连接不能建立!.", vbExclamation
                        End If
                    Else
                        Call ResetProgress
                    End If
                ElseIf m_FtpConnection.FtpGetLastError = ERROR_FTP_USER_TIMEOUT Then
                    intRetVal = MsgBox("服务器没有响应，需要继续尝试连接吗?", vbYesNo + vbQuestion)
                    If intRetVal = vbYes Then
                        GoTo TryAgain
                    Else
                        Call ResetProgress
                    End If
                Else
                    MsgBox "Error #" & m_FtpConnection.FtpGetLastError & vbCrLf & vbCrLf & _
                            m_FtpConnection.GetFtpErrorDescription, vbExclamation
                End If
            End If
        End If
    End With

End Sub

Private Function FileExists(strFileName As String) As Boolean
    
    On Error GoTo ERROR_HANDLER
    
    FileExists = (GetAttr(strFileName) And vbDirectory) = 0

ERROR_HANDLER:
    
End Function

Private Sub RefreshDirectory()
'该过程的功能是刷新目录
    With tvTreeView.SelectedItem
        '
        '从treeview中删除所有的子目录
        '
        If .Children > 0 Then
            For i = 1 To .Children
                tvTreeView.Nodes.Remove (.Child.Index)
            Next i
        End If
        '
        lvListView.ListItems.Clear
        '
        Call ListFiles(tvTreeView.SelectedItem)
        '
    End With
    
End Sub

Private Sub EstablishConnection()
'该过程的功能是建立连接
    Dim tvNode      As Node
    Dim sDirTemp1    As String
    Dim sDirTemp2    As String
    
    '创建一个frmconnect窗体的实例
    Dim f As New frmConnect
    
    '显示该窗体
    f.Show vbModal
    
    '如果单击窗体
    If f.Action = comdOK Then
        '清空listview和treeview
        tvTreeView.Nodes.Clear
        lvListView.ListItems.Clear
        '
        With m_FtpConnection
            '初始化参数
            .FtpServer = f.URL
            .UserName = f.UserName
            .Password = f.Password
            .PassiveMode = CBool(Check1.Value)
            '调用类的connect函数建立连接
            If .Connect Then
                Label1 = f.URL
                If .CurrentDirectory = "/" Then
                    '将根节点加入到treeview
                    Set tvNode = tvTreeView.Nodes.Add(, , , .CurrentDirectory, 1)
                    tvNode.Key = .CurrentDirectory
                    Set tvTreeView.SelectedItem = tvNode
                    Call ListFiles(tvNode, True)
                Else
                    sDirTemp1 = .CurrentDirectory
                    sDirTemp2 = Mid(sDirTemp1, 1, InStr(sDirTemp1, "/"))

                    'add root node to the treeview
                    Set tvNode = tvTreeView.Nodes.Add(, , sDirTemp2, sDirTemp2, 1)
                    sDirTemp1 = Mid(sDirTemp1, InStr(sDirTemp1, "/") + 1)


                    Do While InStr(sDirTemp1, "/") <> 0
                        sDirTemp2 = Mid(sDirTemp1, 1, InStr(sDirTemp1, "/") - 1)
                        Set tvNode = tvTreeView.Nodes.Add(tvNode.Key, tvwChild, tvNode.Key & sDirTemp2 & "/", sDirTemp2, 2)
                        tvNode.ExpandedImage = 3
                        sDirTemp1 = Mid(sDirTemp1, InStr(sDirTemp1, "/") + 1)
                    Loop

                    Set tvNode = tvTreeView.Nodes.Add(tvNode.Key, tvwChild, tvNode.Key & sDirTemp1 & "/", sDirTemp1, 2)
                    tvNode.ExpandedImage = 3
                    Set tvTreeView.SelectedItem = tvNode
                    Call ListFiles(tvNode)
                End If
            End If '.Connect
        End With 'm_FtpConnection
    End If 'f.Action = comdOK
End Sub

Private Sub ListFiles(Optional oNode As Node, Optional bRoot As Boolean = False)
'该函数的功能是列出文件
    Dim CurNode As Node
    Dim tvNode As Node
    Dim strNewKey As String
    
    On Error Resume Next

    lvListView.ListItems.Clear

    With m_FtpConnection
        .PassiveMode = CBool(Check1.Value)
        '如果连接已经建立
        Dim oFiles As New CFtpFiles
        Dim oFile As CFtpFile
        '计算根目录下的文件数
        If .EnumFiles(oFiles) Then
            Set oFiles = oFiles
            '如果数量大于一
            If oFiles.Count > 0 Then
                '获得集合中的所有文件
                For Each oFile In oFiles
                    If oFile.IsDirectory Then
                        '如果是目录，则增加目录节点
                        
                        If oNode.Key = oNode.Root.Key Then
                            If Not oNode.Key = "/" Then
                                strNewKey = oNode.Key & "/" & oFile.FileName & "/"
                            Else
                                strNewKey = oNode.Key & oFile.FileName & "/"
                            End If
                        Else
                            strNewKey = oNode.Key & oFile.FileName & "/"
                        End If
    
                        Set tvNode = tvTreeView.Nodes.Add(oNode.Key, tvwChild, strNewKey, oFile.FileName, 2)
                        
                        tvNode.ExpandedImage = 3
                    Else
                        '如果是文件，则在treeview中增加文件
                        
                        If tvTreeView.SelectedItem.Key = oNode.Key Then
                            AddFileToListView oFile
                        End If
                    End If
                Next
            End If
        Else
            MsgBox "Error #" & m_FtpConnection.FtpGetLastError & vbCrLf & vbCrLf & _
            m_FtpConnection.GetFtpErrorDescription, vbExclamation
        End If
    End With 'm_FtpConnection
    
    oNode.Expanded = True

End Sub

Private Sub ResetProgress()
'重新设置一些控件属性
    ProgressBar1.Value = 0
    sbStatusBar.Panels(1).Text = ""
    
End Sub