<form method="post" action="?">
<div align="center">
<input name="asp2html" type="submit" value="生成静态主页"/>
</div>
</form>
<%
If request.Form("asp2html")<>"" Then
%>

<%
Function GetPage(url)
'获得文件内容
dim Retrieval
Set Retrieval = CreateObject("Microsoft.XMLHTTP")
With Retrieval
  .Open "Get", url, False ', "", ""
  .Send
  GetPage = BytesToBstr(.ResponseBody)
End With
Set Retrieval = Nothing
End Function

Function BytesToBstr(body)
dim objstream
set objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = "GB2312"
BytesToBstr = objstream.ReadText
objstream.Close
set objstream = nothing
End Function

on error resume next
Url="http://www.xxx.com/index.asp" '要读取的页面地址
response.write "开始更新首页...<BR>"
wstr = GetPage(Url)

'response.write(wstr)
Set fs=Server.CreateObject("Scripting.FileSystemObject")

'if not MyFile.FolderExists(server.MapPath("/html/")) then
'MyFile.CreateFolder(server.MapPath("/html/"))'
'end if

'要存放的页面地址
dizhi=server.MapPath("index.htm")
If (fs.FileExists(dizhi)) Then
fs.DeleteFile(dizhi)
End If

Set CrFi=fs.CreateTextFile(dizhi)
Crfi.Writeline(wstr)
set CrFi=nothing
set fs=nothing
response.write "...<font color=red>更新完成！</font>"
%>

<%
End If
%>

<%
Response.Status = "404 Not Found"

Function GetUserCurURL()
    If Request.ServerVariables("HTTPS") = "on" Then
        GetUserCurURL = "https://"
    Else
        GetUserCurURL = "http://"
    End If
    GetUserCurURL = GetUserCurURL & Request.ServerVariables("SERVER_NAME")
    If (Request.ServerVariables("SERVER_PORT") <> 80) Then GetUserCurURL = GetUserCurURL & ":" & Request.ServerVariables("SERVER_PORT")
    GetUserCurURL = GetUserCurURL & Request.ServerVariables("URL")
    If (Request.QueryString <> "") Then GetUserCurURL = GetUserCurURL & "?" & Request.QueryString
End Function

thecururl=Request.ServerVariables("http_host")

if thecururl="www.blueidc.cn" or thecururl="blueidc.cn" then
   redirecturl=Replace(GetUserCurURL(),"blueidc.cn","sunrc.com")
   redirecturl=Replace(redirecturl,"404.asp?404;http://sunrc.com:80/","")
   redirecturl=Replace(redirecturl,"404.asp?404;http://www.sunrc.com:80/","")
   response.redirect redirecturl
end if
%>

if InStr(LCase(Request.ServerVariables("HTTP_ACCEPT")),"text/vnd.wap.wml")>0 then
    response.redirect  "wap.asp" '如果是手机访问则跳转到wap.asp
    response.end
else
    response.redirect  "default.asp" '如果电脑访问跳转到首页
    response.end
end if

<%If InStr(LCase(Request.ServerVariables("HTTP_ACCEPT")),"text/vnd.wap.wml") > 0 Then Response.Redirect "wap.asp"%>

