📄 admin_classcommon.asp
字号:
Public Function StrLength(str)
Dim WINNT_CHINESE
WINNT_CHINESE = (Len("中文") = 2)
If WINNT_CHINESE Then
Dim l, t, c
Dim i
l = Len(str)
t = l
For i = 1 To l
c = Asc(Mid(str, i, 1))
If c < 0 Then c = c + 65536
If c > 255 Then
t = t + 1
End If
Next
strLength = t
Else
strLength = Len(str)
End If
End Function
Public Function ELClng(ByVal lng)
If IsNumeric(lng) Then
If lng-Int(lng)<>0 Then
ELClng = lng
Else
ELClng = Clng(lng)
End If
Else
ELClng = 0
End If
End Function
Public Function ELRequest(strFieldName, requestType)'1：字符串， 2：数字, boolean， 3：过滤字符“'”
If Trim(strFieldName) = "" Then
ELRequest = ""
If requestType = 2 Then ELRequest = 0
Else
ELRequest = Trim(Request(strFieldName))
Select Case requestType
Case 1: ELRequest = Trim(ELRequest)
Case 2:
If ELRequest = "" Then
ELRequest = 0
Else
ELRequest = ELClng(ELRequest)
End If
Case 3: ELRequest = Trim(Replace(ELRequest, "'", "''"))
End Select
End If
End Function
Public Function ELSplit(ByVal Str, Seprate)
If Str = "" Or IsNULL(Str) Then
Dim TempStr
TempStr = Seprate
ELSplit = Split(TempStr, Seprate)
Exit Function
End If
ELSplit = Split(Str, Seprate)
End Function
Public Function ELFormatCurrency(ByVal C)
If Not IsNumeric(C) Then
ELFormatCurrency = "0.00"
Else
If C = 0 Then
ELFormatCurrency = "0.00"
Else
ELFormatCurrency = Replace(FormatCurrency(C), "￥", "")
ELFormatCurrency = Replace(ELFormatCurrency, "$", "")
End If
End If
End Function
Public Function GetTopic(ByVal str, ByVal strlen)
If str = "" Then
GetTopic = ""
Exit Function
End If
If EL_Common.ELCLng(strlen) = 0 Then
GetTopic = str
Exit Function
End If
If EL_Common.ELCLng(strlen) < 0 Then
GetTopic = ""
Exit Function
End If
Dim l, t, c, i, strTemp
str = Replace(Replace(Replace(Replace(str, " ", " "), """, Chr(34)), ">", ">"), "<", "<")
l = Len(str)
t = 0
strTemp = str
strlen = EL_Common.ELCLng(strlen)
For i = 1 To l
c = Abs(Asc(Mid(str, i, 1)))
If c > 255 Then
t = t + 2
Else
t = t + 1
End If
If t >= strlen Then
strTemp = Left(str, i)
Exit For
End If
Next
If strTemp <> str Then
strTemp = strTemp & "…"
End If
GetTopic = Replace(Replace(Replace(Replace(strTemp, " ", " "), Chr(34), """), ">", ">"), "<", "<")
End Function
Public Function Lang(ByVal NString, ByVal DefaultValue)
Dim Root
If NString = "" Then
Lang = DefaultValue
Else
Set Root = LangXML.SelectSingleNode("//"& Replace(NString, ".", "/"))
If Not Root Is Nothing Then Lang = Root.Text
If Lang = "" Then Lang = DefaultValue
End If
End Function
Sub Sort(arr, SortType, DataType) '冒泡排序 1：升序 -1：降序
Dim i, j, l, Temp
l = UBound(arr)
If SortType <> 1 And SortType <> -1 Then
SortType = 1
End If
For i = 0 To l-1
For j = i+1 To l
If DataType = 1 Then
If SortType = 1 Then
If (arr(i) - arr(j)) >0 Then
Temp = arr(i)
arr(i) = arr(j)
arr(j) = Temp
End If
Else
If (arr(i) - arr(j)) <0 Then
Temp = arr(i)
arr(i) = arr(j)
arr(j) = Temp
End If
End If
Else
If StrComp(arr(i),arr(j)) = SortType Then
Temp = arr(i)
arr(i) = arr(j)
arr(j) = Temp
End If
End If
Next
Next
End Sub
Public Function HTMLEncode(ByVal fString)
Dim TempString
If fString = "" Or IsNull(fString) Then
HTMLEncode = ""
Exit Function
Else
TempString = fString
TempString = replace(TempString, ">", ">")
TempString = replace(TempString, "<", "<")
TempString = Replace(TempString, CHR(32), " ")
TempString = Replace(TempString, CHR(34), """)
TempString = Replace(TempString, CHR(39), "'")
TempString = Replace(TempString, CHR(13) & CHR(10), "<BR> ")
TempString = Replace(TempString, CHR(13), "<BR> ")
TempString = Replace(TempString, CHR(10) & CHR(10), "</P><P> ")
TempString = Replace(TempString, CHR(10), "<BR> ")
TempString = Replace(TempString, VBCrLf, "<BR> ")
End If
HTMLEncode = TempString
End Function
Public Function ServerHTMLEncode(ByVal fString)
If fString = "" Or IsNULL(fString) Then
ServerHTMLEncode = ""
Else
ServerHTMLEncode = Server.HTMLEncode(fString)
End If
End Function
Public Function ServerURLEncode(ByVal URL)
If URL = "" Or IsNULL(URL) Then
ServerURLEncode = ""
Else
ServerURLEncode = Server.URLEncode(URL)
End If
End Function
Public Function RemoveHTML(strHTML)
Dim objRegExp, Match, Matches
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "<.+?>"
Set Matches = objRegExp.Execute(strHTML)
For Each Match in Matches
strHtml=Replace(strHTML, Match.Value, "")
Next
RemoveHTML=strHTML
Set objRegExp = Nothing
End Function
Public Function FormatDate(ByVal fDate)
If IsDate(fDate) = False Then fDate = Date()
fDate = FormatDatetime(fDate, 2)
Dim arr
arr = Split(fDate, "-")
FormatDate = arr(0) &"-"& Right("0"& arr(1), 2) &"-"& Right("0"& arr(2), 2)
End Function
Public Sub InsertLog(ByVal LogType, ByVal PostURL, ByVal LogText, ByVal Editor)
Dim LogCmd, tmp, strParameters, wObject, ScriptName
ScriptName = Request.ServerVariables("SCRIPT_NAME")
tmp = Request.ServerVariables("QUERY_STRING")
If tmp <> "" Then
strParameters = "=========== [METHOD: GET] ==========="& VBCRLF & tmp & VBCRLF & VBCRLF
End If
tmp = ""
For Each wObject In Request.Form
tmp = tmp & wObject & "=" & Request.Form(wObject) & VBCRLF
Next
If tmp <> "" Then
strParameters = strParameters &"=========== [METHOD: POST] ==========="& VBCRLF & tmp
End If
If IsNULL(strParameters) Or strParameters = "" Then strParameters = "NULL"
Call InitCommand(LogCmd, "EL_SP_Log")
With LogCmd
.Parameters.Append .CreateParameter("@Type", 3, 1, 4, 0)
.Parameters.Append .CreateParameter("@ArrLogID", 200, 1, 500, "")
.Parameters.Append .CreateParameter("@LogType", 3, 1, 4, LogType)
.Parameters.Append .CreateParameter("@ScriptName", 200, 1, 255, ScriptName)
.Parameters.Append .CreateParameter("@Parameters", 203, 1, LenParameter(strParameters), strParameters)
.Parameters.Append .CreateParameter("@PostURL", 200, 1, 255, PostURL)
.Parameters.Append .CreateParameter("@LogText", 200, 1, 255, LogText)
.Parameters.Append .CreateParameter("@RemoteIp", 200, 1, 15, RemoteIp)
.Parameters.Append .CreateParameter("@Editor", 200, 1, 50, Editor)
.Execute()
End With
Set LogCmd = Nothing
End Sub
Public Sub Pause(ByVal nTime)
Dim i, iStep
iStep = 500000
nTime = ELClng(nTime)
If nTime = 0 Then Exit Sub
If nTime>100 Then nTime = 100
For i = 0 To nTime * iStep
Next
End Sub
Public Sub ShowPage(ByVal URL, ByVal CurrentPage, ByVal PageSizes, ByVal PageCounts, ByVal TotalRowCount, ByVal ItemName, ByVal ItemUnit)
Dim StrHtml, i, ScriptName
ScriptName = EL_CurrentScriptName &"?"
If URL = "" Then
ScriptName = ScriptName & URL
Else
ScriptName = ScriptName & URL &"&"
End If
If CurrentPage > PageCounts Then CurrentPage = PageCounts
Response.Write "<table border=""0"" cellspacing=""1"" cellpadding=""0""><tr><td>"
Response.Write "一共<strong style='color:red'>"& TotalRowCount &"</strong>"& ItemUnit & ItemName &" "
Response.Write "<a href='"& ScriptName &"page=1&pagesizes="& PageSizes &"'>首页</a> "
If CurrentPage = 1 Then
Response.Write "<a disabled>上一页</a> "
Else
Response.Write "<a href='"& ScriptName &"page="& (CurrentPage-1) &"&pagesizes="& PageSizes &"'>上一页</a> "
End If
If CurrentPage >= PageCounts Then
Response.Write "<a disabled>下一页</a> "
Else
Response.Write "<a href='"& ScriptName &"page="& (CurrentPage+1) &"&pagesizes="& PageSizes &"'>下一页</a> "
End If
Response.Write "<a href='"& ScriptName &"page="& PageCounts &"&pagesizes="& PageSizes &"'>尾页</a> "
Response.Write "<strong style='color:red'>"& CurrentPage &"</strong>/<strong>"& PageCounts &"</strong>页 "
Response.Write "<input type='text' onKeyDown=""if(event.keyCode == 13){window.location.href='"& ScriptName &"page="& CurrentPage &"&pagesizes='+this.value;}"" size='3' value='"& PageSizes &"' />"
Response.Write ItemUnit & ItemName &"/页 "
Response.Write "跳转</td><td>"
Response.Write "<input type='text' onKeyDown=""if(event.keyCode == 13){window.location.href='"& ScriptName &"page='+this.value+'&pagesizes="& PageSizes &"';}"" size='3' value='"& CurrentPage &"' />"
Response.Write"</td></tr></table>"
End Sub
Public Sub ShowScriptError()
If Err.Number<>0 Then
Response.Clear()
Dim strError, strURL
strURL = "http://"& Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("URL")
If Trim(Request.ServerVariables("QUERY_STRING")) <>"" Then
strURL = strURL &"?"& Request.ServerVariables("QUERY_STRING")
End If
strError = strError & "<html><head><title>系统错误信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>"
strError = strError & "<link href='Admin_Style.css' type='text/css' rel='stylesheet'><body>"
strError = strError & "<br><table cellpadding=5 cellspacing=1 border=0 width=500 style='border:1px solid #70777b' align=center>"
strError = strError & " <tr align='center' style='background:#0650D2;color:#FFFFFF;font-size:12px;'><td height='25'><strong>系统错误信息</strong></td></tr>"
strError = strError & " <tr style='background:#F0F1F5;font-size:12px;'><td height='100' valign='top'>"
strError = strError & "错误代码：<span class='redText'>" & Err.Number & "</span><br>"
strError = strError & "错误描述：<span class='redText'>" & Err.Description & "</span><br>"
strError = strError & "错误来源：<span class='redText'>" & Err.Source & "</span><br>"
strError = strError & "错误页面：<span class='redText'>" & strURL & "</span><br>"
strError = strError & "</td></tr>"
strError = strError & " <tr align='center' style='background:#F0F1F5;font-size:12px;'><td>"
strError = strError & "<a href='javascript:history.back()'>【返回上页】</a> "
If EL_SendErrorURL <> "" Then
strError = strError & " <a href='"& EL_SendErrorURL &"?"& strURL &"'>【发送错误报告】</a>"
End If
strError = strError & "</td></tr>"
strError = strError & "</table><br>"
strError = strError & "</body></html>"
Err.Clear
Response.Write strError
Call ApplicationTerminate()
End If
End Sub
Public Sub Bottom()
Response.Write "<br>"
Response.Write "<table width=""100%"" border=""0"" align=""bottom"" cellpadding=""0"" cellspacing=""1"">"
Response.Write "<tr><td align=""center"" class=""top_25"">Copyright © 2007 "& SiteName &" All Rights Reserved.</td>"
Response.Write "</tr></table>"
End Sub
End Class
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -