📄 frmclient.frm
字号:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmClient
BorderStyle = 1 'Fixed Single
Caption = "文件传输主机B"
ClientHeight = 6120
ClientLeft = 45
ClientTop = 330
ClientWidth = 4965
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 6120
ScaleWidth = 4965
StartUpPosition = 3 'Windows Default
Begin MSComDlg.CommonDialog commDialog
Left = 960
Top = 1080
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Frame Frame2
Caption = "传输"
Height = 4725
Left = 120
TabIndex = 1
Top = 1080
Width = 4695
Begin MSWinsockLib.Winsock sckReceive
Left = 3840
Top = 0
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin MSWinsockLib.Winsock sckSend
Left = 2880
Top = 0
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin MSWinsockLib.Winsock sckListen
Left = 2040
Top = 0
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.CommandButton cmdSend
Caption = "发送"
Height = 375
Left = 3480
TabIndex = 14
Top = 4200
Width = 1095
End
Begin VB.ListBox lstLog
Height = 1860
Left = 120
TabIndex = 12
Top = 2280
Width = 4455
End
Begin VB.CommandButton cmdSavePath
Caption = "浏览"
Height = 300
Left = 3960
TabIndex = 11
Top = 1440
Width = 615
End
Begin VB.TextBox txtSavePath
Height = 285
Left = 120
Locked = -1 'True
TabIndex = 10
Text = "C:\"
Top = 1440
Width = 3855
End
Begin VB.TextBox txtFilePath
Height = 285
Left = 120
Locked = -1 'True
TabIndex = 3
Top = 600
Width = 3855
End
Begin VB.CommandButton cmdSendPath
Caption = "浏览"
Height = 300
Left = 3960
TabIndex = 2
Top = 600
Width = 615
End
Begin VB.Label Label5
Caption = "传输日志："
Height = 255
Left = 120
TabIndex = 13
Top = 1920
Width = 975
End
Begin VB.Label Label4
Caption = "保存地址："
Height = 255
Left = 120
TabIndex = 9
Top = 1080
Width = 1575
End
Begin VB.Label Label1
Caption = "传输文件路径："
Height = 255
Left = 120
TabIndex = 4
Top = 360
Width = 2295
End
End
Begin VB.Frame Frame1
Caption = "联接"
Height = 975
Left = 120
TabIndex = 0
Top = 0
Width = 4695
Begin VB.CommandButton cmddisconnect
Caption = "断开联机"
Height = 375
Left = 3600
TabIndex = 8
Top = 360
Width = 975
End
Begin VB.CommandButton cmdConnect
Caption = "联接主机"
Height = 375
Left = 2640
TabIndex = 7
Top = 360
Width = 975
End
Begin VB.TextBox txtAddress
Height = 270
Left = 1080
TabIndex = 6
Text = "127.0.0.1"
Top = 360
Width = 1455
End
Begin VB.Label Label2
Caption = "IP地址："
Height = 255
Left = 240
TabIndex = 5
Top = 360
Width = 735
End
End
Begin MSComctlLib.ProgressBar ProgressBar1
Height = 255
Left = 0
TabIndex = 15
Top = 5880
Width = 5040
_ExtentX = 8890
_ExtentY = 450
_Version = 393216
Appearance = 0
End
End
Attribute VB_Name = "frmClient"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim SendFilePath As String '待传输文件路径
Dim SendFileName As String * 50 '待传输文件名
Dim SendFileLength, SendedLength As Long '待传输文件长度与已传输的数据长度
Dim RecvFileName As String '接受文件名
Dim RecvFileLength, ReceivedLength As Long '接受的文件长度与接受到的数据长度
Dim IsReceiving As Boolean '接收控制的标记，true表示正在接受文件内容，false表开始接收控制命令
Dim fNum1, fNum2 As Integer 'fNum1表示发送文件句柄，fNum2表示接受文件句柄
Private Sub cmdConnect_Click()
If sckSend.State <> sckClosed Then sckSend.Close
With sckSend
.RemoteHost = txtAddress
.RemotePort = 12345
.Connect
cmdConnect.Enabled = False
cmddisconnect.Enabled = True
cmdSend.Enabled = True
End With
End Sub
Private Sub cmddisconnect_Click()
sckSend.Close
cmdConnect.Enabled = True
cmddisconnect.Enabled = False
cmdSend.Enabled = False
End Sub
Private Sub cmdSavePath_Click()
Load frmPath
frmPath.Show vbModal, Me
End Sub
Private Sub cmdSend_Click()
On Error GoTo uploadErr
Dim cmdTag As String * 4
Dim tmpChar As Byte
If Dir(SendFilePath, vbHidden Or vbNormal Or vbSystem Or vbReadOnly Or vbArchive) <> "" Then
SendFileLength = FileLen(SendFilePath)
cmdTag = "UP$"
With sckSend
.SendData cmdTag
.SendData SendFileLength
.SendData SendFileName
End With
lstLog.AddItem "文件名：" & SendFileName
lstLog.AddItem " 文件长度:" & SendFileLength & "字节"
fNum1 = FreeFile
cmdSend.Enabled = False
Open SendFilePath For Binary As #fNum1
DoEvents
SendedLength = 0
While Not EOF(fNum1)
Get #fNum1, , tmpChar
sckSend.SendData tmpChar
ProgressBar1.Value = Int((SendedLength / SendFileLength) * 100)
SendedLength = SendedLength + 1
Wend
Close #fNum1
lstLog.AddItem "发送成功！"
cmdSend.Enabled = True
Else
MsgBox "待上传的文件不存在！"
End If
Exit Sub
uploadErr:
lstLog.AddItem "发送失败！"
cmdSend.Enabled = True
End Sub
Private Sub cmdSendPath_Click()
On Error GoTo Cancel
With commDialog
.CancelError = True
.DialogTitle = "打开文件"
.Flags = cdlOFNFileMustExist Or cdlOFNPathMustExist
.Filter = "所有文件(*.*)|*.*"
.ShowOpen
SendFilePath = .FileName
SendFileName = .FileTitle
End With
txtFilePath = SendFilePath
Exit Sub
Cancel:
If Err.Number = 32256 Then
Resume Next
End If
End Sub
Private Sub Form_Load()
With sckListen
.LocalPort = 12346
.Listen
End With
cmdSend.Enabled = False
cmdConnect.Enabled = True
cmddisconnect.Enabled = False
End Sub
Private Sub sckListen_ConnectionRequest(ByVal requestID As Long)
sckReceive.Close
sckReceive.Accept requestID
IsReceiving = False
End Sub
Private Sub sckReceive_DataArrival(ByVal bytesTotal As Long)
On Error GoTo exitRecv
Dim cmdTag As String * 4 '传输命令
Dim tmpChar As Byte
If Not IsReceiving Then
sckReceive.GetData cmdTag, vbString, 4
If Trim(cmdTag) = "UP$" Then
sckReceive.GetData RecvFileLength, vbLong
sckReceive.GetData RecvFileName, vbString, 50
If (RecvFileLength <= 0) Then Exit Sub
If MsgBox("是否接受文件" & RecvFileName & "？", vbOKCancel, "接受文件") = vbOK Then
cmdSend.Enabled = False
RecvFileName = Trim(RecvFileName)
lstLog.AddItem "文件名：" & RecvFileName
lstLog.AddItem " 文件长度：" & RecvFileLength & "字节"
fNum2 = FreeFile
Open txtSavePath & RecvFileName For Binary As #fNum2
If RecvFileLength > (bytesTotal - 58) Then
For i = 1 To bytesTotal - 58
sckReceive.GetData tmpChar, vbByte
Put #fNum2, , tmpChar
Next
ReceivedLength = bytesTotal - 58
IsReceiving = True
Else
For i = 1 To RecvFileLength
sckReceive.GetData tmpChar, vbByte
Put #fNum2, , tmpChar
Next
Close #fNum2
cmdSend.Enabled = True
lstLog.AddItem "接收成功！"
IsReceiving = False
End If
End If
End If
Else
ProgressBar1.Value = Int((ReceivedLength / RecvFileLength) * 100)
If (RecvFileLength - ReceivedLength) > bytesTotal Then
For i = 1 To bytesTotal
sckReceive.GetData tmpChar, vbByte
Put #fNum2, , tmpChar
Next
ReceivedLength = ReceivedLength + bytesTotal
IsReceiving = True
Else
For i = 1 To RecvFileLength - ReceivedLength
sckReceive.GetData tmpChar, vbByte
Put #fNum2, , tmpChar
Next
Close #fNum2
cmdSend.Enabled = True
lstLog.AddItem "接收成功！"
IsReceiving = False
End If
End If
Exit Sub
exitRecv:
cmdSend.Enabled = True
lstLog.AddItem "接收失败！"
IsReceiving = False
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -