Winsock 接收发送文件的源码,文件任意大小-- 不存在任何错误~

原创 2006年06月09日 09:55:00

代码是我收集的在哪里发现的也不记得了,今天有人问我才意识到,应该贴出来....

作者:CSDN 许仙
'Homepage : jjweb.126.com
'MSN :Coderxu#hotmail.com
'QQ:19030300
'转载请保持文章完整,保存以上作者信息 请珍惜他人劳动成果

新建文件Client.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 = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form Client
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Client"
   ClientHeight    =   1230
   ClientLeft      =   4965
   ClientTop       =   4845
   ClientWidth     =   4665
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1230
   ScaleWidth      =   4665
   Begin MSWinsockLib.Winsock wskClient
      Left            =   1830
      Top             =   90
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Timer Timer2
      Interval        =   100
      Left            =   4020
      Top             =   480
   End
   Begin VB.Timer Timer1
      Enabled         =   0   'False
      Interval        =   3000
      Left            =   3600
      Top             =   480
   End
   Begin MSComDlg.CommonDialog Comdlg
      Left            =   2100
      Top             =   390
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.ListBox List1
      Height          =   600
      Left            =   0
      TabIndex        =   5
      Top             =   390
      Width           =   4665
   End
   Begin VB.TextBox Text1
      Height          =   270
      Left            =   780
      TabIndex        =   2
      Text            =   "127.0.0.1"
      Top             =   52
      Width           =   1455
   End
   Begin VB.TextBox Text2
      Height          =   270
      Left            =   2790
      TabIndex        =   1
      Text            =   "5252"
      Top             =   52
      Width           =   675
   End
   Begin VB.CheckBox Check1
      Caption         =   "连接/等待"
      Height          =   225
      Left            =   3510
      TabIndex        =   0
      Top             =   75
      Width           =   1125
   End
   Begin ComctlLib.ProgressBar ProBar
      Height          =   195
      Left            =   0
      TabIndex        =   6
      Top             =   1020
      Width           =   3015
      _ExtentX        =   5318
      _ExtentY        =   344
      _Version        =   327682
      Appearance      =   0
   End
   Begin VB.Label Label1
      Caption         =   "IP 地址:"
      Height          =   180
      Left            =   30
      TabIndex        =   4
      Top             =   97
      Width           =   720
   End
   Begin VB.Label Label2
      Caption         =   "端口:"
      Height          =   180
      Left            =   2310
      TabIndex        =   3
      Top             =   97
      Width           =   450
   End
End
Attribute VB_Name = "Client"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Dim FileNumber As Integer
Dim LenFile As Long
Dim OnAccept As Boolean '是否在接收"字节"数据状态
'----------------------
Dim ProBarLen As Long
Dim VarPlus As Long

Private Sub Check1_Click()
   
    If Check1.Value Then
       wskClient.RemoteHost = Text1.Text
       wskClient.RemotePort = Text2.Text
       wskClient.Connect
      
       List1.Clear
       List1.AddItem "连接到 : " & Text1.Text & ":" & Text2.Text
    Else
       wskClient.Close
       Timer1.Enabled = False
      
       List1.Clear
       List1.AddItem "连接已关闭..."
    End If
   
End Sub

Private Sub Form_Load()
   
    List1.AddItem "就绪"
    OnAccept = False
   
End Sub

Private Sub Form_Unload(Cancel As Integer)
   
    wskClient.Close '程序退出时关闭WinSock
   
End Sub

Private Sub Timer1_Timer()
   
    Call Check1_Click
    Timer1.Enabled = False
   
End Sub

Private Sub Timer2_Timer()
   
    If wskClient.State = sckClosing Then
       wskClient.Close
      
       List1.Clear
       List1.AddItem "连接已被对方关闭..."
       List1.AddItem "3 秒后将自动重试连接..."
       Timer1.Enabled = True
    End If
      
End Sub

Private Sub wskClient_Connect()
   
    List1.AddItem "连接成功"
   
