如何传递文件?(图片、文档、EXE等等）

[ghxnet]

想写一个局域网内传递文件的小程序，文件可能很大
请各位高人给个思路
谢谢！！

[zyg0]

http://community.csdn.net/Expert/topic/3515/3515059.xml?temp=.4378626

[viena]

http://community.csdn.net/Expert/topic/3515/3515059.xml

[lxcc]

http://community.csdn.net/Expert/FAQ/FAQ_Index.asp?id=163863
http://community.csdn.net/Expert/FAQ/FAQ_Index.asp?id=155909

[rabbits]

如果权限有的话，用API函数复制就行了

[aohan]

拷贝

[ghxnet]

我想用winsock，可以吗？

[xubingbing]

可以

[xubingbing]

Option Explicit
Dim i As Integer '用来做为计数器
Dim f As Integer '用来做为作为文件号
Dim Recivedatanum As Long '用来标志接受到的数据包的个数


Private Sub Form_Load()

StatusBar1.Panels(1).Text = "客户端名称：" & tcpclient.LocalHostName





End Sub

Private Sub cmdConnect_Click()
f = FreeFile
Open App.Path & "\" & Text1.Text For Binary As #f
If Not tcpclient.State Then
tcpclient.Close
tcpclient.RemoteHost = txtServer
tcpclient.RemotePort = 100
StatusBar1.Panels(2).Text = "Attempting to connect to remote port" & tcpclient.RemotePort & "……"
tcpclient.Connect

Else

tcpclient.Close
StatusBar1.Panels(2).Text = "No Connecting"

End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If tcpclient.State <> 0 Then
tcpclient.Close
End If
End Sub





Private Sub tcpClient_Connect()

StatusBar1.Panels(2).Text = "connected"
tcpclient.SendData "name:jiangsuzhenjiang1122class:huoyun2233version:1.0"
End Sub

Private Sub tcpClient_DataArrival(ByVal bytesTotal As Long)
Dim Bytdata() As Byte



tcpclient.GetData Bytdata, vbByte
'如果数据包的长度大于等于5，表示可能为拒绝请求原语，判断是否为拒绝请求原语
If UBound(Bytdata) >= 5 Then
If Bytdata(0) = 114 And Bytdata(1) = 101 And Bytdata(2) = 102 And Bytdata(3) = 117 And Bytdata(4) = 115 And Bytdata(5) = 101 Then

MsgBox "服务器上没有最新的软件,不需要升级", vbOKOnly, "提示"
tcpclient.SendData "quit"

Exit Sub
End If
End If

'当数据包的长度大于8时，表示可能为数据包，按照数据包处理
If UBound(Bytdata) >= 7 Then

If LOF(f) > 0 Then
Seek #f, LOF(f) + 1
End If

If Bytdata(UBound(Bytdata) - 7) = 99 And Bytdata(UBound(Bytdata) - 6) = 104 And Bytdata(UBound(Bytdata) - 5) = 115 And Bytdata(UBound(Bytdata) - 4) = 104 And Bytdata(UBound(Bytdata) - 3) = 119 And Bytdata(UBound(Bytdata) - 2) = 99 And Bytdata(UBound(Bytdata) - 1) = 111 And Bytdata(UBound(Bytdata)) = 107 Then
For i = 0 To UBound(Bytdata) - 8
Put #f, , Bytdata(i)
Next i
tcpclient.SendData "quit"
Else
Put #f, , Bytdata
End If

Recivedatanum = Recivedatanum + 1
StatusBar1.Panels(2).Text = "正在接受第" & Recivedatanum & "个数据包！！"



End If


End Sub

Private Sub tcpclient_Close()
Close #f
StatusBar1.Panels(2).Text = "传输完成"
End Sub

这是客户端的代码！！

[xubingbing]

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

Private lTotal As Long '用来保存文件的最大长度
Const iMax = 65536

Dim curnum As Integer '挡前的连接数
Dim maxnum As Integer '最大连接数

Private Sub Form_Load()
curnum = 0
maxnum = 100


tcpserver(0).Close
tcpserver(0).LocalPort = 100
tcpserver(0).Listen
StatusBar1.Panels(1).Text = "服务段名称：" & tcpserver(0).LocalHostName & "……"
StatusBar1.Panels(2).Text = "正在监听本地端口:" & tcpserver(0).LocalPort & "……"
End Sub

Private Sub Form_Unload(Cancel As Integer)
'tcpserver.Close
End Sub


Public Sub SendData(sFile As String, sSaveAs As String, tcpCtl As Winsock)
On Error GoTo ErrHandler
Dim Ifreefile As Integer '用来保存文件号
Dim Lenfile As Long '用来保存文件的长度
Dim Bytdata() As Byte '用来存放文件的缓冲区
Dim iPos As Long
Dim temp(2) As Byte
temp(0) = 111
temp(1) = 107

'将要发送的文件以二进制的方式打开
Ifreefile = FreeFile
Open sFile For Binary Access Read As #Ifreefile

DoEvents
'获得文件的长度，保存在lenfile中
Lenfile = LOF(Ifreefile)
'如果文件的长度小于规定的最大值的长度，那么就直接发送出去
If Lenfile <= iMax Then
ReDim Bytdata(1 To Lenfile)
Get #Ifreefile, , Bytdata
Close #Ifreefile
tcpCtl.SendData Bytdata
Exit Sub
End If

'如果文件的长度达于最大值
ReDim Bytdata(1 To iMax)
Do Until (iPos >= (Lenfile - iMax))

Get #Ifreefile, iPos + 1, Bytdata
tcpCtl.SendData Bytdata
DoEvents
iPos = iPos + iMax

Loop

ReDim Bytdata(1 To Lenfile - iPos)
Get #Ifreefile, iPos + 1, Bytdata
tcpCtl.SendData Bytdata
DoEvents


Close #Ifreefile

tcpCtl.SendData "chshwcok"


Exit Sub
ErrHandler:
MsgBox "Err " & Err & " : " & Error
End Sub

Private Sub tcpserver_Close(Index As Integer)

tcpserver(Index).Close
Unload tcpserver(Index)
StatusBar1.Panels(2).Text = "进程" & Index & "的文件已经传输完毕"





End Sub


Private Sub tcpserver_ConnectionRequest(Index As Integer, ByVal requestID As Long)
If Index = 0 Then
If curnum = 65535 Then
curnum = 1
End If
curnum = curnum + 1
Load tcpserver(curnum)
tcpserver(curnum).LocalPort = 100
tcpserver(curnum).Accept requestID
StatusBar1.Panels(2).Text = "已经接受" & requestID & "的请求"
End If





End Sub

Private Sub tcpserver_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim tmpstring As String
Dim Tfilename As String
Dim Tfilename1 As String
Dim i, j, k As Integer
Dim l As Double

tcpserver(Index).GetData tmpstring, vbString

i = InStr(tmpstring, "name:")
j = InStr(tmpstring, "class:")
k = InStr(tmpstring, "version:")

'如果都不为0，那么表示该包为请求数据传送原语
If i <> 0 And j <> 0 And k <> 0 Then
Dim name As String
Dim class As String
Dim version As String
name = Trim(Mid(tmpstring, 6, j - i - 5))
class = Trim(Mid(tmpstring, j + 6, k - j - 6))
version = Trim(Right(tmpstring, Len(tmpstring) - k - 7))

'开始处理请求数据传送原语
Tfilename = name & class
'判断当前的路径名
If Right(App.Path, 1) = "\" Then
Tfilename = App.Path & Tfilename & "*.exe"
Tfilename = Dir(Tfilename)
'如果存在当前的请求的版本的升级文件，那么就进行处理，否则发送拒绝升级请求原语
If Len(Tfilename) > 1 Then

i = Len(Tfilename)
j = Len(name & class)
l = CDbl(Mid(Tfilename, j + 1, i - j - 4))
'如果存在的文件的版本号大于升级请求的版本号，就开始发送升级文件，否则发送拒绝升级请求原语
If l > CDbl(version) Then
Tfilename1 = App.Path & Tfilename
SendData Tfilename1, "", tcpserver(Index)
txtFile.Text = Tfilename1
WriteLog Tfilename, True
Else
tcpserver(Index).SendData "refuse"
WriteLog Tfilename, False
End If
Else

tcpserver(Index).SendData "refuse"
WriteLog Tfilename, False
End If
Else
Tfilename = App.Path & "\" & Tfilename & "*.exe"
Tfilename = Dir(Tfilename)
'如果存在当前的请求的版本的升级文件，那么就进行处理，否则发送拒绝升级请求原语
If Len(Tfilename) > 1 Then

i = Len(Tfilename)
j = Len(name & class)
l = CDbl(Mid(Tfilename, j + 1, i - j - 4))
'如果存在的文件的版本号大于升级请求的版本号，就开始发送升级文件，否则发送拒绝升级请求原语
If l > CDbl(version) Then
Tfilename1 = App.Path & "\" & Tfilename
SendData Tfilename1, "", tcpserver(Index)
txtFile.Text = Tfilename1
WriteLog Tfilename, True
Else
tcpserver(Index).SendData "refuse"
WriteLog Tfilename, False
End If
Else

tcpserver(Index).SendData "refuse"
WriteLog Tfilename, False
End If

End If

End If

'如果接受到的是推出原语，那么关闭升级控件
If CStr(tmpstring) = "quit" Then
tcpserver_Close Index
End If

End Sub

Private Sub WriteLog(Updatename As String, updateaccess As Boolean)
'下面进行的是写日志文件的操作


Dim myyear As String
Dim mymonth As String
Dim myday As String
Dim Tfilename As String
Dim fso As New FileSystemObject, fldr As Folder
myyear = Year(Date)

mymonth = Month(Date)

If Len(mymonth) < 2 Then
mymonth = "0" & mymonth
End If

myday = Day(Date)

If Len(myday) < 2 Then
myday = "0" & myday
End If

If Right(App.Path, 1) = "\" Then
Tfilename = App.Path & myyear & mymonth & myday & ".txt"
Else
Tfilename = App.Path & "\" & myyear & mymonth & myday & ".txt"
End If

Dim Filenum As Integer
Filenum = FreeFile
Open Tfilename For Append As #Filenum
Write #Filenum, Date & Time & Updatename & "的升级请求" & updateaccess & "完成"
Close #Filenum
End Sub



这是服务段的代码！！自己写着玩的，可以传送！！你自己看看吧

[xiaohuangtao]

http://www.smartmaildemo.com