📄 form1.frm
字号:
Alignment = 2
AutoSize = 1
Object.Width = 8758
EndProperty
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "黑体"
Size = 7.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.TextBox Text1
Height = 270
Left = 480
TabIndex = 15
Top = 840
Width = 3255
End
Begin VB.TextBox Txt
Height = 270
Left = 480
TabIndex = 16
Top = 1200
Width = 2655
End
Begin VB.ListBox List1
Height = 1500
ItemData = "Form1.frx":23CB8
Left = 240
List = "Form1.frx":23CBA
TabIndex = 8
Top = 6600
Width = 5055
End
Begin VB.Label Label2
Height = 255
Left = 3960
TabIndex = 14
Top = 1680
Width = 1215
End
Begin VB.Label Label1
Height = 255
Left = 1320
TabIndex = 13
Top = 1680
Width = 855
End
Begin VB.Menu meutu
Caption = "&meu"
Begin VB.Menu run
Caption = "&运行"
End
Begin VB.Menu aaaa
Caption = "-"
End
Begin VB.Menu del
Caption = "&删除"
End
Begin VB.Menu aabb
Caption = "-"
End
Begin VB.Menu dowdun
Caption = "&下载"
End
Begin VB.Menu aabbb
Caption = "-"
End
Begin VB.Menu refresh
Caption = "&刷新"
End
Begin VB.Menu asd
Caption = "-"
End
Begin VB.Menu newfoler
Caption = "新建文件夹"
End
End
Begin VB.Menu meul
Caption = "&meul"
Begin VB.Menu open
Caption = "打开"
End
Begin VB.Menu xxZ
Caption = "-"
End
Begin VB.Menu unloadflie
Caption = "上传"
End
Begin VB.Menu vnnn
Caption = "-"
End
Begin VB.Menu delflie
Caption = "删除"
End
End
Begin VB.Menu nf
Caption = "newfolder"
Visible = 0 'False
Begin VB.Menu ncf
Caption = "NewCreateFolder"
End
End
Begin VB.Menu file
Caption = "文件"
Begin VB.Menu newcreateConnection
Caption = "新建连接地址"
End
Begin VB.Menu ffgggg
Caption = "-"
End
Begin VB.Menu openConnection
Caption = "打开远程连接"
End
Begin VB.Menu closeConnection
Caption = "关闭远程连接"
End
Begin VB.Menu njjjjj
Caption = "-"
End
Begin VB.Menu Exit
Caption = "退出"
End
End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Option Explicit
Dim itwms As ListItem
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI '定义点(Point)结构
X As Long '点在X坐标(横坐标)上的坐标值
Y As Long '点在Y坐标(纵坐标)上的坐标值
End Type
Dim i As Integer
Dim d As Boolean
Dim fso As New FileSystemObject
Dim strDrive As String
Dim strFolder As String
Sub PrintCursorPos()
Dim dl As Long
Dim MyPoint As POINTAPI
dl& = GetCursorPos(MyPoint) '调用函数，获取屏幕鼠标坐标
'Debug.Print "X=" & Str(MyPoint.X) & " and " & "Y=" & Str(MyPoint.Y)
Label1.Caption = Str(MyPoint.X)
Label2.Caption = Str(MyPoint.Y)
End Sub
Private Sub closeConnection_Click()
Value& = MsgBox("是否要断开与服务器的连接？", vbCritical + vbYesNo, "连接提示")
If Value& = vbYes Then
FrmPass.WinSockCtl.Close
ListView2.Enabled = False
ListView1.BackColor = &H80000000
ListView2.BackColor = &H80000000
Unload FrmPass
FrmMain.List1.AddItem ("断开与远程主机的连接 " & " " & Date & " " & Time & "")
Set itwms = FrmMain.ListView4.ListItems.Add(, , "断开与远程主机的连接")
itwms.SubItems(1) = Date
itwms.SubItems(2) = Time
itwms.SubItems(3) = "断开连接"
FrmMain.Caption = "SSH demo "
End If
End Sub
Private Sub cmbDrives_Click()
Dim drive As drive
Dim file As file
Dim SubFolder As Folder
Dim i As Integer
i = 0
ListView3.ListItems.Clear
If cmbDrives = "" Then Exit Sub
strDrive = cmbDrives.Text
strFolder = ""
Set drive = fso.GetDrive(cmbDrives.Text)
If drive.IsReady Then
For Each SubFolder In drive.RootFolder.SubFolders
ListView3.ListItems.Add , , SubFolder, 1, 1
i = i + 1
Next
For Each file In drive.RootFolder.Files
ListView3.ListItems.Add , , file.Name, 6, 6
i = i + 1
Next
i = ListView3.ListItems.Count
Else
MsgBox "Drives Not ready"
End If
End Sub
Private Sub cmdup_Click()
Dim Folder As Folder
Dim file As file
Dim SubFolder As Folder
Dim i As Integer
If strDrive = "" Then Exit Sub
If strFolder = "" Then Exit Sub
'当前文件夹
Set Folder = fso.GetFolder(strDrive & strFolder)
'上级文件夹
strFolder = Left(strFolder, InStrRev(strFolder, "\") - 1)
lstFiles.Clear
If Not Folder.ParentFolder Is Nothing Then
'添加文件
For Each file In Folder.ParentFolder.Files
lstFiles.AddItem file.Name, i
i = i + 1
Next
i = lstFiles.ListCount
'添加子文件夹
For Each SubFolder In Folder.ParentFolder.SubFolders
lstFiles.AddItem SubFolder, i
i = i + 1
Next
Else
For Each file In Folder.Files
lstFiles.AddItem file.Name, i
i = i + 1
Next
i = lstFiles.ListCount
For Each SubFolder In Folder.SubFolders
lstFiles.AddItem SubFolder, i
i = i + 1
Next
End If
End Sub
Private Sub cmbDrives_KeyDown(KeyCode As Integer, Shift As Integer)
Dim Folder As Folder
Dim SubFolder As Folder
Dim file As file
Dim i As Integer
If KeyCode = 13 Then
i = 0
'If Not ListView3.ListItems.Count > 1 Then
' If InStr(cmbDrives.Text, ":\") Then
Set Folder = fso.GetFolder(cmbDrives.Text)
cmbDrives.Text = Left(cmbDrives.Text, 2)
ListView3.ListItems.Clear
strFolder = strFolder & "\" & Folder.Name
'添加子文件夹
For Each SubFolder In Folder.SubFolders
ListView3.ListItems.Add , , SubFolder, 1, 1
i = i + 1
Next
'添加全部文件
For Each file In Folder.Files
ListView3.ListItems.Add , , file.Name, 6, 6
i = i + 1
Next
i = ListView3.ListItems.Count
' End If
End If
End Sub
Private Sub CmdBrowse_Click()
On Error Resume Next
ListView1.ListItems.Clear
If Right(TextDirectory.Text, 1) <> "\" And Right(TextDirectory.Text, 1) <> "/" Then TextDirectory.Text = TextDirectory.Text & "\"
FrmPass.WinSockCtl.SendData "[LOAD FOLDER NAME]" & TextDirectory.Text
WaitTime = 0
Do Until WaitTime = 10000
WaitTime = WaitTime + 1: DoEvents
Loop
ListView2.ListItems.Clear
FrmPass.WinSockCtl.SendData "[LOAD FOLDER DATA]" & TextDirectory.Text
WaitTime = 0
Do Until WaitTime = 10000
WaitTime = WaitTime + 1: DoEvents
Loop
FrmPass.WinSockCtl.SendData "[FILE SIZE DATA]" & TextDirectory.Text
End Sub
Private Sub CobView_Click()
Select Case CobView.ListIndex
Case 0
ListView3.View = lvwIcon '大图标
Case 1
ListView3.View = lvwList '自由排列
Case 2
ListView3.View = lvwReport '列表
Case 3
ListView3.View = lvwSmallIcon '小图标
End Select
End Sub
Private Sub CobView2_Click()
Select Case CobView2.ListIndex
Case 0
ListView1.View = lvwIcon '大图标
Case 1
ListView1.View = lvwList '自由排列
Case 2
ListView1.View = lvwReport '列表
Case 3
ListView1.View = lvwSmallIcon '小图标
End Select
End Sub
Private Sub Combo2_Change()
'
End Sub
Private Sub Combo2_Click()
On Error Resume Next
If ListView1.SelectedItem.Text <> "" Then
TextDirectory.Text = Left(Combo2.Text, 2) & "\"
CmdBrowse_Click
End If
End Sub
Private Sub Combo2_Scroll()
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -