fmvbftpjr.frm

VB源码,是初学者的福因.让你很快掌握VB编程

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form fmVBFTPJR 
   Caption         =   "vbftpjr"
   ClientHeight    =   4290
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8715
   LinkTopic       =   "Form1"
   ScaleHeight     =   4290
   ScaleWidth      =   8715
   StartUpPosition =   3  '窗口缺省
   Begin VB.OptionButton optAscii 
      Caption         =   "Ascii"
      Height          =   195
      Left            =   3600
      TabIndex        =   16
      Top             =   1920
      Width           =   1095
   End
   Begin VB.OptionButton optBin 
      Caption         =   "Binary"
      Height          =   375
      Left            =   3600
      TabIndex        =   15
      Top             =   1440
      Width           =   855
   End
   Begin VB.CommandButton cmdPut 
      Caption         =   "<--Put<--"
      Height          =   495
      Left            =   3480
      TabIndex        =   14
      Top             =   2640
      Width           =   975
   End
   Begin VB.CommandButton cmdGet 
      Caption         =   "-->Get-->"
      Height          =   495
      Left            =   3480
      TabIndex        =   13
      Top             =   2160
      Width           =   975
   End
   Begin ComctlLib.TreeView TreeView1 
      Height          =   2655
      Left            =   360
      TabIndex        =   12
      Top             =   1440
      Width           =   3015
      _ExtentX        =   5318
      _ExtentY        =   4683
      _Version        =   327682
      Style           =   7
      Appearance      =   1
   End
   Begin VB.FileListBox File1 
      Height          =   1890
      Left            =   6960
      TabIndex        =   11
      Top             =   1920
      Width           =   1575
   End
   Begin VB.DirListBox Dir1 
      Height          =   1980
      Left            =   5040
      TabIndex        =   10
      Top             =   1920
      Width           =   1695
   End
   Begin VB.DriveListBox Drive1 
      Height          =   300
      Left            =   5040
      TabIndex        =   9
      Top             =   1440
      Width           =   3495
   End
   Begin VB.CheckBox chkPassive 
      Caption         =   "Passive FTP syntax"
      Height          =   255
      Left            =   3120
      TabIndex        =   8
      Top             =   840
      Width           =   2175
   End
   Begin VB.CommandButton cmdDisconnect 
      Caption         =   "Disconnect"
      Height          =   495
      Left            =   5760
      TabIndex        =   7
      Top             =   720
      Width           =   1815
   End
   Begin VB.CommandButton cmdConnect 
      Caption         =   "Connect"
      Height          =   495
      Left            =   360
      TabIndex        =   6
      Top             =   720
      Width           =   2175
   End
   Begin VB.TextBox txtPassword 
      Height          =   375
      IMEMode         =   3  'DISABLE
      Left            =   7200
      PasswordChar    =   "*"
      TabIndex        =   5
      Top             =   120
      Width           =   1095
   End
   Begin VB.TextBox txtUser 
      Height          =   375
      Left            =   4680
      TabIndex        =   3
      Top             =   120
      Width           =   1095
   End
   Begin VB.TextBox txtServer 
      Height          =   375
      Left            =   1680
      TabIndex        =   0
      Top             =   120
      Width           =   1455
   End
   Begin ComctlLib.ImageList ImageList1 
      Left            =   3600
      Top             =   3360
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      MaskColor       =   12632256
      _Version        =   327682
   End
   Begin VB.Label label4 
      Caption         =   "Password:"
      Height          =   255
      Left            =   6000
      TabIndex        =   4
      Top             =   120
      Width           =   855
   End
   Begin VB.Label Label3 
      Caption         =   "User Name:"
      Height          =   255
      Left            =   3360
      TabIndex        =   2
      Top             =   120
      Width           =   975
   End
   Begin VB.Label Label2 
      Caption         =   "FTP Server Name:"
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   1695
   End
End
Attribute VB_Name = "fmVBFTPJR"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim bActiveSession As Boolean
Dim hOpen As Long, hConnection As Long
Dim dwType As Long

Dim EnumItemNameBag As New Collection
Dim EnumItemAttributeBag As New Collection
    

Private Sub Form_Load()
    bActiveSession = False
    hOpen = 0
    hConnection = 0
    chkPassive.Value = 1
    optBin.Value = 1
    dwType = FTP_TRANSFER_TYPE_BINARY
    Dim imgI As ListImage
    Set imgI = ImageList1.ListImages.Add(, "open", LoadPicture("open.bmp"))
    Set imgI = ImageList1.ListImages.Add(, "closed", LoadPicture("closed.bmp"))
    Set imgI = ImageList1.ListImages.Add(, "leaf", LoadPicture("leaf.bmp"))
    Set imgI = ImageList1.ListImages.Add(, "root", LoadPicture("root.bmp"))
    TreeView1.ImageList = ImageList1
    TreeView1.Style = tvwTreelinesPictureText
    hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
    If hOpen = 0 Then ErrorOut Err.LastDllError, "InternetOpen"
    cmdDisconnect.Enabled = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If hConnection <> 0 Then InternetCloseHandle (hConnection)
    If hOpen <> 0 Then InternetCloseHandle (hOpen)
    hConnection = 0
    hOpen = 0
    If bActiveSession Then TreeView1.Nodes.Remove txtServer.Text
    bActiveSession = False
    ClearTextBoxAndBag
End Sub

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 cmdDisconnect_Click()
    bDirEmpty = True
    If hConnection <> 0 Then InternetCloseHandle hConnection
    hConnection = 0
    ClearBag
    TreeView1.Nodes.Remove txtServer.Text
    bActiveSession = False
    EnableUI (True)
End Sub

Private Sub ClearTextBoxAndBag()
    txtServer.Text = ""
    txtUser.Text = ""
    txtPassword.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