VB实现局域网内的文件传输

原创 2004年09月22日 09:06:00

为了设计统一和用户操作方便,我们希望将服务端与客户端融合在一起,形成一个程序,这样用户理解起来,更加直观一点(其实这样做也是为了方便调试,大家可以在本机上测试,自己传文件给自己)。所以,我们在程序中需要使用两个Winsock控件,一个负责监听,一个负责发送,当发送端连接成功以后,便选择一个待发送的文件(可以是任意二进制文件),接着将文件名和文件字节长度发送给接收端,接收端收到这个消息以后,将文件名和文件长度解析出来,然后通知发送端可以开始发送文件;发送端读到这个消息之后,将文件流以字节的形式发送到接收端,接收端收到后,将二进制流回写,保存成文件即可。这里要注意两点,一个是由于Winsock每次最大传输8K的内容,所以需要将文件分解,每次传输固定数目的字节流,这样发送和接收时都可以根据这个数目来判断文件传输的进程,一旦字节流数目等于文件的大小,就需要关闭相应的文件句柄;另一点是由于我只使用一个Winsock控件接收,接收文本时需要注意要将UNICODE转码,解析成可识别的信息。

 

源代码

'下面的代码既是服务器又是客户端

'采用应答式发送方式

'自动拆分文件,包括2进制

<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" />

 

Option Explicit

'Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

 

Dim mybyte() As Byte '发送方数组

 

Const filecomesMSG = "a file is coming " '有文件到来

Const RemoteIsReadyMSG = "sender is ready " '准备好了

Const FileisOverMSG = "the file is ended" '文件完毕

Const RemoteDenyMSG = "the user canceled" '用户取消

Const filecountMSG = "the file lengh is" '文件长度

Const RecevieIsReadyMSG = "Receiver is ready " '准备接收

 

Dim arrdata() As Byte '收到的信息

Dim filesave As Integer '保存文件的句柄

Dim filehandle As Integer '发送方文件的句柄

Dim FileSize As Double '文件的大小

 

Dim Sendbyte As Long

Dim Receivebyte As Long

 

Dim MyLocation As Double

Dim myMSG As String '消息

Dim FileisOver As Boolean '文件是否已经完毕

 

Const ReceivePort = 7905

Const BUFFER_SIZE = 5734

 

Private Sub cmdConnect_Click()

    Timer2.Enabled = True

End Sub

 

Private Sub cmdsend_Click()

 

    On Error GoTo errorhandle

 

    With CommonDialog1

        .CancelError = True

        .DialogTitle = "选择您要传送的文件"

        .Filter = "All Files (*.*)|*.*"

        .ShowOpen

    End With

 

    filehandle = FreeFile

    Open CommonDialog1.FileName For Binary Access Read As #filehandle

 

    cmdSend.Enabled = False

   

    FileSize = CDbl(FileLen(CommonDialog1.FileName))

   

    Label1.Caption = "等待回应>>>"

    MsgBox ("选择的文件大小为 " & LOF(filehandle) & " 字节")

   

    If WinsockSend.State = sckConnected Then

        WinsockSend.SendData filecomesMSG & CommonDialog1.FileName '发送发出文件信息

    End If

   

    Exit Sub

   

errorhandle:

cmdSend.Enabled = True

MsgBox ("你没有选择一个文件!")

 

End Sub

 

 

Private Sub Form_Load()

   

    WinsockReceive.LocalPort = ReceivePort

    WinsockReceive.Listen

          

    FileisOver = True

 

    Label1.Caption = "准备传输>>>"

   

End Sub

 

Public Function SendChunk()

 

Dim mybytesize As Long

 

    If WinsockSend.State <> sckConnected Then Exit Function

   

    mybytesize = BUFFER_SIZE

   

    If LOF(filehandle) - Loc(filehandle) < BUFFER_SIZE Then mybytesize = (LOF(filehandle) - Loc(filehandle))

   

    ReDim mybyte(0 To mybytesize - 1)

   

    Get #filehandle, , mybyte

   

    WinsockSend.SendData mybyte

   

    Sendbyte = Sendbyte + mybytesize

   

    ProgressBar1.Value = Int((100 / FileSize) * Sendbyte)

   

    If Sendbyte >= FileSize Then

        FileisOver = True

        WinsockSend.SendData FileisOverMSG

    End If

 

End Function

 

Private Sub Timer2_Timer()

    If WinsockSend.State = sckConnected Then

   

        Timer2.Enabled = False

       

        cmdConnect.Enabled = False

       

    ElseIf WinsockSend.State <> 1 And WinsockSend.State <> 6 And WinsockSend.State <> 7 And WinsockSend.State <> 8 And WinsockSend.State <> 9 Then

   

        WinsockSend.Connect txtHost.Text, ReceivePort

       

    ElseIf WinsockSend.State = 8 Or WinsockSend.State = 9 Then

   

        WinsockSend.Close

    End If

   

   

End Sub

 

Private Sub WinsockReceive_ConnectionRequest(ByVal requestID As Long)

 

    If WinsockReceive.State <> sckClosed Then WinsockReceive.Close

   

    WinsockReceive.Accept requestID

   

   

End Sub

 

