google sitemap generater source code ver 0.1.2,修改了一个bug

[ 2007-07-06 20:17:16 | 作者: Admin ]
: | |
<%
' BSD 2.0 license,
' http://www.opensource.org/licenses/bsd-license.php
'
'转贴或修改请保留bug提供人和bug修复人的信息,包括邮箱和网站名称,
'如bug提供人和bug修复人另有要求的除外
'可以在 http://www.vtalkback.com/site-map 对代码进行测试
'版本 0.1.2
'------------------------------变量初始化-----------------------------------------------------------
ver="0.1.2"
'script configuration
'debug =0
'Response.CharSet="gb2312";
'current_charset="utf-8"
current_charset="gb2312"    '必须使用小写
'Url="http://www.vtalkback.com"
'Url="http://www.jwmodel.com"
Url=request("url")
Url=trim(url)
if right(Url,1)="/" then
  Url=left(url,len(url)-1)
end if

first_page=Url
'response.write first_page& " "& url&" "
'response.flush

'first_page=""
none_http_url=right(url,len(url)-len("http://")) '生成无 http://的url

root_url_len=instr(none_http_url,"/")

if(root_url_len=0) then
root_url_len=len(none_http_url)
end if

root_url="http://" & left(none_http_url,root_url_len) '去掉尾部的 '/'
if right(root_url,1)="/" then
  root_url=left(root_url,len(root_url)-1)
end if

'response.write root_url & " <br>"
'response.flush

str_depth = request("url_depth")
FinalDepth=CInt(str_depth)
'---------------Depth limit----------------------
'if FinalDepth>2 then
'  FinalDepth=2
'end if
'FinalDepth=1

'response.write "str_depth =" & str_depth & " <br>"
'response.flush

'------------------------------------------------
LimitUrl=1000
'leave sitemapDate empty if you want sitemapDate=now
sitemapDate=""
'sitemapPriority possible value are from 0.1 to 1.0
sitemapPriority="0.7"
'sitemapChangefreq possible value are: always, hourly, daily, weekly, monthly, yearly, never
sitemapChangefreq="monthly"
'see http://www.time.gov/ for utcOffset
utcOffset=1

Dim objRegExp,objUrlArchive,strHTML,objMatch,crawledUrlArchive,BytesStream,CharsetRegExp,CharsetUrlArchive,oHttp
Set oHttp=Server.CreateObject("WinHttp.WinHttpRequest.5.1")
Server.ScriptTimeout=300
set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
Set BytesStream = Server.CreateObject("ADODB.Stream")

Set objUrlArchive=Server.CreateObject("Scripting.Dictionary")
Set crawledUrlArchive=Server.CreateObject("Scripting.Dictionary")
Set CharsetUrlArchive=Server.CreateObject("Scripting.Dictionary")
Set objRegExp = New RegExp
objRegExp.IgnoreCase = True
objRegExp.Global = True

'you can change this patterns for your needs
'objRegExp.Pattern = "href=(.*?)[\s|>]"
'objRegExp.Pattern = "<!--(.*?)-->|<(\s*)a(\s*)href=(.*?)[" & chr(34) & "](.*?)" & "[" & chr(34)&"]"
objRegExp.Pattern = "<!--(.*?)-->|<(\s*)a(\s*)href=(.*?)[\s|>]"
Set CharsetRegExp = New RegExp
CharsetRegExp.IgnoreCase = True
CharsetRegExp.Global = True
CharsetRegExp.Pattern = "<META(.*?)Content-Type(.*?)>"
'to remove elements from html urls
RemoveText=array("<",">","a href=",chr(34),"'","href=")
'to exclude elements from urls
ExcludeUrl=array("mailto:","javascript:",".css",".ico","file:")

'if you want sitemapDate=now
if sitemapDate="" then filelmdate=now()

sitemapDate=iso8601date(filelmdate,utcOffset)

'------------------------------</变量初始化>-----------------------------------------------------------
crawl first_page,1

For Depth=0 to FinalDepth-1

  arrUrl=objUrlArchive.Keys
  arrDepth=objUrlArchive.Items
  For LoopUrl= 0 to ubound(arrurl)
    willCrawlUrl=url&"/"&arrUrl(LoopUrl)
    willCrawldepth=arrDepth(LoopUrl)

'    response.write "willCraw="& willCrawlUrl &" depth="&willCrawldepth&" <br>"
'    response.flush
    
    if crawledUrlArchive.Exists(willCrawlUrl)=false and willCrawldepth < FinalDepth then
'      response.write "Craw="& willCrawlUrl &" depth="&willCrawldepth&" <br>"
'      response.flush
      crawledUrlArchive.add willCrawlUrl,1
      'if ubound(arrurl)>max_url_count then
      '  Exit For
      'end if
      'debugging
      'response.write "<!-- pagefound='"&loopurl&"'-->"
      crawl willCrawlUrl,willCrawldepth+1      
      if objUrlArchive.Count-1>LimitUrl then exit for 'if you want to limit the url number
    end if

  Next
  erase arrUrl
  erase arrDepth
Next

' create the xml on the fly
'arrDepth=objUrlArchive.Items
'response.write "<textarea rows=" &chr(34)& "93" &chr(34)& "name=" &chr(34)& "S1" &chr(34)& "cols=" &chr(34)& "138" &chr(34)& ">"

writeHead  '输出文件头

arrCharset=CharsetUrlArchive.items
arrurl=objUrlArchive.Keys
For LoopUrl=0 to ubound(arrurl)
'  response.write "<loc>"&server.htmlencode(url&"/"&arrUrl(LoopUrl))&"</loc>"   '输出url
'  response.write "<loc>&&&&"&server.urlEncode(url&"/"&arrUrl(LoopUrl))&"</loc>" '输出url
  cur_charset=arrCharset(LoopUrl)
  cur_url=arrUrl(LoopUrl)
  writelink cur_url,cur_charset
Next

response.write Chr(13) & Chr(10)
response.write "</urlset>"
response.write Chr(13) & Chr(10)

'response.write "</textarea>"
'arrUrl=objUrlArchive.Keys

'response.write "<!-- pagefound='"&ubound(arrurl)+2&"'--> "
'---------------------------<清除环境变量>-----------------------------------------------
erase arrUrl
erase arrCharset  

'erase arrDepth
objUrlArchive.RemoveAll()
crawledUrlArchive.RemoveAll()
CharsetUrlArchive.RemoveAll()
Set BytesStream = Nothing
set xmlhttp = nothing
set oHttp = nothing
'---------------------------</清除环境变量>-----------------------------------------------
'*************************************************************************************************************
function writeHead()
  response.ContentType = "text/xml; charset=gb2312"
  response.write "<?xml version='1.0' encoding='gb2312'?>"
  response.write Chr(13) & Chr(10)
  response.write "<!-- generator='http://www.vtalkback.com/sitemap/&#39; ver='" &ver &"'-->"  
  response.write Chr(13) & Chr(10)
  response.write "<!-- pagefound='"&ubound(objUrlArchive.Keys)+2&"'--> "  
  response.write Chr(13) & Chr(10)
  response.write "<urlset xmlns='http://www.google.com/schemas/sitemap/0.84&#39;>"
  response.write Chr(13) & Chr(10)

  response.write "<url>"
  response.write Chr(13) & Chr(10)
  response.write "<loc>"&url&"/</loc>"
  response.write Chr(13) & Chr(10)
  response.write "<lastmod>"&sitemapDate&"</lastmod>"
  response.write Chr(13) & Chr(10)
  response.write "<priority>"&sitemapPriority&"</priority>"
  response.write Chr(13) & Chr(10)
  response.write "<changefreq>"&sitemapChangefreq&"</changefreq>"
  response.write Chr(13) & Chr(10)
  response.write "</url>"
  response.write Chr(13) & Chr(10)
end function
'*************************************************************************************************************
Function writeLink(write_url,write_charset)
'  response.write "<loc>"&write_charset&"</loc>"       

  response.write "<url>"
  response.write Chr(13) & Chr(10)
  
  if write_charset="gb2312" then      
