| 发表于：2007-04-20 10:06:2215楼 得分:0 |
option explicit
'wininet访问网络api
private declare function internetopen lib "wininet.dll " alias "internetopena " （byval sagent as string, byval laccesstype as long, byval sproxyname as string, byval sproxybypass as string, byval lflags as long) as long
private declare function internetconnect lib "wininet.dll " alias "internetconnecta " （byval hinternetsession as long, byval lpszservername as string, byval nproxyport as integer, byval lpszusername as string, byval lpszpassword as string, byval dwservice as long, byval dwflags as long, byval dwcontext as long) as long
private declare function internetopenurl lib "wininet.dll " alias "internetopenurla " （byval hinternet as long, byval lpszurl as string, byval lpszheaders as string, byval dwheaderslength as long, byval dwflags as long, byval dwcontext as long) as long
private declare function httpopenrequest lib "wininet.dll " alias "httpopenrequesta " （byval hhttpsession as long, byval sverb as string, byval sobjectname as string, byval sversion as string, byval sreferer as string, byval something as long, byval lflags as long, byval lcontext as long) as long
private declare function httpsendrequest lib "wininet.dll " alias "httpsendrequesta " （byval hhttprequest as long, byval sheaders as string, byval lheaderslength as long, byval soptional as string, byval loptionallength as long) as integer
private declare function httpqueryinfo lib "wininet.dll " alias "httpqueryinfoa " （byval hhttprequest as long, byval linfolevel as long, byref sbuffer as any, byref lbufferlength as long, byref lindex as long) as integer
private declare function httpaddrequestheaders lib "wininet.dll " alias "httpaddrequestheadersa " （byval hhttprequest as long, byval sheaders as string, byval lheaderslength as long, byval lmodifiers as long) as integer
private declare function internetreadfile lib "wininet.dll " （byval hfile as long, byval sbuffer as string, byval lnumbytestoread as long, lnumberofbytesread as long) as integer
private declare function internetreadfilebyte lib "wininet.dll " alias "internetreadfile " （byval hfile as long, byref sbuffer as byte, byval lnumbytestoread as long, lnumberofbytesread as long) as integer
private declare function internetclosehandle lib "wininet.dll " （byval hinet as long) as integer
private const internet_flag_no_cache_write = &h4000000
private const http_query_content_length = 5
private const internet_open_type_preconfig = 0
private const internet_invalid_port_number = 0
private const internet_flag_reload = &h80000000
private const internet_service_http = 3
private const internet_default_http_port = 80
private const http_addreq_flag_add = &h20000000
private const http_addreq_flag_replace = &h80000000
private const useragent = "mozilla/4.0 （ulickbot（www.ulick.net); msie 6.0; windows nt 5.1) "
private hnet as long
private hconnect as long
private hrequest as long
private hurlfile as long
private bret as long
private sub class_initialize（)
hnet = internetopen（useragent, internet_open_type_preconfig, vbnullstring, internet_invalid_port_number, 0)
end sub
private sub class_terminate（)
if hrequest then internetclosehandle hrequest
if hconnect then internetclosehandle hconnect
if hnet then internetclosehandle hnet
end sub
'发送url
public function sendurl（byval surl as string) as long
'on error resume next
dim hurl as long
hurl = internetopenurl（hnet, surl, vbnullstring, 0, internet_flag_reload, 0)
sendurl = hurl
end function
'发送url，返回这个url文件的html代码，可选referer参数
public function geturlfile（byval surl as string, optional sreferer as string) as string
'on error resume next
dim dwsize as long
dim htmlbody as string
dim dwbuf as string * 1024
if len（sreferer) then
hurlfile = sendreferer（surl, sreferer)
else
hurlfile = sendurl（surl)
end if
if hurlfile = 0 then exit function
do
dwbuf = vbnullstring
bret = internetreadfile（hurlfile, dwbuf, 1024, dwsize)
htmlbody = htmlbody & mid（dwbuf, 1, dwsize)
loop while （dwsize <> 0)
if hurlfile then internetclosehandle hurlfile
geturlfile = htmlbody
end function
public function filedownload（byval surl as string, byval sfile as string, optional sreferer as string) as boolean
dim b（999) as byte
dim endbyte（) as byte
dim bdoloop as boolean
dim sreadbuffer as string
dim lnumberofbytesread as long
dim fileid as integer
dim strsize as string
dim size as long
strsize = string$（1024, " ")
fileid = freefile
if len（sreferer) then
hurlfile = sendreferer（surl, sreferer)
else
hurlfile = sendurl（surl)
end if
httpqueryinfo hurlfile, http_query_content_length or internet_invalid_port_number, byval strsize, len（strsize), 0
size = clng（trim（strsize))
if size = 0 then exit function
open sfile for output as fileid
close fileid
open sfile for binary as fileid
dim j as long
for j = 1 to size \ 1000
bdoloop = internetreadfilebyte（hurlfile, b（0), 1000, lnumberofbytesread)
put fileid, , b
if not cbool（lnumberofbytesread) then exit for
next
if size mod 1000 <> 0 then
dim tmp as long
tmp = （size mod 1000) - 1
redim endbyte（tmp)
bdoloop = internetreadfilebyte（hurlfile, endbyte（0), tmp + 1, lnumberofbytesread)
put fileid, , endbyte
end if
close fileid
if hurlfile then internetclosehandle hurlfile
filedownload = true
end function
private function sendreferer（byval surl as string, byval sreferer as string) as long
dim srv, url, sheader as string
dim i as long
i = instr（surl, "/ ")
srv = mid（surl, i + 2, len（surl) - （i + 1))
i = instr（srv, "/ ")
url = mid（srv, i, len（srv) + 1 - i)
srv = left$（srv, i - 1)
if hrequest then internetclosehandle hrequest
if hconnect then internetclosehandle hconnect
hconnect = internetconnect（hnet, srv, 0, vbnullstring, "http/1.0 ", internet_service_http, 0, 0)
if hconnect = 0 then exit function
hrequest = httpopenrequest（hconnect, "get ", url, "http/1.0 ", vbnullstring, 0, internet_flag_reload, 0)
if hrequest = 0 then exit function
sheader = "referer: " & iif（len（sreferer) = 0, surl, sreferer) & vbcrlf
bret = httpaddrequestheaders（hrequest, sheader, len（sheader), http_addreq_flag_replace or http_addreq_flag_add)
bret = httpsendrequest（hrequest, vbnullstring, 0, vbnullstring, 0)
sendreferer = hrequest
end function | | |
|