<%
'==================================================================
'程序说明：用于自动生成新闻静态页，手动添加分页功能，自动生成页码
'
'程序作者：Www.Leadbbs.Com 简体中文版 QQ: 7275244
'
'程序用途：演示用，CopyLeft :p
'
'时间：2005年9月28日
'
'使用方法：绝对路径下建立info目录，建立Template.Html文件，
'===================================================================
if Request.ServerVariables("REQUEST_METHOD") = "POST" then
Dim Fso 'FileSystemObject
Dim Mp '存放MapPath
Dim ObjStream 'ObjStream
Dim ObjHtml 'ObjHtml建立文件
Dim FileName '文件名
Dim CountPage '计算内容中的页数
Dim ContentTemp '内容临时变量
Dim i '临时计数变量
Dim NewsContent '存储新闻内容变量
Dim NowPage '存放当前页数变量
Dim NewsPage '存储分页信息
FileName = "Test"
NewsContent = ""
NewsPage = ""
Content = Request("Content")
'写入数据库
'Insert Into Article
'按照标记分页程式
ContentTemp = Split(Content,"$分页符$")
CountPage = Ubound(ContentTemp)
if CountPage = -1 then
Response.Write("错误：没有输入新闻内容！")
Response.End()
End if
'==============
'输出检测信息
'==============
'Response.Write("共有页数:" & CountPage+1)
'Response.Write("每页显示信息为：<br>")
'For i = 0 to CountPage
'Response.Write("第" & i + 1 & "页:" & ContentTemp(i) & "<br>")
'Next
'==============
'检测输出结束
'==============
'开始生成HTML页
Set Fso = CreateObject("Scripting.FileSystemObject")
For i = 0 to CountPage
'==================
'判断页数，成生页码
'==================
if CountPage > 0 then '不是单页新闻，需要显示分页信息
if i = 0 then
NowPage = 1 '当前页
NewsPage = GetPageCount(NowPage,CountPage+1,FileName)
else
NowPage = i + 1
NewsPage = GetPageCount(NowPage,CountPage+1,FileName)
FileName = FileName & "_" & NowPage
end if
end if
'==================
'生成页码结束
'==================
Mp = Server.MapPath("/Template.Html")
Set ObjStream = Fso.OpenTextFile(Mp,1,-2)
while not ObjStream.AtEndOfStream
NewsContent= NewsContent & ObjStream.ReadLine & vbcrlf '读出文件内容
wend
'Response.Write("文件：" & FileName & ".Html 第" & i + 1 & "次写入值为：" & ContentTemp(i) & "<br>")
NewsContent=Replace(NewsContent,"{Content}",ContentTemp(i))
NewsContent=Replace(NewsContent,"{NewsPage}",NewsPage)
Dir = Server.MapPath("/info") & "\"
Set ObjHtml = Fso.CreateTextFile(Dir & "/" & FileName & ".Html")
ObjHtml.WriteLine NewsContent
NewsContent = "" '复原新闻内容变量
FileName = Left(FileName,4) '复原原文件名称
Next
Set Fso = Nothing
Response.Redirect(Request.ServerVariables("HTTP_REFERER"))
End if

Function GetPageCount(NowPage,CountPage,FileName) '自动生成页码
'==========显示结果============
'上一页 1 2 3 下一页
'上一页 ... 4 5 6 下一页
'上一页 1 2 3 ... 下一页
'上一页 ... 4 5 6 ... 下一页
'==============================
Dim ShowPageNum '定义显示页码数量
Dim PageUp '上页
Dim PageDown '下页
Dim i '循环变量
ShowPageNum = 7 '最好是单数，好看一些 ... 11 12 13 <14> 15 16 17 ...
PageUp = ""
PageDown = ""
if NowPage=1 then
GetPageCount = GetPageCount & "<a href=""" & FileName & ".html""><font color=""#ff0000""><b>1</b></font></a> "
else
GetPageCount = GetPageCount & "<a href=""" & FileName & ".html"">1</a> "
end if

if CountPage <= ShowPageNum then
For i = 2 to CountPage
GetPageCount = GetPageCount & "<a href=""" & FileName & "_" & i & ".html"">" & GetColor(i,NowPage) & "</a> "
Next
else '页数大于自定义的显示页码数量
if (NowPage - 3) > 1 and (NowPage + 3) < CountPage then
GetPageCount = "... "
For i = NowPage - 3 to NowPage + 3
GetPageCount = GetPageCount & "<a href=""" & FileName & "_" & i & ".html"">" & GetColor(i,NowPage) & "</a> "
Next
GetPageCount = GetPageCount & "..."
else
if (NowPage - 3) > 1 and (NowPage + 3) => CountPage then
GetPageCount = "... "
For i = CountPage - ShowPageNum to CountPage
GetPageCount = GetPageCount & "<a href=""" & FileName & "_" & i & ".html"">" & GetColor(i,NowPage) & "</a> "
Next
else
For i = 2 to ShowPageNum
GetPageCount = GetPageCount & "<a href=""" & FileName & "_" & i & ".html"">" & GetColor(i,NowPage) & "</a> "
Next
GetPageCount = GetPageCount & "..."
end if
end if
End if
'加首头页尾
if NowPage > 1 then
if NowPage > 2 then
PageUp = "<a href=""" & FileName & "_" & NowPage - 1 & ".html"">上页</a> "
else
PageUp = "<a href=""" & FileName & ".html"">上页</a> "
end if
end if
if NowPage < CountPage then
PageDown = "<a href=""" & FileName & "_" & NowPage + 1 & ".html"">下页</a> "
End if
GetPageCount = "<a href=""" & FileName & ".html"">首页</a> " & PageUp & GetPageCount & PageDown & "<a href=""" & FileName & "_" & CountPage & ".html"">末页</a>"
End Function

Function GetColor(i,NowPage) '当前页标志色
if i = NowPage then
GetColor = "<font color=""#ff0000""><b>" & NowPage & "</b></font>"
else
GetColor = i
end if
End Function
%>

<%
'调用方法：
'获取10个1到100之间的整数
Response.Write GetrndNumber(1,100,10)

Function GetrndNumber(intStart,intEnd,intCount)
     Rem 取指定范围内不同的随机整数
     Rem intStart:起始值
     Rem intEnd:结束值
     Rem intCount:值个数
     Rem no_mIss
     Rem 调用:GetrndNumber(1,9,5)
     On error resume next
     Dim i,reValue,strreValue
     reValue = "" : strreValue = ","
     If Not isNumeric(intStart) or Not isNumeric(intEnd) _
           or Not isNumeric(intCount)  Then Response.write "参数错误!" : Response.End
     If intCount>(intEnd - intStart)+1 Then Response.write "参数错误!" : Response.End
     randomize
     For i = 0 to intCount - 1
           reValue = Int((intEnd - intStart + 1) * Rnd + intStart)
           If instr(strreValue,"," & reValue & ",")>0 Then
                 i = i - 1
           Else
                 strreValue = strreValue & reValue & ","
           End If
     Next
     strreValue = left(strreValue,len(strreValue) - 1)
     strreValue = Replace(strreValue,",","",1,1)
     GetrndNumber = strreValue
End Function
%>

<%
'获取10个1到100之间的整数
RndStr=GetrndNumber(1,100,10)  '这个函数在上面的例子中，你可以把上面的函数拷贝到这里来
Response.Write RndStr
Dim aData
aData = split(RndStr,",")
Call ResponseArray(QuickSort(aData),"从小到大排序")

Function QuickSort(a_Data)
    Dim i, j
    Dim bound, t
    bound = UBound(a_Data)

    For i = 0 To bound-1
        For j = i+1 To bound
            If Cint(a_Data(i)) > Cint(a_Data(j)) Then '这里的大于>如果改成小于< 则按照从大到小排序
                t = a_Data(i)
                a_Data(i) = a_Data(j)
                a_Data(j) = t
            End If
        Next
    Next

    QuickSort = a_Data
End Function

'输出数组
Sub ResponseArray(a_Data, str)
    Dim s
    s = ""
    Response.Write "<b>" & str & "：</b>"
    For i = 0 To UBound(a_Data)
        s = s & a_Data(i) & ","
    Next
    s = Left(s, Len(s)-1)
    Response.Write s
    Response.Write "<hr>"
End Sub
%>

Randomize
dim i,DispRecord
i=0
DispRecord=10 '设置显示的随机记录数量

sql="select id,caption from table"
set rs=server.CreateObject("adodb.recordset")
rs.open sql,conn,1,3

