google sitemap generater source code ver 0.1.3,增加空的url处理

[ 2007-10-23 20:46:25 | 作者: 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.3

'------------------------------变量初始化-----------------------------------------------------------

ver="0.1.3"

'script configuration

'debug =0

'Response.CharSet="gb2312";

'current_charset="utf-8"

current_charset="gb2312"    '必须使用小写

Url="http://www.vtalkback.com"

Url=request("url")

Url=trim(url)
if Url="" then '2007年10月23日星期二 处理空变量 http://www.vtalkback.com/sitemap/sitemap.asp?url=
  Url="http://www.vtalkback.com"
end if

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>
[最后修改由 Admin, 于 2007-10-23 20:46:25]
评论Feed 评论Feed: http://www.vTalkback.com/blog/feed.asp?q=comment&id=136

这篇日志没有评论.

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