香港虚拟主机
本站公告
新闻资讯
虚拟主机帮助
域名帮助
服务器帮助
邮箱帮助
建站帮助
网站推广帮助
VPS帮助
特色主机帮助
网站备案专题
会员帮助信息
代理帮助信息
成功案例
我司获香港虚拟主机排行榜十…
香港虚拟主机金秋促销活动正…
百度整治给SEO带来了新的希望
百度同时收录网站带WWW和不带…
百度对原创内容的判断标准 如…
如何建设网站 网站建设三步曲
如何挑选老域名 老域名有那些…
域名常见故障与分析
虚拟主机基本参数介绍
交换链接的技巧 谈一下选择交…
您现在的位置: 江南数联 >> 帮助中心 >> 建站帮助 >> 正文

分页类,异常类

  作者:admin    来源:本站原创    点击次数:29     更新时间:2012-10-7 6:52:43  
     
 
关注石头有礼
 
 

分页类,异常类

其它的一些,比如分页类,异常类(用于信息提示),文件操作类(未完成),经常用到的工具类及验证输入的表单验证类(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 我佛山人
' wfsr@cunite.com
'*************************************************
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
%>

本章关健词:江南数联 域名注册 海外虚拟主机 G享虚拟主机 国内虚拟主机 企业邮箱 网站建设 自助建站 400电话申请 微聚商

 
  版权申请:分页类,异常类出自江南数联dns06.com未经授权请勿转载!  
 
  • 上一篇帮助:

  • 下一篇帮助:
  •  
         

    扫一扫关注公众号有礼
    Copyright@2004-2015 江南数联 版权所有未经授权请勿复制!
    《中华人民共和国增值电信业务经营许可证》ISP证编号:皖B2-20080036 湘B2-20160056
    公司全称:永州石头网络技术有限公司(运营部)
    地址: 中国·湖南省永州市育才路158号 服务热线:400 616 9260
    安徽公司:安徽仁科信息技术有限公司 地址:合肥万和新城广场A-608 
    关注词:网站空间虚拟空间空间域名域名空间域名主机网站空间哪家好网站空间多少钱