lngCount = rs.RecordCount
redim idList(lngCount)
while i<DispRecord

     lngRnd = Int((lngCount * Rnd) + 1)
     rs.AbsolutePosition = lngRnd
     if isEmpty(idList(lngRnd)) then '如果第lngRnd条记录在数组中为空，则显示该条记录

          response.write rs(0)&"<Br>"   '你可以自己设定需要输出的内容

          idList(lngRnd)=1     '第lngRnd条记录已经显示，把他在数组中的值设定为1，下次就不再显示
          i=i+1
     end if

wend
rs.close
set rs=nothing
Erase idList

<%
Dim objConn, objRs, db, strSQL
Dim totalCount, rndArray, rsOutputMax, intI
'-----------------
'|连接数据库|
'-----------------
db = "db/dbname.mdb"
strSQL = "Select id,name FROM table_name"
Set objConn = Server.CreateObject("ADODB.Connection")
objConn.Open "provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(db)
Set objRs = Server.CreateObject("ADODB.Recordset")
objRs.Open strSQL, objConn, 1, 3
'--------------
'|读取数据|
'--------------
totalCount = objRs.RecordCount '生成随机数范围的上限
rsOutputMax = 10 '输出记录条数
rndArray = myRnd(rsOutputMax,totalCount,1)
Response.Write "  id          name"
Response.Write "------------------"
For intI = 1 To rsOutputMax
  objRs.AbsolutePosition = rndArray(intI)
  Response.Write "  " & objRs("id") & "          " & objRs("name") & "<br>"
Next
'--------------
'|清理资源|
'--------------
Set objRs = Nothing
objConn.Close
Set objConn = Nothing
'--------------------------------------------------
'|生成指定范围内不重复随机数的函数|
'|nMax:输出随机数的个数                |
'|upper:指定范围上限                     |
'|lower:指定范围下限                     |
'--------------------------------------------------
Function myRnd(nMax,upper,lower)
  Dim a(), i, j, k, reCount
  ReDim a(nMax)
  Randomize Timer
  For i = 1 To nMax
    reCount = False
    k = Int((upper - lower + 1) * Rnd + lower)
    For j = 1 To i - 1
      If k = a(j) Then reCount = True : Exit For
    Next
    If reCount = True Then
      i = i - 1
    Else
      a(i) = k
    End If
  Next
  myRnd = a
End Function
%>

<%
'连接数据库代码略
DIM sql,rs
sql="select top 100 * from table order by rnd(id)"
Set rs=server.CreateObject("adodb.recordset")
rs.open sql,conn,1,1
DIM Appeared
Call DisRndRecord(10,rs.recordCount)'调用函数该位置显示记录
'#DisRndRecord(DisNum,rsBound)
'#参数DisNum：显示数量
'#参数rsBound：随机数产生范围
Sub DisRndRecord(DisNum,rsBound)
DIM i,ThisRnd
If rsBound<DisNum Then DisNum=rsBound'记录总数小于要抽取记录条数的情况
For i=0 To DisNum-1
ThisRnd=GetRnd(rsBound)'取得一个不重复的随机数
rs.Move(ThisRnd)'游标移动到随机数位置数读取
Response.Write "<br>"&rs("id")
rs.Move(-ThisRnd)
Next
End Sub
'# 函数GetRnd(bound)返回一个不重复的随机数字
'#参数bound：随机范围
Function GetRnd(bound)
DIM ranNum
Randomize()
ranNum=int(bound*rnd)
If Instr(Appeared,"["&ranNum&"]") Then'产生的随机数是否出现过
ranNum=getRnd(bound)
End If
Appeared=Appeared&"["&ranNum&"]"'记录已出现的随机数
GetRnd=ranNum
End Function
rs.close
Set rs=Nothing
conn.close
Set conn=Nothing
%>

<%
’-------------------------数据库连接-----------------------
Set objConn = Server.CreateObject("ADODB.Connection")
objConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" &_
"Data Source=" & Server.MapPath("data.mdb")
objConn.Open

