自动判断网页编码获取网页源代码内容的函数

自动判断网页编码获取网页源代码内容的函数

'页面下载的函数,url是网页地址，urlcode是网页编码，例子gethttppage(" [url]http://www.sifulaoda.com/[/url]","GB2312")
function gethttppage(url,urlcode) 
  dim http 
  set http=Server.createobject("MSXML2.XMLHTTP") 
  Http.open "GET",url,false 
  Http.send() 
  if Http.readystate<>4 then
  gethttppage=""
   exit function 
  end if 
  gethttppage=readfile(Http.responseBody,urlcode) 
  set http=nothing
  if err.number<>0 then err.Clear  
end function

'字节流变换字符，url是字节流，urlcode网页编码,gb2312,utf-8例子readfile(Http.responseBody,"GB2312")
'20071119可自动判断编码方式
function readfile(url,urlcode)
dim srmobj
set srmobj=Server.CreateObject("ado" & "db.stre" & "am")
srmobj.type=1
srmobj.mode=3
srmobj.open
srmobj.write url
srmobj.position=0
srmobj.type=2

'判断编码方式开始
If AscB(MidB(url,1,1))=&HEF And AscB(MidB(url,2,1))=&HBB Then 
srmobj.charset="utf-8" 
ElseIf AscB(MidB(url,1,1))=&HFF And AscB(MidB(url,2,1))=&HFE Then 
srmobj.charset="unicode" 
Else 
srmobj.charset="gb2312" 
End If
'判断编码方式结束

'srmobj.charset=urlcode
readfile=srmobj.readtext()
set srmobj=nothing
end function

'剔除日文平甲字的函数:
function riwen(mm)
riwen=replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(mm,"ゴ",""),"ガ",""),"ギ",""),"グ ",""),"ゲ",""),"ザ",""),"ジ",""),"ズ",""),"ヅ",""),"デ",""),"ド",""),"ポ",""),"ベ",""),"プ",""),"ビ",""),"パ",""),"ヴ",""),"ボ",""),"ペ",""),"ブ",""),"ピ",""),"バ",""),"ヂ",""),"ダ",""),"ゾ",""),"ゼ","")
end function

code=riwen(gethttppage(" [url]http://www.wangjianran.com/[/url]","gb2312"))

本文转自分瓜博客51CTO博客，原文链接http://blog.51cto.com/aiqing/51134如需转载请自行联系原作者

aiqing