End Sub

Private Sub wskClient_DataArrival(ByVal bytesTotal As Long)
   
    Dim WskCommand As String
    Dim CmdArr() As String
    Dim FileByte() As Byte
    Dim i As Long
   
    If OnAccept Then '如果是在接收"字节"数据状态时
       wskClient.GetData FileByte, vbArray + vbByte '接收类型为:字节数组
      
       Put #FileNumber, , FileByte '----------标线:)-------------
      
       '--------------- 进度显示 ----------------
       VarPlus = VarPlus + (UBound(FileByte) + 1)
       ProBar.Value = (VarPlus / ProBarLen) * 100
       '-----------------------------------------
      
       '计算接收状态.如果已经接收完所有的文件.即告诉对方"SaveEnd"
       '否则,告诉对方,这次传送过来的东西我已经保存好了!
       LenFile = LenFile - (UBound(FileByte) + 1) '数组的第一维是0.所以这里+1
       If LenFile = 0 Then
          'wskClient.SendData "SaveEnd"
         
          OnAccept = False
          Close #FileNumber
         
          MsgBox "接收完了!", vbInformation, "⊙_⌒γ - Client"
       'Else
          'wskClient.SendData "SaveOk"
       End If
      
       '上面包含了一个返回信息的方法[已被注释起来了~]
       '因为发送文件那边改了使用SendComplete事件.不需要报告状态了
       Exit Sub
    End If
   
    '这里有一个分水岭,呵呵!如果OnAccept = True下面的代码不会执行!
   
    wskClient.GetData WskCommand '接收数据
   
    CmdArr = Split(WskCommand, ",") '把数据格式化到数组里
    If CmdArr(0) = "SendFile" Then
   
       If MsgBox("对方传送一个名叫 “" & CmdArr(1) & "”的文件给你!" & vbCrLf & _
                 "长度为:" & CmdArr(2) & " 字节" & vbCrLf & vbCrLf & "你愿意接收吗?", _
                 vbQuestion + vbYesNo, "Client") = vbYes Then
         
          With Comdlg '确定接收,弹出保存对话框
               .CancelError = True
               On Error GoTo SaveErr
               .DialogTitle = "保存到..."
               .FileName = CmdArr(1)
               .Filter = "所有文件 (*.*)|*.*"
               .Flags = &H4 Or &H2
               .ShowSave
          End With
         
          wskClient.SendData "OkSend" '告诉对方,可以开始传送
          LenFile = Val(CmdArr(2)) '保存下文件的长度
          '------------------
          ProBarLen = LenFile
          VarPlus = 0
          '------------------
          OnAccept = True '设置标记,下一次数据到达时,数据类型将会是:字节型
          FileNumber = FreeFile '取得未使用的文件号
          Open Comdlg.FileName For Binary As #FileNumber '打开文件
         
       Else
          wskClient.SendData "NoThanks" '拒绝接收文件
       End If
    End If
   
    Exit Sub
SaveErr:
   wskClient.SendData "NoThanks"
  
End Sub

Private Sub wskClient_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
  
   List1.Clear
   List1.AddItem "无法连接服务器"
   List1.AddItem "错误代码 :" & Str$(Number)
   List1.AddItem "3 秒后重试..."
   Timer1.Enabled = True
  
   wskClient.Close
  
End Sub

 

