请问如何用VB编写一个程序,实现两台电脑通过Internet 传输文件(要求简单,可靠,高效)，请有实际应用经验的大侠指教！！！

Question

请问如何用VB编写一个程序,实现两台电脑通过Internet 传输文件(要求简单,可靠,高效)，请有实际应用经验的大侠指教！！！谢谢

Answer 1

'// ServerOption ExplicitDim m_sockets As Integer
Dim srvpath As String
Dim IsReceived As Boolean
Dim onlines As LongConst PORT = 32654Private Sub Form_Load()onlines = 0
m_sockets = 0Winsock1(m_sockets).LocalPort = PORT
Winsock1(m_sockets).Bind
Winsock1(m_sockets).ListenEnd SubPrivate Sub Form_Unload(Cancel As Integer)
Dim i As IntegerFor i = 0 To m_sockets
    If Winsock1(i).State = sckConnected Then
        Winsock1(i).SendData "close"
    End If
    Winsock1(i).Close
Next iEnd SubPrivate Sub Winsock1_Close(Index As Integer)
Winsock1(Index).Close
onlines = onlines - 1
Picture1.Cls
Picture1.Print "online:" & onlines
End SubPrivate Sub Winsock1_ConnectionRequest(Index As Integer, ByVal requestID As Long)
If Index = 0 Then
    m_sockets = m_sockets + 1
    Load Winsock1(m_sockets)
    Winsock1(m_sockets).LocalPort = 0
    
    If Winsock1(m_sockets).State <> sckClosed Then
        Winsock1(m_sockets).Close
    End If
    Winsock1(m_sockets).Accept requestID
    
    onlines = onlines + 1
    Picture1.Cls
    Picture1.Print "online:" & onlines
End If
End Sub'send file (file must be opened as shared)
Private Sub SendFile(srcpath As String, sock As Winsock)Dim buff() As Byte
Dim lnfile As Long
Dim nLoop As Long
Dim nRemain As Long
Dim cn As Long
Dim filenumber As Integer'On Error GoTo PROC_ERR
On Error Resume Nextlnfile = FileLen(srcpath)If lnfile > 1024 Then
    nLoop = Fix(lnfile / 1024)
    nRemain = lnfile Mod 1024
Else
    nLoop = 0
    nRemain = lnfile
End IfIf lnfile = 0 Then
    MsgBox "Ivalid Source File", vbCritical, "Server"
    Exit Sub
End Iffilenumber = FreeFileOpen srcpath For Binary Shared As #filenumber
    If nLoop > 0 Then
        For cn = 1 To nLoop
            ReDim buff(1024) As Byte
            Get #filenumber, , buff
            sock.SendData buff
            IsReceived = False
            While IsReceived = False
                DoEvents
            Wend
        Next
        
        If nRemain > 0 Then
            ReDim buff(nRemain) As Byte
            Get #filenumber, , buff
            sock.SendData buff
            IsReceived = False
            While IsReceived = False
                DoEvents
            Wend
        End If
    Else
        ReDim buff(nRemain) As Byte
        Get #filenumber, , buff
        sock.SendData buff
        IsReceived = False
        While IsReceived = False
            DoEvents
        Wend
    End If
Close #filenumbersock.SendData "complete"Exit SubPROC_ERR:
    'MsgBox Err.Number & ":" & Err.Description, vbExclamation, "Error"
End SubPrivate Sub Winsock1_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    
    Dim rec As String
    
    rec = String(bytesTotal + 1, Chr(0))
    Winsock1(Index).GetData rec
    
    Select Case rec
        Case "login"        Case "flash"
            Winsock1(Index).SendData "start"
        Case "ok"
            SendFile App.Path + "\id.txt", Winsock1(Index)
        Case "receive"
            IsReceived = True
    End Select
    
End SubPrivate Sub Winsock1_Error(Index As Integer, 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)
Winsock1(Index).Close
End Sub

Answer 2

'// Client
Option ExplicitDim fl As Integer
Dim byterec As LongConst HOST = "192.168.0.168"
Const PORT = 32654Private Sub Command1_Click()
If Winsock1.State = sckConnected Then
    Winsock1.SendData "flash"
End If
End SubPrivate Sub Command2_Click()
Winsock1.ConnectWait 1If Winsock1.State = sckConnected Then
    Winsock1.SendData "login"
    
    Picture1.Cls
    Picture1.Print "Connected"
End IfEnd SubPrivate Sub Command3_Click()
If Winsock1.State = sckConnected Then
    Winsock1.SendData "logout"
    Winsock1.Close
End If
End SubPrivate Sub Form_Load()With Line1
    .BorderColor = &H808080
    .X1 = 120
    .X2 = 6120
    .Y1 = 4560
    .Y2 = .Y1
End WithWith Line2
    .BorderColor = vbWhite
    .BorderWidth = 2
    .X1 = Line1.X1
    .X2 = Line1.X2
    .Y1 = Line1.Y1 + 20
    .Y2 = .Y1
End With
Line1.ZOrder 0Winsock1.LocalPort = 0
Winsock1.RemoteHost = HOST
Winsock1.RemotePort = PORTWinsock1.ConnectLabel1.Caption = "Connecting server ......"
Timer1.Enabled = True
End SubPrivate Sub Form_Unload(Cancel As Integer)
If Winsock1.State = sckConnected Then
    Winsock1.SendData "logout"
    Winsock1.Close
End If
End SubPrivate Sub Timer1_Timer()
If Winsock1.State = sckConnected Then
    Winsock1.SendData "login"    Label1.Caption = "Already Connected."
    
    Timer1.Enabled = False
    Timer2.Enabled = True
Else
    Winsock1.Close
    Winsock1.Connect
    
    Label1.Caption = "No Connected"
End If
End SubPrivate Sub Timer2_Timer()
If Winsock1.State = sckConnected Then
    Winsock1.SendData "flash"
    Label1.Caption = "Preparing download id file......"
End If
Timer2.Enabled = False
End SubPrivate Sub Winsock1_DataArrival(ByVal bytesTotal As Long)Dim buff() As Byte
Dim rec As String
Dim ret As IntegerReDim buff(bytesTotal + 1) As ByteWinsock1.GetData buffSelect Case bytetostr(buff)
    Case "close"
        Winsock1.Close
    Case "complete"
        Close #fl
    Case "start"
        Dim dstpath As String
        
        dstpath = App.Path + "\王码五笔.EXE"
        
        fl = FreeFile
        
        If Len(Dir(dstpath)) > 0 Then
            ret = MsgBox("File already exist!" & vbCrLf & "You wont overwrite it?", vbQuestion + vbYesNo, "Client")
            If ret = vbYes Then
                Kill dstpath
            Else
                'insert cancel code
                Exit Sub
            End If
        End If
        
        Open dstpath For Binary As #fl
        byterec = 0
        
        Winsock1.SendData "ok"
    Case Else
        byterec = byterec + bytesTotal
        Put #fl, , buff
                      
        Picture1.Cls
        Picture1.Print "Bytes received: " & Format(byterec / 1024, ".00") & "kb"
        Winsock1.SendData "receive"
End SelectEnd SubPublic Function Wait(i As Integer)
    Dim PauseTime, start    PauseTime = i
    start = Timer
    Do While Timer < start + PauseTime
        DoEvents
    Loop
End FunctionPublic Function bytetostr(b() As Byte) As String
    
    Dim i As Integer
    
    bytetostr = ""
    
    For i = 0 To UBound(b)
        bytetostr = bytetostr & Chr(b(i))
    Next i
    
End Function

Answer 3

http://blog.csdn.net/qyii/archive/2004/12/02/202677.aspx