'    write_url=num2gb(write_url)  
    write_url=urldecode(write_url)
'    response.write write_charset
  else  'utf8
'    response.write write_charset&"aa"
    write_url=urldecode(write_url)  'new_url=url2utf(cur_url) new_url=num2gb(cur_url) new_url=gb2utf(new_url)  
  end if
'  write_url=replace(write_url,"&amp;",GB2UTF8("&"))
    

  response.write "<loc>"&url&"/"&write_url&"</loc>"       '输出url
  response.write Chr(13) & Chr(10)
'-------------------------------------------------------------------------------------
  response.write "<lastmod>"&sitemapDate&"</lastmod>"
  response.write Chr(13) & Chr(10)
  response.write "<priority>"&sitemapPriority&"</priority>"
  response.write Chr(13) & Chr(10)
  response.write "<changefreq>"&sitemapChangefreq&"</changefreq>"
  response.write Chr(13) & Chr(10)
  response.write "</url>"
  response.write Chr(13) & Chr(10)
end function

'***********************************爬行**************************************************************************
Function crawl(sub_url,crawl_depth)
  sub_url=urldecode(sub_url)
'----------------<sub_url处理>-------------------------------------------
'--------------不能处理重定向bug---由(http://www.xiaoyezi.com )报告---------------------------------
'----------------(http://www.vtalkback.com , calldefine@sohu.com) 修补----------------------------------------
'  sub_url1=sub_url
'  response.write "sub_url="& sub_url&"<br> "
  sub_url=GetAbsoluteURL(sub_url,1) '读取重定向后的 url
'  if sub_url1<>sub_url then
'    response.write sub_url1&" "&sub_url
'    response.flush  
'  end if
'------------</sub_url处理>-------------------------------------------

'------------<sub_dir处理>-------------------------------------------
'  response.write "sub_url="& sub_url&"<br> "&len(sub_url)&" "& len(url) &"</br>"
'  response.flush  
  sub_dir=right(sub_url,len(sub_url) - len(url))  ' http://www.vtalkback.com/blog -> blog
'  response.write "sub_dir="& sub_dir&" <br>"

  if instr(sub_dir,"?")>0 then
    sub_dir=left(sub_dir,InStr(sub_dir,"?")-1)
  end if
  
  if instr(sub_dir,".")>0 or instr(sub_dir,"?")>0 or instr(sub_dir,"=")>0 or instr(sub_dir,"#")>0 then
    sub_dir=left(sub_dir,InStrRev(sub_dir,"/"))  
  end if
  
  if sub_dir<>"" and right(sub_dir ,1)<>"/" then
    sub_dir=sub_dir&"/"
  end if
  
'  response.write "sub_url="& sub_url&" <br>"
'  response.flush
'------------</sub_dir处理>----------------------------------------------------
'  response.write "sub_url="& sub_url&" <br>"
'  response.flush
  xmlhttp.open "GET", sub_url, false
  xmlhttp.send ""

'------------------------------------<取网页charset值>------------------------------------------------
  if XmlHttp.readystate <> 4 then
    exit function
  end if

  htmlText = xmlhttp.responseText  
  if htmlText="" then
    exit function
  end if
  
  For Each CharsetMatch in CharsetRegExp.Execute(htmlText)
    CharsetMatch=lcase(CharsetMatch)
    char_index=instr(CharsetMatch,"charset=")
    if char_index>0 then
      CharsetMatch=right(CharsetMatch,len(CharsetMatch)-char_index-7)
'      CharsetMatch=trim(CharsetMatch)
      char_index=instr(CharsetMatch,chr(34))
      CharsetMatch=left(CharsetMatch,char_index-1) '去掉双引号
      current_charset=trim(CharsetMatch)
'      current_charset=CharsetMatch
  
    end if
  next
  
'  response.write "--------------" & current_charset &"--------------------- <br>"
'  response.flush  
'------------------------------------</取网页charset值>------------------------------------------------
  

