1、利用Winsock下载文件利用Winsock下载文件(支持断点续传)-数据库专栏,SQL Server 作者:网友供稿 点击:6 推荐 西部数码-全国虚拟主机10强!20余项虚拟主机管理功能,全国领先!第6代双线路虚拟主机,南北访问畅通无阻!可在线rar解压,自动数据恢复设置虚拟目录等.免费赠送访问统计,企业邮局.Cn域名注册10元/年,自助建站480元起,免费试用7天,满意再付款!P4主机租用799元/月.月付免压金 站内搜索 按标题搜索 按内容搜索 文章页数:1 第一步,建立工程,引用winsock(visual basic最好打sp6,否则ms有一个bug),在此省略第二步,具体实现代码
2、步骤1:发送请求说明:(1)这里简单采用了判断是否已经有同名文件表示是否要断点续传(2)下载的地址,大小和已下载字节数也只是简单地存在ini文件中,更安全的做法本文不作讨论有兴趣的朋友可以联系我- name:downloadfile author:reker 2004/3/20 desc:连接远端主机,发送接收文件请求,等待远端主机响应 params:none history:none-private sub downloadfile() on error resume next starttime = time() with winsck .remotehost = host 远端主机地址
3、.remoteport = 80 .connect 等待服务器连接相应 do while .state sckconnected doevents: doevents: doevents: doevents 20秒超时 if datediff(s, starttime, time() 20 then showinfo 连接超时 .close exit sub end if loop 发送下载文件请求 此处使用http/1.0协议 strcommand = get + updateurl + http/1.0 + vbcrlf 下载地址 strcommand = strcommand + acc
4、ept: */* + vbcrlf 这句可以不要 strcommand = strcommand + accept: text/html + vbcrlf 这句可以不要 strcommand = strcommand + vbcrlf strcommand = strcommand & host: & host & vbcrlf if dir(savefilename) then 是否已经存在下载文件 dim confirm confirm = msgbox(已经存在文件,是否断点续传?, vbyesno + vbquestion, 提示) if confirm = vbyes then do
5、wnposition = if not ofilectrl.readkeyfromini(update, downsize, apppath + update.ini, downposition) then 读取上次下载的字节数 msgbox 读取大小错误, vbinformation, 提示 end if 发送断点续传请求 strcommand = strcommand & range: bytes= & clng(downposition) & - & vbcrlf else kill savefilename 删除原文件 end if end if strcommand = strcom
6、mand & connection: keep-alive & vbcrlf strcommand = strcommand & vbcrlf .senddata strcommand end with if err then lblprocessresult.caption = lblprocessresult.caption & vbcrlf & vbcrlf & 下载文件出错: & err.description lblprocessresult.refresh end ifend sub第二步,具体实现代码步骤2:接收数据- name:winsck_dataarrival author
7、:reker 2004/3/20 desc:略 params:略 return:none history:none-private sub winsck_dataarrival(byval bytestotal as long) on error resume next doevents: doevents dim bytedata() as byte winsck.getdata bytedata(), vbbyte receivedata = receivedata & strconv(bytedata(), vbunicode) if instr(1, receivedata, cont
8、ent-length:) 0 and filesize = 0 then 仅第一次计算,filesize=0 dim pos1 as long, pos2 as long pos1 = instr(1, receivedata, content-length:) pos2 = instr(pos1 + 16, receivedata, vbcrlf) if pos2 pos1 then filesizebyte = mid(receivedata, pos1 + 16, pos2 - pos1 - 16) 计算文件的长度 starttime = timer() 保存开始下载的时间 progss
9、bar.max = filesizebyte 设置进度条 filesize = formatnumber(filesizebyte / 1024, 2) 以kb表示 showinfo 本次下载的文件共 + cstr(filesize) + kb. end if end if 从服务器响应返回的数据查找下载文件的起始位置 if fileheaderlen = 0 then for i = 0 to ubound(bytedata() - 3 if bytedata(i) = 13 and bytedata(i + 1) = 10 and bytedata(i + 2) = 13 and byte
10、data(i + 3) = 10 then startpos = i + 4 将文件头的长度保存下来 fileheaderlen = startpos exit for end if doevents next i end if filesizehavedown = bytestotal + filesizehavedown - fileheaderlen 已下载文件长度,需减去响应的文件头长度 dbldownloadspeed = formatnumber(formatnumber(filesizehavedown / 1024, 2) / (formatnumber(timer() - s
11、tarttime), 4), 2) 计算下载速率 kb/s if dbldownloadspeed 0 then 计算剩余下载的时间 sresttime = getresttime(clng(filesize - (filesizehavedown) / 1024) / dbldownloadspeed) 此过程略,可以删除此段代码 labresttime.caption = 剩余时间: + sresttime labresttime.refresh end if labdownloadspeed.caption = cstr(dbldownloadspeed) + kb/s labdownl
12、oadspeed.refresh progssbar.value = filesizehavedown 写数据 fnum = freefile() open savefilename for binary lock write as #fnum if lof(fnum) 0 then seek #fnum, lof(fnum) + 1 end if if startpos 0 then for i = startpos to ubound(bytedata() put #fnum, , bytedata(i) next i else put #fnum, , bytedata() end if
13、 close #fnum if err then lblprocessresult.caption = lblprocessresult.caption & vbcrlf & 获取数据出错: & err.description lblprocessresult.refresh end ifend sub VBVB在线更新程序示例,支持.zip自解压缩(2006-11-24 23:52:00)【收藏】 【评论】 【打印】 【关闭】 标签:VB在线更新程序示例解压缩 用VB帮星河霸业游戏团队的第二天堂游戏写的一个在线更新程序, 自动判断是否需要更新,支持多文件更新,并支持.zip压缩文件更新,自动
14、将.zip压缩文件解压到目录下。源代码下载:VB_OnlineUpdateInet.rar其中:ClientInfor.inf 文件:第一行的数据表示: 客户端游戏版本号 第一行的数据表示: 更新文件存放的网络路径UpdateInfor.inf文件:第一行的数据表示: 最新游戏版本号 第二行的数据表示: 有多少文件需要更新 后面每行的数据表示: 需要更新的文件的名称 frmUpdate.frm窗体:负责下载modZip.BAS模块: 只负责用来压缩文件和解压缩文件的 其中的 UnZipTo 函数用来解压缩的zlib.dll: 为WinZip的dll文件更新完毕后,ClientInfor.inf
15、文件的第一行的数据会变为最新版本号frmUpdate.frm窗体代码如下:Private Sub cmdExit_Click() Unload Me End SubPrivate Sub cmdUpdate_Click() Dim strClientInfor() As String Dim strUpdateInfor() As String Dim nNum As Integer 存储更新到第几个文件 出错则跳出更新,并提示给用户On Error GoTo ErrMsg strClientInfor() = getClientInfor strUpdateInfor() = getUpda
16、teInfor(strClientInfor(1) inetOLUpdate.RequestTimeout = 0 以验证客户可以连接到服务器,后面更新将不在设置请求超时 nNum = 0 Dim verClient As Double Dim verUpdate As Double Dim strName As Variant Dim bArray() As Byte Dim nI As Integer Dim strFlag As String 保存后缀名 verClient = strClientInfor(0) 获得客户端游戏版本号 verUpdate = strUpdateInfor
17、(0) 获得最新游戏版本号 If verClient verUpdate Then 判断客户端游戏版本是否是最新版 If MsgBox(已出最新版,是否更新游戏, vbInformation + vbYesNo, 在线更新) = vbYes Then 设置进度条 timUpdate.Enabled = True proUpdate.Max = CInt(strUpdateInfor(1) proUpdate.Min = 0 更新游戏 For nI = 2 To CInt(strUpdateInfor(1) + 1 显示正在更新第几个文件,以及更新文件总数 lblNumber.Caption =
18、 文件更新( & (nI - 1) & / & CInt(strUpdateInfor(1) & ) 读取服务器更新文件,并保存到客户端 bArray() = inetOLUpdate.OpenURL(strClientInfor(1) + / + strUpdateInfor(nI), icByteArray) Open App.Path + + strUpdateInfor(nI) For Binary Access Write As #1 Put #1, , bArray() Close #1 nNum = nI - 1 存储更新到第几个文件 proUpdate.Value = nNum
19、 更新进度条 lblScale.Caption = (proUpdate.Value / proUpdate.Max) * 100 & % 显示更新比例 Next nI 减压.zip文件 For nI = 2 To CInt(strUpdateInfor(1) + 1 strFlag = Mid(strUpdateInfor(nI), InStr(strUpdateInfor(nI), .) + 1) 获得后缀名 If strFlag = zip Then 判断该文件是否为.zip压缩文件 UnZipTo App.Path, App.Path + + strUpdateInfor(nI) 解压
20、缩 Kill App.Path + + strUpdateInfor(nI) 删除压缩文件 End If Next nI 更新客户端信息文件 UpdateInfor.inf updateClientInfor strUpdateInfor(0), strClientInfor(1) MsgBox 游戏更新完毕,谢谢你的支持!, vbInformation + vbOKOnly, 在线更新 Unload Me 结束在线更新 End If Else MsgBox 已是最新版,不需要更新!, vbInformation + vbOKOnly Unload Me 结束在线更新 End If Exit
21、Sub ErrMsg: MsgBox 游戏更新出错,请重新启动游戏更新, vbCritical + vbOKOnly, 在线更新 End SubPrivate Sub Form_Load() inetOLUpdate.RequestTimeout = 15 请求连接超过15秒,则退出连接End Sub 获得客户端游戏版本号和服务器路径信息Public Function getClientInfor() As Variant Dim strInfor(10) As String Dim strTest As String Dim nI As Integer nI = 0 Open App.Pat
22、h + /ClientInfor.inf For Input As #1 打开ClientInfor.inf Do While Not EOF(1) 获得客户端的 游戏版本 和 服务器路径 信息 Line Input #1, strInfor(nI) nI = nI + 1 Loop Close #1 getClientInfor = strInfor() End Function 获得更新文件信息 strPath 为更新文件在网上的地址Public Function getUpdateInfor(strPath As String) As Variant Dim strInfor(20) A
23、s String Dim nI As Integer Dim bArray() As Byte 读取服务器更新文件的信息,并保存到客户端 bArray() = inetOLUpdate.OpenURL(strPath + /UpdateInfor.inf, icByteArray) Kill UpdateInfor.inf 删除原有更新文件 Open App.Path + /UpdateInfor.inf For Binary Access Write As #1 Put #1, , bArray() Close #1 nI = 0 Open App.Path + /UpdateInfor.i
24、nf For Input As #1 打开ServerInfor.inf Do While Not EOF(1) 获得最新的 游戏版本 和 更新文件的路径 Line Input #1, strInfor(nI) nI = nI + 1 Loop Close #1 getUpdateInfor = strInfor() End Function 更新客户端信息文件 UpdateInfor.infPublic Function updateClientInfor(strVersion As String, strWebPath As String) As Boolean Open App.Path + /ClientInfor.inf For Output As #1 Print #1, strVersion Print #1, strWebPath Close #1 End FunctionmodZip.BAS模块代码如下: 只负责用来压缩文件和解压缩文件的(可以不看)
copyright@ 2008-2022 冰豆网网站版权所有
经营许可证编号:鄂ICP备2022015515号-1