fmvbftpjr.frm

一个完整的ftp源代码!用VB写的!希望大家能够喜欢!

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.2#0"; "comctl32.ocx"
Begin VB.Form fmVBFTPJR 
   Caption         =   "vbftpjr"
   ClientHeight    =   5640
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8715
   LinkTopic       =   "Form1"
   ScaleHeight     =   5640
   ScaleWidth      =   8715
   StartUpPosition =   3  'Windows Default
   Begin VB.OptionButton optAscii 
      Caption         =   "Ascii"
      Height          =   195
      Left            =   3600
      TabIndex        =   20
      Top             =   3120
      Width           =   1095
   End
   Begin VB.OptionButton optBin 
      Caption         =   "Binary"
      Height          =   375
      Left            =   3600
      TabIndex        =   19
      Top             =   2640
      Width           =   855
   End
   Begin VB.CommandButton cmdPut 
      Caption         =   "<---Put<---"
      Height          =   495
      Left            =   3480
      TabIndex        =   18
      Top             =   3840
      Width           =   975
   End
   Begin VB.CommandButton cmdGet 
      Caption         =   "--->Get--->"
      Height          =   495
      Left            =   3480
      TabIndex        =   17
      Top             =   3360
      Width           =   975
   End
   Begin ComctlLib.TreeView TreeView1 
      Height          =   2655
      Left            =   360
      TabIndex        =   16
      Top             =   2640
      Width           =   3015
      _ExtentX        =   5318
      _ExtentY        =   4683
      _Version        =   327682
      Style           =   7
      Appearance      =   1
   End
   Begin VB.FileListBox File1 
      Height          =   2040
      Left            =   6960
      TabIndex        =   15
      Top             =   3120
      Width           =   1575
   End
   Begin VB.DirListBox Dir1 
      Height          =   2115
      Left            =   5040
      TabIndex        =   14
      Top             =   3120
      Width           =   1695
   End
   Begin VB.DriveListBox Drive1 
      Height          =   315
      Left            =   5040
      TabIndex        =   13
      Top             =   2640
      Width           =   3495
   End
   Begin VB.CheckBox chkPassive 
      Caption         =   "Passive FTP syntax"
      Height          =   255
      Left            =   3120
      TabIndex        =   12
      Top             =   1800
      Width           =   2175
   End
   Begin VB.CommandButton cmdDisconnect 
      Caption         =   "Disconnect"
      Height          =   495
      Left            =   5760
      TabIndex        =   11
      Top             =   1680
      Width           =   1815
   End
   Begin VB.CommandButton cmdConnect 
      Caption         =   "Connect"
      Height          =   495
      Left            =   360
      TabIndex        =   10
      Top             =   1680
      Width           =   2175
   End
   Begin VB.TextBox txtPassword 
      Height          =   375
      IMEMode         =   3  'DISABLE
      Left            =   7200
      PasswordChar    =   "*"
      TabIndex        =   9
      Top             =   1080
      Width           =   1095
   End
   Begin VB.TextBox txtUser 
      Height          =   375
      Left            =   4680
      TabIndex        =   7
      Top             =   1080
      Width           =   1095
   End
   Begin VB.TextBox txtServer 
      Height          =   375
      Left            =   1680
      TabIndex        =   4
      Top             =   1080
      Width           =   1455
   End
   Begin VB.CommandButton cmdClosehOpen 
      Caption         =   "Close Internet Session"
      Height          =   495
      Left            =   2280
      TabIndex        =   3
      Top             =   240
      Width           =   1935
   End
   Begin VB.TextBox txtProxy 
      Height          =   435
      Left            =   7200
      TabIndex        =   1
      Top             =   240
      Width           =   1095
   End
   Begin VB.CommandButton cmdInternetOpen 
      Caption         =   "Start Internet Session"
      Height          =   495
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   1935
   End
   Begin ComctlLib.ImageList ImageList1 
      Left            =   2280
      Top             =   5160
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      MaskColor       =   12632256
      _Version        =   327682
   End
   Begin VB.Label label4 
      Caption         =   "Password:"
      Height          =   255
      Left            =   6000
      TabIndex        =   8
      Top             =   1080
      Width           =   855
   End
   Begin VB.Label Label3 
      Caption         =   "User Name:"
      Height          =   255
      Left            =   3360
      TabIndex        =   6
      Top             =   1080
      Width           =   975
   End
   Begin VB.Label Label2 
      Caption         =   "FTP Server Name:"
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   1080
      Width           =   1335
   End
   Begin VB.Line Line1 
      X1              =   240
      X2              =   8520
      Y1              =   840
      Y2              =   840
   End
   Begin VB.Label Label1 
      Caption         =   "TIS Compatible Proxy (No CERN):"
      Height          =   255
      Left            =   4440
      TabIndex        =   2
      Top             =   360
      Width           =   2535
   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
    EnableUI (False)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    cmdClosehOpen_Click
End Sub

Private Sub cmdInternetOpen_Click()
    If Len(txtProxy.Text) <> 0 Then
        hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PROXY, txtProxy.Text, vbNullString, 0)
    Else
        hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
    End If
    If hOpen = 0 Then ErrorOut Err.LastDllError, "InternetOpen"
    EnableUI (True)
End Sub

Private Sub cmdClosehOpen_Click()
    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
    EnableUI (False)
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 = ""