分页类，异常类

其它的一些，比如分页类，异常类（用于信息提示），文件操作类（未完成），经常用到的工具类及验证输入的表单验证类（asp版，配合前台js版使用更佳）：
分页类pager
<%
class pager private iurl
private ipage
private iparam
private ipagesize
private ipagecount
private irecordcount
private icurrentpageindex public property let url(byval purl)
iurl = purl
end property public property get url()
if iurl = "" then
if request.querystring <> "" then
dim query
for each key in request.querystring
if key <> param then
query = query & key & "=" & server.urlencode(request.querystring(key)) & "&"
end if
next
iurl = page & "?" & query & param & "="
else
iurl = page & "?" & param & "="
end if
end if
url =iurl
end property public property let page(byval ppage)
ipage = ppage
end property public property get page()
page = ipage
end property public property let param(byval pparam)
iparam = pparam
end property public property get param()
param = iparam
end property public property let pagesize(byval ppagesize)
ipagesize = ppagesize
end property public property get pagesize()
pagesize = ipagesize
end property public property get pagecount()
if (not ipagecount > 0) then
ipagecount = irecordcount \ ipagesize
if (irecordcount mod ipagesize) > 0 or irecordcount = 0 then 
ipagecount = ipagecount + 1
end if
end if
pagecount = ipagecount
end property public property let recordcount(byval precordcount)
irecordcount = precordcount
end property public property get recordcount()
recordcount = irecordcount
end property public property let currentpageindex(byval pcurrentpageindex)
icurrentpageindex = pcurrentpageindex
end property public property get currentpageindex()
if icurrentpageindex = "" then
if request.querystring(param) = "" then
icurrentpageindex = 1
else
if isnumeric(request.querystring(param)) then
icurrentpageindex = cint(request.querystring(param))
if icurrentpageindex < 1 then icurrentpageindex = 1
if icurrentpageindex > pagecount then icurrentpageindex = pagecount
else icurrentpageindex = 1
end if
end if
end if
currentpageindex = icurrentpageindex
end property private sub class_initialize()
with me
.param = "page"
.pagesize = 10
end with
end sub private sub class_terminate()
end sub private function navigation()
dim nav
if currentpageindex = 1 then
nav = nav & " 首页 上页 "
else
nav = nav & " <a href=""" & url & "1"">首页</a> <a href=""" & url & (currentpageindex - 1) & """>上页</a> "
end if if currentpageindex = pagecount or pagecount = 0 then
nav = nav & " 下页 尾页 "
else
nav = nav & " <a href=""" & url & (currentpageindex + 1) & """>下页</a> <a href=""" & url & pagecount & """>尾页</a> "
end if navigation = nav
end function private function selectmenu()
dim selector
dim i : i = 1
while i <= pagecount
if i = icurrentpageindex then
selector = selector & "<option value=""" & i & """ selected=""true"">" & i &"</option>" & vbcrlf 
else 
selector = selector & "<option value=""" & i & """>" & i &"</option>" & vbcrlf
end if
i = i + 1
wend
selectmenu = vbcrlf & "<select style=""font:9px tahoma"" onchange=""location='" & url & "' + this.value"">" & vbcrlf & selector & vbcrlf & "</select>" & vbcrlf
end function public sub display()
if recordcount > 0 then
%>
<style>b{font:bold}</style>
<div style="text-align:right;width:100%">>>分页 <%=navigation()%> 页次：<b><%=icurrentpageindex%></b>/<b><%=pagecount%></b>页 <b><%=pagesize%></b>个记录/页 转到<%=selectmenu()%>页 共 <b><%=irecordcount%></b>条记录</div>
<%
else
response.write("<div style=""text-align:center"">暂无记录</div>")
end if
end sub end class
%> 异常类exception：
<%
class exception
private iwindow
private itarget
private itimeout
private imode
private imessage
private ihaserror
private iredirect public property let window(byval value)
iwindow = value
end property
public property get window()
window = iwindow
end property public property let target(byval value)
itarget = value
end property
public property get target()
target = itarget
end property public property let timeout(byval value)
if isnumeric(value) then
itimeout = cint(value)
else
itimeout = 3000
end if
end property
public property get timeout()
timeout = itimeout
end property public property let mode(byval value)
if isnumeric(value) then
imode = cint(mode)
else
imode = 1
end if
end property
public property get mode()
mode = imode
end property public property let message(byval value)
if ihaserror then
imessage = imessage & "<li>" & value & "</li>" & vbcrlf
else
ihaserror = true
imessage = "<li>" & value & "</li>" & vbcrlf
end if
end property
public property get message()
message = imessage
end property public property let haserror(byval value)
ihaserror = cbool(value)
end property
public property get haserror()
haserror = ihaserror
end property public property let redirect(byval value)
iredirect = cbool(value)
end property
public property get redirect()
redirect = iredirect
end property private sub class_initialize()
with me
.window = "self"
.target = prepage()
.timeout = 3000
imode = 1
imessage = "出现错误，正在返回，请稍候..."
.haserror = false
.redirect = true
end with
end sub 

private sub class_terminate()
end sub public function prepage()
if request.servervariables("http_referer") <> "" then
prepage = request.servervariables("http_referer")
else
prepage = "/index.asp"
end if
end function public function alert()
dim words : words = me.message
words = replace(words, "<li>", "\n")
words = replace(words, "</li>", "")
words = replace(words, vbcrlf, "")
words = "提示信息：\t\t\t" & words
%>
<script type="text/javascript">
<!--
alert("<%=words%>")
<%=me.window%>.location = "<%=me.target%>"
//-->
</script>
<%
end function public sub throw()
if not haserror then exit sub
response.clear()
select case cint(me.mode)
case 1
%>
<link href="/css/admin.css" rel="stylesheet" type="text/css">
<table class="border-all" cellspacing="1" cellpadding="5" width="50%" align="center" border="0">
<tbody>
<tr> 
<th height="21" align="middle" background="images/th_bg.gif" class="title">提示信息</th>
</tr>
<tr> 
<td align="center" bgcolor="#ffffff" height="40"> 
<table cellspacing="0" cellpadding="0" width="95%" border="0">
<tbody>
<tr> 
<td height="5"></td>
</tr>
<tr> 
<td><%=me.message%></td>
</tr>
<tr>
<td> </td>
</tr>
<tr>
<td align="center"><a href="javascript :history.back()">[返回]</a> <a href="/">[首页]</a> </td>
</tr>
</tbody>
</table>
</td>
</tr>
</tbody>
</table>
<% if redirect then%> <script type="text/javascript">
<!--
settimeout("<%=me.window%>.location='<%=me.target%>'",<%=me.timeout%>)
//-->
</script><%end if%>
<%
case 2
call alert()
case else
response.write message
end select
response.end()
end sub
end class
%> 文件操作类file：
<%
class file private fso
private ipath
private icontent public property let path(byval ppath)
ipath = ppath
end property public property get path()
path = ipath
end property public property let content(byval pcontent)
icontent = pcontent
end property public property get content()
content = icontent
end property private sub class_initialize()
set fso = server.createobject("scripting.filesystemobject")
end sub private sub class_terminate()
set fso = nothing
end sub public sub save()
dim f
set f = fso.opentextfile(server.mappath(path), 2, true)
f.write content
end sub end class
%>
常用的工具类utility：
<%
class utility private reg public function htmlencode(str)
if isnull(str) or isempty(str) or str = "" then
htmlencode = ""
else
dim s : s = str
s = replace(s, "<", "<")
s = replace(s, ">", ">")
s = replace(s, " ", " ")
s = replace(s, vbcrlf, "<br />")
htmlencode = s
end if
end function public function htmlfilter(byval code)
if isnull(code) or isempty(code) then exit function
with reg
.global = true
.pattern = "<[^>]+?>"
end with
code = reg.replace(code, "")
htmlfilter = code
end function public function limit(byval str, byval num)
dim strlen : strlen = len(str)
if strlen * 2 <= num then
limit = str
else
dim strrlen
call rlen(str, strrlen)
if strrlen <= num then
limit = str
else
dim i
dim restr
if strlen > num * 2 then
i = num \ 2
restr = left(str, i)
call rlen(restr, strrlen)
while strrlen < num
i = i + 1
restr = left(str, i)
call rlen(restr, strrlen)
wend
else
i = strlen
restr = str
call rlen(restr, strrlen)
while strrlen > num
i = i - 1
restr = left(str, i)
call rlen(restr, strrlen)
wend
end if
call rlen(right(restr, 1), strrlen)
if strrlen > 1 then
limit = left(restr, i-1) & "…"
else
limit = left(restr, i-2) & "…"
end if
end if
end if
end function public function encode(byval str)
str = replace(str, """", """)
str = replace(str, "'", "'")
encode = str
end function public function encodeall(byval str)
dim m, ms
reg.pattern = "[\x00-\xff]"
set ms = reg.execute(str)
for each m in ms
str = replace(str, m.value, "" & asc(m.value) & ";")
next
encodeall = str
end function

