Paging and exception

Source: Internet
Author: User
Tags servervariables

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
%>

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.