'-------------------------------<编码读取>------------------------------------------------------------------------------
'-------------------不能处理gb2312的bug---由(membership1@163.com)(http://www.sijiholiday.com )报告-------------------
'-------------------------(http://www.vtalkback.com)(calldefine@sohu.com) 修补------------------------------------------

'  strHTML=bytes2BSTR(xmlHttp.responseBody)

  BytesStream.Type = 1
  BytesStream.Mode =3
  BytesStream.Open
  BytesStream.Write xmlHttp.responseBody
  BytesStream.Position = 0
  BytesStream.Type = 2
  BytesStream.Charset = current_charset
'    strHTML = xmlhttp.responseText
  strHTML=BytesStream.ReadText
BytesStream.close

'    response.binarywrite htmlbody
'  response.write(strHtml)
'  response.flush
'----------------------------------</编码读取>-----------------------------------------------------------------------------

  For Each objMatch in objRegExp.Execute(strHTML)
'    response.write objMatch & "<br>"
'    response.flush

   if left(objMatch,4)<>"<!--" then

    for i=0 to ubound(excludeUrl)
      if instr(objmatch,excludeUrl(i))>0 then objmatch=""
    next

    if objmatch<>"" then
'      response.write "objmatch1="& objMatch& " <br>"
    
'      response.write "obj match is "&right(objMatch,len(objMatch)-1)&"<br>"
'      response.flush
'------------------------<url整理>---------------------------------------------------------------
'---------------不能处理gb2312的bug---由(membership1@163.com)(http://www.sijiholiday.com )报告--------------------
'-------------------------(http://www.vtalkback.com)(calldefine@sohu.com) 修补------------------------------------------
'      objMatch=server.htmlencode(objMatch)
'      response.write objMatch & "<br>"
'      response.flush

'      for i=0 to ubound(RemoveText)     '清除无效字符 chr(34),"'"
'        objMatch=replace(lcase(objMatch),lcase(RemoveText(i))," ")
'      next

      objMatch=lcase(objMatch)
      objMatch=replace(objMatch,chr(34)," ") '去掉url中的符号
      objMatch=replace(objMatch,"'"," ")
      objMatch=replace(objMatch,">"," ")
'      response.write "objmatch2="& objMatch& " <br>"

'      str_index=instr(objMatch,chr(34))   '去掉引号和引号左边的内容
'      objMatch=right(objMatch,len(objMatch)-str_index)

      str_index=instr(objMatch,"=")     '去掉第一个等号和等号左边的内容
      objMatch=right(objMatch,len(objMatch)-str_index)

      objMatch=ltrim(objMatch)     '取出有效字符

'      response.write objMatch & "<br>"
'      response.flush

      str_index=instr(objMatch," ")     '去掉空格和空格右边的内容

'      response.write objMatch &" "&str_index &"<br>"
'      response.flush
      if str_index <> 0 then      
        objMatch=left(objMatch,str_index-1)
      end if
'      response.write objMatch & str_index &"<br>"
'      response.flush

'      str_index=instr(objMatch,chr(34))   '去掉引号和引号右边的内容
'      objMatch=left(objMatch,str_index-1)
'------------------------</url整理>---------------------------------------------------------------

'------------------------<root反斜线处理>---------------------------------------------------------------------------------  '--------------------不能处理/url格式的bug---由(cndanxian@gmail.com)(http://www.gamelee.cn )报告-----------------------
'-------------------------(http://www.vtalkback.com)(calldefine@sohu.com) 修补------------------------------------------
  

      if left(objMatch,1)="/" then '/blog --> http://www.vtalkback.com/blog
        objMatch=root_url & objMatch
      end if

'      response.write objMatch & "<br>"
'      response.flush
'------------------------</root反斜线处理>-------------------------------------------------------------------------

'--------------------------------<去掉root url>----------------------------------------------------------
'      response.write "url2="& url& " <br>"
'      response.flush

      'in some cases this is better if left(objMatch,len(url))=Url then

      if left(objMatch,len(url))=Url then
        the_url=right(objMatch,len(objMatch) - len(url))
        if the_url<>"" and left(the_url,1)="/" then
          the_url=right(the_url,len(the_url) - 1) '去掉左边 "/"
        end if
        objMatch = the_url
        
      elseif left(objMatch,len(none_http_url))=none_http_url then
        the_url=right(objMatch,len(objMatch) - len(none_http_url))
        if the_url<>"" and left(the_url,1)="/" then
          the_url=right(the_url,len(the_url) - 1) '去掉左边 "/"
        end if
        objMatch = the_url

      elseif instr(objMatch,"http://")=0 and objmatch<>"" then
        the_url=sub_dir&objMatch
        if the_url<>"" and left(the_url,1)="/" then
          the_url=right(the_url,len(the_url) - 1) '去掉左边 "/"
        end if
        objMatch = the_url
'        response.write "subdir="& sub_dir& " <br>"
'        response.flush
        
        
      else '(out of domain)
        objMatch=""
      end if
'--------------------------------</去掉root url>------------------------------------------------------
    end if  

    if objmatch<>"" then

'------------------------<&符号转换>--------------------------------------------------------------------------------

      objMatch=replace(objMatch,"&","&amp;")      '& to &amp
      objMatch=replace(objMatch,"&amp;#","&#")
      objMatch=replace(objMatch,"&amp;amp;","&amp;")

      if right(objMatch,1)="/" then       '右边的去掉 "/"
        objMatch=left(objMatch,len(objMatch)-1)
      end if

'      response.write objMatch & "<br>"
'      response.flush
'------------------------</&符号转换>---------------------------------------------------------------------------

'--------------------------------<编码处理>------------------------------------------------      
'注 如果原始页面有%表示的url编码,此时%会被转换成为%25

     if current_charset="gb2312"  then
'       objMatch=gb2num(objMatch)

'        response.write current_charset&" "& sub_url & "<br>"
'        response.write objMatch & "<br>"
        objMatch= server.urlEncode(objMatch)       
'        response.write objMatch &" " & "<br>"
'        response.flush
      else
'        response.write "url2 " & current_charset&" "&sub_url & "<br>"
'        response.write objMatch &" " & "<br>"
'        objMatch= urlDecode(objMatch)
        objMatch= server.urlEncode(objMatch)
'        response.write objMatch &" " & "<br>"
'        response.flush

'        objMatch=server.htmlencode(objMatch)  
'        objMatch=encodeURI(objMatch)
'        objMatch=UTF2GB(objMatch)
'       objMatch=gb2num(objMatch)
      end if

'--------------------------------</编码处理>------------------------------------------------      
      
'      if objMatch<>newMatch then
'        response.write objMatch & "<br>"
'        response.write newMatch & "<br>"
'        response.flush
'      end if

      if objUrlArchive.Exists(objMatch)= false and the_url<>"" then
        objUrlArchive.Add objMatch,crawl_depth
        CharsetUrlArchive.Add objMatch,current_charset
'        response.write objMatch &" "&sub_url& "<br>" '显示url所在页面----------
'        response.flush
        
'        writelink ObjMatch,current_charset        
      end if
    
    end if
   end if  
  Next
End Function

'*************************************************************************************************************

function gb2num(str)
  newStr=""
  for i=1 to len(str)   'gb2312处理
    c=mid(str,i,1)
    if asc(c)<0 then
      gb2312Code=ascW(c)
      if gb2312Code <0 then
        gb2312Code =gb2312Code+65536
      end if
      newStr=newStr & "&#" & gb2312Code & ";"
    else
      newStr=newStr&c
    end if
  next
  gb2num=newStr
end function
'*************************************************************************************************************
function url2utf(str)
  url2utf=decodeURI(str)
end function

'*************************************************************************************************************

Function URLDecode(enStr) '注 如果原始页面有%表示的url编码,到此时%会成为%25,decode后还原为%
  dim deStr
  dim c,i,v
  deStr=""
  
  for i=1 to len(enStr)
    c=Mid(enStr,i,1)
    if c="%" then
      v=eval("&h"+Mid(enStr,i+1,2)) 'eval 计算一个表达式的值
      if v<128 then
        deStr=deStr&chr(v)
        i=i+2
      else
        
        if isvalidhex(mid(enstr,i,3)) then '双字节url符号
          if isvalidhex(mid(enstr,i+3,3)) then
            v=eval("&h"+Mid(enStr,i+1,2)+Mid(enStr,i+4,2)) '+65536
            
            deStr=deStr& chr(v)

            i=i+5
          else       '单个url符号
            v=eval("&h"+Mid(enStr,i+1,2)+cstr(hex(asc(Mid(enStr,i+3,1)))))
            deStr=deStr&chr(v)
            i=i+3
          end if
        else
'          destr=destr&c
        end if
      end if
    else
      if c="+" then
        deStr=deStr&" "
      else
        deStr=deStr&c
      end if
    end if
  next
'  response.write Chr(13) & Chr(10)
'  response.write "enstr="&enStr  
'  response.write Chr(13) & Chr(10)
'  response.write "destr="&deStr  
'  response.write Chr(13) & Chr(10)
'  response.flush
  
  URLDecode=deStr
end function
'*************************************************************************************************************
function isvalidhex(str)
  isvalidhex=true
  str=ucase(str)
  if len(str)<>3 then isvalidhex=false:exit function
  if left(str,1)<>"%" then isvalidhex=false:exit function
    c=mid(str,2,1)
  if not (((c>="0") and (c<="9")) or ((c>="A") and (c<="Z"))) then isvalidhex=false:exit function
    c=mid(str,3,1)
  if not (((c>="0") and (c<="9")) or ((c>="A") and (c<="Z"))) then isvalidhex=false:exit function
end function

'*************************************************************************************************************

function num2gb(str)
  newStr=""
  for i=1 to len(str)
    c=mid(str,i,1)
    if c="&" and mid(str,i+1,1)="#" then
      num=""
      for j=i+2 to len(str)
        ch=mid(str,j,1)
        if ch=";" then
          i=j
          exit for
        end if
        num=num &ch
      next
      newStr=newStr & chrW(CLng(num)) 'GB2UTF8(chrW(CLng(num)))        
    else
      newStr=newStr & c
    end if
  next
  num2gb=newStr
end function
'*************************************************************************************************************
'Function GB2UTF(Chinese)
' For i = 1 to Len (Chinese)
' a = Mid(Chinese, i, 1)
' GB2UTF = GB2UTF & "&#x" & Hex(Ascw(a)) & ";"
' Next
'End Function
'*************************************************************************************************************
Function GB2UTF(Chinese)
For i = 1 to Len (Chinese)
a = Mid(Chinese, i, 1)
GB2UTF = GB2UTF & Ascw(a)
Next
End Function
'*************************************************************************************************************

function UTF2GB(UTFStr)
for Dig=1 to len(UTFStr)
if mid(UTFStr,Dig,1)="%" then
if len(UTFStr) >= Dig+8 then
GBStr=GBStr & ConvChinese(mid(UTFStr,Dig,9))
Dig=Dig+8
else
GBStr=GBStr & mid(UTFStr,Dig,1)
end if
else
GBStr=GBStr & mid(UTFStr,Dig,1)
end if
next
UTF2GB=GBStr
end function
'*************************************************************************************************************

Function iso8601date(dLocal,utcOffset)  
  Dim d
  ' convert local time into UTC
  d = DateAdd("H",-1 * utcOffset,dLocal)

  ' compose the date
  iso8601date = Year(d) & "-" & Right("0" & Month(d),2) & "-" & Right("0" & Day(d),2)
' & "T" & _Right("0" & Hour(d),2) & ":" & Right("0" & Minute(d),2) & ":" & Right("0" & Second(d),2) & "Z"
End Function

'*************************************************************************************************************
Function GetAbsoluteURL(sUrl,iStep) '读取重定向后的 url
  Dim bUrl,bDat
  GetAbsoluteURL=sUrl
  If iStep>15 Then
   Response.Write "递归嵌套超过15层" & "<br />"
    exit function
  End If

  If InStr(sUrl,"?")>0 THen
    Dim tmpUrl : tmpUrl=split(sUrl,"?")
    bUrl=tmpUrl(0)
    bDat=tmpUrl(1)
  Else
    bUrl=sUrl
    bDat=""
  End If

'  Response.Write "<p style=""border-top:solid 1px silver;padding:0px;margin:0px;"">"
'  Response.Write "正在准备获取 " & sUrl & "<br />"

'  if bDat<>"" Then Response.Write "3 &nbsp;&nbsp;>>参数: " & bDat & "<br />"

  oHttp.Option(6)=0   '禁止自动Redirect
  oHttp.SetTimeouts 5000,5000,30000,5000
'  Response.Write burl&"<br /> "
  oHttp.Open "HEAD",sUrl,False
  On Error Resume Next
  oHttp.Send bDat

'  response.write oHttp.responseText
'  response.flush
'  Response.Write " <br /> "
  
  If Err.Number<>0 Then
'    Response.Write "<font color=""red"">发生错误:" & Err.Description & "</font><br />"
    Err.Clear
'    GetAbsoluteURL=""
'    Set oHttp=Nothing
'    Response.Write "</p>"
    Exit Function
  End If
'  Response.Write " <br /> "

  On Error Goto 0
'  Response.Write "&nbsp;&nbsp;>>HTTP 状态:" & oHttp.Status & "<br />"

  If oHttp.Status<>200 And oHttp.Status<>302 and oHttp.Status<>301 Then
'    Response.Write "<font color=""red"">HTTP错误:" & oHttp.StatusText & "</font><br />"
    Err.Clear
    GetAbsoluteURL=""
'    Set oHttp=Nothing
'    Response.Write "</p>"
    Exit Function
  End If
  Dim sLoca
  On Error Resume Next
  sLoca=oHttp.getResponseHeader("Location")

  If Err.Number<>0 Then
    Err.Clear
    sLoca=""
  End If
  
  On Error Goto 0
'  Response.Write " <br /> "

  If sLoca = "" Then
'    Response.Write "&nbsp;&nbsp;>>Content-Type:" & oHttp.getResponseHeader("Content-Type") & "<br />"
'    Response.Write "&nbsp;&nbsp;>>没有返回Location头<br />"
    GetAbsoluteURL=sUrl
'    Set oHttp=Nothing
'    Response.Write " </p>"
    GetAbsoluteURL=sUrl
    Exit Function
  Else

'    Response.Write " &nbsp;&nbsp;>>Content-Type:" & oHttp.getResponseHeader("Content-Type") & "<br />"
'    Response.Write " 收到Location头:" & sLoca & "<br />"
'    Response.Write " </p>"

    '这里要生成新的URL

    If InStr(sLoca,"://")<=0 Then
      '没有指定协议,按当前URL的位置重新设置
      Dim ind : ind=InstrRev(sUrl,"/")
      sUrl=Left(sUrl,ind)
      sLoca=sUrl & sLoca
    End If
    GetAbsoluteURL=GetAbsoluteURL(sLoca,iStep+1)

  End If
End Function

%>
<script language="javaScript" runat="Server">
function UTF8toGB(str){
  return decodeURIComponent(str)

}
function encodeURI(str){
  return encodeURIComponent(str)
}
function decodeURI(str){
  return decodeURIComponent(str)
}

function GB2UTF8(str){
  return encodeURIComponent(str)
}

function convert(str) {
  return string(str.getBytes("UTF-8"),"gb2312");
}

</script>
评论Feed 评论Feed: http://www.vTalkback.com/blog/feed.asp?q=comment&id=119

这篇日志没有评论.

发表
表情图标
[smile] [confused] [cool] [cry]
[eek] [angry] [wink] [sweat]
[lol] [stun] [razz] [redface]
[rolleyes] [sad] [yes] [no]
[heart] [star] [music] [idea]
UBB代码
转换链接
表情图标
悄悄话
用户名:   密码:  
验证码 * 请输入验证码