VB File Download

Source: Internet
Author: User

Private declare function urldownloadtofile lib "urlmon" alias "urldownloadtofilea" (byval pcaller as long, byval szurl as string, byval szfilename as string, byval dwreserved as long, byval lpfncb as long) as long <br/> sub commandelist click () <br/> r = urldownloadtofile (0, "http://2ting.rm130.com/99123-6/0007/8.Wma", "C:/8.wma", 0, 0) <br/> end sub <br/>



It may be that you are no longer able to access it, but thunder downloads from other places using a method similar to leeching, so the download is successful.
Next, we do not recommend using the urldowntofile function. Most Trojans may be killed by using this API ..

I used to write a download function using winnet API.



<Br/> private const scuseragent = "BF" <br/> private const internet_open_type_direct = 1 <br/> private const internet_open_type_proxy = 3 <br/> private const internet_flag_reload = & h80000000 br/> private const http_query_content_length = 5 <br/> private const buffersizea & = 512 </P> <p> private declare function internetopen lib "wininet" alias "internetopena" (byval sagent as string, byval laccesstype Long, byval sproxyname as string, byval sproxybypass as string, byval lflags as long) As long <br/> private declare function internetclosehandle lib "wininet" (byval hinet as long) as integer <br/> private declare function internetreadfile lib "wininet" (byval hfile as long, byref sbuffer as byte, byval lnumbytestoread as long, lnumberofbytesread as long) as integer <br/> private declare function in Ternetopenurl lib "wininet" alias "timeout" (byval hinternetsession as long, byval lpszurl as string, byval lpszheaders as string, byval encoded as long, byval dwflags as long, byval dwcontext as long) as long <br/> private declare function httpqueryinfo lib "wininet. DLL "alias" httpqueryinfoa "(byval hhttprequest as long, byval linfolevel as long, byref sbuffer as any, byref lbuff Erlength as long, byref lindex as long) as integer </P> <p> 'download and save to the file <br/> function downfile (byval strurl as string, byval strpath as string, optional byval remove as Boolean) as Boolean <br/> on error goto err: <br/> dim hopen as long, hfile as long, sbuffer () as byte, RET as long </P> <p> hopen = internetopen (scuseragent, internet_open_type_direct, vbnullstring, vbnullstring, 0) <br/> If hopen = 0 then Downfile = false: exit function <br/> hfile = internetopenurl (hopen, strurl, vbnullstring, byval 0 &, internet_flag_reload, byval 0 &) <br/> If hfile = 0 then downfile = false: exit function </P> <p> If Dir (strpath) "" Then <br/> If Remove then <br/> kill strpath <br/> else <br/> downfile = false <br/> exit function <br/> end if <br/> end if </P> <p> 'if Dir (strpath) "" Then <br/> 'If (msgbox ("the target file exists, yes No overwrite? ", Vbyesno )) = vbyes then <br/> 'Kill strpath <br/> 'else <br/> 'downfile = false <br/> 'exit function <br/> 'end If <br /> 'end If </P> <p> open strpath for binary as #1 <br/> redim sbuffer (999) <br/> DO <br/> internetreadfile hfile, sbuffer (0), 1000, RET <br/> If RET 0 then <br/> If RET 0 then <br/> testurl = true <br/> else <br/> testurl = false <br/> end if </P> <p> internetclosehandle hfile <br/> internetclosehandle hopen </P> <p> exit function </P> <p> err: <br/> testurl = false <br/> end function </P> <p> 'obtain the link file size <br/> function getfilebyte (byval strurl as string) <br/> on error goto err: </P> <p> dim sbuffer as string * buffersizea <br/> dim hhttpqueryinfo & <br/> dim hinternetopen as long <br/> dim hinternetopenurl & <br/> dim hfile as long <br/> dim RET as long </P> <p> hinternetopen = internetopen (scuseragent, response, vbnullstring, vbnullstring, 0) <br/> response = internetopenurl (hinternetopen, strurl, vbnullstring, 0, timeout, 0) <br/> hhttpqueryinfo = httpqueryinfo (response, byval sbuffer, Len (sbuffer), 0) <br/> sbuffer = IIF (hhttpqueryinfo, left (sbuffer, Len (sbuffer), "0 ") <br/> getfilebyte = clng (sbuffer) </P> <p> internetclosehandle hinternetopen </P> <p> exit function </P> <p> err: <br/> getfilebyte =-1 <br/> end function </P> <p>


Http://www.vbgood.com/viewthread.php? Tid = 83553

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.