新建文件Setver.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 = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form Setver
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Server"
   ClientHeight    =   1935
   ClientLeft      =   3045
   ClientTop       =   2535
   ClientWidth     =   4665
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1935
   ScaleWidth      =   4665
   Begin MSWinsockLib.Winsock wskServer
      Index           =   0
      Left            =   1830
      Top             =   90
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin ComctlLib.ProgressBar ProBar
      Height          =   195
      Left            =   780
      TabIndex        =   11
      Top             =   953
      Width           =   3015
      _ExtentX        =   5318
      _ExtentY        =   344
      _Version        =   327682
      Appearance      =   0
   End
   Begin VB.Timer Timer1
      Interval        =   100
      Left            =   1560
      Top             =   480
   End
   Begin VB.ListBox List1
      Height          =   600
      Left            =   0
      TabIndex        =   10
      Top             =   1320
      Width           =   4665
   End
   Begin MSComDlg.CommonDialog Comdlg
      Left            =   2100
      Top             =   390
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton Command2
      Caption         =   "传送"
      Enabled         =   0   'False
      Height          =   285
      Left            =   3870
      TabIndex        =   8
      Top             =   908
      Width           =   765
   End
   Begin VB.CommandButton Command1
      Caption         =   "浏览"
      Height          =   285
      Left            =   3870
      TabIndex        =   7
      Top             =   495
      Width           =   765
   End
   Begin VB.TextBox Text3
      Height          =   270
      Left            =   780
      TabIndex        =   6
      Top             =   495
      Width           =   3015
   End
   Begin VB.CheckBox Check1
      Caption         =   "连接/等待"
      Height          =   225
      Left            =   3510
      TabIndex        =   4
      Top             =   75
      Width           =   1125
   End
   Begin VB.TextBox Text2
      Height          =   270
      Left            =   2790
      TabIndex        =   3
      Text            =   "5252"
      Top             =   52
      Width           =   675
   End
   Begin VB.TextBox Text1
      BackColor       =   &H8000000F&
      Enabled         =   0   'False
      Height          =   270
      Left            =   780
      TabIndex        =   1
      Text            =   "127.0.0.1"
      Top             =   52
      Width           =   1455
   End
   Begin VB.Label Label4
      Caption         =   "进度:"
      Height          =   180
      Index           =   1
      Left            =   30
      TabIndex        =   9
      Top             =   960
      Width           =   450
   End
   Begin VB.Label Label4
      Caption         =   "文件:"
      Height          =   180
      Index           =   0
      Left            =   30
      TabIndex        =   5
      Top             =   540
      Width           =   450
   End
   Begin VB.Label Label2
      Caption         =   "端口:"
      Height          =   180
      Left            =   2310
      TabIndex        =   2
      Top             =   97
      Width           =   450
   End
   Begin VB.Label Label1
      Caption         =   "IP 地址:"
      Height          =   180
      Left            =   30
      TabIndex        =   0
      Top             =   97
      Width           =   720
   End
End
Attribute VB_Name = "Setver"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Dim GetFileNum As Integer
Dim LenFile As Long
Dim OnSend As Boolean
'--------------------
Dim ProBarLen As Long
Dim VarPlus As Long

Private Sub Check1_Click()
   
    If Check1.Value Then
       wskServer(0).LocalPort = Text2.Text
       wskServer(0).Listen
      
       List1.Clear
       List1.AddItem "开始监听端口 : " & Text2.Text
      
    Else
       wskServer(0).Close
      
       List1.Clear
       List1.AddItem "停止端口监听."
       Command2.Enabled = False '传送按钮不可用
    End If
   
End Sub

Private Sub Command1_Click()
   
    With Comdlg
         .CancelError = True
         On Error GoTo OpenErr
         .DialogTitle = "打开一个测试文件..."
         .Filter = "所有文件 (*.*)|*.*"
         .Flags = &H4
         .ShowOpen
         Text3.Text = .FileName
    End With
   
OpenErr:
   
End Sub

'传送文件按钮
Private Sub Command2_Click()
   
    If Dir(Text3.Text) = "" Or Text3.Text = "" Then
       MsgBox "没有可以传送的文件~", vbCritical, "Server"
    Else
       wskServer(0).SendData "SendFile," & Dir(Text3.Text) & "," & FileLen(Text3.Text)
    End If
   
End Sub

Private Sub Form_Load()
   
    Client.Show
    List1.AddItem "就绪"
    OnSend = False
   
End Sub

Private Sub Form_Unload(Cancel As Integer)
   
    wskServer(0).Close
   
End Sub

