Paging and exception

Others, such as paging, exception (for information prompts), file operation (unfinished), frequently used tool class, and form verification class for verification input (ASP, better use with front-end JS version ):
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
End Sub Private Sub Class_Terminate ()
End Sub Private Function Navigation ()
Dim Nav
If CurrentPageIndex = 1 Then
Nav = Nav & "Homepage"
Else
Nav = Nav & "<a href =" "& Url &" 1 "> homepage </a> <a href =" "& Url & (CurrentPageIndex-1) & ""> previous page </a>"
End If CurrentPageIndex = PageCount Or PageCount = 0 Then
Nav = Nav & "last page"
Else
Nav = Nav & "<a href =" & Url & (CurrentPageIndex + 1) & "> next page </a> <a href =" & Url & PageCount & ""> last page </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%" >>> page <% = Navigation () %>: <B> <% = ICurrentPageIndex %> </B>/<B> <% = PageCount %> </B> page <B> <% = PageSize %> </B> records/pages to <% = SelectMenu () %> total <B> <% = IRecordCount %> </B> records </div>
<%
Else
Response. Write ("<div style =" "text-align: center" "> no record </div> ")
End If
End Sub End Class
%> Exception 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 = "an error is returned. Please wait ..."
. HasError = False
. Redirect = True
End
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 = "prompt message: \ 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"> message </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 () "> [Return] </a> <a href ="/"> [homepage] </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 operation class:
<%
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
%>
Common tool 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
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
End Sub End Class
%>
<%
Dim Util: Set Util = New Utility
%> Input verification class Validator:
<% @ Language = "VBScript" CodePage = "936" %>
<%
'Option Explicit
Class Validator
'*************************************** **********
'Validator for ASP beta 3 server script
'Code by my Buddha Mountain
'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 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
%>