ASP常用函数库
清理SQL字符串，防止注入
'在当前位置设置断点，如果出错则给出错误提示并停止运行，否则提示没错，继续运行
'当前位置输出某个变量值
'替换response.write ，偷懒的做法
'在当前位置停止运行，同时检查错误
'输出表格属性，也是一偷懒的做法
'隐藏该标签，如<table ..... <% Hide_This % > >
'禁止某个控件的点击，如<a >,<input ../>等等
'在当前位置显示一个图片，给出帮助信息，点击后弹出提示框
'检查输入值，如果为空，则用-替代，可用于防止保存到数据库的为空值，或某值为空时的显示不规则
'用CSS定义<H6>，显示系统提示信息，如需要，可提供更详细的使用说明
'检查当前recordset是否为空
'清理以,分割的字符串，清理其中的两个分隔符号，去掉前后的符号
'去掉输入参数里的HTML标签，这是其中一个函数
'在新闻标题列表等应用中，只取一定长度的字符，若超过这个长度，则加上...
'这是一组时间函数，是我在做取昨天的日期的时候整理的
'一组根据输入值是否为空而返回同值的函数
<% function Sqlstr(data) sqlstr="'" & replace(data,"'","''") & "'" end function
'在当前位置设置断点，如果出错则给出错误提示并停止运行，否则提示没错，继续运行
sub Chkerr(place) if is_debug = false then exit sub if err then Response.Write "错误发生在:"&place&"<br />错误描述:"&err.description response.End() else Response.Write "<br />在[<font color=""red"">"&place&"</font>]没有发生错误！" end if end sub
'当前位置输出某个变量值
sub Chkstr(str) if is_debug then Response.Write str&"<br />" end sub
'替换response.write ，偷懒的做法
sub Outputx(str) Response.Write str end sub
'在当前位置停止运行，同时检查错误
sub Debug(dstr) if dstr="" then dstr="Debug stops here:--" chkerr dstr outputx "<br />DEBUG STOPS HERE" response.End() end sub
'输出表格属性，也是一偷懒的做法
sub Table_Alt()
response.Write(" width=""98%"" border=""1"" align=""center"" cellpadding=""0"" cellspacing=""1"" bordercolorright=""#000000"" bordercolordark=""#ffffff"" ")
end sub
'隐藏该标签，如<table ..... <% Hide_This % > >
sub Hide_This() outputx " style=""display:none;"" " end sub
'禁止某个控件的点击，如<a >,<input ../>等等
sub Disable_Menu() response.Write " onclick=""return false;"" " end sub
'在当前位置显示一个图片，给出帮助信息，点击后弹出提示框
sub help(str)
str = "-- 帮助 -- \n\n帮助信息:"&str
response.Write "<a href=""#"" onclick=""alert('"&str&"');return false;""><img src=""p/help.gif"" alt="""&replace(replace(str,"\n\n","\n"),"\n","<br />")&""" /></a>"
end sub
'检查输入值，如果为空，则用-替代，可用于防止保存到数据库的为空值，或某值为空时的显示不规则
function Get_Value(x) if isnull(x) or x="" then get_value = "-" else get_value = x end if end function
'用CSS定义<H6>，显示系统提示信息，如需要，可提供更详细的使用说明
sub Sys_Tip(msg) if len(msg)>0 then response.write "<h6>"&msg&"</h6>" end sub
'检查当前recordset是否为空
'用if isrb(rs) then 替代 if rs.bof and rs.eof then '也是一偷懒的方法 function isRb(rs) if rs.bof and rs.eof then isrb = true else isrb = false end if end function
'清理以,分割的字符串，清理其中的两个分隔符号，去掉前后的符号
function Clean_Ary(ary_name) if left(ary_name,1) = "," then ary_name=mid(ary_name,2,len(ary_name)) if right(ary_name,1) = "," then ary_name=mid(ary_name,1,len(ary_name)-1) do while instr(ary_name,",,")<>0 ary_name = replace(ary_name,",,",",") loop clean_ary = ary_name end function
'去掉输入参数里的HTML标签，这是其中一个函数
Function RemoveHTML_A(strText)
Dim nPos1
Dim nPos2
nPos1 = InStr(strText, "<")
Do While nPos1>0
nPos2 = InStr(nPos1+1, strText, ">")
If nPos2>0 Then
strText = Left(strText, nPos1 - 1) & Mid(strText, nPos2 + 1)
Else
Exit Do
End If
nPos1 = InStr(strText, "<")
Loop
RemoveHTML_A = strText
End Function
'在新闻标题列表等应用中，只取一定长度的字符，若超过这个长度，则加上...
function GetTitle(title,content,length)
If length = 0 Then length = 8
if title = "" or isnull(title) then title = left(RemoveHTML_A(content),30)
If Len(title) > length Then
GetTitle = Left(title, length) & ".."
Else
GetTitle = title
End If
end function
'关闭和释放记录集对象 sub RsClose(rst) if isobject(rst) then rst.close set rst = nothing end if end sub '关闭和释放connetion对象 sub DbClose(conn) if isobject(conn) then conn.close set conn = nothing end if end sub '这也是种关闭和释放对象的方法，在页末使用 sub EndPage(rs,conn) set rs = nothing set conn = nothing end sub
'这是一组时间函数，是我在做取昨天的日期的时候整理的
'判断是否是闰年
Function IsLeapYear(yr)
If ((yr Mod 4 = 0 ) And (yr Mod 100 <> 0)) Or (yr Mod 400 = 0) Then
IsLeapYear = True
Else
IsLeapYear = False
End If
End Function
function get_month_last_day(sm)
redim months(12)
months(1)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31"
months(2)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28"
if IsLeapYear(year(date())) then months(2) = months(2) &",29"
months(3)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31"
months(4)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30"
months(5)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31"
months(6)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30"
months(7)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31"
months(8)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31"
months(9)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30"
months(10)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31"
months(11)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30"
months(12)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31"
get_month_last_day = mid(months(sm),len(months(sm))-1,2)
end function
'得到昨天的日期
function get_lastday(this_day)
'outputx "今天是"&this_day&",今年的第["&datediff("d","2005-1-1",this_day)&"]天<br />"
syear = year(this_day)
smonth = month(this_day)
sday = day(this_day)
if sday = 1 then
if smonth = 1 then '去年
get_lastday = cstr(cint(syear)-1)&"-12-31"
else
get_lastday = syear&"-"& cstr(cint(smonth)-1)&"-"&get_month_last_day(cstr(cint(smonth)-1))
end if
else
get_lastday = syear&"-"&smonth&"-"&cstr(sday-1)
end if
end function
'一组根据输入值是否为空而返回同值的函数
'检查是否为空，如是则返回"未填写" function chk_not_input(str) if str="" or isnull(str) then chk_not_input="未填写" else chk_not_input=str end if end function '检查是否为空，返回str类型 function chk_null_str(str) if str="" or isnull(str) then chk_null_str="未填" else chk_null_str=str end if end function '检查是否为空，返回0 function chk_null_0(str) if isnull(str) or str="" or str="-" then chk_null_0="0" else chk_null_0=str end if end function '检查是否为空，为空则用X替换 function chk_null_x(str,x) if str="" or isnull(str) then chk_null_x=x else chk_null_x=str end if end function '检查是否为空，为空则用横线替换 function chk_null_line(str) if str="" or isnull(str) then chk_null_line="-" else chk_null_line=str end if end function %> '''''''''''''''''''''''''''''''''''''''''''弹出信息对话框并做相应处理'''''''''''''''''''''''''''''''''''''''''''''''''
一直使用着，调用很明了，有两种：
1，call alert("弹出返回信息","-1")
2，call alert("跳转某地址","http: //.....")Function alert(message,gourl) message = replace(message,"'","\'") If gourl="" or gourl="-1" then Response.Write ("<script language=javascript>alert('" & message & "');history.go(-1)</script>") Else Response.Write ("<script language=javascript>alert('" & message & "');location='" & gourl &"'</script>") End If Response.End() End Function
'''''''''''''''''''''''''''''''''''''''''''禁止站外提交数据'''''''''''''''''''''''''''''''''''''''''''''''''
主要用在一些权限页面（即凭借用户名密码正确登录后能访问的页）上，直接 call outofsite() 调用检查。
注意：这里就使用了上面的 alert(message,gourl) 函数。Function outofsite() Dim server_v1,server_v2 server_v1=Cstr(Request.ServerVariables("HTTP_REFERER")) server_v2=Cstr(Request.ServerVariables("SERVER_NAME")) if mid(server_v1,8,len(server_v2))<>server_v2 then call alert("\n注意，为确保本站点的安全性：\n● 禁止直接输入网址到达机密页面！\n● 禁止从站点外部非法向本站提交数据！\n● 请使用正确的访问途径合法登录，谢谢合作。","-1") end if End Function
'''''''''''''''''''''''''''''''''''''''''''取得IP地址'''''''''''''''''''''''''''''''''''''''''''''''''
要获得IP值直接使用 call userip() 即可Function Userip() Dim GetClientIP '如果客户端用了代理服务器，则应该用ServerVariables("HTTP_X_FORWARDED_FOR")方法 GetClientIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR") If GetClientIP = "" or isnull(GetClientIP) or isempty(GetClientIP) Then '如果客户端没用代理，应该用Request.ServerVariables("REMOTE_ADDR")方法 GetClientIP = Request.ServerVariables("REMOTE_ADDR") End If Userip = GetClientIP End function
'''''''''''''''''''''''''''''''''''''''''''简易处理较长文本'''''''''''''''''''''''''''''''''''''''''''''''''
我一般是用在首页的新闻标题调用，主要是中文，所以就用个简易的。
比如提取标题只显示12个字。 call conleft(rs("n_title"),12)function conleft(contact,i) if len(contact)>i then contact=left(contact,i) conleft=contact&"..." else conleft=contact end if end function
'''''''''''''''''''''''''''''''''''''''''''登陆验证接口函数'''''''''''''''''''''''''''''''''''''''''''''''''
接口有一定的通用性：）
先 call outofsite() 防止外部注册机提交
requestname和requestpwd 分别表示接受用户名和密码的表单对象的名称
tablename、namefield和pwdfield 分别表示数据库中存放用户信息的表、记录用户名的字段和用户密码的字段。（这里密码是MD5加密，否则请修改函数中的MD5()包含）
reurl 表示正确登录后跳转的地址
注意：这里同样使用了上面的 alert(message,gourl) 函数
有人还有就是增加了验证码，这里说明下：主要是先验证码正确，再检测用户名和密码的，所以本函数与有验证码的登录无大关系。
关于这个还有要增强的，就是每次用户名和密码不正确的记录，连上该帐号测试的IP，一起通过JMAIL发送到管理员信箱，这样管理员就能随时掌握登录的情况。Function chk_regist(requestname,requestpwd,tablename,namefield,pwdfield,reurl) call outofsite() dim cn_name,cn_pwd cn_name=trim(request.form(""&requestname&"")) cn_pwd=trim(request.form(""&requestpwd&"")) if cn_name="" or cn_pwd="" then call alert("请将帐号或密码填写完整，谢谢合作。","-1") response.end() end if Set rs = Server.CreateObject ("ADODB.Recordset") sql = "Select * from "&tablename&" where "&namefield&"='"&cn_name&"'" rs.open sql,conn,1,1 if rs.eof then call alert("警告，非法猜测用户名！","-1") else if rs(""&pwdfield&"")=md5(cn_pwd) then session("cn_name")=rs(""&namefield&"") '这个地方的session名称可以自己修改 response.Redirect(reurl) else call alert("请正确输入用户名和与之吻合的密码。","-1") end if end if End Function
'''''''''''''''''''''''''''''''''''''''''''布尔切换值函数'''''''''''''''''''''''''''''''''''''''''''''''''
主要用在一些双向选择的字段类型上，比如产品的 推荐和不推荐 等
具体如何应用就不详说了，各位慢慢看function pvouch(tablename,fildname,autoidname,indexid) dim fildvalue Set rs = Server.CreateObject ("ADODB.Recordset") sql = "Select * from "&tablename&" where "&autoidname&"="&indexid rs.Open sql,conn,2,3 fildvalue=rs(""&fildname&"") if fildvalue=0 then fildvalue=1 else fildvalue=0 end if rs(""&fildname&"")=fildvalue rs.update rs.close Set rs = Nothing end function
检查数据是否重复，比如注册用户的时候。'检查数据是否重复 Function chkRecord(newValue,chkTable,chkField) Dim chkRecordRs,chkRecordSql,chkValue If Trim(newValue) = "" Then chkValue = false Else chkRecordSql = "Select ID From "&chkTable&" Where "&chkField&" = '"&newValue&"'" Set chkRecordRs = Conn.Execute( chkRecordSql ) If chkRecordRs.Eof Or chkRecordRs.Bof Then chkValue = true Else chkValue = false End If Set chkRecordRs = Nothing End If chkRecord = chkValue End Function
获取在cname表中与id对应的fname的值Function getName(id,cname,fname) If IsNumeric(id) Then Dim getNameRs,getNameSql getNameSql = "Select "&fname&" From "&cname&" Where Id="&Cint(id) Set getNameRs = Conn.Execute (getNameSql) If Not(getNameRs.Eof Or getNameRs.Bof) Then getName = getNameRs(fname) Else getName = "" End If Set getNameRs = Nothing Else getName = "" End If End Function
站点链接检测function checklink(str) dim rs,truelink if (str="http://") then str="" end if if not (str="") then set rs=new regexp rs.ignorecase=true rs.global=true rs.pattern="(http:\/\/((\w)+[.]){1,}([A-Za-z]|[0-9]{1,3})(((\/[\~]*|\\[\~]*)(\w)+)|[.](\w)+)*(((([?](\w)+){1}[=]*))*((\w)+){1}([\&](\w)+[\=](\w)+)*)*)" truelink=rs.test(str) if truelink=false then response.redirect("error.asp?err=site") response.end set rs=nothing end if end if end function
电子邮件地址检测function checkmail(str) dim rs,truemail if not (str="") then set rs=new regexp rs.ignorecase=true rs.global=true rs.pattern="(\w)+[@]{1}((\w)+[.]){1,3}(\w)+" truemail=rs.test(str) if truemail=false then response.redirect("error.asp?err=email") response.end set rs=nothing end if end if end function
'禁止采集页面Sub LockPage() Dim http_reffer,server_name http_reffer=Request.ServerVariables("HTTP_REFERER") server_name=Request.ServerVariables("SERVER_NAME") if CheckAgent()=False Then if http_reffer="" or left(http_reffer,len("http://"&server_name)+1)<>"http://"&server_name&"/" Then Response.Write("<html><body>") Response.Write("<form action='' name=checkrefer id=checkrefer method=post>") Response.Write("</form>") Response.Write("<script>") 'Response.Write("alert('禁止非法访问');") Response.Write("document.all.checkrefer.action=document.URL;") Response.Write("document.all.checkrefer.submit();") Response.Write("</script>") Response.Write("</body></html>") response.end end If End If End Sub'检查当前访问者是否是蜘蛛人 Function CheckAgent() Dim user_agent,allow_agent user_agent=Request.ServerVariables("HTTP_USER_AGENT") allow_agent=split("Baiduspider,Scooter,ia_archiver,Googlebot,FAST-WebCrawler,MSNBOT,Slurp",",") CheckAgent=False for agenti=lbound(allow_agent) to ubound(allow_agent) if instr(user_agent,allow_agent(agenti))>0 Then CheckAgent=True exit For End If Next end Function'身份证校验 Function CheckidCard(idcard) Dim LenCard LenCard=Len(idcard) '判断身份证长度 if not (LenCard = 15 Or LenCard = 18) Then CheckidCard= "身份证长度不是15位或18位" exit Function End If '变量声明区 dim WeightedFactor,VerifyCode,area,birthday,lastnum,Ai,i,Total,Modnum,sex,age,province,sexNum,provinceID WeightedFactor = array(7,9,10,5,8,4,2,1,6,3,7,9,10,5,8,4,2) '为前17位各个数字对应的加权因子 VerifyCode = array(1,0,"x",9,8,7,6,5,4,3,2) '通过模得到的校验码 area="11北京,12天津,13河北,14山西,15内蒙古,21辽宁,22吉林,23黑龙江,31上海,32江苏,33浙江,34安徽,35福建,36江西,37山东,41河南,42湖北,43湖南,44广东,45广西,46海南,50重庆,51四川,52贵州,53云南,54西藏,61陕西,62甘肃,63青海,64宁夏,65新疆,71台湾,81香港,82澳门,91国外" '判断地区 provinceID=left(idcard,2) if instr(area,provinceID)=0 then CheckidCard= "身份证头2位错误" exit function end If '补齐15位卡号 if LenCard= 15 then idcard=left(idcard,6) & "19" & mid(idcard,7,9) '判断生日 birthday= mid(idcard,7,4)+"-"+mid(idcard,11,2)+"-"+mid(idcard,13,2) if not isdate(birthday) then CheckidCard= "生日非法" exit function end If if datediff("yyyy",cdate(birthday),date())<18 then CheckidCard= "你还未满18岁,不可能有身份证的" exit function end If '判断检验码 if len(idcard)=18 then lastnum=int(right(idcard,1)) 'lastnum为18位身份证最后一位 Ai=left(idcard,17) 'Ai为除最后一位字符的字串 For i = 0 To 16 Total = Total + cint(Mid(Ai,i+1,1)) * WeightedFactor(i) 'Total前17位数字与对应的加权因子积的和 Next Modnum=total mod 11 '此数为模,total除以11后的余数 if VerifyCode(Modnum)<>lastnum then CheckidCard= "最后一位校验码不对" exit function end if end If '计算性别 sexNum=mid(idcard,17,1) sex="男性" if (sexNum mod 2) =0 then sex="女性" '计算年龄 age=datediff("yyyy",cdate(birthday),date()) '计算省份 province=mid(area,instr(area,provinceID)+2,3) province=replace(province,",","") CheckidCard= "恭喜,身份证通过校验<br/>" & "您为:" & sex & ",来自于:" & province & ",生日为:" & birthday End Function'设置页面马上过期 Sub PageNoCache() Response.Expires = 0 Response.expiresabsolute = Now() - 1 Response.addHeader "pragma", "no-cache" Response.addHeader "cache-control", "private" Response.CacheControl = "no-cache" Response.Buffer = True Response.Clear Server.ScriptTimeOut=999999999 End Sub'把中文變成unicode function chinese2unicode(Salon) dim i dim Salon_one dim Salon_unicode if Salon="" then Salon="无" for i=1 to len(Salon) Salon_one=Mid(Salon,i,1) Salon_unicode=Salon_unicode&chr(38) Salon_unicode=Salon_unicode&chr(35) Salon_unicode=Salon_unicode&chr(120) Salon_unicode=Salon_unicode& Hex(ascw(Salon_one)) Salon_unicode=Salon_unicode&chr(59) Next chinese2unicode=Salon_unicode End Function
格式日期:Function OracleDate( dt ) dt = CDate( dt ) ' just to be sure OracleDate = Right( "0" & Day(dt), 2 ) & "-" _ & UCase( MonthName(Month(dt), True) ) & "-" _ & Year(dt) End Function
查找字符串的次数:Function search(pSearch, pSearchStr) Dim tempSearch, tempSearchStr, startpos, endpos startpos = 1 Dim ctr ctr = 0 Do While (startpos > 0) endpos = InStr(startpos, LCase(pSearch), LCase(pSearchStr)) If endpos > 0 Then ctr = ctr + 1 startpos = endpos + Len(pSearchStr) Else Exit Do End If Loop search = ctr End Function
'// 去调HTML标签 输出 function delhtml(strhtml) dim objregexp, stroutput set objregexp = new regexp objregexp.ignorecase = true objregexp.global = true objregexp.pattern = "(<[a-za-z].*?>)|(<[\/][a-za-z].*?>)" stroutput = objregexp.replace(strhtml, "") stroutput = replace(stroutput, "<", "<") stroutput = replace(stroutput, ">", ">") delhtml = stroutput set objregexp = nothing end function
<%
'程序参数说明 'PapgeSize 定义分页每一页的记录数 'GetRS 返回经过分页的Recordset此属性只读 'GetConn 得到数据库连接 'GetSQL 得到查询语句 '程序方法说明 'ShowPage 显示分页导航条,唯一的公用方法 '=================================================================== Const Btn_First="<font face=""webdings"">9</font>" '定义第一页按钮显示样式 Const Btn_Prev="<font face=""webdings"">3</font>" '定义前一页按钮显示样式 Const Btn_Next="<font face=""webdings"">4</font>" '定义下一页按钮显示样式 Const Btn_Last="<font face=""webdings"">:</font>" '定义最后一页按钮显示样式 Const XD_Align="Center" '定义分页信息对齐方式 Const XD_Width="100%" '定义分页信息框大小 Class Xdownpage Private XD_PageCount,XD_Conn,XD_Rs,XD_SQL,XD_PageSize,Str_errors,int_curpage,str_URL,int_totalPage,int_totalRecord,XD_sURL '================================================================= 'PageSize 属性 '设置每一页的分页大小 '================================================================= Public Property Let PageSize(int_PageSize) If IsNumeric(Int_Pagesize) Then XD_PageSize=CLng(int_PageSize) Else str_error=str_error & "PageSize的参数不正确" ShowError() End If End Property Public Property Get PageSize If XD_PageSize="" or (not(IsNumeric(XD_PageSize))) Then PageSize=10 Else PageSize=XD_PageSize End If End Property '================================================================= 'GetRS 属性 '返回分页后的记录集 '================================================================= Public Property Get GetRs() Set XD_Rs=Server.createobject("adodb.recordset") XD_Rs.PageSize=PageSize XD_Rs.Open XD_SQL,XD_Conn,1,1 If not(XD_Rs.eof and XD_RS.BOF) Then If int_curpage>XD_RS.PageCount Then int_curpage=XD_RS.PageCount End If XD_Rs.AbsolutePage=int_curpage End If Set GetRs=XD_RS End Property '================================================================ 'GetConn 得到数据库连接 '================================================================ Public Property Let GetConn(obj_Conn) Set XD_Conn=obj_Conn End Property '================================================================ 'GetSQL 得到查询语句 '================================================================ Public Property Let GetSQL(str_sql) XD_SQL=str_sql End Property '================================================================== 'Class_Initialize 类的初始化 '初始化当前页的值 '================================================================== Private Sub Class_Initialize '======================== '设定一些参数的黙认值 '======================== XD_PageSize=10 '设定分页的默认值为10 '======================== '获取当前面的值 '======================== If request("page")="" Then int_curpage=1 ElseIf not(IsNumeric(request("page"))) Then int_curpage=1 ElseIf CInt(Trim(request("page")))<1 Then int_curpage=1 Else Int_curpage=CInt(Trim(request("page"))) End If End Sub '==================================================================== 'ShowPage 创建分页导航条 '有首页、前一页、下一页、末页、还有数字导航 '==================================================================== Public Sub ShowPage() Dim str_tmp XD_sURL = GetUrl() int_totalRecord=XD_RS.RecordCount If int_totalRecord<=0 Then str_error=str_error & "总记录数为零，请输入数据" Call ShowError() End If If int_totalRecord="" then int_TotalPage=1 Else If int_totalRecord mod PageSize =0 Then int_TotalPage = CLng(int_TotalRecord / XD_PageSize * -1)*-1 Else int_TotalPage = CLng(int_TotalRecord / XD_PageSize * -1)*-1+1 End If End If If Int_curpage>int_Totalpage Then int_curpage=int_TotalPage End If '================================================================== '显示分页信息，各个模块根据自己要求更改显求位置 '================================================================== response.write "" str_tmp=ShowFirstPrv response.write str_tmp str_tmp=showNumBtn response.write str_tmp str_tmp=ShowNextLast response.write str_tmp str_tmp=ShowPageInfo response.write str_tmp response.write "" End Sub '==================================================================== 'ShowFirstPrv 显示首页、前一页 '==================================================================== Private Function ShowFirstPrv() Dim Str_tmp,int_prvpage If int_curpage=1 Then str_tmp=Btn_First&" "&Btn_Prev Else int_prvpage=int_curpage-1 str_tmp="<a href="""&XD_sURL & "1" & """>" & Btn_First&"</a> <a href=""" & XD_sURL & CStr(int_prvpage) & """>" & Btn_Prev&"</a>" End If ShowFirstPrv=str_tmp End Function '==================================================================== 'ShowNextLast 下一页、末页 '==================================================================== Private Function ShowNextLast() Dim str_tmp,int_Nextpage If Int_curpage>=int_totalpage Then str_tmp=Btn_Next & " " & Btn_Last Else Int_NextPage=int_curpage+1 str_tmp="<a href=""" & XD_sURL & CStr(int_nextpage) & """>" & Btn_Next&"</a> <a href="""& XD_sURL & CStr(int_totalpage) & """>" & Btn_Last&"</a>" End If ShowNextLast=str_tmp End Function '==================================================================== 'ShowNumBtn 数字导航 '==================================================================== Private Function showNumBtn() Dim i,str_tmp For i=1 to int_totalpage str_tmp=str_tmp & "[<a href=""" & XD_sURL & CStr(i) & """>"&i&"</a>] " Next showNumBtn=str_tmp End Function '==================================================================== 'ShowPageInfo 分页信息 '更据要求自行修改 '==================================================================== Private Function ShowPageInfo() Dim str_tmp str_tmp="页次:"&int_curpage&"/"&int_totalpage&"页 共"&int_totalrecord&"条记录 "&XD_PageSize&"条/每页" ShowPageInfo=str_tmp End Function '================================================================== 'GetURL 得到当前的URL '更据URL参数不同，获取不同的结果 '================================================================== Private Function GetURL() Dim strurl,str_url,i,j,search_str,result_url search_str="page=" strurl=Request.ServerVariables("URL") Strurl=split(strurl,"/") i=UBound(strurl,1) str_url=strurl(i)'得到当前页文件名 str_params=Trim(Request.ServerVariables("QUERY_STRING")) If str_params="" Then result_url=str_url & "?page=" Else If InstrRev(str_params,search_str)=0 Then result_url=str_url & "?" & str_params &"&page=" Else j=InstrRev(str_params,search_str)-2 If j=-1 Then result_url=str_url & "?page=" Else str_params=Left(str_params,j) result_url=str_url & "?" & str_params &"&page=" End If End If End If GetURL=result_url End Function '==================================================================== ' 设置 Terminate 事件。 '==================================================================== Private Sub Class_Terminate XD_RS.close Set XD_RS=nothing End Sub '==================================================================== 'ShowError 错误提示 '==================================================================== Private Sub ShowError() If str_Error <> "" Then Response.Write("" & str_Error & "") Response.End End If End Sub End class set conn = server.CreateObject("adodb.connection") conn.open "driver={microsoft access driver (*.mdb)};dbq=" & server.Mappath("pages.mdb") '#############类调用样例################# '创建对象 Set mypage=new xdownpage '得到数据库连接 mypage.getconn=conn 'sql语句 mypage.getsql="select * from [test] order by id asc" '设置每一页的记录条数据为5条 mypage.pagesize=5 '返回Recordset set rs=mypage.getrs() '显示分页信息，这个方法可以，在set rs=mypage.getrs()以后,可在任意位置调用，可以调用多次 mypage.showpage() '显示数据 Response.Write("<br/>") for i=1 to mypage.pagesize '这里就可以自定义显示方式了 if not rs.eof then response.write rs(0) & "<br/>" rs.movenext else exit for end if next %>
日历类:<% Class caDataGrid 'private variables private pAutoColumns, pConnStr, pSqlStr, intColCnt Private pOutPut, pConn, pRec, x, y, pArray 'this runs when you create a reference to the caDataGrid class Private Sub Class_Initialize() Set pConn = server.createobject("adodb.connection") Set pRec = server.createobject("adodb.recordset") intColCnt = 0 pAutoColumns = True End Sub 'Properties - all writable Public Property Let ConnectionString(strConn) pConnStr = strConn End Property Public Property Let AutoColumns(bAutoCols) If bAutoCols = True or bAutoCols = False then pAutoColumns = bAutoCols End IF End Property Public Property Let SqlString(strSql) pSqlStr = strSql End Property 'Methods for our class Public Sub AddColumn(strColName) If intColCnt = 0 then pOutPut = "<table width='100%' border=1 cellpadding=0 cellspacing=0>" & vbcrlf pOutPut = pOutPut & "<tr>" & vbcrlf End If pOutPut = pOutPut & "<td><strong>" & strColName & "</strong></td>" & vbcrlf intColCnt = intColCnt + 1 End Sub Public Sub Bind pConn.Open pConnStr Set pRec = pConn.Execute(pSqlStr) If pAutoColumns = True then 'assign column names from returned recordset pOutPut = "<table width='100%' border=1 cellpadding=0 cellspacing=0>" & vbcrlf pOutPut = pOutPut & "<tr>" & vbcrlf Redim pColNames(pRec.Fields.Count) For x = 0 to pRec.Fields.Count - 1 pOutPut = pOutPut & "<td>" & pRec.Fields(x).Name & "</td>" & vbcrlf Next End If pOutPut = pOutPut & "</tr>" & vbcrlf pArray = pRec.GetRows For x = 0 to UBound(pArray, 2) pOutPut = pOutPut & "<tr>" & vbcrlf For y = 0 to UBound(pArray, 1) pOutPut = pOutPut & "<td>" & pArray(y, x) & "</td>" & vbcrlf Next pOutPut = pOutPut & "</tr>" & vbcrlf Next pOutPut = pOutPut & "</table>" & vbcrlf Response.Write pOutPut End Sub 'this runs when we destroy our reference to caDataGrid Private Sub Class_Terminate() pOutPut = "" pRec.Close Set pRec = nothing pconn.close Set pConn = nothing End Sub End Class %>日历类function getdata ($month=NULL,$year=NULL,$appointment=array()) { $month = ( $month ==NULL )? date("n"):$month; $year = ( $year ==NULL )? date("Y"):$year; $weekday_cn = array("日","一","二","三","四","五","六"); // //先判断月份以及是不是2月和闰月 // //可以用一个数组来代替 //设定数组下标为月份数，值为天数，根据月份数返回对应的值（天数） // if ($month !=2) { switch ($month) { case 1: $day = 31; break; case 3: $day = 31; break; case 4: $day = 30; break; case 5: $day = 31; break; case 6: $day = 30; break; case 7: $day = 31; break; case 8: $day = 31; break; case 9: $day = 30; break; case 10: $day = 31; break; case 11: $day = 30; break; case 12: $day = 31; break; } }else{ if (date("L",mktime(0,0,0,$month,0,$year))) { $day = 29; }else{ $day = 28; } } //得到开始的第一天是星期几 $start_day = (int)date("w",mktime(0,0,0,$month,date("j",mktime(0,0,0,$month,1,$year)),$year)); //日期从1开始计数 $n=1; //得到今天是几号 $today=(int)date("j"); //打印表头 echo "<table width=\"200\" border=\"0\" cellspacing=\"1\" cellpadding=\"2\" class=\"calendar_table\"><tr class=\"calendar_tr_header\">"; echo "<th colspan=\"7\" scope=\"col\" class=\"calendar_th_header\">".$year."年".$month."月"."</th></tr>\n"; echo "<tr align=\"center\" class=\"calendar_tr_week\">"; for ($i=0;$i<count($weekday_cn);$i++) { echo "<th scope=\"col\" class=\"calendar_th_week\">".$weekday_cn[$i]."</th>\n"; } echo "</tr>"; //打印第一行 echo "<tr align=\"center\" class=\"calendar_tr_day\"> \n"; for ($i=0;$i<$start_day;$i++) echo "<td class=\"calendar_td_day\"> </td>\n"; for ($j=0;$j<(7-$start_day);$j++) { # $url_n = "<a href=\"".$appointment[$n]."\" class=\"calendar_app_day\">".$n."</a>"; $str_n = ( $appointment[$n] ==NULL )?$n:( "<a href=\"".$appointment[$n]."\" class=\"calendar_app_url\">".$n."</a>" ); $table_td= ($today ==$n)?("<td class=\"calendar_td_today\"><span class=\"calendar_app_today\">".$str_n."</span></td>"):("<td class=\"calendar_td_day\">".$str_n."</td>"); echo $table_td; $n++; } echo "</tr>\n"; //已显示多少天 $m=($n-1); //根据剩余天数除以7得到的商，用ceil()取整后，确定最后需要显示多少行 for($i=0;$i<(ceil($day-$m)/7);$i++){ echo "<tr align=\"center\" class=\"calendar_tr_day\"> "; //每行7天7个单元格 for ($j=0;$j<7;$j++) { if ($n<=$day) { $str_n = ( $appointment[$n] ==NULL )?$n:( "<a href=\"".$appointment[$n]."\" class=\"calendar_app_url\">".$n."</a>" ); //显示是否是当日 $table_td= ($today ==$n)?("<td class=\"calendar_td_today\"><span class=\"calendar_app_today\">".$n."</span></td>"):("<td class=\"calendar_td_day\">".$n."</td>"); echo $table_td; $n++; }else{ //余下的空格显示 echo "<td class=\"calendar_td_day\"> </td>\n"; } } echo "</tr>"; } echo "</table>"; }
方法有点笨，不过还算能用。也可以从外部定义CSS。
使用方法：
/*
//使用方法
//getdata();
//或给出月份和年度信息
//getdata(1,2006);
//
//CSS控制关键词
//
//calendar_table 整个表格
//calendar_tr_header 表格头部年月信息行
//calendar_th_header 表格头部年月信息单元格
//calendar_tr_week 星期行
//calendar_th_week 星期单元格
//calendar_tr_day 日期行
//calendar_td_day 日期单元格
//calendar_app_url 日程安排链接
//calendar_td_today 显示当日的单元格
//calendar_app_day 有日程安排的单元格
*/
Access 数据添加修改，写烦了只有这么投懒了！
====================类=================
Class Updata
Private UD_Conn,UD_Rs,UD_Record,UD_Data,UD_Sql
Public Property Let GetConn(obj_conn)
UD_Conn = obj_conn
End Property
'Public Property Set SetRs()
'Set UD_Rs = Server.CreateObject("ADODB.Recordset")
'End Property
public Property Let GetSql(str_sql)
UD_Sql = str_sql
End Property
Public Property Let GetRecord(arr_record)
UD_Record = arr_record
End Property
public Property Let GetData(arr_data)
UD_Data = arr_data
End Property
Private Sub FillData
Dim I,J
J = Ubound(UD_Record)
For I = 0 To J
UD_Rs(UD_Record(I)).Value = UD_Data(I)
Next
End Sub
Public Sub UD_AddNew
Set UD_Rs = Server.CreateObject("ADODB.Recordset")
UD_Rs.Open UD_Sql,UD_Conn,3,2
UD_Rs.AddNew
FillData
UD_Rs.Update
UD_Rs.Close
Set UD_Rs = Nothing
End Sub
Public Sub UD_Update
Set UD_Rs = Server.CreateObject("ADODB.Recordset")
UD_Rs.Open UD_Sql,UD_Conn,3,2
FillData
UD_Rs.Update
UD_Rs.Close
Set UD_Rs = Nothing
End Sub
End Class
===============实例=============
OpenDB
Set UD = new UpData
UD.GetConn = Conn
UD.GetSql = "Select * From Clinet Where 1=0"
UD.GetRecord =Array(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20)
UD.GetData = Array(Req("ClinetName"),Req("Sex"),Req("PID"),Req("Marriage"),Req("Know"),Req("BirthDay"),Req("Nation"),Req("FamMemb"),Req("HomePage"),Req("Email"),Req("HomeTel"),Req("WorkTel"),Req("Mobile"),Req("Zip"),Req("Address"),Req("Msn"),Req("QQ"),Req("Company"),Req("Job"),Req("Remark"))
UD.UD_AddNew
Set UD = Nothing
CloseDB
Call Msg(Array("添加成功","Clinet_Manage.asp"),3)
分页函数。
<%
'翻页函数
'传入参数： Rs_tmp (记录集), PageSize (每页显示的记录条数)
'输 出： 记录集翻页显示功能
Sub TurnPage(ByRef Rs_tmp,PageSize) 'Rs_tmp 记录集 ; PageSize 每页显示的记录条数;
Dim TotalPage '总页数
Dim PageNo '当前显示的是第几页
Dim RecordCount '总记录条数
Rs_tmp.PageSize = PageSize
RecordCount = Rs_tmp.RecordCount
TotalPage = INT(RecordCount / PageSize * -1)*-1
PageNo = Request.QueryString ("PageNo")
'直接输入页数跳转；
If Request.Form("PageNo")<>"" Then PageNo = Request.Form("PageNo")
'如果没有选择第几页，则默认显示第一页；
If PageNo = "" then PageNo = 1
If RecordCount <> 0 then
Rs_tmp.AbsolutePage = PageNo
End If
'获取当前文件名，使得每次翻页都在当前页面进行；
Dim fileName,postion
fileName = Request.ServerVariables("script_name")
postion = InstrRev(fileName,"/")+1
'取得当前的文件名称，使翻页的链接指向当前文件；
fileName = Mid(fileName,postion)
%>
<script language="JavaScript">
<!--
function test(){
if (document.gopage.PageNo.value=="" || isNaN(document.gopage.PageNo.value)) {
alert("输入页数必须为数字");
document.gopage.PageNo.focus();
return false;
}
return true;
}
// --></script>
<table border=0 width='100%' cellspacing="0" cellpadding="0">
<tr>
<td align=left width="254"> 总共：<font color=#ff3333><%=TotalPage%></font>页
当前：<font color=#ff3333><%=PageNo%></font>页 每页<font color=#ff3333>20</font>个客户</td>
<td align="right"> <%If RecordCount = 0 or TotalPage = 1 Then
Response.Write "首页|前页|后页|末页"
Else%> <a href="<%=fileName%>?PageNo=1">首页|</a> <%If PageNo - 1 = 0 Then
Response.Write "前页|"
Else%> <a href="<%=fileName%>?PageNo=<%=PageNo-1%>">前页|</a> <%End If
If PageNo+1 > TotalPage Then
Response.Write "后页|"
Else%> <a href="<%=fileName%>?PageNo=<%=PageNo+1%>">后页|</a> <%End If%> <a href="<%=fileName%>?PageNo=<%=TotalPage%>">末页</a>
<%End If%></td>
<form onSubmit="return test();" name=gopage action=allclient_op.asp method=get>
<td width=124 align=right>
<table width="100%" border="0" cellspacing="0" cellpadding="0">
<tr>
<td align=right>转到第</td>
<td><%If TotalPage = 1 Then%>
<input type=text name=PageNo size=3 readonly disabled style="background:#d3d3d3" class=input>
<%Else%>
<input type=text name=PageNo size=3 value="" class=input maxlength=4 title=请输入页号,然后回车>
<%End If%>页
<input type="submit" value="go" name=button class=bo>
</td>
</tr>
</table>
</td>
</form>
</tr>
</table>
<%End Sub%>
把这个函数做到一个文件里。比如inc_page.asp。然后只要是会用到分页。就用
<!--#include file="inc_page.asp"-->
<%
'数据库链接语句和sql语句略
%>
dim RowCount
RowCount = 20 '每页显示的记录条数
<%
call TurnPage(rs,RowCount)
%>
'OK，大家可以试试，很方便，现在我在做分页程序时都用它。
分页形式如下：
首页 上一页 下一页 尾页 转到：页
