如何用VB实现文件传输?

非下载文件,而是点对点传输,原理是什么呢?

'// Server

Option Explicit

Dim m_sockets As Integer
Dim srvpath As String
Dim IsReceived As Boolean
Dim onlines As Long

Const PORT = 32654

Private Sub Form_Load()

onlines = 0
m_sockets = 0

Winsock1(m_sockets).LocalPort = PORT
Winsock1(m_sockets).Bind
Winsock1(m_sockets).Listen

End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer

For i = 0 To m_sockets
If Winsock1(i).State = sckConnected Then
Winsock1(i).SendData "close"
End If
Winsock1(i).Close
Next i

End Sub

Private Sub Winsock1_Close(Index As Integer)
Winsock1(Index).Close
onlines = onlines - 1
Picture1.Cls
Picture1.Print "online:" & onlines
End Sub

Private 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 Next

lnfile = FileLen(srcpath)

If lnfile > 1024 Then
nLoop = Fix(lnfile / 1024)
nRemain = lnfile Mod 1024
Else
nLoop = 0
nRemain = lnfile
End If

If lnfile = 0 Then
MsgBox "Ivalid Source File", vbCritical, "Server"
Exit Sub
End If

filenumber = FreeFile

Open 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 #filenumber

sock.SendData "complete"

Exit Sub

PROC_ERR:
'MsgBox Err.Number & ":" & Err.Description, vbExclamation, "Error"
End Sub

Private 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 Sub

Private 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

'// Client
Option Explicit

Dim fl As Integer
Dim byterec As Long

Const HOST = "192.168.0.168"
Const PORT = 32654

Private Sub Command1_Click()
If Winsock1.State = sckConnected Then
Winsock1.SendData "flash"
End If
End Sub

Private Sub Command2_Click()
Winsock1.Connect

Wait 1

If Winsock1.State = sckConnected Then
Winsock1.SendData "login"

Picture1.Cls
Picture1.Print "Connected"
End If

End Sub

Private Sub Command3_Click()
If Winsock1.State = sckConnected Then
Winsock1.SendData "logout"
Winsock1.Close
End If
End Sub

Private Sub Form_Load()

With Line1
.BorderColor = &H808080
.X1 = 120
.X2 = 6120
.Y1 = 4560
.Y2 = .Y1
End With

With Line2
.BorderColor = vbWhite
.BorderWidth = 2
.X1 = Line1.X1
.X2 = Line1.X2
.Y1 = Line1.Y1 + 20
.Y2 = .Y1
End With
Line1.ZOrder 0

Winsock1.LocalPort = 0
Winsock1.RemoteHost = HOST
Winsock1.RemotePort = PORT

Winsock1.Connect

Label1.Caption = "Connecting server ......"
Timer1.Enabled = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
If Winsock1.State = sckConnected Then
Winsock1.SendData "logout"
Winsock1.Close
End If
End Sub

Private 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 Sub

Private Sub Timer2_Timer()
If Winsock1.State = sckConnected Then
Winsock1.SendData "flash"
Label1.Caption = "Preparing download id file......"
End If
Timer2.Enabled = False
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

Dim buff() As Byte
Dim rec As String
Dim ret As Integer

ReDim buff(bytesTotal + 1) As Byte

Winsock1.GetData buff

Select 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 Select

End Sub

Public Function Wait(i As Integer)
Dim PauseTime, start

PauseTime = i
start = Timer
Do While Timer < start + PauseTime
DoEvents
Loop
End Function

Public 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

我只会下载 option explicit'这个的意思是要求变量必须声明后才能使用private declare function urldownloadtofile lib "urlmon" alias "urldownloadtofilea" (byval pcaller as long, byval szurl as string, byval szfilename as string, byval dwreserved as long, byval lpfncb as long) as longprivate declare function shellexecute lib "shell32.dll" alias "shellexecutea" (byval hwnd as long, byval lpoperation as string, byval lpfile as string, byval lpparameters as string, byval lpdirectory as string, byval nshowcmd as long) as longprivate declare sub sleep lib "kernel32" (byval dwmilliseconds as long)'这三个是函数声明private sub command1_click()urldownloadtofile 0, text1.text, text2.text, 0, 0 'text1.text是下载文件的地址 text2.text是保存的磁盘（要包括文件名）例 'text1.text= www.baidu.com/123.exe text2.text=c:\1.exe(这个文件名是可以改的)end sub没有完全达到你的要求抱歉啊 祝你早日成功 有兴趣加我qq493317276我们共同学习