Private Sub Form_Activate()
If transfer.State <> sckClosed Then
transfer.Close
End If
transfer.Protocol = sckTCPProtocol
transfer.Bind 2000
transfer.Listen
End Sub
Private Sub Form_Load()
If receive.State <> sckClosed Then
receive.Close
End If
receive.Protocol = sckTCPProtocol
receive.RemoteHost = "192.168.1.174"
receive.RemotePort = 2000
End Sub
Private Sub transfer_ConnectionRequest(ByVal requestID As Long)
If transfer.State <> sckClosed Then
transfer.Close
transfer.Accept requestID
End If
Dim FreeF As Integer
Dim LenFile As Long '文件的长度
Dim bytData() As Byte '存放数据的数组
Dim ipos As Long
Const imax = 65535
FileName = "d:\1.mp3"
FreeF = FreeFile '获得空闲的文件号
Open FileName For Binary As #FreeF '打开文件
DoEvents
LenFile = LOF(FreeF) '获得文件长度
If LenFile <= imax Then '如果要发送的文件小于数据块大小，直接发送
ReDim bytData(1 To LenFile) '根据文件长度重新定义数组大小
Get #FreeF, , bytData '把文件读入到数组里
Close #FreeF '关闭文件
transfer.SendData bytData '发送数据
Exit Sub
End If
'文件大于数据块大小，进行分块发送
Do Until (ipos >= (LenFile - imax)) '发送整块数据的循环
ReDim bytData(1 To imax)
Get #FreeF, ipos + 1, bytData
transfer.SendData bytData
ipos = ipos + imax '移动iPos，使它指向下来要读的数据
Loop
'这里要注意的是，必须检查文件有没有剩下的数据，如果文件大小正好等于数据块大小的
' 整数倍，那么就没有剩下的数据了
ReDim bytData(1 To LenFile - ipos) '发送剩下的不够一个数据块的数据
Get #FreeF, ipos + 1, bytData
transfer.SendData bytData
Close #FreeF
End Sub
Private Sub receive_DataArrival(ByVal bytesTotal As Long)
Dim bytData() As Byte
Dim lLenFile As Long
Dim f
Dim strfilename As String
f = FreeFile
strfilename = "d:\2.mp3"
Open strfilename For Binary As #f 'strFileName是文件名
lLenFile = LOF(f)
ReDim bytData(1 To bytesTotal)
receive.GetData bytData
If lLenFile = 0 Then 'lLenFile=0表示是第一次打开文件，这里有个问题，就是'如果如果该文件存在的话，就会出错，应该在打开前检查文件是否存在。（这里我省略了）
Put #f, 1, bytData
Else
Put #f, lLenFile + 1, bytData
End If
Close #f
End Sub
Private Sub command1_Click()
If receive.State <> sckClosed Then
receive.Close
End If
receive.Connect
End Sub

有错误,不能点击下载第二次~~~

求牛人帮忙~~谢谢了~