📄 frmftp2.frm
字号:
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmFTP2
Caption = "FTP客户端程序"
ClientHeight = 5310
ClientLeft = 60
ClientTop = 345
ClientWidth = 6750
LinkTopic = "Form1"
ScaleHeight = 5310
ScaleWidth = 6750
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame4
Height = 1350
Left = 30
TabIndex = 13
Top = 60
Width = 6615
Begin VB.TextBox txtPort
Appearance = 0 'Flat
Height = 315
Left = 3750
TabIndex = 27
Top = 180
Width = 825
End
Begin VB.TextBox txtServer
Appearance = 0 'Flat
Height = 315
Left = 1425
TabIndex = 25
Top = 180
Width = 1410
End
Begin VB.CheckBox chkAnon
Caption = "匿名登录"
Height = 315
Left = 3090
TabIndex = 22
Top = 960
Width = 1530
End
Begin VB.CheckBox chkPassive
Caption = "FTP反向对话"
Height = 315
Left = 3105
TabIndex = 18
Top = 615
Width = 1995
End
Begin VB.CommandButton cmdDisconnect
Caption = "断开"
Height = 345
Left = 5205
TabIndex = 17
Top = 690
Width = 1275
End
Begin VB.CommandButton cmdConnect
Caption = "连接"
Height = 375
Left = 5160
TabIndex = 16
Top = 195
Width = 1335
End
Begin VB.TextBox txtPassword
Appearance = 0 'Flat
Height = 300
IMEMode = 3 'DISABLE
Left = 1425
PasswordChar = "*"
TabIndex = 15
Top = 960
Width = 1395
End
Begin VB.TextBox txtUser
Appearance = 0 'Flat
Height = 300
Left = 1425
TabIndex = 14
Top = 585
Width = 1395
End
Begin VB.Label Label5
Alignment = 1 'Right Justify
Caption = "端口:"
Height = 300
Left = 3090
TabIndex = 26
Top = 240
Width = 585
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Caption = "FTP服务器:"
Height = 255
Left = 180
TabIndex = 24
Top = 195
Width = 1005
End
Begin VB.Label label4
Alignment = 1 'Right Justify
Caption = "口令:"
Height = 255
Left = 180
TabIndex = 20
Top = 990
Width = 1005
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
Caption = "用户名:"
Height = 255
Left = 180
TabIndex = 19
Top = 615
Width = 1005
End
End
Begin VB.Frame Frame3
Caption = "FTP服务器:"
Height = 2010
Left = 1245
TabIndex = 11
Top = 1485
Width = 5415
Begin ComctlLib.TreeView TreeView1
Height = 1635
Left = 120
TabIndex = 12
Top = 255
Width = 5145
_ExtentX = 9075
_ExtentY = 2884
_Version = 327682
Style = 7
Appearance = 1
End
Begin ComctlLib.ImageList ImageList1
Left = 4440
Top = -165
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
MaskColor = 12632256
_Version = 327682
End
End
Begin VB.Frame Frame2
Caption = "本地计算机:"
Height = 1620
Left = 1260
TabIndex = 5
Top = 3570
Width = 5370
Begin VB.FileListBox File1
Height = 1350
Left = 2475
TabIndex = 8
Top = 195
Width = 2865
End
Begin VB.DirListBox Dir1
Height = 930
Left = 105
TabIndex = 7
Top = 600
Width = 2160
End
Begin VB.DriveListBox Drive1
Height = 300
Left = 135
TabIndex = 6
Top = 195
Width = 2160
End
End
Begin VB.Frame Frame1
Height = 3675
Left = 60
TabIndex = 0
Top = 1485
Width = 1125
Begin VB.CommandButton cmdDelFile
Caption = "删除文件"
Height = 345
Left = 105
TabIndex = 23
Top = 3075
Width = 900
End
Begin VB.CommandButton cmdDelDir
Caption = "删除目录"
Height = 345
Left = 135
TabIndex = 10
Top = 2628
Width = 900
End
Begin VB.CommandButton cmdMdDir
Caption = "新建目录"
Height = 345
Left = 120
TabIndex = 9
Top = 2190
Width = 900
End
Begin VB.OptionButton optAscii
Caption = "文本"
Height = 330
Left = 90
TabIndex = 4
Top = 930
Width = 855
End
Begin VB.OptionButton optBin
Caption = "二进制"
Height = 330
Left = 90
TabIndex = 3
Top = 540
Width = 855
End
Begin VB.CommandButton cmdPut
Caption = "上载"
Height = 345
Left = 135
TabIndex = 2
Top = 1766
Width = 900
End
Begin VB.CommandButton cmdGet
Caption = "下载"
Height = 345
Left = 150
TabIndex = 1
Top = 1335
Width = 900
End
Begin VB.Label Label1
Caption = "传输方式:"
Height = 300
Left = 90
TabIndex = 21
Top = 210
Width = 960
End
End
End
Attribute VB_Name = "frmFTP2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub chkAnon_Click()
'设置匿名登录时的参数,用户名为NULL,口令也为NULL
Static strUser As String
If chkAnon.Value = 1 Then
strUser = txtUser.Text
txtUser.Text = "Anonymous"
txtPassword.Text = ""
Else
'不是采取匿名登录连接时,设置恢复原来的用户名
txtUser.Text = strUser
txtPassword.Text = ""
End If
End Sub
Private Sub cmdConnect_Click()
'连接ftp服务器,只有当前不处于连接状态时连接
If Not bActiveSession And hOpen <> 0 Then
If txtServer.Text = "" Then
MsgBox "请键入要连接的FTP服务器的域名或IP地址!"
Exit Sub
End If
Dim nFlag As Long
If chkPassive.Value Then
'设置FTP会话是反向的
nFlag = INTERNET_FLAG_PASSIVE
Else
nFlag = 0
End If
Dim strUser As String
Dim strPassword As String
If chkAnon.Value = 1 Then
'匿名登录连接时,登录用户名及口令均为NULL
strUser = ""
strPassword = ""
Else
'用用户名及口令连接
strUser = txtUser.Text
strPassword = txtPassword.Text
End If
Dim Port As Integer
If Val(txtPort.Text) < 0 Then
Port = INTERNET_INVALID_PORT_NUMBER
Else
Port = Val(txtPort.Text)
End If
'根据打开internet连接的函数internetopen()返回的句柄,用户名,口令
'打开与ftp服务器的连接
hConnection = InternetConnect(hOpen, txtServer.Text, Port, _
strUser, strPassword, INTERNET_SERVICE_FTP, nFlag, 0)
If hConnection = 0 Then
'与ftp服务器的连接失败,显示连接错误信息
bActiveSession = False
ErrorOut Err.LastDllError, "InternetConnect"
Else
'与FTP服务器的连接成功,设置各个控件的Enabled属性
bActiveSession = True
chkPassive.Enabled = True
chkAnon.Enabled = False
cmdConnect.Enabled = False
cmdDisconnect.Enabled = True
txtServer.Enabled = False
txtPort.Enabled = False
txtUser.Enabled = False
txtPassword.Enabled = False
EnableUI (True)
FillTreeViewControl (txtServer.Text)
'FtpEnumDirectory()---遍历服务器当前目录下的文件及文件夹,并将其
'添加到treeview中
'在此子程序中使用了FtpFindFirstFile
'FtpFindNextFile函数,可将当前目录下的文件全部找出来
FtpEnumDirectory ("")
If EnumItemNameBag.Count = 0 Then Exit Sub
'集合EnumItemNameBag为空,遍历目录下的文件数为0
FillTreeViewControl (txtServer.Text)
End If
End If
End Sub
Private Sub cmdDelDir_Click()
Dim temp
temp = MsgBox("在本地计算机删除目录请按 “是”" & vbCrLf _
& "在FTP服务器上删除目录请按“否”", vbYesNoCancel)
If temp = vbCancel Then Exit Sub
If temp = vbYes Then
RmDir (Dir1.Path)
Dir1.Refresh
Exit Sub
End If
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
Dim strDelDir As String
strDelDir = TreeView1.SelectedItem.Text
Set nodX = TreeView1.SelectedItem.Parent
'以下程序的作用是在ftp服务器删除目录文件夹
If bActiveSession Then
If nodX Is Nothing Then
MsgBox "请选择FTP服务器上一个要删除的目录!"
Exit Sub
End If
If nodX.Image = "leaf" Then
MsgBox "请选择FTP服务器上一个要删除的目录!"
Exit Sub
End If
'取得要删除的目录名
strDelDir = Right(strDelDir, Len(strDelDir) - Len(txtServer.Text))
Dim bMake As Boolean
'根据目录名删除目录
bMake = FtpRemoveDirectory(hConnection, strDelDir)
If bMake Then
MsgBox "文件夹删除成功!"
'将ftp服务器当前目录下的节点去除
Dim nodChild As Node, nodNextChild As Node
Set nodChild = nodX.Child
'删除TreeView中所有的节点
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
'重新取得当前FTP目录下的文件及目录,加入到TreeView中
FtpEnumDirectory (nodX.Text)
FillTreeViewControl (nodX.Text)
End If
End If
End Sub
Private Sub cmdDelFile_Click()
'此子程序的作用是在ftp服务器删除文件
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
Dim strDelFile As String
strDelFile = TreeView1.SelectedItem.Text
Set nodX = TreeView1.SelectedItem.Parent
If bActiveSession Then
If TreeView1.SelectedItem.Image <> "leaf" Then
MsgBox "请选择FTP服务器中要删除的文件!"
Exit Sub
End If
strDelFile = Right(strDelFile, Len(strDelFile) - Len(txtServer.Text))
Dim bMake As Boolean
bMake = FtpDeleteFile(hConnection, strDelFile)
If bMake Then
MsgBox "文件删除成功!"
'将Treeview中FTP服务器当前目录下的节点去除
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
'重新取得当前FTP服务器目录下的文件,加入到
'TreeView相应的节点中
FtpEnumDirectory (nodX.Text)
FillTreeViewControl (nodX.Text)
End If
End If
End Sub
Private Sub cmdDisconnect_Click()
'断开连接,关闭所有的Internet连接的句柄
'去除TreeView中所有节点
'清除所有对象集合的元素
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -