📄 form4.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form4
BackColor = &H80000009&
Caption = "Form4"
ClientHeight = 2250
ClientLeft = 3330
ClientTop = 2235
ClientWidth = 6525
LinkTopic = "Form4"
ScaleHeight = 2250
ScaleWidth = 6525
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 255
Left = 5880
TabIndex = 6
Top = 1560
Width = 255
End
Begin VB.Timer Timer1
Interval = 100
Left = 4320
Top = 1080
End
Begin VB.Timer Timer2
Enabled = 0 'False
Interval = 100
Left = 3960
Top = 1080
End
Begin VB.CommandButton cmdConnect
Caption = "连接"
Height = 375
Left = 4680
TabIndex = 3
Top = 840
Width = 255
End
Begin VB.CommandButton cmdsend
Caption = "选文件"
Height = 495
Left = 4680
TabIndex = 2
Top = 1320
Width = 255
End
Begin VB.TextBox txtHost
Height = 375
Left = 1680
TabIndex = 1
Text = "220.170.46.206"
Top = 840
Width = 2175
End
Begin MSComctlLib.ProgressBar ProgressBar1
Height = 255
Left = 240
TabIndex = 0
Top = 1920
Width = 6015
_ExtentX = 10610
_ExtentY = 450
_Version = 393216
Appearance = 1
End
Begin MSWinsockLib.Winsock WinsockSend
Left = 5040
Top = 1080
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 5400
Top = 1080
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin MSWinsockLib.Winsock WinsockReceive
Left = 4680
Top = 1080
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Label1"
Height = 255
Left = 240
TabIndex = 5
Top = 1440
Width = 735
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "对方ip"
Height = 375
Left = 720
TabIndex = 4
Top = 840
Width = 975
End
End
Attribute VB_Name = "Form4"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim mybyte() As Byte '发送方数组
Const filecomesMSG = "a file is coming " '有文件到来
Const RemoteIsReadyMSG = "sender is ready " '准备好了
Const FileisOverMSG = "the file is ended" '文件完毕
Const RemoteDenyMSG = "the user canceled" '用户取消
Const filecountMSG = "the file lengh is" '文件长度
Const RecevieIsReadyMSG = "Receiver is ready " '准备接收
Dim arrdata() As Byte '收到的信息
Dim filesave As Integer '保存文件的句柄
Dim filehandle As Integer '发送方文件的句柄
Dim FileSize As Double '文件的大小
Dim Sendbyte As Long
Dim Receivebyte As Long
Dim MyLocation As Double
Dim myMSG As String '消息
Dim FileisOver As Boolean '文件是否已经完毕
Const ReceivePort = 7905
Const BUFFER_SIZE = 5734
Private Sub cmdConnect_Click()
Timer2.Enabled = True
End Sub
Private Sub cmdsend_Click()
On Error GoTo errorhandle
With CommonDialog1
.CancelError = True
.DialogTitle = "选择您要传送的文件"
.Filter = "All Files (*.*)|*.*"
.ShowOpen
End With
filehandle = FreeFile
Open CommonDialog1.FileName For Binary Access Read As #filehandle
cmdsend.Enabled = False
FileSize = CDbl(FileLen(CommonDialog1.FileName))
Label1.caption = "等待回应>>>"
If WinsockSend.State = sckConnected Then
WinsockSend.SendData filecomesMSG & CommonDialog1.FileName '发送发出文件信息
End If
Exit Sub
errorhandle:
cmdsend.Enabled = True
MsgBox ("你没有选择一个文件！")
End Sub
Private Sub Form_Load()
WinsockReceive.LocalPort = ReceivePort
WinsockReceive.Listen
FileisOver = True
Label1.caption = "准备传输>>>"
End Sub
Public Function SendChunk()
Dim mybytesize As Long
If WinsockSend.State <> sckConnected Then Exit Function
mybytesize = BUFFER_SIZE
If LOF(filehandle) - Loc(filehandle) < BUFFER_SIZE Then mybytesize = (LOF(filehandle) - Loc(filehandle))
ReDim mybyte(0 To mybytesize - 1)
Get #filehandle, , mybyte
WinsockSend.SendData mybyte
Sendbyte = Sendbyte + mybytesize
ProgressBar1.Value = Int((100 / FileSize) * Sendbyte)
If Sendbyte >= FileSize Then
FileisOver = True
WinsockSend.SendData FileisOverMSG
End If
End Function
Private Sub Timer2_Timer()
If WinsockSend.State = sckConnected Then
Timer2.Enabled = False
cmdConnect.Enabled = False
ElseIf WinsockSend.State <> 1 And WinsockSend.State <> 6 And WinsockSend.State <> 7 And WinsockSend.State <> 8 And WinsockSend.State <> 9 Then
WinsockSend.Connect txtHost.Text, ReceivePort
ElseIf WinsockSend.State = 8 Or WinsockSend.State = 9 Then
WinsockSend.Close
End If
End Sub
Private Sub WinsockReceive_ConnectionRequest(ByVal requestID As Long)
If WinsockReceive.State <> sckClosed Then WinsockReceive.Close
WinsockReceive.Accept requestID
End Sub
Private Sub WinsockReceive_DataArrival(ByVal bytesTotal As Long)
ReDim arrdata(0 To bytesTotal - 1)
WinsockReceive.GetData arrdata, vbByte + vbArray
myMSG = StrConv(arrdata, vbUnicode) '二进制转为字符串
Select Case Mid(myMSG, 1, 17)
Case filecomesMSG '这些消息发送方和接受方都可收到
'显示保存对话框
On Error GoTo errorhandle
CommonDialog1.FileName = Mid(myMSG, 17, Len(myMSG))
CommonDialog1.DialogTitle = "选择保存文件的路径"
CommonDialog1.ShowSave
filesave = FreeFile
Receivebyte = 0
cmdsend.Enabled = False
WinsockReceive.SendData RecevieIsReadyMSG
Case FileisOverMSG
Close #filesave
MsgBox ("文件传输成功！") '大家一起处理
cmdConnect.Enabled = True
cmdsend.Enabled = True
Label1.caption = "准备传输>>>"
ProgressBar1.Value = 0
WinsockReceive.SendData FileisOverMSG
WinsockReceive.Close
WinsockReceive.Listen
Case filecountMSG
FileSize = Mid(myMSG, 18, Len(myMSG))
Open CommonDialog1.FileName For Binary Access Write As #filesave
WinsockReceive.SendData RemoteIsReadyMSG
Label1.caption = "文件准备传输！"
FileisOver = False
Case Else
If Receivebyte < FileSize Then
Receivebyte = Receivebyte + bytesTotal
Put #filesave, , arrdata
WinsockReceive.SendData RemoteIsReadyMSG
ProgressBar1.Value = Int((100 / FileSize) * Receivebyte)
End If
End Select
Exit Sub
errorhandle:
WinsockReceive.SendData RemoteDenyMSG
cmdConnect.Enabled = True
End Sub
Private Sub WinsockSend_DataArrival(ByVal bytesTotal As Long)
WinsockSend.GetData myMSG
Select Case myMSG
Case RecevieIsReadyMSG
WinsockSend.SendData filecountMSG & FileSize
FileisOver = False
Sendbyte = 0
Case RemoteIsReadyMSG
'如果文件还没有结束，继续传输
If Not FileisOver Then
Label1.caption = "文件正在被传输>>>"
SendChunk
Else
WinsockSend.SendData FileisOverMSG
End If
Case FileisOverMSG
'主机处理
Close #filehandle
MsgBox ("文件传输成功！") '大家一起处理
WinsockSend.SendData FileisOverMSG
WinsockSend.Close
cmdConnect.Enabled = True
ProgressBar1.Value = 0
cmdsend.Enabled = True
Label1.caption = "准备传输>>>"
Case RemoteDenyMSG
MsgBox ("用户终止了传输！")
cmdsend.Enabled = True
Label1.caption = "准备传输>>>"
Close #filehandle
End Select
Exit Sub
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -