请问怎样使用winsock协议传输文件?

不知道你的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

嘿嘿。

服务器代码:

Option Explicit

Private Sub Command1_Click()

Dim BytDate() As Byte

Dim FileName As String

Dim lngFile As Long

Dim i As Long

FileName = "D:\Image\Oct2003.MDB " '取得文件名及路径

lngFile = FileLen(FileName) \ 1024 '取得文件长度

Me.ProgressBar1.Min = 0

Me.ProgressBar1.Max = lngFile + 1

ProgressBar1.Value = 0

For i = 0 To lngFile

ReDim myFile(1023) As Byte '初始化数组

Open FileName For Binary As #1 '打开文件

Get #1, i * 1024 + 1, myFile'将文件写入数组

Close #1 '关闭文件

Winsock1.SendData myFile '发送

DoEvents

ProgressBar1.Value = ProgressBar1.Value + 1

Next i

If ProgressBar1.Value = ProgressBar1.Max Then MsgBox "OK"

End Sub

Private Sub Form_Load()

Winsock1.Protocol = sckTCPProtocol

Winsock1.LocalPort = 2001

Winsock1.Listen

FormCLI.Show

End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)

If Winsock1.State <>0 Then Winsock1.Close

Winsock1.Accept requestID

End Sub

客户端代码:

Option Explicit

Private Sub Form_Load()

With Winsock1

.Protocol = sckTCPProtocol

.RemoteHost = "192.168.0.69"

.RemotePort = 2001

.Connect

End With

End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

Static i As Long

Dim myFile() As Byte

Dim myLong As Double

Dim myPath As String

myPath = "d:\abc.MDB"

ReDim myFile(bytesTotal - 1) '此处也可以是(0 To bytesTotal-1)

Winsock1.GetData myFile

Open myPath For Binary As #1'新建文件

myLong = FileLen(myPath)

Put #1, myLong + 1, myFile '将收到的数据写入新文件中

Close #1 '关闭

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

---