📄 admin_function.asp
字号:
<%
Function Add_Root_Dir(f_Path)
Dim f_All_Path
If Left(f_Path,1)="/" Then
f_All_Path = FR_ROOT_DIR & f_Path
Else
f_All_Path = FR_ROOT_DIR & "/" & f_Path
End If
If Trim(FR_ROOT_DIR) <> "" Then
f_All_Path = "/" & f_All_Path
End If
Add_Root_Dir = f_All_Path
End Function
'******************************************
'函数名: Pagelist(Url,Url2,Pcount,Curp,Rcount)
'作用:返回分页连接
'参数:Url,Url2,Pcount,Curp,Rcount 地址页面，地址参数，页面总数，当前页，总记录数
'返回值：
'******************************************
Function Pagelist(Url,Url2,Pcount,Curp,Rcount)
Prevpage=Purp-1 '''''上一页
If Prevpage<=0 Then
Prevpage=1
End If
Nextpage=Curp+1 '''''下一页
If NextPage>Pcount Then
Nextpage=Pcount
End If
Dim HtmlStr
response.write "<table width='100%' border='0' align='center'><tr>"
response.write "<form method='post' action='"&url&"?"&url2&"'>"
response.write "<td width='50%' align='left' height='25'>当前页数：<font color='red'>"&curp&"</font> 总页数：<font color='red'>"&pcount&"</font> 共有<font color='red'>"&rcount&"</font>条信息</td>"
response.write "<td width='50%' align='right'>"
response.write "输入页码： <input type='text' name='Gocurrentpage' size='2'>"
response.write "<input type='submit' value='GO' name='B2'>"
''''''显示分页信息'''''''''''''''
if curp>1 then
response.write" <a href='"&url&"?currentpage=1&"&url2&"' title='最前页' class='gj'>首页</a>"
response.write" <a href='"&url&"?currentpage="&prevpage&"&"&url2&"' title='前一页' class='gj'>上页</a>"
else
response.write" 首页"
response.write" 上页"
end if
if curp<pcount then
response.write" <a href='"&url&"?currentpage="&nextpage&"&"&url2&"' title='后一页' class='gj'>下页</a>"
response.write" <a href='"&url&"?currentpage="&pcount&"&"&url2&"' title='最后页' class='gj'>末页</a>"
else
response.write" 下页"
response.write" 末页"
end if
response.write "</td>"
response.write "</form>"
response.write "</tr>"
response.write "</table>"
end function
'******************************************
'函数名: Write Err()
'作用:显示错误信息
'参数:无
'返回值：无
'******************************************
Sub Show_Err()
Err.Clear
Dim HtmlStr
HtmlStr="<table width='90%' border='0' align='center' cellpadding='3' cellspacing='1' class=border>"
HtmlStr=HtmlStr&"<tr>"
HtmlStr=HtmlStr&"<td class=tr>"
HtmlStr=HtmlStr&"<div align='center'><font color='ffffff'><b>错误提示</b></font></div></td>"
HtmlStr=HtmlStr&"</tr>"
HtmlStr=HtmlStr&"<tr class=Td>"
HtmlStr=HtmlStr&"<td><div align='left'>"&ErrMsg&"</div></td>"
HtmlStr=HtmlStr&"</tr>"
HtmlStr=HtmlStr&"<tr>"
HtmlStr=HtmlStr&"<td align='center' class=Td><a href='javascript:history.go(-1)'><< 返回上一页</a></td>"
HtmlStr=HtmlStr&"</tr>"
HtmlStr=HtmlStr&"</table>"
Response.Write HtmlStr
Response.End
End Sub
'******************************************
'函数名: Write Err()
'作用:显示成功信息
'参数:无
'返回值：无
'******************************************
Sub Show_Suc(InFo)
Dim HtmlStr
HtmlStr="<table width='90%' border='0' align='center' cellpadding='3' cellspacing='1' class=border>"
HtmlStr=HtmlStr&"<tr>"
HtmlStr=HtmlStr&"<td class=tr>"
HtmlStr=HtmlStr&"<div align='center'><font color='ffffff'><b>操作成功</b></font></div></td>"
HtmlStr=HtmlStr&"</tr>"
HtmlStr=HtmlStr&"<tr class=Td>"
HtmlStr=HtmlStr&"<td><div align='left'><li>"&InFo&"</li></div></td>"
HtmlStr=HtmlStr&"</tr>"
HtmlStr=HtmlStr&"<tr>"
HtmlStr=HtmlStr&"<td align='center' class=Td><a href='javascript:history.go(-1)'><< 返回上一页</a></td>"
HtmlStr=HtmlStr&"</tr>"
HtmlStr=HtmlStr&"</table>"
Response.Write HtmlStr
End Sub
'******************************************
'函数名: GetUrl(ReStr)
'作用:返回当前地址
'参数:ReStr
'返回值：1返回服务器地址，2返回网页文件地址，0返回完全地址栏地址
'******************************************
Function GetUrl(ReStr)
IF Not isNumeric(ReStr) Then Exit Function
Select Case ReStr
Case 1
GetUrl="http://"&Request.ServerVariables("SERVER_NAME")
Case 2
GetUrl=Request.ServerVariables("URL")
Case 3
GetUrl=Request.ServerVariables("URL")
If Request.ServerVariables("QUERY_STRING")<>"" Then GetURL=GetUrl&"?"& Request.ServerVariables("QUERY_STRING")
Case 0
GetUrl="http://"&Request.ServerVariables("SERVER_NAME")&Request.ServerVariables("URL")
If Request.ServerVariables("QUERY_STRING")<>"" Then GetURL=GetUrl&"?"& Request.ServerVariables("QUERY_STRING")
End Select
End Function
'******************************************
'函数名: GetIp()
'作用:获取用户真实IP函数
'参数:无
'返回值：无
'******************************************
Function GetIP()
GetIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If GetIP = "" Then GetIP = Request.ServerVariables("REMOTE_ADDR")
End Function
'**************************************************
'函数名：strLen
'作 用：求字符串长度。汉字算两个字符，英文算一个字符。
'参 数：str ----要求长度的字符串
'返回值：字符串长度
'**************************************************
Function StrLen(str)
If isNull(str) Or Str = "" Then
strLen = 0
Exit Function
End If
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
Next
strLen=t
Else
strLen=len(str)
End If
End Function
'**************************************************
'函数名：StrLeft
'作 用：截字符串，汉字一个算两个字符，英文算一个字符
'参 数：str ----原字符串
' strlen ----截取长度
'返回值：截取后的字符串
'**************************************************
function StrLeft(str,strlen)
if str="" then
StrLeft=""
exit function
end if
dim l,t,c, i
str=replace(replace(replace(replace(str," "," "),""",chr(34)),">",">"),"<","<")
l=len(str)
t=0
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
StrLeft=left(str,i) & "..."
exit for
else
StrLeft=str
end if
next
StrLeft=replace(replace(replace(replace(StrLeft," "," "),chr(34),"""),">",">"),"<","<")
end function
'**************************************************
'函数名：IsObjInstalled
'作 用：检测组件
'参 数：strClassString ----组件名
'返回值：True 或 False
'**************************************************
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If Err = 0 Then IsObjInstalled = True
If Err = -2147352567 Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function
'**************************************************
'函数名：CheckStr
'作 用：检测ID值
'参 数：Str ----字符
'返回值：True 或 False
'**************************************************
Function CheckStr(Str)
If Not isNumeric(Str) or Str="" then
CheckStr=True
Elseif isNull(Str) then
CheckStr=True
Else
CheckStr=False
End if
End Function
'**************************************************
'函数名：Encode,HTMLDecode
'作 用：转换字符
'参 数：fString
'返回值：
'**************************************************
function Encode(fString)
if not isnull(fString) then
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = Replace(fString, " ", " ")
fString = Replace(fString, CHR(32), " ")
fString = Replace(fString, CHR(34), """)
fString = Replace(fString, CHR(39), "'")
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), "</P><P>")
fString = Replace(fString, CHR(10), "<BR>")
Encode = fString
end if
end function
function HTMLDecode(fString)
if not isnull(fString) then
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = replace(fString, " ", " ")
fString = Replace(fString, "", CHR(13))
fString = Replace(fString, "</P><P>", CHR(10) & CHR(10))
fString = Replace(fString, "<BR>", CHR(10))
HTMLDecode = fString
end if
end function
'**************************************************
'函数名：Buffer()
'作 用：是否绶存输出
'参 数：NumStr
'返回值：1
'**************************************************
Function Buffer(NumStr)
If NumStr=True then
Response.Buffer = True
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 1
Response.Expires = 0
Response.CacheControl = "no-cache"
End if
End Function
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -