TCP传输大文件完整代码

TCP传输大文件完整代码
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1
Caption = "TCP传输BY无名"
ClientHeight = 975
ClientLeft = 60
ClientTop = 450
ClientWidth = 4455
LinkTopic = "Form1"
ScaleHeight = 975
ScaleWidth = 4455
StartUpPosition = 3 '窗口缺省
Begin VB.TextBox Text3
Height = 270
Left = 0
TabIndex = 6
Text = "127.0.1.1"
Top = 720
Width = 1575
End
Begin mandButton Command3
Caption = "发送"
Enabled = 0 'False
Height = 255
Left = 3000
TabIndex = 4
Top = 720
Width = 1455
End
Begin mandButton Command2
Caption = "连接"
Height = 255
Left = 1560
TabIndex = 3
Top = 720
Width = 1455
End
Begin mandButton command1
Caption = "监听2001"
Height = 255
Left = 0
TabIndex = 2
Top = 0
Width = 1575
End
Begin VB.TextBox Text2
Height = 270
Left = 0
TabIndex = 1
Text = "d:\2.rar"
Top = 480
Width = 4455
End
Begin VB.TextBox Text1
Height = 270
Left = 0
TabIndex = 0
Text = "c:\1.rar"
Top = 240
Width = 4455
End
Begin MSWinsockLib.Winsock Winsock1
Left = 360
Top = 1080
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin bel Label1
Height = 255
Left = 2640
TabIndex = 5
Top = 0
Width = 1695
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim complete As Boolean
Dim T As Boolean
Dim savepath As String
Dim filemax_len As Long
Dim byteall As Long

Private Sub command1_Click()
Winsock1.LocalPort = 2001
Winsock1.Listen
Command2.Enabled = False
End Sub

Public Function send(filepath As String, savepath As String, str As Integer)
Dim i As Long
Dim f() As Byte
Dim d() As Byte
file_len = FileLen(filepath)

a = Split(filepath, "\")
b = UBound(a)
file_name = a(b)
str2vbuni "send" & "|" & flie_name & "|" & file_len & "|" & savepat

h & "|"

If file_len <= (1024 * str) Then
ReDim f(0 To file_len - 1)
Open filepath For Binary As #1
Get #1, 1, f
Close #1
DoEvents
Winsock1.SendData f
ElseIf file_len > (1024 * str) Then
n = file_len \ (1024 * str)
m = file_len Mod (1024 * str)

ReDim f(0 To (1024 * str - 1))
Open filepath For Binary As #1
For i = 0 To n - 1
Get #1, i * (1024 * str) + 1, f

delay ' 延迟
Winsock1.SendData f
complete = False '还原
Label1.Caption = i & "/" & n - 1
Next

If m <> 0 Then
ReDim f(0 To m - 1)

Get #1, n * (1024 * str) + 1, f
delay ' 延迟
Winsock1.SendData f
complete = False '还原
Close #1
Else
Close #1
End If
End If
End Function
Private Sub Command2_Click()
Winsock1.RemoteHost = Text3.Text
Winsock1.RemotePort = 2001
Winsock1.Connect
command1.Enabled = False
End Sub

Private Sub Command3_Click()
send Text1.Text, Text2.Text, 4
End Sub


Private Sub Winsock1_Connect()
Command3.Enabled = True
Command2.Enabled = False
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim s1() As Byte
Dim s2() As Byte
If T = False Then
Winsock1.GetData s1

GetData = StrConv(s1, vbFromUnicode)
Data = Split(GetData, "|")

Select Case Data(0)
Case "send"
file_name = Data(1)
filemax_len = Data(2)
savepath = Data(3)
T = True
byteall = 0
str2vbuni "nextblock|"

If Dir(savepath) <> "" Then Kill savepath

Case "nextblock" '请求下一块
complete = True
Case "over"
Debug.Print "done"
End Select

ElseIf T = True Then
byteall = byteall + bytesTotal
Winsock1.GetData s2
If savepath = "直接数据" Then
Else

If Dir(savepath) = "" Then
file_len = 0
Else
file_len = FileLen(savepath)
End If

Open savepath For Binary As #1
Put #1, file_len + 1, s2
Close #1


If byteall = filemax_len Then
T = False
str2vbuni "over|"
Else
str2vbuni "nextblock|"

End If
End If
End If
End Sub
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
If Winsock1.State <> sckClosed Then Winsock1.Close
Winsock1.Accept requestID
End Sub
Private Sub Winsock1_Close()
Winsock1.Close
Winsock1.Listen
End Sub


Function str2vbuni(s As String)
Dim a() As Byte
a = StrConv(s, vbUnicode)
Winsock1.SendData a
DoEvents
End Function
Function delay()
Do
DoEvents
Sleep (1)
Loop Until complete = True
End Function