不知道你的winsock 是udp还是tcpip协议
这里给你一个我写的实例 我是用的udp 这个发送闷皮谈了一段数据不一定接收就正确 所以我做了校验
'以下是发送文件的
Option Explicit
Dim GetFileNum As Integer, LenFile As Long, SendByte() As Byte '发送的包
Private Sub Command1_Click()
On Error Resume Next
Command1.Enabled = False
GetFileNum = FreeFile '取得未使用的文件蚂碰号
LenFile = FileLen(Text1.Text) '获得需传送的文件的长度
If Text2.Text = "" Or Right(Left(Text2.Text, 2), 1) <> ":" Then Text2.Text = Text1.Text
Winsock0.SendData "#SEND STA#" & LenFile & "//" & Text2.Text
Wt 0.5
Open Text1.Text For Binary As #GetFileNum '打开需传送的文件
Call TCPSendFile(Winsock0, GetFileNum, SplitFile) '传送文件
Me.Caption = Now
Ti.Enabled = True
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim A As String
On Error Resume Next
Command2.Top = -2000
Winsock0.RemoteHost = IPX '服务器ip
Winsock0.RemotePort = FilePort
End Sub
Private Function SplitFile() As Long '拆包'为了清晰,下面分别用两个子过程来完成计算这次还可以传多少个字节的数据和传握轿送数据
On Error Resume Next
Dim GetCount As Long
If LenFile >= 4000 Then '计算出这次可发送的字节数
GetCount = 4000
LenFile = LenFile - GetCount
Else
GetCount = LenFile
LenFile = LenFile - GetCount
End If
SplitFile = GetCount
End Function
Private Sub TCPSendFile(objWinSock As Winsock, FileNumber As Integer, SendLen As Long)
On Error Resume Next
Dim FileByte() As Byte, I As Long, j As Long, Temp As String * 4
ReDim SendByte(0)
ReDim FileByte(SendLen - 1)
Temp = SendLen + 7
SendByte = Temp '把长度负值给包头
Get #FileNumber, , FileByte '读取文件
ReDim Preserve SendByte(SendLen + 7) '把包头+到文件头
For I = 0 To UBound(FileByte)
SendByte(I + 7) = FileByte(I)
'DoEvents
Next
Winsock0.SendData SendByte
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Winsock0.Close
Err.Clear
End Sub
Private Sub TEnd_Timer()
On Error Resume Next
Winsock0.SendData "#END#"
Err.Clear
End Sub
Private Sub Ti_Timer()
On Error Resume Next
Winsock0.SendData "#ERR#"
End Sub
Private Sub Winsock0_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
Dim S As String
Winsock0.GetData S
Select Case S
Case "ok" '成功继续发送
If LenFile = 0 Then '发送完成
If S <> "#SEND END#" Then Winsock0.SendData "#SEND END#"
Me.Caption = "文件上传成功!"
Command1.Enabled = True
Ti.Enabled = False
TEnd.Enabled = True
Exit Sub
Else
Me.Caption = "文件上传完成:[" & Left((FileLen(Text1.Text) - LenFile) / FileLen(Text1.Text) * 100, 4) & "%]"
End If
Call TCPSendFile(Winsock0, GetFileNum, SplitFile)
Case "#END#"
TEnd.Enabled = False
FMain.TiF.Enabled = True
Case "no" '不成功重发上一个包
Winsock0.SendData SendByte
End Select
End Sub
'以下是接收文件的
Option Explicit
Dim FOK As Boolean, Fs As Long, FileNumber As Integer, LenFile As Long '文件的长度
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Command2_Click()
On Error Resume Next
Dim A As String
Me.Caption = "开始下载"
If Dir(Text2.Text) <> "" And ChV.Value = 0 Then
If MsgBox("文件已经存在,覆盖吗?", vbCritical + vbYesNo) = vbYes Then Kill Text2.Text Else Exit Sub
Else
Kill Text2.Text
End If
If Text2.Text = "" Then Text2.Text = Text1.Text
'Command2.Enabled = False
If Ch.Value = 0 Then A = "#DOW#" Else A = "#DOV#"
FMain.Wsk.SendData A & Text1.Text
Wt 1
FMain.Wsk.SendData "#DOE#" & Text2.Text
End Sub
Private Sub Form_Load()
Dim A As String
'FMain.Ts.Enabled = True
On Error Resume Next
If FMain.Cb.Text = "本地组" Or FMain.Cb.Text = "全部组" Then
Me.Caption = "请重选下载用户[“组”不能正确下载]"
Else
Command1.Top = -2000
Winsock0.LocalPort = FilePort
Winsock0.Bind
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Winsock0.Close
Err.Clear
End Sub
Private Sub La_Click()
CDL.FileName = ""
CDL.ShowOpen
Text2.Text = CDL.FileName
End Sub
Private Sub Winsock0_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
Dim FileByte() As Byte, A As String, MendByte() As Byte, I As Long, J As Long, Temp As String, W As String
Winsock0.GetData FileByte, vbArray + vbByte '接收类型为:字节数组
J = UBound(FileByte) '获得包长
For I = 0 To 7 Step 2 '合并包头
Temp = Temp & Chr(FileByte(I))
Next
For I = 0 To 9 '文件发送结束标记
A = A & Chr(FileByte(I))
Next
If A = "#ERR#" Then Winsock0.SendData "no"
If A = "#END#" Then
For I = 0 To Len(FMain.TIn.Text)
If I < 100 Then
W = Left(Right(FMain.TIn.Text, I), 1)
If W = "!" Then
W = Left(Right(FMain.TIn.Text, I + 4), 5)
Exit For
End If
Else
Exit For
End If
Next I
If W <> "下载完成!" Then
FOK = False
Me.Caption = "下载完成![" & Text2.Text & "]"
FMain.TIn.Text = FMain.TIn.Text & "[" & Now & "]" & "下载完成!(" & Fs & "<=" & LenFile & ")" & vbCrLf
Command2.Enabled = True
End If
Else
If Val(Temp) = J Then '比较长度看丢包没有
ReDim MendByte(J - 8)
For I = 0 To J - 8 '提出包头
MendByte(I) = FileByte(I + 7)
Next
Fs = Fs + UBound(FileByte) - 7
Put #FileNumber, , MendByte '写文件
Winsock0.SendData "ok" '发送继续发送的请求
Me.Caption = "文件下载完成:[" & Left(Fs / LenFile * 100, 4) & "%]"
Else
If Left(A, 10) = "#SEND STA#" Then
A = ""
For I = 10 To UBound(FileByte) '文件发送结束标记
A = A & Chr(FileByte(I))
Next
LenFile = Val(Left(A, InStr(A, "//") - 1))
For I = 0 To Len(Text2.Text)
A = Left(Right(Text2.Text, I), 1)
If A = "\" Then Exit For
Next
If Dir(Left(Text2.Text, Len(Text2.Text) - I + 1), vbDirectory) = "" Then MkDir Left(Text2.Text, Len(Text2.Text) - I + 1)
'"#SEND STA#" & FileLen(Text1.Text) & "//" & Text2.Text
FileNumber = FreeFile '取得未使用的文件号
Fs = 0
Open Text2.Text For Binary As #FileNumber '打开文件
Else
If A <> "#SEND END#" Then
Winsock0.SendData "no" '出现丢包,请求重发
Else
Winsock0.SendData "#END#" '发送继续发送的请求
Close #FileNumber
Reset
If FOK = False Then
FOK = True
Me.Caption = "下载完成![" & Text2.Text & "]"
FMain.TIn.Text = FMain.TIn.Text & "[" & Now & "]" & "下载完成!(" & Fs & "<=" & LenFile & ")" & vbCrLf
Command2.Enabled = True
Else
FOK = False
End If
End If
End If
End If
End If
End Sub
1.创建一个新的标准EXE文件 2.加入一个Winsock控件 3.加入如下代码: Private Sub Form Load() tcpServer.LocalPort = 1001 tcpServer.Localhost = ″servser″ tcpServer.remotePort = 1002 tcpServer.Localhost = ″klint″ tcpServer.Listen End Sub ′连接检雹指查 Private Sub tcpServer ConnectionRequest (ByVal requestID As Long) If tcpServer.State <>sckClosed Then tcpServer.Close tcpServer.Accept requestID End Sub ′发送数据 Private Sub frmserver monsemove(x,y) tcpServer.SendData ″x″&str(x) tcpServer.SendData ″y″&str(y) End Sub 1.创建一个新的标准EXE文件 2.加入一个Winsock控件 3.加入两个TEXT框—— txt x和 txt y 4.加入如下代码: Private Sub Form Load() tcpServer.LocalPort = 1002 tcpServer.Localhost = ″klint″ tcpServer.remotePort = 1001 tcpServer.Localhost = ″servser″ tcpServer.Listen End Sub ′连接检查 Private Sub tcpklint ConnectionRequest (ByVal requestID As Long) If tcpklint.State <>sckClosed Then tcpklint.Close tcpklint.Accept requestID End Sub Private Sub tcpClient DataArrival (ByVal bytesTotal As Long) Dim strData As String tcpklint.GetData strData if left(strData,1)=″X″then txt x.Text = strData else txt y.Text = strData endif End Sub 以上例程实现的是一个非常简单的点对点通信,在此基础上略加改造,可以形成功能复杂的实时计算机网络A-A交互通信系统,用于控制、图形仿真等。 使用UDP协 议建立余配对等通信和通过TCP建立客户/服务器通信的方法略有不同,它不需要建立客户和服务器,而是建立对等通信 1.设定Winsock的RemoteHost 属性为一个通信的计算机名称 2.设定 RemotePort 为一竖肆指个接口号 3.调用Winsock的Bind 事件绑定本地的接口号。具体设定方法为: Private Sub Form Load() With Winsock1 .RemoteHost= ″PeerB″ .RemotePort = 1001 ′远程连接号 .Bind 1002 ′绑定的本地号 End With End Sub欢迎分享,转载请注明来源:内存溢出
评论列表(0条)