📄 form1.frm
字号:
VERSION 5.00
Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1
Caption = "FTP浏览"
ClientHeight = 4905
ClientLeft = 60
ClientTop = 345
ClientWidth = 6660
LinkTopic = "Form1"
ScaleHeight = 4905
ScaleWidth = 6660
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command3
Caption = "退出"
Height = 375
Left = 5400
TabIndex = 11
Top = 1320
Width = 1100
End
Begin VB.CommandButton Command2
Caption = "断开"
Height = 375
Left = 5400
TabIndex = 10
Top = 720
Width = 1100
End
Begin MSComctlLib.ListView ListView1
Height = 2175
Left = 240
TabIndex = 9
Top = 2160
Width = 5775
_ExtentX = 10186
_ExtentY = 3836
View = 3
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 393217
Icons = "ImageList1"
SmallIcons = "ImageList1"
ColHdrIcons = "ImageList1"
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin MSComctlLib.ImageList ImageList1
Left = 6000
Top = 1800
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 32
ImageHeight = 32
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 2
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Form1.frx":0000
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Form1.frx":0454
Key = ""
EndProperty
EndProperty
End
Begin VB.CheckBox Check1
Caption = "匿名"
Height = 375
Left = 4200
TabIndex = 8
Top = 960
Width = 855
End
Begin VB.TextBox Text3
Height = 350
IMEMode = 3 'DISABLE
Left = 1800
PasswordChar = "*"
TabIndex = 6
Top = 1560
Width = 1815
End
Begin VB.CommandButton Command1
Caption = "连接"
Height = 375
Left = 5400
TabIndex = 4
Top = 240
Width = 1100
End
Begin VB.Timer Timer2
Interval = 50
Left = 6240
Top = 3120
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 500
Left = 6240
Top = 2400
End
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 495
Left = 0
TabIndex = 3
Top = 4410
Width = 6660
_ExtentX = 11748
_ExtentY = 873
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 3
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
EndProperty
End
Begin InetCtlsObjects.Inet Inet1
Left = 6000
Top = 3600
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
AccessType = 1
Protocol = 2
RemotePort = 21
URL = "ftp://"
End
Begin VB.TextBox Text2
Height = 350
Left = 1800
TabIndex = 2
Text = $"Form1.frx":08A8
Top = 960
Width = 1815
End
Begin VB.TextBox Text1
Height = 350
Left = 1800
TabIndex = 0
Top = 240
Width = 2895
End
Begin VB.Label Label3
Caption = "密码："
Height = 375
Left = 720
TabIndex = 7
Top = 1560
Width = 735
End
Begin VB.Label Label2
Caption = "用户名："
Height = 375
Left = 600
TabIndex = 5
Top = 1080
Width = 735
End
Begin VB.Label Label1
Caption = "FTP服务器地址："
Height = 375
Left = 360
TabIndex = 1
Top = 360
Width = 1575
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strDirectory As String
Dim InetState As String
Private Sub Check1_Click()
If Check1.Value = 1 Then
Text2.Text = "anonymous"
Text3.Text = "aldl@263.net"
Else
Text2.Text = ""
Text3.Text = ""
End If
End Sub
Private Sub Command1_Click()
Dim i As Integer, temp As String, strurl As String
On Error GoTo Handle
strurl = Text1.Text
Inet1.UserName = Text2.Text
Inet1.Password = Text3.Text
For i = 1 To 4 '处理输入的URL
temp = Mid(strurl, i, 1)
If Asc(temp) <= Asc("z") And Asc(temp) >= Asc("a") Then
strurl = Left(strurl, i - 1) + StrConv(temp, vbUpperCase) + Right(strurl, Len(strurl) - i)
End If
Next i
If Left$(strurl, 6) = "FTP://" Then
Inet1.Execute strurl
Else
Inet1.Execute "ftp://" & strurl
End If
Timer1.Enabled = True
Handle:
StatusBar1.Panels(2).Text = Err.Description
StatusBar1.Refresh
End Sub
Private Sub Command2_Click()
Inet1.Cancel
ListView1.ListItems.Clear
End Sub
Private Sub Command3_Click()
End
End Sub
Private Sub Form_Load()
StatusBar1.Panels(1).Width = StatusBar1.Width / 2
StatusBar1.Panels(2).Width = StatusBar1.Width / 4
StatusBar1.Panels(3).Width = StatusBar1.Width / 4
ListView1.View = 0 '使用大图标格式
End Sub
Private Sub Inet1_StateChanged(ByVal State As Integer)
InetState = State
DoEvents
End Sub
Private Sub Timer1_Timer()
DoEvents
'监视连接状态
If Inet1.StillExecuting Then
StatusBar1.Panels(2).Text = "wait......."
Else
If InetState = 12 Then
Timer1.Enabled = False
Dim iFile As Integer
Dim strBuff As String
strBuff = Inet1.GetChunk(1024)
iFile = FreeFile()
'Len1 = Len(strBuff)
FillList (strBuff)
End If
End If
End Sub
Private Sub Timer2_Timer()
DoEvents
'解释连接状态
StatusBar1.Panels(3).Text = Inet1.ResponseInfo
Select Case InetState
Case 0
StatusBar1.Panels(1).Text = "未连接"
Case 1
StatusBar1.Panels(1).Text = "正在查询主机的IP地址"
Case 2
StatusBar1.Panels(1).Text = "地址已找到"
Case 3
StatusBar1.Panels(1).Text = "正在与主机连接"
Case 4
StatusBar1.Panels(1).Text = "已与主机连接成功"
Case 5
StatusBar1.Panels(1).Text = "正在向主机发送请求"
Case 6
StatusBar1.Panels(1).Text = "发送请求已成功"
Case 7
StatusBar1.Panels(1).Text = "正在接收主机的响应"
Case 8
StatusBar1.Panels(1).Text = "已成功地接收到主机的响应"
Case 9
StatusBar1.Panels(1).Text = "正在解除与主机的连接"
Case 10
StatusBar1.Panels(1).Text = "已成功地与主机解除了连接"
Case 11
StatusBar1.Panels(1).Text = "与主机通讯时出现了错误"
Case 12
StatusBar1.Panels(1).Text = "完成" '请求已经完成，并且所有数据均已接收到
End Select
End Sub
Private Sub FillList(dirName As String)
'处理返回的目录信息
Dim i As Integer, i1 As Integer, i2 As Integer, j As Integer
Dim nodexx As ListItem, ss As String, filen As String
Dim TL As Boolean
ListView1.ListItems.Clear
i2 = 0
1:
i1 = Len(dirName)
TL = False
For i = 1 To i1
ss = Mid(dirName, i, 1)
aa = Asc(ss)
If aa = 13 Then
filen = Mid(dirName, 1, i - 1)
If Len(filen) >= 1 Then
i2 = i2 + 1
For j = 1 To Len(filen)
If Mid(filen, j, 1) = "/" Then
TL = True
filen = Mid(filen, 1, j - 1)
Exit For
End If
Next j
If TL Then
Set nodexx = ListView1.ListItems.Add(i2, filen, filen, 1)
Else
Set nodexx = ListView1.ListItems.Add(i2, filen, filen, 2)
End If
ListView1.View = 0
dirName = Mid(dirName, i + 2, i1 - i - 2)
GoTo 1
End If
End If
Next i
StatusBar1.Panels(2).Text = "共" & Str$(i2) & "个项目"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -