当前位置:96看吧 > 技术文档 > ASP编程 > asp整站生成静态页面

asp整站生成静态页面

时间:2009/08/12
作者:诚心(MaWenDong)
来源:96看吧
查看:
标签:asp

xmlhttp.asp

  1. <%  
  2.   On Error Resume Next   
  3.   Server.ScriptTimeOut=9999999   
  4.   Function getHTTPPage(Path)   
  5.    t = GetBody(Path)   
  6.    getHTTPPage=BytesToBstr(t,"GB2312")   
  7.   End function  
  8.   Function GetBody(url)   
  9.    on error resume next   
  10.    Set Retrieval = CreateObject("Microsoft.XMLHTTP")   
  11.    With Retrieval   
  12.    .Open "Get", url, False""""   
  13.    .Send   
  14.    GetBody = .ResponseBody   
  15.    End With   
  16.    Set Retrieval = Nothing   
  17.   End Function     
  18.   Function BytesToBstr(body,Cset)   
  19.    dim objstream   
  20.    set objstream = Server.CreateObject("adodb.stream")   
  21.    objstream.Type = 1   
  22.    objstream.Mode =3   
  23.    objstream.Open   
  24.    objstream.Write body   
  25.    objstream.Position = 0   
  26.    objstream.Type = 2   
  27.    objstream.Charset = Cset   
  28.    BytesToBstr = objstream.ReadText   
  29.    objstream.Close   
  30.    set objstream = nothing   
  31.   End Function    
  32.   Function Newstring(wstr,strng)   
  33.    Newstring=Instr(lcase(wstr),lcase(strng))   
  34.    if Newstring<=0 then Newstring=Len(wstr)   
  35.   End Function   
  36. %> 

httptohtml.asp

  1. <!--#include file="xmlhttp.asp"-->  
  2. <%  
  3. '页面的起始  
  4. url="co.asp?id=2,"   
  5. if session("wb_cx")="" then   
  6. '进入程序页面递归类将页面中的内容和连接取出  
  7. wb_cx=PcMane(url)  
  8. session("wb_cx")=wb_cx  
  9. end if   
  10. wb_cx=session("wb_cx")  
  11. '判断递归类中是否存有数据  
  12. if wb_cx<>"" then  
  13. fso_wstr=split(wb_cx,"<|@|>")  
  14. fso_wstr_1=split(fso_wstr(0),",")  
  15. fso_wstr_2=split(fso_wstr(1),"[|@|]")  
  16. for i=0 to UBound(fso_wstr_1)-1  
  17. '将连接转换成html格式  
  18. qman_html_url=(thhs(thhs(fso_wstr_1(i),"?","~"),".asp","")&".html")  
  19. qman_html_min=fso_wstr_2(i+1)  
  20. for j=0 to UBound(fso_wstr_1)-1  
  21. '将页面中的连接转换成html格式连接  
  22. qman_html_minurl=(thhs(thhs(thhs(fso_wstr_1(j),"?","~"),".asp",""),"&","_")&".html")  
  23. qman_html_min=thhs(qman_html_min,fso_wstr_1(j),qman_html_minurl)  
  24. qman_html_min=thhs(qman_html_min,"&","?")  
  25. qman_html_min=thhs(qman_html_min,"?nbsp;","&nbsp;")  
  26. next  
  27. qman_html_min=qman_html_min&"<script type='text/javascript'>"&_  
  28. "if (!document.location.search == '')"&_  
  29. "{"&_  
  30. "var h=location.href;"&_  
  31. "var r=new RegExp('[^\\?]*/([^&]*)','i');"&_  
  32. "var t=h.match(r);"&_  
  33. "if (t)"&_  
  34. "{"&_  
  35. "var str = t[1]; "&_  
  36. "newstr=str.replace('.html?','&'); "&_  
  37. "location=newstr+'.html';"&_  
  38. "}"&_  
  39. "}"&_  
  40. "</script>" 
  41. '用fso写出html页面  
  42. Set fso = Server.CreateObject("Scripting.FileSystemObject")  
  43. FilePath = Server.MapPath(qman_html_url)  
  44. Set fout = fso.CreateTextFile(FilePath)  
  45. fout.WriteLine qman_html_min  
  46. NEXT  
  47. else  
  48. end if  
  49. '页面内容和连接递归类开始  
  50. function PcMane(url)  
  51.        dim arrID  
  52.        arrID =url  
  53.           '连接地址  
  54.           http="http://www.96kb.com/" 
  55.        '正则提取<a href=>中的信息 在这程序里面我只是提取了我网站的信息可能和其他的连接不一样大家如果提取自己网站的信息请自己修改  
  56.           DG_href="<(a href=)[\w].+?>" 
  57.        DG_Split=Split(arrID,",")  
  58.        for i=0 to Ubound(DG_Split)-1  
  59.           DG_new=getHTTPPage(http&DG_Split(i))  
  60.        DG_wstr_1=DG_wstr_1&stripHTML(">",stripHTML("<a href=",RegExpTest(DG_href,DG_new)))  
  61.           DG_news=DG_news&"[|@|]"&DG_new  
  62.           next  
  63.           '输出所有的连接用唯一函数转换将多余雷同的信息去除  
  64.           DG_wstr=FormateOrderBy(DG_wstr_1)  
  65.           '判断从url 和 DG_wstr唯一后的结果   
  66.           '如果是一样的说明已经没有连接了 结束 递归  
  67.        if len(arrID)=len(DG_wstr) then  
  68.        PcMane=DG_wstr  
  69.        exit function  
  70.        else  
  71.        arrID=PcMane(DG_wstr)  
  72.        end if  
  73.           '全部结束后将其内容输出  
  74.        PcMane =arrID&"<|@|>"&DG_news  
  75.  
  76. '唯一函数  
  77. end function  
  78. Function FormateOrderBy(OrderByText)     
  79. Dim   tmp,tmp2,i,j     
  80. tmp3=""     
  81. tmp   =   Split(OrderByText,",")     
  82. For   i=0   To   Ubound(tmp)-1     
  83. For   j=i+1   To   Ubound(tmp)     
  84. If   UCase(Trim(tmp(i)))=UCase(Trim(tmp(j)))   Then     
  85. tmp(j)=""     
  86. End   If     
  87. Next     
  88. Next     
  89. tmp2=""     
  90. For   i=0   To   Ubound(tmp)     
  91. If   tmp(i)<>""Then tmp2=tmp2&tmp(i)&","     
  92. Next     
  93. FormateOrderBy=Left(tmp2,Len(tmp2))     
  94. End Function   
  95.  
  96. '正则函数  
  97. Function RegExpTest(patrn, strng)   
  98. Dim regEx, Match, Matches  
  99. Set regEx = New RegExp  
  100. regEx.Pattern = patrn  
  101. regEx.IgnoreCase = True 
  102. regEx.Global = True 
  103. Set Matches = regEx.Execute(strng)  
  104. For Each Match in Matches  
  105. RetStr = RetStr & Match.Value&"," 
  106. Next   
  107. RegExpTest = RetStr   
  108. End Function   
  109. Function stripHTML(patrn,strHTML)  
  110. Dim objRegExp, strOutput  
  111. Set objRegExp = New Regexp  
  112. objRegExp.IgnoreCase = True 
  113. objRegExp.Global = True 
  114. objRegExp.Pattern =patrn  
  115. strOutput = objRegExp.Replace(strHTML, "")  
  116. stripHTML = strOutput  
  117. Set objRegExp = Nothing 
  118. End Function 
  119. Function thhs(min,xtmin,thmin)  
  120. thhs=replace(min,xtmin,thmin)  
  121. End Function   
  122. %> 
上一篇:asp计算程序执行时间
下一篇:ASP获得当前页面地址的方法
页面举报
Report
关闭页面
Close
收藏页面
Favorites
分享页面
Share
版权信息:栏目内,站内会员所分享的全部“资源/素材/文章”,仅供学习与参考,版权为原作者所有。
下载提示:非注册用户每天可下载一个文件,已注册会员不受限制。
网友评论
数据载入中
验证码
  • 请您注意:
  • ·请不要在评论中含与内容无关的广告链接。
  • ·不良评论请用报告管理员,以利管理员及时删除。
  • ·遵守中华人民共和国的各项有关法律法规
  • ·承担一切因您的行为而直接或间接导致的民事或刑事法律责任
  • ·本站管理人员有权保留或删除评论中的任意内容
  • ·您在本站发表的作品,本站有权在网站内转载或引用
  • ·参与本评论即表明您已经阅读并接受上述条款
相关最新
相关热门