Private Sub WinsockReceive_DataArrival(ByVal bytesTotal As Long)

   

    ReDim arrdata(0 To bytesTotal - 1)

   

    WinsockReceive.GetData arrdata, vbByte + vbArray

   

    myMSG = StrConv(arrdata, vbUnicode)        '二进制转为字符串

   

    Select Case Mid(myMSG, 1, 17)

   

    Case filecomesMSG '这些消息发送方和接受方都可收到

        '显示保存对话框

        On Error GoTo errorhandle

        CommonDialog1.FileName = Mid(myMSG, 17, Len(myMSG))

        CommonDialog1.DialogTitle = "选择保存文件的路径"

        CommonDialog1.ShowSave

        filesave = FreeFile

       

        Receivebyte = 0

        cmdSend.Enabled = False

        WinsockReceive.SendData RecevieIsReadyMSG

    Case FileisOverMSG

        Close #filesave

       

        MsgBox ("文件传输成功!") '大家一起处理

       

        cmdConnect.Enabled = True

       

        cmdSend.Enabled = True

       

        Label1.Caption = "准备传输>>>"

       

        ProgressBar1.Value = 0

       

        WinsockReceive.SendData FileisOverMSG

       

        WinsockReceive.Close

       

        WinsockReceive.Listen

       

    Case filecountMSG

        FileSize = Mid(myMSG, 18, Len(myMSG))

        Open CommonDialog1.FileName For Binary Access Write As #filesave

        WinsockReceive.SendData RemoteIsReadyMSG

        Label1.Caption = "文件准备传输!"

        FileisOver = False

       

    Case Else

        If Receivebyte < FileSize Then

            Receivebyte = Receivebyte + bytesTotal

            Put #filesave, , arrdata

            WinsockReceive.SendData RemoteIsReadyMSG

            ProgressBar1.Value = Int((100 / FileSize) * Receivebyte)

        End If

    End Select

    Exit Sub

errorhandle:

    WinsockReceive.SendData RemoteDenyMSG

    cmdConnect.Enabled = True

   

End Sub

 

Private Sub WinsockSend_DataArrival(ByVal bytesTotal As Long)

    WinsockSend.GetData myMSG

    Select Case myMSG

   

    Case RecevieIsReadyMSG

        WinsockSend.SendData filecountMSG & FileSize

        FileisOver = False

        Sendbyte = 0

       

    Case RemoteIsReadyMSG

        '如果文件还没有结束,继续传输

        If Not FileisOver Then

            Label1.Caption = "文件正在被传输>>>"

            SendChunk

        Else

            WinsockSend.SendData FileisOverMSG

        End If

    Case FileisOverMSG

        '主机处理

        Close #filehandle

       

        MsgBox ("文件传输成功!") '大家一起处理

       

        WinsockSend.SendData FileisOverMSG

       

        WinsockSend.Close

       

        cmdConnect.Enabled = True

       

        ProgressBar1.Value = 0

       

        cmdSend.Enabled = True

        Label1.Caption = "准备传输>>>"

    Case RemoteDenyMSG

        MsgBox ("用户终止了传输!")

        cmdSend.Enabled = True

        Label1.Caption = "准备传输>>>"

        Close #filehandle

    End Select

    Exit Sub

 

End Sub

 

本程序在WinXPSP1+VB6Win2000SP4+VB6下面调试成功。

C# Winform局域网传送文件

//发送文件 private void btn_sendFile_Click(object sender, EventArgs e) { ...
  • smartsmile2012
  • smartsmile2012
  • 2013年03月11日 10:19
  • 4993

基于Qt的P2P局域网聊天及文件传送软件设计

基于Qt的P2P局域网聊天及文件传送软件设计zouxy09@qq.comhttp://blog.csdn.net/zouxy09       这是我的《通信网络》的课程设计作业,之前没怎么学过Qt,但...
  • zouxy09
  • zouxy09
  • 2013年06月20日 21:28
  • 22725

在两台电脑之间通过网线、局域网快速传东西的几种方法

测试环境:win7+USB3.0 如果资料少的话,用U盘当然很好,如果资料中的小文件不多,总的文件也不大,用U盘也不错。 但如果文件多达400多G,小文件又很多,那U盘会慢的让人发狂,在USB3....
  • moses1994
  • moses1994
  • 2015年05月05日 20:42
  • 6191

基于VB的局域网文件传输系统

  • 2011年11月24日 22:28
  • 195KB
  • 下载

java语言实现的局域网点对点文件传输

  • 2013年06月18日 23:40
  • 12KB
  • 下载

QT实现局域网聊天工具(带UDP文件传输)

三年多以前刚学习QT写的一个局域网聊天工具小项目。 由于是初学QT时写的,代码比较简略,也没时间好好整理项目,仅供大家参考相关TCP以及UDP的连接与传输功能   以及相关控件的基本使用方法。 1...
  • liukang325
  • liukang325
  • 2015年05月04日 16:53
  • 8950

C#实现一个局域网文件传输工具

工作需要,经常会在工作的台式机和笔记本之间传文件或者需要拷贝文本,两个机器都位于局域网内,传文件或者文本的方式有很多种,之前是通过共享文件夹来进行文件的拷贝,或者通过SVN进行同步。文本传递比较简单,...
  • qwertyupoiuytr
  • qwertyupoiuytr
  • 2017年07月11日 16:58
  • 1144

实现的局域网内大文件传输(ftp功能)

以Xp系统为例。 (1)安装iis6.0,。点击【控制面板】-【添加或删除程序】-【添加或删除windows组件】,勾选【internet信息服务】,点击【详细信息】,勾选【文件传输协议服务】,点击...
  • yunxian_19
  • yunxian_19
  • 2015年04月05日 19:30
  • 333

python用tcp实现局域网内文件传输(文本,图片,视频)

功能: 可以利用python创建的TCP客户端从我们自己搭建的TCP服务器上下载文件. 实现需求: 安装socket模块 简单了解sokcet模块用法...
  • wf134
  • wf134
  • 2017年11月12日 23:08
  • 630

局域网文件传输飞鸽

  • 2017年10月13日 21:49
  • 4.37MB
  • 下载
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:VB实现局域网内的文件传输
举报原因:
原因补充:

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