vbs或asp采集文章时网页编码问题

'/*=========================================================================   
' * intro       研究网页编码很长时间了，因为最近要设计一个友情链接检测的vbs脚本，而与你链接的人的页面很可能是各种编码，以前采取的方法是：如果用gb2312查不到再用utf-8查，再找不到证明对方没有给你做链接虽然不是100%正确，但也差不多了，这两种编码用的人比较多，偶然间在收藏夹里的一个地址看到的一个思路，终于可以在采集文章时自动判断网页的编码了。因为研究过程中这个问题困扰很久，虽然现在觉得简单了，想必很多人还在找，所以把这三个函数贴出来。   
' * filename    getwebcodepage.vbs   
' * author      yongfa365   
' * version     v2.0   
' * web         http://www.yongfa365.com   
' * email       yongfa365[at]qq.com   
' * firstwrite  http://www.yongfa365.com/item/getwebcodepage.vbs.html   
' * madetime    2008-01-29 20:55:46   
' * lastmodify  2008-01-30 20:55:46   
' *==========================================================================*/   

  
call gethttppage("http://www.baidu.com/")   
call gethttppage("http://www.google.com/")   
call gethttppage("http://www.yongfa365.com/")   
call gethttppage("http://www.cbdcn.com/")   
call gethttppage("http://www.csdn.net/")   

  
'得到匹配的内容，返回数组   
'getcontents(表达式，字符串，是否返回引用值)   
'msgbox getcontents("a(.+?)b", "a23234b ab a67896896b sadfasdfb" ,true)(0)   

function getcontents(patrn, strng , yinyong)   
'by www.yongfa365.com 转载请保留链接，以便最终用户及时得到最新更新信息   
    on error resume next  
    set re = new regexp  
    re.pattern = patrn   
    re.ignorecase = true  
    re.global = true  
    set matches = re.execute(strng)   
    if yinyong then  
        for i = 0 to matches.count -1   
            if matches(i).value<>"" then retstr = retstr & matches(i).submatches(0) & "柳永法"  
        next  
    else  
        for each omatch in matches   
            if omatch.value<>"" then retstr = retstr & omatch.value & "柳永法"  
        next  
    end if  
    getcontents = split(retstr, "柳永法")   
end function  

function gethttppage(url)   
    on error resume next  
    set xmlhttp = createobject("msxml2.xmlhttp")   
    xmlhttp.open "get", url, false  
    xmlhttp.send   
    if xmlhttp.status<>200 then exit function  
    getbody = xmlhttp.responsebody   
    '柳永法(www.yongfa365.com)在此的思路是,先根据返回的字符串找，找文件头，如果还没有的话就用gb2312,一般都能直接匹配出编码。   
    '在返回的字符串里看，虽然中文是乱码，但不影响我们取其编码，   
    getcodepage = getcontents("charset=[""']*([^"",']+)", xmlhttp.responsetext , true)(0)   
    '在头文件里看编码   
     if len(getcodepage)<3 then getcodepage = getcontents("charset=[""']*([^"",']+)", xmlhttp.getresponseheader("content-type") , true)(0)   
    if len(getcodepage)<3 then getcodepage = "gb2312"  
    set xmlhttp = nothing  
    '下边这句在正式使用时要屏蔽掉   
    wscript.echo url & "-->" & getcodepage   
    gethttppage = bytestobstr(getbody, getcodepage)   
end function  

  
function bytestobstr(body, cset)   
    on error resume next  
    dim objstream   
    set objstream = createobject("adodb.stream")   
    objstream.type = 1   
    objstream.mode = 3   
    objstream.open  
    objstream.write body   
    objstream.position = 0   
    objstream.type = 2   
    objstream.charset = cset   
    bytestobstr = objstream.readtext   
    objstream.close  
    set objstream = nothing  
end function