📄 inet.frm
字号:
Width = 600
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "用户名:"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 240
Index = 2
Left = 5004
TabIndex = 2
Top = 108
Width = 840
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "端口:"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 240
Index = 1
Left = 3744
TabIndex = 1
Top = 108
Width = 600
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "服务器地址："
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 240
Index = 0
Left = 12
TabIndex = 0
Top = 108
Width = 1440
End
Begin VB.Menu mnuServer
Caption = "服务器"
Visible = 0 'False
Begin VB.Menu sdeletedir
Caption = "删除目录"
End
Begin VB.Menu screatedir
Caption = "创建目录"
End
Begin VB.Menu aaa
Caption = "-"
End
Begin VB.Menu srename
Caption = "改文件名"
End
Begin VB.Menu sdeletefile
Caption = "删除文件"
End
End
End
Attribute VB_Name = "form_inet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim InetData As Variant
Dim CurrentDir As String
Dim CurrentServerDir As String
Dim xpos As Long, ypos As Long
Dim xpos1 As Long, ypos1 As Long
Dim OperationStyle As Integer
'创建的新的目录名
Dim NewDir As String
'新文件名
Dim NewFileName As String
'原来文件名
Dim OldFileName As String
Dim itemA As ListItem
'表示已经得到文件的大小
Dim SizeGet As Boolean
Dim ListIndex As Integer
'1表示列出服务器目录
'2表示获得文件大小
Private Sub cmdCancel_Click()
If Not Inet1.StillExecuting Then
Inet1.Cancel
'Inet1.Execute , "close"
Else
MsgBox "系统正在忙！"
End If
End Sub
Private Sub cmdConnect_Click()
InitInet
End Sub
Private Sub cmdDownLoad_Click()
On Error Resume Next
DownFile CurrentServerDir & ListServerDir.SelectedItem, CurrentDir & ListServerDir.SelectedItem
End Sub
Private Sub cmdUpDir_Click()
ChDir ".."
Dir1.Path = CurDir
If Right(Dir1.Path, 1) <> "\" Then
CurrentDir = Dir1.Path & "\"
cmdUpDir.Enabled = True
Else
CurrentDir = Dir1.Path
cmdUpDir.Enabled = False
End If
ListClientDir.ListItems.Clear 'Clear Out Old Items
Combo1.Text = CurrentDir
AddFileToListClientDir
AddDirToListClientDir
End Sub
Private Sub cmdUpLoad_Click()
On Error Resume Next
UpFile CurrentDir & ListClientDir.SelectedItem, CurrentServerDir & ListClientDir.SelectedItem
End Sub
Private Sub cmdUpSDir_Click()
If CurrentServerDir <> "" Then
If Inet1.StillExecuting Then
MsgBox "还没有执行完毕!"
Else
ListServer UpServerDir
End If
Else
MsgBox "已经到了最上一层目录!"
End If
End Sub
Private Function UpServerDir() As String
Dim tempPos1 As Integer
On Error Resume Next
If CurrentServerDir <> "" Then
tempPos1 = InStrRev(CurrentServerDir, "/", Len(CurrentServerDir) - 1, vbTextCompare)
CurrentServerDir = Mid(CurrentServerDir, 1, tempPos1)
UpServerDir = CurrentServerDir
End If
End Function
Private Sub Dir1_Change()
OperationStyle = 6
File1.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub Form_Load()
With ListClientDir
.View = lvwReport
.ColumnHeaders.Add , "name", "名称", 1000
.ColumnHeaders.Add , "date", "日期时间", 1800
End With
With ListServerDir
.View = lvwReport
.ColumnHeaders.Add , "name", "名称", 800
.ColumnHeaders.Add , "size", "大小", 800
.ColumnHeaders.Add , "date", "日期", 800
.ColumnHeaders.Add , "time", "时间", 800
.ColumnHeaders.Add , "property", "属性", 800
End With
'把驱动器设置成当前驱动器
ChDrive Drive1.Drive
'把目录设置成当前目录
Dir1.Path = CurDir
InitListClientDir
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
DoEvents
Set form_inet = Nothing
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 'icNone
Text1.Text = Text1.Text & vbCrLf & "无状态可报告"
Case 1 'icHostResolvingHost
Text1.Text = Text1.Text & vbCrLf & "正在查询所指定的主机的 IP 地址"
Case 2 'icHostResolved
Text1.Text = Text1.Text & vbCrLf & "已成功地找到所指定的主机的 IP 地址"
Case 3 'icConnecting
Text1.Text = Text1.Text & vbCrLf & "正在与主机连接"
Case 4 'icConnected
Text1.Text = Text1.Text & vbCrLf & "已与主机连接成功"
Case 5 'icRequesting
Text1.Text = Text1.Text & vbCrLf & "正在向主机发送请求"
Case 6 'icRequestSent
Text1.Text = Text1.Text & vbCrLf & "发送请求已成功"
Case 7 'icReceivingResponse
Text1.Text = Text1.Text & vbCrLf & "正在接收主机的响应"
Case 8 'icResponseReceived
Text1.Text = Text1.Text & vbCrLf & "已成功地接收到主机的响应"
Case 9 'icDisconnecting
Text1.Text = Text1.Text & vbCrLf & "正在解除与主机的连接"
Case 10 'icDisconnected
Text1.Text = Text1.Text & vbCrLf & "已成功地与主机解除了连接"
Case 11 'icError
Text1.Text = Text1.Text & vbCrLf & "与主机通讯时出现了错误"
Text1.Text = Text1.Text & vbCrLf & "错误" & Inet1.ResponseCode & ":" & Inet1.ResponseInfo
Case 12 'icResponseCompleted
Text1.Text = Text1.Text & vbCrLf & "该请求已经完成，并且所有数据均已接收到"
Select Case OperationStyle
Case 1 '列出目录和文件
ListServerDir.ListItems.Clear
InetData = Inet1.GetChunk(1024, 0) '0表示把数据作为字符串来检索，1表示把数据作为字节数组来检索
If Trim(InetData) <> 0 Then
tempArray = Split(InetData, vbCrLf, , vbTextCompare)
Combo2.Text = "Root/" & CurrentServerDir
i = 0
Do While i < UBound(tempArray)
If tempArray(i) <> "" Then
DealListServerDir (tempArray(i))
End If
i = i + 1
Loop
ListIndex = 1
End If
'GetFileSize
Case 2 '获得每个文件的大小
FileSize = Inet1.GetChunk(1024, 0)
itemA.SubItems(1) = CStr(FileSize)
ListIndex = ListIndex + 1
GetFileSize
Case 3 '删除目录
Text1.Text = Text1.Text & vbCrLf & itemA & "目录被删除!"
ListServerDir.ListItems.Remove (ListServerDir.SelectedItem.Index)
Case 4 '删除文件
Text1.Text = Text1.Text & vbCrLf & itemA & "文件被删除!"
ListServerDir.ListItems.Remove (ListServerDir.SelectedItem.Index)
Case 5 '更改文件名
Text1.Text = Text1.Text & vbCrLf & itemA & "文件被改名为" & NewFileName
ListServerDir.SelectedItem.Text = NewFileName
Case 6 '创建目录
Text1.Text = Text1.Text & vbCrLf & NewDir & "目录被创建!"
Set itmX = ListServerDir.ListItems.Add(, , NewDir & "/")
itmX.SmallIcon = 1
itmX.Icon = 1
Case 7 '下载文件
Text1.Text = Text1.Text & vbCrLf & ListServerDir.SelectedItem & "文件下载成功!"
Set itmX = ListClientDir.ListItems.Add(, , ListServerDir.SelectedItem)
itmX.Icon = 2
itmX.SmallIcon = 2
Case 8 '上载文件
Text1.Text = Text1.Text & vbCrLf & ListClientDir.SelectedItem & "文件上载成功!"
Set itmX = ListServerDir.ListItems.Add(, , ListClientDir.SelectedItem)
itmX.Icon = 2
itmX.SmallIcon = 2
Case Else
End Select
End Select
Text1.SelLength = Len(Text1.Text)
End Sub
'-------------------------------------------------------------------
'该函数的功能是处理从服务器端得到的数据
'Written by wxp
'date 2000-10
'-------------------------------------------------------------------
Private Sub DealListServerDir(tempStr As String)
If Right(Trim(tempStr), 1) <> "/" Then
'表示接受到的是文件
AddFileToListServerDir (tempStr)
Else
'表示接收到的是目录
AddDirToListServerDir (tempStr)
End If
End Sub
'-------------------------------------------------------------------
'该函数的功能是向listserverdir控件中加入指定目录下的文件
'Written by wxp
'date 2000-10
'-------------------------------------------------------------------
Private Sub AddFileToListServerDir(tempStr As String)
Dim itmX As ListItem
Set itmX = ListServerDir.ListItems.Add(, , tempStr)
itmX.Icon = 2
itmX.SmallIcon = 2
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -