一个不太完善的ASP整站静态生成程序
2006-04-02 09:35
323 查看
<%
'**************************************************************************************************'
' 大路整站静态生成程序 '
' by 吕鑫 '
' date 2006.3.30 '
' http://www.dalu2000.com '
'***************************************************************************************************
const def_page = "index.asp" '定义程序开始读取的页面
const html_url = "html" '定义静态程序存放的目录
const html_flag = 0 '0为只生成没有的,1为全部重新生成
const temp_name = "~temp.html" '临时文件名称
dim dalu,fsoname
set dalu = new allhtml
call dalu.page_load()
'****************************************************************************************************
class allhtml
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function
sub page_load()
fsoname = checkfso()
'call deltemp()
'response.Write("删除OK")
'response.End()
'on error resume next
call getfile(def_page)
'call checkurl(html_url)
end sub
Function checkfso()
'为了兼容服务器上不同名的FSO
if IsObjInstalled("scripting.daluabc2000fso") then
checkfso = "scripting.daluabc2000fso"
else
checkfso = "scripting.filesystemobject"
end if
end Function
sub getfile(def_page)
dim content,fso,ts
response.Write def_page&"<br />"
call asptohtm(def_page)
'读取文件
set fso = server.CreateObject(fsoname)
set ts = fso.OpenTextFile(server.MapPath(html_url&"/"&temp_name),1)
content = ts.ReadAll
'释放内存
set fso = nothing
set ts = nothing
'正则判断内容里面是否有链接并替换
content = chglink(content,def_page)
end sub
sub writefile(content,page_url)
'把内容写入静态页面
set fso = server.CreateObject(fsoname)
set ts_w = fso.OpenTextFile(server.MapPath(page_url),2,true)
ts_w.write content
'释放内存
set fso = nothing
set ts_w = nothing
end sub
sub deltemp()
set fso = server.CreateObject(fsoname)
if fso.fileExists(server.MapPath(html_url&"/"&temp_name)) then
fso.deletefile(server.MapPath(html_url&"/"&temp_name))
end if
set fso = nothing
end sub
function checkfile(page_url)
set fso = server.CreateObject(fsoname)
if fso.fileExists(server.MapPath(page_url)) then
checkfile = false
else
checkfile = true
end if
'释放内存
set fso = nothing
end function
function chglink(content,page_url)
Dim regEx,Matches,match,str,j
dim part1,part2,part3,part4,part5 '文件名及后缀
dim html_name
j = 0
str = "href="&chr(34)&"([^ /s/t/r/n.:;>"&chr(34)&"]+).([^ /t/r/n.:;>"&chr(34)&"]+)"&chr(34)&"" '设置模板
content = CheckExp(str,content,"href="&chr(34)&"$1.$2"&chr(34)&"")
Set regEx=New RegExp '建立一个新对像
regEx.Pattern=str '设置模板
regEx.IgnoreCase=true '搜索是否区分大小写的 true表是不区分 flase表示区分
regEx.Global=True '搜索是否应用于整个字符串
set Matches = regEx.execute(content)
for each match in Matches
part1 = CheckExp(str,match.value,"$1")
part2 = CheckExp(str,match.value,"$2")
part4 = part1&"."&part2
part3 = part1&tohtml(part2)
'替换链接地址为静态
content = replace(content,chr(34)&part4&chr(34),chr(34)&part3&chr(34))
next
page_url = split(page_url,".")
html_name = page_url(0)&tohtml(page_url(1))
response.Write "生成静态页面"&html_url&"/"&html_name&"<br />"
call writefile(content,html_url&"/"&html_name)
for each match in Matches
part1 = CheckExp(str,match.value,"$1")
part2 = CheckExp(str,match.value,"$2")
part4 = part1&"."&part2
part3 = part1&tohtml(part2)
'递归遍历所有链接
'判断文件是否已经生成
if instr(part4,"asp") then
if checkfile(html_url&"/"&part3) then
call getfile(part4)
end if
end if
next
chglink = content
end function
function tohtml(key)
dim temp
'静态页面生成规则
if instr(key,"css") or instr(key,"js") or instr(key,"html") or instr(key,"htm") or instr(key,"jpg") or instr(key,"gif") then
key = "."&key
elseif instr(key,"?") then
if instr(key,"&") then
key = replace(replace(replace(key,"asp?","_"),"=",""),"&","_")&".html"
else
key = replace(replace(replace(key,"asp?","_"),"=",""),"&","_")&".html"
end if
elseif instr(key,"asp") then
key = ".html"
else
key = key
end if
tohtml = key
end function
Function CheckExp(patrn,strng,tagstr)
Dim regEx,Matches
Set regEx=New RegExp '建立一个新对像
regEx.Pattern=patrn '设置模板
regEx.IgnoreCase=true '搜索是否区分大小写的 true表是不区分 flase表示区分
regEx.Global=True '搜索是否应用于整个字符串
Matches=regEx.replace(strng,tagstr) '匹配并替代字符串
CheckExp=Matches '返回函数结果
end function
function bin2str(bin)
dim tmp,ustr
tmp=""
for i=1 to LenB(bin)-1
ustr=AscB(MidB(bin,i,1))
if ustr>127 then
i=i+1
tmp=tmp&chr(ustr*256+AscB(MidB(bin,i,1)))
else
tmp=tmp&chr(ustr)
end if
next
bin2str=tmp
end function
sub asptohtm(strUrl)
'strUrl = geturl(strUrl)
'读取页面生成静态页面
dim objXmlHttp,objAdoStream
set objXmlHttp = Server.CreateObject("MSXML2.XMLHTTP")
objXmlHttp.open "POST",geturl(strUrl),false
objXmlHttp.send()
binFileData = objXmlHttp.responseBody
'判断是否临时文件是否存在
'call deltemp()
set objAdoStream = Server.CreateObject("ADODB.Stream")
objAdoStream.Type = 1
objAdoStream.Open
objAdoStream.Write(binFileData)
objAdoStream.SaveToFile Server.MapPath(html_url&"/"&temp_name),2
objAdoStream.Close
set objXmlHttp = nothing
set objAdoStream = nothing
end sub
function geturl(strUrl)
dim tem_ary,tem_url
tem_url = request.ServerVariables("url")
tem_ary = split(request.ServerVariables("url"),"/")
tem_url = replace(tem_url,"/"&tem_ary(ubound(tem_ary)),"")
geturl = "http://"&request.ServerVariables("SERVER_NAME")&tem_url&"/"&strUrl
end function
end class
%>
'**************************************************************************************************'
' 大路整站静态生成程序 '
' by 吕鑫 '
' date 2006.3.30 '
' http://www.dalu2000.com '
'***************************************************************************************************
const def_page = "index.asp" '定义程序开始读取的页面
const html_url = "html" '定义静态程序存放的目录
const html_flag = 0 '0为只生成没有的,1为全部重新生成
const temp_name = "~temp.html" '临时文件名称
dim dalu,fsoname
set dalu = new allhtml
call dalu.page_load()
'****************************************************************************************************
class allhtml
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function
sub page_load()
fsoname = checkfso()
'call deltemp()
'response.Write("删除OK")
'response.End()
'on error resume next
call getfile(def_page)
'call checkurl(html_url)
end sub
Function checkfso()
'为了兼容服务器上不同名的FSO
if IsObjInstalled("scripting.daluabc2000fso") then
checkfso = "scripting.daluabc2000fso"
else
checkfso = "scripting.filesystemobject"
end if
end Function
sub getfile(def_page)
dim content,fso,ts
response.Write def_page&"<br />"
call asptohtm(def_page)
'读取文件
set fso = server.CreateObject(fsoname)
set ts = fso.OpenTextFile(server.MapPath(html_url&"/"&temp_name),1)
content = ts.ReadAll
'释放内存
set fso = nothing
set ts = nothing
'正则判断内容里面是否有链接并替换
content = chglink(content,def_page)
end sub
sub writefile(content,page_url)
'把内容写入静态页面
set fso = server.CreateObject(fsoname)
set ts_w = fso.OpenTextFile(server.MapPath(page_url),2,true)
ts_w.write content
'释放内存
set fso = nothing
set ts_w = nothing
end sub
sub deltemp()
set fso = server.CreateObject(fsoname)
if fso.fileExists(server.MapPath(html_url&"/"&temp_name)) then
fso.deletefile(server.MapPath(html_url&"/"&temp_name))
end if
set fso = nothing
end sub
function checkfile(page_url)
set fso = server.CreateObject(fsoname)
if fso.fileExists(server.MapPath(page_url)) then
checkfile = false
else
checkfile = true
end if
'释放内存
set fso = nothing
end function
function chglink(content,page_url)
Dim regEx,Matches,match,str,j
dim part1,part2,part3,part4,part5 '文件名及后缀
dim html_name
j = 0
str = "href="&chr(34)&"([^ /s/t/r/n.:;>"&chr(34)&"]+).([^ /t/r/n.:;>"&chr(34)&"]+)"&chr(34)&"" '设置模板
content = CheckExp(str,content,"href="&chr(34)&"$1.$2"&chr(34)&"")
Set regEx=New RegExp '建立一个新对像
regEx.Pattern=str '设置模板
regEx.IgnoreCase=true '搜索是否区分大小写的 true表是不区分 flase表示区分
regEx.Global=True '搜索是否应用于整个字符串
set Matches = regEx.execute(content)
for each match in Matches
part1 = CheckExp(str,match.value,"$1")
part2 = CheckExp(str,match.value,"$2")
part4 = part1&"."&part2
part3 = part1&tohtml(part2)
'替换链接地址为静态
content = replace(content,chr(34)&part4&chr(34),chr(34)&part3&chr(34))
next
page_url = split(page_url,".")
html_name = page_url(0)&tohtml(page_url(1))
response.Write "生成静态页面"&html_url&"/"&html_name&"<br />"
call writefile(content,html_url&"/"&html_name)
for each match in Matches
part1 = CheckExp(str,match.value,"$1")
part2 = CheckExp(str,match.value,"$2")
part4 = part1&"."&part2
part3 = part1&tohtml(part2)
'递归遍历所有链接
'判断文件是否已经生成
if instr(part4,"asp") then
if checkfile(html_url&"/"&part3) then
call getfile(part4)
end if
end if
next
chglink = content
end function
function tohtml(key)
dim temp
'静态页面生成规则
if instr(key,"css") or instr(key,"js") or instr(key,"html") or instr(key,"htm") or instr(key,"jpg") or instr(key,"gif") then
key = "."&key
elseif instr(key,"?") then
if instr(key,"&") then
key = replace(replace(replace(key,"asp?","_"),"=",""),"&","_")&".html"
else
key = replace(replace(replace(key,"asp?","_"),"=",""),"&","_")&".html"
end if
elseif instr(key,"asp") then
key = ".html"
else
key = key
end if
tohtml = key
end function
Function CheckExp(patrn,strng,tagstr)
Dim regEx,Matches
Set regEx=New RegExp '建立一个新对像
regEx.Pattern=patrn '设置模板
regEx.IgnoreCase=true '搜索是否区分大小写的 true表是不区分 flase表示区分
regEx.Global=True '搜索是否应用于整个字符串
Matches=regEx.replace(strng,tagstr) '匹配并替代字符串
CheckExp=Matches '返回函数结果
end function
function bin2str(bin)
dim tmp,ustr
tmp=""
for i=1 to LenB(bin)-1
ustr=AscB(MidB(bin,i,1))
if ustr>127 then
i=i+1
tmp=tmp&chr(ustr*256+AscB(MidB(bin,i,1)))
else
tmp=tmp&chr(ustr)
end if
next
bin2str=tmp
end function
sub asptohtm(strUrl)
'strUrl = geturl(strUrl)
'读取页面生成静态页面
dim objXmlHttp,objAdoStream
set objXmlHttp = Server.CreateObject("MSXML2.XMLHTTP")
objXmlHttp.open "POST",geturl(strUrl),false
objXmlHttp.send()
binFileData = objXmlHttp.responseBody
'判断是否临时文件是否存在
'call deltemp()
set objAdoStream = Server.CreateObject("ADODB.Stream")
objAdoStream.Type = 1
objAdoStream.Open
objAdoStream.Write(binFileData)
objAdoStream.SaveToFile Server.MapPath(html_url&"/"&temp_name),2
objAdoStream.Close
set objXmlHttp = nothing
set objAdoStream = nothing
end sub
function geturl(strUrl)
dim tem_ary,tem_url
tem_url = request.ServerVariables("url")
tem_ary = split(request.ServerVariables("url"),"/")
tem_url = replace(tem_url,"/"&tem_ary(ubound(tem_ary)),"")
geturl = "http://"&request.ServerVariables("SERVER_NAME")&tem_url&"/"&strUrl
end function
end class
%>
相关文章推荐
- 一个不太完善的ASP整站静态生成程序
- 一个不太完善的ASP整站静态生成程序
- ASP网站数据采集程序制作:一个采集入库生成本地文件的几个FUCTION(可用来生成HTML静态网页)
- ASP网站数据采集程序制作:一个采集入库生成本地文件的几个FUCTION(可用来生成HTML静态网页)
- ASP网站数据采集程序制作:一个采集入库生成本地文件的几个FUCTION(可用来生成HTML静态网页)
- 使用Asp.net mvc + Linq + mvc_scaffold_gen_setup.exe 生成一个完整的家庭帐册大管家程序 之二
- 使用Asp.net mvc + Linq + mvc_scaffold_gen_setup.exe 生成一个完整的家庭帐册大管家程序 之三
- 最近设计了一个生成asp代码的程序,同时也可以作为数据库管理查询的软件,发两张图,等完全做好了,给大家共享!
- 因为公司的产品用asp开发, 前一段时间用asp写了一个生成静态页面并分页的程序,但缘于对.net的热爱,写了这个.net下的生成静态页面并分页的程序。 主要的原理就是替换模板里的特殊字符。
- ASP.NET 2.0中,生成一个静态文件的方法
- ASP中一个很不错的四位数字验证码生成代码 - [ASP程序]
- 自己写了一个通过smarty与php相互结合的例子,动态生成静态程序,写的很烂
- ASP中一个很不错的四位数字验证码生成代码 - [ASP程序]
- 收了100元辛苦费,写了一个最简单的C#ASP.NET的3层架构例子代码,源码是通过代码生成器生成的【写程序的效率神奇的高】
- 使用Asp.net mvc + Linq + mvc_scaffold_gen_setup.exe 生成一个完整的家庭帐册大管家程序 之一
- ASP.NET生成静态文件的一个静态类
- 最近设计了一个生成asp代码的程序,同时也可以作为数据库管理查询的软件,有兴趣的朋友可以去下载!
- 我是一个新手,请问哪位可以用ASP写一个登录程序(急需)
- ASP生成静态Html文件技术杂谈
- 一个spring+hibernate开发的小程序的修改(其中配置文件使用的是HibernateSynchronizer插件生成)