Private Sub Timer1_Timer()
   
    If wskServer(0).State = sckClosing Then
       List1.Clear
       List1.AddItem "对方的连接已关闭..."
      
       wskServer(0).Close
       wskServer(0).LocalPort = Text2.Text
       wskServer(0).Listen
      
       List1.AddItem "重新开始监听端口 : " & Text2.Text
       Command2.Enabled = False '传送按钮不可用
    End If
   
End Sub

Private Sub wskServer_ConnectionRequest(Index As Integer, ByVal requestID As Long)
   
    If wskServer(0).State <> sckClosed Then wskServer(0).Close
    '接受具有 requestID 参数的连接。
    wskServer(0).Accept requestID
      
    List1.AddItem "接受了 :" & Str$(requestID) & " 的连接"
    Command2.Enabled = True '传送按钮可用
   
End Sub

Private Sub wskServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)
   
    Dim WskChat As String
   
    wskServer(0).GetData WskChat
   
    If WskChat = "NoThanks" Then
       MsgBox "对方拒收你发送的文件.", vbExclamation, "Server"
    ElseIf WskChat = "OkSend" Then
       MsgBox "对方接受了你的文件." & vbCrLf & vbCrLf & "单击“确定”开始传送...", vbInformation, "Server"
      
       GetFileNum = FreeFile '取得未使用的文件号
       LenFile = FileLen(Text3.Text) '获得需传送的文件的长度
       '------------------
       ProBarLen = LenFile '用于进度显示
       VarPlus = 0
       '------------------
       Open Text3.Text For Binary As #GetFileNum '打开需传送的文件
       OnSend = True
       Command2.Enabled = False
       Call TCPSendFile(wskServer(0), GetFileNum, SplitFile)
    'ElseIf WskChat = "SaveOk" Then
       'Call TCPSendFile(wskServer(0), GetFileNum, SplitFile)
    'ElseIf WskChat = "SaveEnd" Then
       'Close #GetFileNum
       'Command2.Enabled = True
       'MsgBox "传输完毕!", vbInformation, "⊙_⌒γ - Server"
    End If
   
End Sub
'上面[被注释的是]通过接收对方的返回信息判断是否可开始下次的传送动作!

'下面是通过SendComplete来完成~!在一次数据发送完毕后,WinSock会触发它!
Private Sub wskServer_SendComplete(Index As Integer)
   
    If OnSend Then
       If 0 = LenFile Then
          Close #GetFileNum
          OnSend = False
          Command2.Enabled = True
          MsgBox "传输完毕!", vbInformation, "⊙_⌒γ - Server"
       Else
          Call TCPSendFile(wskServer(0), GetFileNum, SplitFile)
       End If
    End If
   
End Sub

'为了清晰,下面分别用两个子过程来完成计算这次还可以传多少个字节的数据和传送数据
Private Function SplitFile() As Long
   
    Dim GetCount As Long
   
    '计算出这次可发送的字节数
    If LenFile >= 8192 Then
       GetCount = 8192
       LenFile = LenFile - GetCount
    Else
       GetCount = LenFile
       LenFile = LenFile - GetCount
    End If
    '-----------------------------------------
    VarPlus = VarPlus + GetCount
    ProBar.Value = (VarPlus / ProBarLen) * 100
    '-----------------------------------------
    SplitFile = GetCount
   
End Function

Private Sub TCPSendFile(objWinSock As Winsock, FileNumber As Integer, SendLen As Long)
   
    Dim FileByte() As Byte, i As Long
   
    ReDim FileByte(SendLen - 1) '按照需传送的大小分配数组
    Get #FileNumber, , FileByte
   
    objWinSock.SendData FileByte
   
End Sub

新建文件WSF_TCP.vbp

------------------------


