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了, :) 谢谢作者共享他的经典代码,辛苦了!

相关文章推荐

高德地图 keytool 错误: java.lang.Exception: 密钥库文件不存在

高德地图 首先,如果照着做的话,你会出现 这样的错,是因为目录下没有debug.ketstore   可以通过输入 keytool -genkey -v -keystore debug.k...

Java命令行编译文件时出现的错误,找不到符号或软件包不存在等

习惯了eclipse的自动编译,Java命令行编译、执行文件只会最基础的部分,就是对单文件的编译和执行,而且不包含任何外部JAR包。但有时候你还非得用命令行,会碰到一些问题,博主这里给出几种常见的问题...

winsock错误-头文件包含顺序

Windows平台下用C++做网络开发很多时候都会同时包含这两个头文件,如若顺序不当(windows.h先于winsock2.h)就会出现很多莫名其妙的错误。诸如: c:\program f...
  • ljh0302
  • ljh0302
  • 2015年12月03日 15:42
  • 901

jquery.uploadpreview.js文件大小限止,兼容ie8,safari9,对源码做了点修改

(function($) { jQuery.fn.extend({ uploadPreview: function(opts) { opts = jQu...
  • wan318
  • wan318
  • 2016年03月15日 10:42
  • 1440

libcurl远程获取文件大小源码

这是一个简单的获取远程文件大小的源码,我们可以改写为大批量
  • tao_627
  • tao_627
  • 2014年09月10日 14:57
  • 2731

用SOCKET传输任意大小的文件

  • 2006年02月23日 09:05
  • 11KB
  • 下载
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:Winsock 接收发送文件的源码,文件任意大小-- 不存在任何错误~
举报原因:
原因补充:

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