private sub class_initialize()
set reg = new regexp
reg.global = true
end sub
private sub class_terminate()
set reg = nothing
end sub public sub rlen(byref str, byref rl)
with reg
.pattern = "[^\x00-\xff]"
rl = len(.replace(str, ".."))
end with
end sub end class
%>
<%
dim util : set util = new utility
%> 输入验证类validator：
<%@language="vbscript" codepage="936"%>
<%
'option explicit
class validator
'*************************************************
' validator for asp beta 3 服务器端脚本
' code by 我佛山人
' [e-mail]
'*************************************************
private re
private icodename
private icodesessionname public property let codename(byval pcodename)
icodename = pcodename
end property public property get codename()
codename = icodename
end property public property let codesessionname(byval pcodesessionname)
icodesessionname = pcodesessionname
end property public property get codesessionname()
codesessionname = icodesessionname
end property private sub class_initialize()
set re = new regexp
re.ignorecase = true
re.global = true
me.codename = "vcode"
me.codesessionname = "vcode"
end sub private sub class_terminate()
set re = nothing
end sub public function isemail(byval str)
isemail = test("^\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*$", str)
end function public function isurl(byval str)
isurl = test("^http:\/\/[a-za-z0-9]+\.[a-za-z0-9]+[\/=\?%\-&_~`@[\]\':+!]*([^<>""])*$", str)
end function public function isnum(byval str)
isnum= test("^\d+$", str)
end function public function isqq(byval str)
isqq = test("^[1-9]\d{4,8}$", str)
end function public function iszip(byval str)
iszip = test("^[1-9]\d{5}$", str)
end function public function isidcard(byval str)
isidcard = test("^\d{15}(\d{2}[a-za-z0-9])?$", str)
end function public function ischinese(byval str)
ischinese = test("^[\u0391-\uffe5]+$", str)
end function public function isenglish(byval str)
isenglish = test("^[a-za-z]+$", str)
end function public function ismobile(byval str)
ismobile = test("^((\(\d{3}\))|(\d{3}\-))?13\d{9}$", str)
end function public function isphone(byval str)
isphone = test("^((\(\d{3}\))|(\d{3}\-))?(\(0\d{2,3}\)|0\d{2,3}-)?[1-9]\d{6,7}$", str)
end function public function issafe(byval str)
issafe = (test("^(([a-z]*|[a-z]*|\d*|[-_\~!@#\$%\^&\*\.\(\)\[\]\{\}<>\?\\\/\'\""]*)|.{0,5})$|\s", str) = false)
end function public function isnotempty(byval str)
isnotempty = lenb(str) > 0
end function public function isdateformat(byval str, byval format)
if not isdate(str) then
isdateformat = false
exit function
end if if format = "ymd" then
isdateformat = test("^((\d{4})|(\d{2}))([-./])(\d{1,2})\4(\d{1,2})$", str)
else 
isdateformat = test("^(\d{1,2})([-./])(\d{1,2})\\2((\d{4})|(\d{2}))$", str)
end if
end function public function isequal(byval src, byval tar)
isequal = (src = tar)
end function public function compare(byval op1, byval operator, byval op2)
compare = false
if dic.exists(operator) then
compare = eval(dic.item(operator))
elseif isnotempty(op1) then
compare = eval(op1 & operator & op2 )
end if
end function public function range(byval src, byval min, byval max)
min = cint(min) : max = cint(max)
range = (min < src and src < max)
end function public function group(byval src, byval min, byval max)
min = cint(min) : max = cint(max)
dim num : num = ubound(split(src, ",")) + 1
group = range(num, min - 1, max + 1)
end function public function custom(byval str, byval reg)
custom = test(reg, str)
end function public function limit(byval str, byval min, byval max)
min = cint(min) : max = cint(max)
dim l : l = len(str)
limit = (min <= l and l <= max)
end function public function limitb(byval str, byval min, byval max)
min = cint(min) : max = cint(max)
dim l : l =blen(str)
limitb = (min <= l and l <= max)
end function private function test(byval pattern, byval str)
if isnull(str) or isempty(str) then
test = false
else
re.pattern = pattern
test = re.test(cstr(str))
end if
end function public function blen(byval str)
blen = len(replace(str, "[^\x00-\xff]", ".."))
end function private function replace(byval str, byval pattern, byval restr)
re.pattern = pattern
replace = re.replace(str, restr)
end function private function b2s(byval istr) 
dim reval : reval= ""
dim i, code, ncode
for i = 1 to lenb(istr) 
code = ascb(midb(istr, i, 1)) 
if code < &h80 then 
reval = reval & chr(code) 
else 
ncode = ascb(midb(istr, i+1, 1)) 
reval = reval & chr(clng(code) * &h100 + cint(ncode)) 
i = i + 1 
end if 
next
b2s = reval 
end function public function safestr(byval name)
if isnull(name) or isempty(name) then
safestr = false
else
safestr = replace(trim(name), "(\s*and\s*\w*=\w*)|['%&<>=]", "")
end if
end function public function safeno(byval name)
if isnull(name) or isempty(name) then
safeno = 0
else
safeno = (replace(trim(name), "^[\d]*(\d+)[\d\d]*$", "$1"))
end if
end function public function isvalidcode()
isvalidcode = ((request.form(me.codename) = session(me.codesessionname)) and session(me.codesessionname) <> "")
end function public function isvalidpost()
dim url1 : url1 = cstr(request.servervariables("http_referer"))
dim url2 : url2 = cstr(request.servervariables("server_name"))
isvalidpost = (mid(url1, 8, len(url2)) = url2)
end function end class
%>