asp对象化之:模板操作类
发表于:2007-06-30来源:作者:点击数:
标签:
% ’************************************************************* ’转发时请保留此声明信息,这段声明不并会影响你的速度! ’************************************************************* ’*******************************************************
<%
’*************************************************************
’转发时请保留此声明信息,这段声明不并会影响你的速度!
’*************************************************************
’*************************************************************
’@author: 面条
’@realname: 徐仁禄
’@email: xurenlu@sohu.com
’@QQ: 55547082
’@Homepage: http://www.ksdn.net
’@版权申明:
’ 非盈利性质团体或者个人可以免费使用.
’*************************************************************
’ 我敢担保 本程序由本人独立完成 ,没有参考他人的任何程序(参考了本人自己的
php版本的template,不过那个也是本人独立完成的 .)同时本人声明 本class的所有示例版权均为本人所有,任何人或者单位实体不得随意更改
’ 本template可免费用于:
’ 1.个人的非商业性质应用。
’ 2.公益性质团体,如红十字会,孤儿院等等
’
’具体使用方法请看example.asp文件.
’
’adSaveCreateOverWrite
class template
dim adSaveCreateOverWrite
dim adSaveCreateNotExist
public starttag
public endtag
public filename
dim key_arr()
dim val_arr()
public content
public total
public contenta()
public BlockContent ’ 块的内容(解析后的)
public block_begin_delim
public block_end_delim
public block_begin_word
public block_END_word
public block_null
sub Class_Initialize()’ 类的初始化
redim key_arr(0)
redim val_arr(0)
redim contenta(0)
adSaveCreateOverWrite=2
adSaveCreateNotExist=1
starttag="{"
endtag="}"
total=0
block_begin_word="BEGIN"
block_end_word="END"
block_begin_delim="<!--"
block_end_delim="-->"
block_null=" " ’ begin 和end之间用空格隔开
end sub
sub echo (a)
response.write a
end sub
function readfile(filepath)
dim stm2
on error resume next
set stm2 =server.createobject("ADODB.Stream")
stm2.Charset = "gb2312"
stm2.Open
stm2.LoadFromFile filepath
readfile = stm2.ReadText
end function
function writefile(filepath,str)’ 写入文件的函数
dim stm
on error resume next
Set stm = server.createobject("ADODB.Stream")
stm.Charset = "gb2312"
stm.Open
stm.WriteText str
stm.SaveToFile filepath, adSaveCreateOverWrite
end function
function SetFile(file)’ 设置文件,读取文件内容
filename=file
content=readfile(file)
end function
function inarray(val,arr)’val是否在数组arr中
dim tmp,i,rr,re,pt,tt
for i =0 to ubound(arr)
if arr(i)=val then
inarray=i
exit function
end if
next
inarray=-1 ’不在数组中.
end function
function listarray(arr,str)
dim tmp,i,rr,re,pt,tt
str=" " & str
for i=0 to ubound(arr)
echo str & i & ":" & arr(i) &
vbcrlf
next
end function
function NewKey(key,val) ’添加新的键值.
dim tmp,i,rr,re,pt,tt,pos
i=total
pos=inarray(key,key_arr)
if pos=-1 then ’//如果这个键值不存在.
redim Preserve key_arr(i)
redim Preserve val_arr(i)
’echo "key_arr(" & i & ")=" & key & vbcrlf
key_arr(i)=key
val_arr(i)=val
total=total+1
else
key_arr(pos)=key
val_arr(pos)=val
end if
end function
function resetKeys()’ 初始化键名数组
redim key_arr(0)
redim val_arr(0)
total=0
end function
function getTextContent(Tcontent)
dim tmp,i,rr,re,pt,tt
’ 得到把某一个文本段的{}内容替换后的块.
tmp=Tcontent
for i=0 to total -1
tmp=replace(tmp & "",starttag & key_arr(i) & endtag, val_arr(i)& "" ) ’ 替换各个键值.
next
’ 替换{***}类似的东西。
’ 目前暂时先放一放把。
’’
’’
set re=new RegExp
re.Global=True
re.Ignorecase=True
pt="{([a-zA-Z0-9_]{0,100})}"
re.Pattern=pt
set tt=re.Execute(tmp)
for i= 0 to tt.count -1
tmp=replace(tmp & " ", tt.item(i) & "" ,"")
next
set re=nothing
set tt=nothing
’’
’’
getTextContent=tmp
end function
function getText()
dim tmp,i,rr,re,pt,tt
’ 得到把某一个文本段的{}内容替换后的块.
tmp=content
for i=0 to total -1
tmp=replace(tmp & "",starttag & key_arr(i) & endtag & "", val_arr(i) & "" ) ’ 替换各个键值.
next
’ 替换{***}类似的东西。
’ 目前暂时先放一放把。
’’
’’
set re=new RegExp ’ 这里是模式匹配的应用 有正规表达式应用高手的指导一下!
re.Global=True
re.Ignorecase=True
pt="{([a-zA-Z0-9_]{0,100})}"
re.Pattern=pt
set tt=re.Execute(tmp)
for i= 0 to tt.count -1
tmp=replace(tmp & "", tt.item(i) & "","")
next
set re=nothing
set tt=nothing
’’
’’
getText=tmp
content=tmp
end function
function getBlockContent(block)’ 得到模板内容中某一个块的内容
dim i,pos1,pos2,firststr,secondstr,tempstr
firstStr="<!-- BEGIN " & Block & " -->"
secondStr="<!-- END " & Block & " -->"
pos1=instr(content,firststr)
pos2=instr(content,secondstr)
if (pos2-pos1)<=0 then
else
tempstr=mid(content,pos1,pos2-pos1)
tempstr=replace(tempstr,firststr,"")
tempstr=replace(tempstr,secondstr,"")
’response.write replace(tmpstr,"<--","")
end if
’response.end
getBlockContent=tempstr ’ 返回该字符串.
end function
sub tofile(file)’ 输出到某个文件
dim tmp
tmp=gettext()
writefile file,content’ 输出到文件
end sub
function ParseBlock(block) ’ 到到某一个块的解析后的内容.
dim b,tmp
dim firststr,secondstr,tempstr
b=GetBlockContent(block) ’得到某一个块解析前的内容
tmp=getTextContent(b)’得到这个块解析后的内容.
BlockContent=BlockContent & tmp ’ 保存起来拉 哈哈。这样就实现了重复显示某一个块.
firstStr="<!-- BEGIN " & Block & " -->"
secondStr="<!-- END " & Block & " -->"
tmp=replace(tmp,firststr,"")
tmp=replace(tmp,secondstr,"")
ParseBlock=tmp
end function
function replaceBlock(block)’ 把解析了几次的块的内容给替换解析了.
dim con,tmp
dim firststr,secondstr,tempstr
con=GetBlockContent(block) ’得到这个块解析前的内容.
tmp=replace(content & "",con & "",Blockcontent & "")
blockcontent=""
firstStr="<!-- BEGIN " & Block & " -->"
secondStr="<!-- END " & Block & " -->"
tmp=replace(tmp,firststr,"")
tmp=replace(tmp,secondstr,"")
content=tmp
end function
function replaceBlockforNUll(block)’ 把解析了几次的块的内容给替换解析了.
dim tmp,con
con=GetBlockContent(block) ’得到这个块解析前的内容.
tmp=replace(content & "",con & "","")
blockcontent=""
content=tmp
end function
function replaceBlockfor(block,deStr)’ 把解析了几次的块的内容给替换解析了.
dim tmp,con
con=GetBlockContent(block) ’得到这个块解析前的内容.
tmp=replace(content & "",con & "",Dstr)
blockcontent=""
content=tmp
end function
end class
%>
原文转自:http://www.ltesting.net