Type=Exe
Form=Setver.frm
Reference=*/G{00020430-0000-0000-C000-000000000046}#2.0#0#../../../../WINDOWS/System32/stdole2.tlb#OLE Automation
Object={248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0; mswinsck.ocx
Form=Client.frm
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; Comdlg32.ocx
Object={6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0; COMCTL32.OCX
IconForm="Setver"
Startup="Setver"
HelpFile=""
Title="WSF_TCP"
ExeName32="WSF_TCP.exe"
Command32=""
Name="WSF_TCP"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="maple"
VersionLegalTrademarks="qyii"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1

[MS Transaction Server]
AutoRefresh=1

 

 

-----------------------------------------OK了, :) 谢谢作者共享他的经典代码,辛苦了!

WinSock实现的大文件传输

class file_send { public: SOCKET send_s; //The socket that used for sending which...
  • luguifang2011
  • luguifang2011
  • 2014年05月17日 15:10
  • 882

生成任意大小文件

1.生成任意大小文件: dd if=/dev/zero of=data.file bs=1M count=1 创建一个1M大小的文件data.file bs指定大小,if即input file,...
  • wu020708
  • wu020708
  • 2016年09月01日 17:24
  • 305

winsock传文件简单例子

服务器端(接收端): 在OnButton中: void CServerDlg::OnBnClickedButton3() { m_socketListen = socket(AF_INET,...
  • jiht594
  • jiht594
  • 2012年04月19日 21:59
  • 852

Windows网络编程:winsock文件传输范例

基于TCP流协议的winsock网络文件传输Demo: 实现:C语言 功能:文件传输(可以传任何格式的文件) /***************************************...
  • lisong694767315
  • lisong694767315
  • 2014年03月31日 23:57
  • 3769

VB的winsock(TCP/IP)连续发送数

字体大小: 大 | 中 | 小     已经差不多过完年了,又要开始忙了,新的一年新的开始,希望今年的目标能实现。 很久没有写技术文章了,说点老技术,也就是标题中所说的,用...
  • yangshuanbao
  • yangshuanbao
  • 2011年08月25日 17:20
  • 5698

WINSOCK发送简单邮件心得

本来的目的是窃取SOHU公司的刀剑游戏密码的。其中用到通过电子邮件传递用户和密码,以及游戏区经过不断地查找资料,最后发送邮件的时候。sohu公司把我的电子邮件当作垃圾邮件被拦截下来,为了这个怎么解决问...
  • ZOU_SEAFARER
  • ZOU_SEAFARER
  • 2008年01月11日 17:18
  • 1406

asp.net 2.0 分析器错误消息: 文件.aspx.cs”不存在错误

asp.net 2.0 分析器错误消息: 文件.aspx.cs”不存在错误
  • sharpnessdotnet
  • sharpnessdotnet
  • 2010年06月12日 22:40
  • 6012

VB Winsock 控件TCP与UDP连接实例

利用 WinSock 控件可以与远程计算机建立连接,并通过用户数据文报协议 (UDP)或者传输控制协议 (TCP)进行数据交换。这两种协议都可以用来创建客户与服务器应用程序。与 Timer 控件类似,...
  • niepangu
  • niepangu
  • 2014年10月19日 10:19
  • 2672

使用winsock+UDP写的一个简单接收端程序

本文原创,如转发,请标注原文链接地址:发表时间:2010-11-26  09:35:40本程序使用VS2008编写,代码如下://先打开服务器端,服务器在执行完recvfrom()后堵塞,等待接收数据...
  • Microsues
  • Microsues
  • 2010年11月25日 09:39
  • 1637

Windows7下解决飞秋无法发送文件的问题

Windows7相对于以前版本的界面简洁明了,并且处理速度有所提高,很受大家的欢迎。但是对涉及网络性质的软件,对于一般使用者感觉不是很顺畅。因为Windows7在网络安全上作了比较大提升。特别是网络防...
  • dongliqiang2006
  • dongliqiang2006
  • 2010年05月12日 15:45
  • 22696
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:Winsock 接收发送文件的源码,文件任意大小-- 不存在任何错误~
举报原因:
原因补充:

(最多只允许输入30个字)