📄 inet.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 = "Inet"
ClientHeight = 5100
ClientLeft = 60
ClientTop = 345
ClientWidth = 5895
LinkTopic = "Form1"
ScaleHeight = 5100
ScaleWidth = 5895
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton UpCmd
Caption = "向上"
Height = 255
Left = 5400
TabIndex = 15
Top = 720
Width = 495
End
Begin VB.ComboBox Combo1
Height = 300
Left = 120
TabIndex = 14
Top = 720
Width = 5055
End
Begin InetCtlsObjects.Inet Inet1
Left = 1800
Top = 3600
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
AccessType = 1
Protocol = 2
RemotePort = 21
URL = "ftp://"
End
Begin MSComctlLib.ImageList ImageList1
Left = 3600
Top = 3120
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 2
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Inet.frx":0000
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "Inet.frx":0452
Key = ""
EndProperty
EndProperty
End
Begin VB.Frame Frame1
Caption = "Frame1"
Height = 1095
Left = 120
TabIndex = 12
Top = 3840
Width = 5655
Begin VB.TextBox Text1
Height = 735
Left = 120
MultiLine = -1 'True
TabIndex = 13
Top = 240
Width = 5415
End
End
Begin MSComctlLib.ListView List1
Height = 2775
Left = 120
TabIndex = 11
Top = 960
Width = 5655
_ExtentX = 9975
_ExtentY = 4895
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 393217
Icons = "ImageList1"
SmallIcons = "ImageList1"
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin VB.CommandButton CloseCmd
Caption = "断开"
Height = 255
Left = 5400
TabIndex = 10
Top = 360
Width = 495
End
Begin VB.CommandButton ConCmd
Caption = "连接"
Height = 255
Left = 5400
TabIndex = 9
Top = 0
Width = 495
End
Begin VB.CheckBox Check1
Caption = "匿名访问"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 600
TabIndex = 4
Top = 360
Width = 1215
End
Begin VB.TextBox PassTxt
Height = 270
IMEMode = 3 'DISABLE
Left = 4320
PasswordChar = "*"
TabIndex = 3
Top = 360
Width = 975
End
Begin VB.TextBox UserTxt
Height = 270
Left = 2640
TabIndex = 2
Top = 360
Width = 1095
End
Begin VB.TextBox PortTxt
Height = 270
Left = 4800
TabIndex = 1
Text = "21"
Top = 0
Width = 495
End
Begin VB.TextBox UrlTxt
Height = 270
Left = 600
TabIndex = 0
Text = "162.105.37.72"
Top = 0
Width = 3615
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "密码"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 3840
TabIndex = 8
Top = 360
Width = 420
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "用户名"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 1920
TabIndex = 7
Top = 360
Width = 630
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "端口"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 4320
TabIndex = 6
Top = 0
Width = 420
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "地址"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 120
TabIndex = 5
Top = 0
Width = 420
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim InetData As Variant
Dim CurrentServerDir As String
Dim xpos As Long, ypos As Long
Dim OperationStyle As Integer
Private Sub Form_Load()
Check1.Value = 1
UserTxt.Enabled = False
PassTxt.Enabled = False
UpCmd.Enabled = False
ConCmd.Enabled = True
CloseCmd.Enabled = False
List1.ColumnHeaders.Add 1, "名称", "名称", List1.Width
End Sub
Private Sub Check1_Click()
If Check1.Value = 0 Then
UserTxt.Enabled = True
PassTxt.Enabled = True
End If
End Sub
' 连接服务器
Private Sub ConCmd_Click()
With Inet1
If Left(Trim(UrlTxt.Text), 6) <> "ftp://" Then
.URL = "ftp://" & Trim(UrlTxt.Text)
End If
If PortTxt.Text <> "" Then
.RemotePort = CInt(Trim(PortTxt.Text))
Else
.RemotePort = 21
End If
If Check1.Value = 1 Then
.UserName = ""
Else
.UserName = Trim(UserTxt.Text)
.Password = Trim(PassTxt.Text)
End If
End With
CurrentServerDir = "/"
If Inet1.StillExecuting Then
MsgBox "无法断开保持连接"
Exit Sub
End If
'列出服务器根目录
ListServer
CloseCmd.Enabled = True
UpCmd.Enabled = True
End Sub
' 断开连接
Private Sub CloseCmd_Click()
Inet1.Cancel
List1.ListItems.Clear
UpCmd.Enabled = False
End Sub
'列出服务器指定目录的下的文件和子目录
Private Sub ListServer()
On Error GoTo ErrorH
If Not Inet1.StillExecuting Then
OperationStyle = 1
Inet1.Execute , "DIR"
End If
Exit Sub
ErrorH:
'
End Sub
' 返回连接状态信息
Private Sub Inet1_StateChanged(ByVal State As Integer)
Dim tempArray As Variant
Dim i As Integer
Dim FileSize As Variant
Dim itmX As ListItem
On Error Resume Next
Select Case State
Case 0
Case 1
Text1.Text = Text1.Text & vbCrLf & "正在查询所指定的主机的 IP 地址"
Case 2
Text1.Text = Text1.Text & vbCrLf & "已成功地找到所指定的主机的 IP 地址"
Case 3
Text1.Text = Text1.Text & vbCrLf & "正在与主机连接"
Case 4
Text1.Text = Text1.Text & vbCrLf & "已与主机连接成功"
Case 5
Text1.Text = Text1.Text & vbCrLf & "正在向主机发送请求"
Case 6
Text1.Text = Text1.Text & vbCrLf & "发送请求已成功"
Case 7
Text1.Text = Text1.Text & vbCrLf & "正在接收主机的响应"
Case 9
Text1.Text = Text1.Text & vbCrLf & "正在解除与主机的连接"
Case 10
Text1.Text = Text1.Text & vbCrLf & "已成功地与主机解除了连接"
Case 11
Text1.Text = Text1.Text & vbCrLf & "与主机通讯时出现了错误"
Text1.Text = Text1.Text & vbCrLf & "错误" & Inet1.ResponseCode & ":" & Inet1.ResponseInfo
Case 8, 12
Select Case OperationStyle
Case 1
Text1.Text = Text1.Text & vbCrLf & "成功列出目录内容"
List1.ListItems.Clear
InetData = Inet1.GetChunk(1024, 0)
Combo1.Text = CurrentServerDir
If Trim(InetData) <> 0 Then
tempArray = Split(InetData, vbCrLf, , vbTextCompare)
i = 0
Do While i < UBound(tempArray)
If tempArray(i) <> "" Then
DealList (tempArray(i))
End If
i = i + 1
Loop
End If
Case 2
Text1.Text = Text1.Text & vbCrLf & "成功改变目录"
ListServer
Case Else
End Select
End Select
Text1.SelLength = Len(Text1.Text)
End Sub
Private Sub DealList(tempStr As String)
If Right(Trim(tempStr), 1) <> "/" Then
'表示接受到的是文件
AddFileToList (tempStr)
Else
'表示接收到的是目录
AddDirToList (tempStr)
End If
End Sub
' 将文件名加入到列表视图中
Private Sub AddFileToList(tempStr As String)
Dim itmX As ListItem
Set itmX = List1.ListItems.Add(, , tempStr)
itmX.Icon = 1
itmX.SmallIcon = 1
End Sub
' 将目录加入到列表视图中
Private Sub AddDirToList(tempStr As String)
Dim itmX As ListItem
Set itmX = List1.ListItems.Add(, , tempStr)
itmX.Icon = 2
itmX.SmallIcon = 2
End Sub
Private Sub List1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
xpos = x
ypos = y
End Sub
Private Sub List1_DblClick()
Dim item As ListItem
If List1.HitTest(xpos, ypos) Is Nothing Then
Exit Sub
Else
Set item = List1.HitTest(xpos, ypos)
End If
Select Case item.Icon
Case 1 ' 是文件
Case 2 ' 是目录
OperationStyle = 2
If item.Text = "./" Then
ElseIf item.Text = "../" Then
Inet1.Execute , "CD ../"
UpServerDir
Else
CurrentServerDir = CurrentServerDir & item
Inet1.Execute , "CD " & CurrentServerDir
End If
End Select
End Sub
Private Sub Upcmd_Click()
If CurrentServerDir <> "" Then
If Inet1.StillExecuting Then
MsgBox "还没有执行完毕!"
Else
OperationStyle = 2
Inet1.Execute , "CD ../"
UpServerDir
End If
Else
MsgBox "已经到了最上一层目录!"
End If
End Sub
Private Sub UpServerDir()
Dim tempPos1 As Integer
On Error Resume Next
If CurrentServerDir <> "/" Then
tempPos1 = InStrRev(CurrentServerDir, "/", Len(CurrentServerDir) - 1, vbTextCompare)
CurrentServerDir = Mid(CurrentServerDir, 1, tempPos1)
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -