您的位置：程序门 -> vb -> 网络编程

有无类似源程序，功能为从服务器读取数据及文件，再返回处理结果到服务器。有的话请贴一下

[收藏此页] [打印本页]选择字色：背景色：字体：[大][中][小]

有无类似源程序，功能为从服务器读取数据及文件，再返回处理结果到服务器。有的话请贴一下[已结贴,结贴人:baeta]

发表于：2007-09-13 13:02:11 楼主

如题，谢了先

发表于：2007-09-13 13:53:241楼得分:100

server：

private sub form_load（)

sckfser.listen
end sub

private sub sckfser_connectionrequest（byval requestid as long)

' text1 = requestid

'on error goto iderror
if sckfser.state <> sckclosed then sckfser.close
sckfser.accept requestid

'iderror:
'msgbox err.description, vbcritical

end sub

private sub sckfser_dataarrival（byval bytestotal as long)
dim strdata as string
dim sdata as string
dim lret as long
dim databyte（) as byte
dim sendfilelen

sckfser.getdata databyte

strdata = strconv（databyte, vbunicode)
msgbox " "

if is_filesend = true then 'is_filesend是个全局变量
put #myfreefile, , databyte
sendfilelen = sendfilelen - ubound（databyte) - 1

if sendfilelen <= 0 then
close #myfreefile
myfreefile = 0
is_filesend = false
end if
else
text1.text = strdata
if instr（1, strdata, " ¦filesend ¦ ") <> 0 then

dim sfilename as string
dim k as integer
is_filesend = true
k = instr（11, strdata, " ¦ ")
sfilename = mid$（strdata, 11, k - 11)

sendfilelen = clng（right$（strdata, len（strdata) - k))

myfreefile = freefile
open sfilename for binary as myfreefile

end if

'......... '其他程序

end if
end sub

发表于：2007-09-13 13:55:552楼得分:0

这是客户端的发送代码，部分（它这个太复杂了，谁有服务器，传到服务器上去就好了）
sub sendfiletoserver（xfilename as string, destination as string)
dim buffer as string
dim buffersize as integer
dim fiz as file
dim pinche as listitem
dim fizobj as scripting.filesystemobject
dim filelength as long, superbuffer as long
dim percentdone as long, b as integer

set fizobj = createobject（ "scripting.filesystemobject ")
set fiz = fizobj.getfile（xfilename)

buffersize = 2048

i = freefile 'find free file
open xfilename for binary access read as #i 'open the file to read
debug.print "--------opening " + xfilename
filelength = lof（i)

startsending = false
frmupload.winsock.senddata （ "file= " + destination + fiz.name + ": " & lof（i))
debug.print "sending 'file= ' " + fiz.name

if lof（i) <> 0 then
do while startsending <> true: doevents
if cancelupload = true then exit sub
loop

do while not eof（i): doevents
if cancelupload = true then exit sub
if filelength - loc（i) < buffersize then
let buffersize = filelength - loc（i)
if buffersize = 0 then goto done
end if

buffer = space（buffersize)

get #i, , buffer
if loc（i) > 3536851 then
debug.print loc（i)
end if
waitforserverrecieve = true
frmupload.winsock.senddata buffer
do while waitforserverrecieve = true: doevents
if cancelupload = true then exit sub
loop 'wait for server to recieve packet

superbuffer = superbuffer + len（buffer)
debug.print "buffersize= " & buffersize & " superbuffer= " & superbuffer & " filepointer " & loc（i)

frmupload.bytessent = formatfilesize（superbuffer) + " of " + formatfilesize（filelength) + " sent "
if superbuffer = 0 then goto skippercent 'don 't want division by zero

percentdone = superbuffer / filelength * 100
on error resume next
frmupload.progress.value = percentdone
on error goto 0
doevents
skippercent:

loop
end if
done:
close #i
debug.print "--------closing " + xfilename

startsending = false
end sub

发表于：2007-09-13 13:56:103楼得分:0

这是服务器端主要的接收代码！
private sub up_dataarrival（index as integer, byval bytestotal as long)
dim data as string, filesize as long, percent as long

'on error goto errorhandle

call up（index).getdata（data, , bytestotal)

if left（data, 5) = "file= " then 'received file upload confirmation from
'client... separate data, and set variables

' temp$ = right（data, len（data) - 5)
' slash = findreverse（temp$, "\ ")
' parentfolder$ = left（temp$, slash)
' 'debug.print data
' if exists（parentfolder$) = false then
' mkdir （parentfolder$)
' end if

dim folders2create as new collection
dim objfso as new filesystemobject
data = right（data, len（data) - 5)

colon = instr（data, ": ")

nextstring = right（data, len（data) - colon)

realcolon = instr（nextstring, ": ") + 2

filesize1 = right（data, len（data) - realcolon)
debug.print filesize1
filename = left（data, realcolon - 1)

filetransferadd filename, filesize1, up（index).remotehostip, " " 'add item to list for file transfers

pf = objfso.getparentfoldername（filename)
do while pf <> " ": doevents
if objfso.folderexists（pf) = false then
folders2create.add pf
end if
pf = objfso.getparentfoldername（pf)
loop

'create folders （if needed)
on error resume next
for x = folders2create.count to 1 step -1
mkdir folders2create.item（x)
next x

set folders2create = nothing
'delete the file
if exists（filename) then kill filename

'open the file so that packets received can be directly
'written to the already open disk file
filenum = freefile（)
i = freefile
open filename for binary access write as #filenum

if filesize1 = 0 then
'if the file size is 0 bytes, just close the file
'and tell the client it 's done receiving the file
close #filenum
call frmmain.up（index).senddata（ "filedone ")
soutput "received ' " & filename & " ' （ " & filesize1 & " bytes) from ip ' " & up（index).remotehostip & " ' "
exit sub
end if

'inform the client that it can start sending
'data packets （the default is 2048 bytes)
call frmmain.up（index).senddata（ "begin ")
exit sub
end if

'inform the client that the packet was received sucessfully
put #filenum, , data
doevents
debug.print lof（filenum)
frmmain.up（index).senddata （ "ok ")

'write the incoming data directly to the disk file

'if the size of the disk file matches the size as told
'by the client, we are done receiving this file, so
'close it and inform the client that the file was
'received successfully
if lof（filenum) = filesize1 then
close #filenum
debug.print "closed file#: " & filenum & " up "
call frmmain.up（index).senddata（ "filedone ")
soutput "received ' " & filename & " ' （ " & filesize1 & " bytes) from ip ' " & up（index).remotehostip & " ' "

'if logging is enabled in options, write this transfer to the log
if getsetting（ "andromeda ", "settings ", "writetransferlog ") = "1 " then
writelog app.path + "\ftransfer.txt ", "received ' " & filename & " ' （ " & filesize1 & " bytes) from ip ' " & up（index).remotehostip & " ' time/date= " & format（now, "hh:mm:ss am/pm - mm/dd/yyyy ")
end if

filenum = 0 'set filenum back to zero
exit sub
end if

exit sub

errorhandle:
soutput （ "error in up（ " & index & "): " & err.description & " #: " & err.number)

end sub

下一篇：大家新年好! 小弟使用winsock编写web浏览器，有些问题不明白特来请教
上一篇：我是穷人，我想买掉足球软件服务端

其他资讯