’-------------------------检索数据-----------------------
strSQL = "Select id,DataColumn FROM DataTable"    ’Sql语句，检索数据库
Set objRS = Server.CreateObject("ADODB.Recordset")    ’创建记录集
objRS.Open strSQL, objConn, 1, 1                                    ’执行检索
Count=objRS.RecordCount            ’得到记录总数
Item=4                                           ’需要显示的记录数
’-------------------------检索数据完毕-----------------------

redim a(Item, 2),t(Count)   ’定义2数组，数组a用来储存记录，数组t用来删选记录

’初始数组数值，目的为了插入数据以后和此值做比较
for each j in t
    j=0
next

’ 随机抽取记录号
Randomize timer        ’初始化随机数生成器
for j=1 to Item
    k=int(rnd*Count+1)    ’从总数里面随机取一条记录
    do while t(k)<>0                    ’判断是否记录是否已在数组中
      k=int(rnd*Item+1)
    loop
    t(k)=1            ’第k条记录被选中，设置为1，下次将不再选中
next
’--------------------------------------
j=1:i=1’定义下标

’ 循环选取数据集objRS中的部分记录存放到数组中
Do While Not objRS.Eof
      if t(j)=1 then
          a(i,1)=objRS("id")                      ’记录id
          a(i,2)=objRS("DataColumn")     ’记录内容
          i=i+1
     end if
j=j+1
objRS.MoveNext
Loop

’----------------------------显示内容--------------------
for i=1 to Item
    Response.write "序号"&a(i,1)&"<br>"
    Response.write "内容"&a(i,2)&"<p>"
next
’----------------------------显示内容完毕--------------------

’释放资源
objRs.Close
set objRs=nothing
objConn.Close
set objConn=nothing
%>

<%  
function html2ubb(l1)  
if len(trim(l1))>0 then  
else  
exit function  
end if  
dim l4,I1,I2,I3  
dim i,I4:I4=array(16,19,21,24,32,45)  
I1=l1  
set I2=new regexp  
I2.global=true  
I2.ignorecase=true'忽略大小写  
I2.pattern="/r":I1=I2.replace(I1,"")  
I2.pattern="on(load|click|dbclick|mouseover|mousedown|mouseup)=""[^""]+""":I1=I2.replace(I1,"")  
I2.pattern="<script[^>]*?>([\w\W]*?)<\/script>":I1=I2.replace(I1,"")  
I2.pattern="<a[^>]+href=""([^""]+)""[^>]*>(.*?)<\/a>":I1=I2.replace(I1,"$2")  
I2.pattern="<font[^>]+color=([^ >]+)[^>]*>(.*?)<\/font>":I1=I2.replace(I1,"[color=$1]$2[/color]")  
I2.pattern="<img[^>]+src=""([^""]+)""[^>]*>":I1=I2.replace(I1,"")  
I2.pattern="<([\/]?)b>":I1=I2.replace(I1,"[$1b]")  
I2.pattern="<([\/]?)strong>":I1=I2.replace(I1,"[$1b]")  
I2.pattern="<([\/]?)u>":I1=I2.replace(I1,"[$1u]")  
I2.pattern="<([\/]?)i>":I1=I2.replace(I1,"[$1i]")  
I2.pattern=" ":I1=I2.replace(I1," ")  
I2.pattern="&":I1=I2.replace(I1,"&")  
I2.pattern="""":I1=I2.replace(I1,"""")  
I2.pattern="<":I1=I2.replace(I1,"<")  
I2.pattern=">":I1=I2.replace(I1,">")  
I2.pattern="<br />":I1=I2.replace(I1,vbcrlf)  
I2.pattern="<[^>]*?>":I1=I2.replace(I1,"")  
I2.pattern="\n+":I1=I2.replace(I1,vbcrlf)  
set I2=nothing  
html2ubb=I1  
end function  
%>