谁能给我一个winsock发送和接收文件的例子啊？

Question

我的写文件过程如下：
    Dim fang As string
    wskWksbbsj.GetData fang, vbstring
    
     Open (App.Path + "\xxhs.dat") For Append Access Read Write As #1
        Put #1, , fang
    Close #1
读文件过程如下：
     Dim fang As string
           
      Open (App.Path + "\xxhs.dat") For Append Access Read Write As #1
          Get #1, 1, fang
     Close #1
     wskCtrlbbsj.SendData fang还有,你可以搜索一下.

Answer 1

'发送文件
Private Sub sendfile(filename As String)
    Dim s As String * 8
    Dim fn As String * 50
    Dim i As Integer
    Dim b(4096) As Byte
    Dim c() As Byte
    Dim filelength As Long
    Open filename For Binary Access Read As #1
    filelength = LOF(1)
    If filelength = 0 Then
        Unload Me
    End If
    s = Trim(Str(filelength))
    tcp.SendData s
    i = 0
    Do While True
        If Mid(filename, Len(filename) - i, 1) = "\" Then
            fn = Mid(filename, Len(filename) - i + 1, i)
            Exit Do
        Else
            i = i + 1
        End If
    Loop
    fn = read_hz(fn, 50)
    tcp.SendData fn
    ReDim c(filelength Mod 4096)
'    Shape1.Width = 0
    For i = 0 To filelength \ 4096
        If i = filelength \ 4096 Then
            Get 1, , c
            tcp.SendData c
            
        Else
            Get 1, , b
            tcp.SendData b
 '           Shape1.Width = 2550 * i / (filelength \ 4096)
        End If
        
    Next
    
    '    tcp.GetData b, vbByte + vbArray, read_length
     '   Put 1, , b
        'Next
'        tcp.GetData s1, vbByte
 '       Put 1, , s1
        
    Close #1
  '  DoEvents
End Sub'接收文件   请修改一下即可
Private Sub tcp_DataArrival(ByVal bytesTotal As Long)
    Dim buffer As String
    Dim a() As Byte    
    Dim f As New FileSystemObject
    If state = 0 Then
        tcp.GetData buffer, , 65
        ret.length = Left(buffer, 8)
        ret.jym = Mid(buffer, 9, 4)
        ret.fhz = Mid(buffer, 13, 3)
        ret_string = Trim(Mid(buffer, 16, 50))
        If ret.fhz <> "000" Then
            MsgBox (ret_string)
            Unload Me
            Exit Sub
        End If        filename = App.Path + "\" + Trim(ret_string)
        filelength = Val(ret.length)
        Open filename For Binary Access Write As #1
        state = 1
        bytesTotal = bytesTotal - 65
        length = 0
        Shape2.Width = 0
        'Shape1.Width = 2550 * length / filelength
    End If
    If state = 1 And bytesTotal > 0 Then
        ReDim a(bytesTotal)
        length = length + bytesTotal
        tcp.GetData a, vbArray + vbByte
        Put 1, , a
        Shape2.Width = 2550 * length / filelength
        'Shape1.Refresh
        
    End If
    If length >= filelength Then
        Close #1
        'If Right(filename, 3) = "DOC" Then
         '   Shell "winword " + filename, vbNormalFocus
        'Else
        '    Shell "kodakimg " + filename, vbNormalFocus
        'End If
        Shell "start " + filename, vbNormalFocus
        tcp.Close
        state = 0
        Unload Me
        
    End If
   ' DoEvents
End Sub'发送文件
Private Sub sendfile(filename As String)
    Dim s As String * 8
    Dim fn As String * 50
    Dim i As Integer
    Dim b(4096) As Byte
    Dim c() As Byte
    Dim filelength As Long
    Open filename For Binary Access Read As #1
    filelength = LOF(1)
    If filelength = 0 Then
        Unload Me
    End If
    s = Trim(Str(filelength))
    tcp.SendData s
    i = 0
    Do While True
        If Mid(filename, Len(filename) - i, 1) = "\" Then
            fn = Mid(filename, Len(filename) - i + 1, i)
            Exit Do
        Else
            i = i + 1
        End If
    Loop
    fn = read_hz(fn, 50)
    tcp.SendData fn
    ReDim c(filelength Mod 4096)
'    Shape1.Width = 0
    For i = 0 To filelength \ 4096
        If i = filelength \ 4096 Then
            Get 1, , c
            tcp.SendData c
            
        Else
            Get 1, , b
            tcp.SendData b
 '           Shape1.Width = 2550 * i / (filelength \ 4096)
        End If
        
    Next
    
    '    tcp.GetData b, vbByte + vbArray, read_length
     '   Put 1, , b
        'Next
'        tcp.GetData s1, vbByte
 '       Put 1, , s1
        
    Close #1
  '  DoEvents
End Sub'接收文件   请修改一下即可
Private Sub tcp_DataArrival(ByVal bytesTotal As Long)
    Dim buffer As String
    Dim a() As Byte    
    Dim f As New FileSystemObject
    If state = 0 Then
        tcp.GetData buffer, , 65
        ret.length = Left(buffer, 8)
        ret.jym = Mid(buffer, 9, 4)
        ret.fhz = Mid(buffer, 13, 3)
        ret_string = Trim(Mid(buffer, 16, 50))
        If ret.fhz <> "000" Then
            MsgBox (ret_string)
            Unload Me
            Exit Sub
        End If        filename = App.Path + "\" + Trim(ret_string)
        filelength = Val(ret.length)
        Open filename For Binary Access Write As #1
        state = 1
        bytesTotal = bytesTotal - 65
        length = 0
        Shape2.Width = 0
        'Shape1.Width = 2550 * length / filelength
    End If
    If state = 1 And bytesTotal > 0 Then
        ReDim a(bytesTotal)
        length = length + bytesTotal
        tcp.GetData a, vbArray + vbByte
        Put 1, , a
        Shape2.Width = 2550 * length / filelength
        'Shape1.Refresh
        
    End If
    If length >= filelength Then
        Close #1
        'If Right(filename, 3) = "DOC" Then
         '   Shell "winword " + filename, vbNormalFocus
        'Else
        '    Shell "kodakimg " + filename, vbNormalFocus
        'End If
        Shell "start " + filename, vbNormalFocus
        tcp.Close
        state = 0
        Unload Me
        
    End If
   ' DoEvents
End Sub