VB實現局域網內的文件傳輸

2024-07-21 02:21:04

字體：大中小

來源：轉載

供稿：網友

最大的網站源碼資源下載站，

為了設計統一和用戶操作方便，我們希望將服務端與客戶端融合在一起，形成一個程序，這樣用戶理解起來，更加直觀一點（其實這樣做也是為了方便調試，大家可以在本機上測試，自己傳文件給自己）。所以，我們在程序中需要使用兩個winsock控件，一個負責監聽，一個負責發送，當發送端連接成功以后，便選擇一個待發送的文件（可以是任意二進制文件），接著將文件名和文件字節長度發送給接收端，接收端收到這個消息以后，將文件名和文件長度解析出來，然后通知發送端可以開始發送文件；發送端讀到這個消息之后，將文件流以字節的形式發送到接收端，接收端收到后，將二進制流回寫，保存成文件即可。這里要注意兩點，一個是由于winsock每次最大傳輸8k的內容，所以需要將文件分解，每次傳輸固定數目的字節流，這樣發送和接收時都可以根據這個數目來判斷文件傳輸的進程，一旦字節流數目等于文件的大小，就需要關閉相應的文件句柄；另一點是由于我只使用一個winsock控件接收，接收文本時需要注意要將unicode轉碼，解析成可識別的信息。

源代碼

'下面的代碼既是服務器又是客戶端

'采用應答式發送方式

'自動拆分文件，包括2進制

option explicit

'private declare sub sleep lib "kernel32" (byval dwmilliseconds as long)

dim mybyte() as byte '發送方數組

const filecomesmsg = "a file is coming " '有文件到來

const remoteisreadymsg = "sender is ready " '準備好了

const fileisovermsg = "the file is ended" '文件完畢

const remotedenymsg = "the user canceled" '用戶取消

const filecountmsg = "the file lengh is" '文件長度

const recevieisreadymsg = "receiver is ready " '準備接收

dim arrdata() as byte '收到的信息

dim filesave as integer '保存文件的句柄

dim filehandle as integer '發送方文件的句柄

dim filesize as double '文件的大小

dim sendbyte as long

dim receivebyte as long

dim mylocation as double

dim mymsg as string '消息

dim fileisover as boolean '文件是否已經完畢

const receiveport = 7905

const buffer_size = 5734

private sub cmdconnect_click()

timer2.enabled = true

end sub

private sub cmdsend_click()

on error goto errorhandle

with commondialog1

.cancelerror = true

.dialogtitle = "選擇您要傳送的文件"

.filter = "all files (*.*)|*.*"

.showopen

end with

filehandle = freefile

open commondialog1.filename for binary access read as #filehandle

cmdsend.enabled = false

filesize = cdbl(filelen(commondialog1.filename))

label1.caption = "等待回應>>>"

msgbox ("選擇的文件大小為 " & lof(filehandle) & " 字節")

if winsocksend.state = sckconnected then

winsocksend.senddata filecomesmsg & commondialog1.filename '發送發出文件信息

end if

exit sub

errorhandle:

cmdsend.enabled = true

msgbox ("你沒有選擇一個文件！")

end sub

private sub form_load()

winsockreceive.localport = receiveport

winsockreceive.listen

fileisover = true

label1.caption = "準備傳輸>>>"

end sub

public function sendchunk()

dim mybytesize as long

if winsocksend.state <> sckconnected then exit function

mybytesize = buffer_size

if lof(filehandle) - loc(filehandle) < buffer_size then mybytesize = (lof(filehandle) - loc(filehandle))

redim mybyte(0 to mybytesize - 1)

get #filehandle, , mybyte

winsocksend.senddata mybyte

sendbyte = sendbyte + mybytesize

progressbar1.value = int((100 / filesize) * sendbyte)

if sendbyte >= filesize then

fileisover = true

winsocksend.senddata fileisovermsg

end if

end function

private sub timer2_timer()

if winsocksend.state = sckconnected then

timer2.enabled = false

cmdconnect.enabled = false

elseif winsocksend.state <> 1 and winsocksend.state <> 6 and winsocksend.state <> 7 and winsocksend.state <> 8 and winsocksend.state <> 9 then

winsocksend.connect txthost.text, receiveport

elseif winsocksend.state = 8 or winsocksend.state = 9 then

winsocksend.close

end if

end sub

private sub winsockreceive_connectionrequest(byval requestid as long)

if winsockreceive.state <> sckclosed then winsockreceive.close

winsockreceive.accept requestid

end sub

private sub winsockreceive_dataarrival(byval bytestotal as long)

redim arrdata(0 to bytestotal - 1)

winsockreceive.getdata arrdata, vbbyte + vbarray

mymsg = strconv(arrdata, vbunicode) '二進制轉為字符串

select case mid(mymsg, 1, 17)

case filecomesmsg '這些消息發送方和接受方都可收到

'顯示保存對話框

on error goto errorhandle

commondialog1.filename = mid(mymsg, 17, len(mymsg))

commondialog1.dialogtitle = "選擇保存文件的路徑"

commondialog1.showsave

filesave = freefile

receivebyte = 0

cmdsend.enabled = false

winsockreceive.senddata recevieisreadymsg

case fileisovermsg

close #filesave

msgbox ("文件傳輸成功！") '大家一起處理

cmdconnect.enabled = true

cmdsend.enabled = true

label1.caption = "準備傳輸>>>"

progressbar1.value = 0

winsockreceive.senddata fileisovermsg

winsockreceive.close

winsockreceive.listen

case filecountmsg

filesize = mid(mymsg, 18, len(mymsg))

open commondialog1.filename for binary access write as #filesave

winsockreceive.senddata remoteisreadymsg

label1.caption = "文件準備傳輸！"

fileisover = false

case else

if receivebyte < filesize then

receivebyte = receivebyte + bytestotal

put #filesave, , arrdata

winsockreceive.senddata remoteisreadymsg

progressbar1.value = int((100 / filesize) * receivebyte)

end if

end select

exit sub

errorhandle:

winsockreceive.senddata remotedenymsg

cmdconnect.enabled = true

end sub

private sub winsocksend_dataarrival(byval bytestotal as long)

winsocksend.getdata mymsg

select case mymsg

case recevieisreadymsg

winsocksend.senddata filecountmsg & filesize

fileisover = false

sendbyte = 0

case remoteisreadymsg

'如果文件還沒有結束，繼續傳輸

if not fileisover then

label1.caption = "文件正在被傳輸>>>"

sendchunk

else

winsocksend.senddata fileisovermsg

end if

case fileisovermsg

'主機處理

close #filehandle

msgbox ("文件傳輸成功！") '大家一起處理

winsocksend.senddata fileisovermsg

winsocksend.close

cmdconnect.enabled = true

progressbar1.value = 0

cmdsend.enabled = true

label1.caption = "準備傳輸>>>"

case remotedenymsg

msgbox ("用戶終止了傳輸！")

cmdsend.enabled = true

label1.caption = "準備傳輸>>>"

close #filehandle

end select

exit sub

end sub

上一篇：VB 一個Function傳回多個值

下一篇：vb可不可以實現虛擬中斷