📄 ms_publicfunction.asp
字号:
<%'==============================================================
'程序名称：茂盛网站管理系统(Maoin CSM)
'当前版本：Maosin CMS Version 1.1 Powered by maosin.com
'程序作者：阿茂（李胜茂）
'网站地址：www.maosin.com www.maosin.net
' QQ：57861417
'电子邮箱：maosin@163.com maosin@maosin.com
'--------------------------------------------------------------
'Copyright (C) 2006 maosin.com All Rights Reserved.
'免费版本请在程序首页保留(Powered by：Maosin CMS)版权链接信息；
'您可以对此版本进行修改，美化，但请保留此ASP文件内的版权信息；
'茂盛设计网保留此软件的法律追究权利
'==============================================================
Sub parentClass(sql,url,parent_id,parent_menu,child_table,child_id,child_title)
dim classMenu,classStr
classMenu=application("classMenu"&url)
if isEmpty(classMenu) then
Set parentRS=Server.CreateObject("ADODB.RecordSet")
parentRS.Open sql,connstr,1,1
catID=request("catID")
classID=request("classID")
Do while Not parentRS.EOF
menuid=parentRS(parent_id)
title=parentRS(parent_menu)
classStr=classStr&"<div class=""classList"">【<a href="&url&"?"&parent_id&"="&menuid&">"
if cstr(menuid)=cstr(catID) and classID="" then
classStr=classStr&"<font color=""#ff4444"">"&title&"</font>"
else
classStr=classStr&title
end if
classStr=classStr&"</a>】 "
classStr=classStr&childClass(url,parent_id,menuid,child_table,child_id,child_title)
classStr=classStr&"</div>"
parentRS.MoveNext
Loop
parentRS.close
Set parentRS=Nothing
application("classMenu"&url)=classStr
response.write(classStr)
else
response.write(classMenu)
end if
End Sub
Function childClass(url,parent_id,menuid,child_table,child_id,child_title)
i=0
Csql="select * from "&child_table&" where "&parent_id&"="&menuid&" ORDER BY classID ASC"
Set menuClass=Server.CreateObject("ADODB.RecordSet")
menuClass.open Csql,connstr,1,1
classID=request("classID")
Do while Not menuClass.EOF
If i<8 Then'每行显子分类数
If cstr(menuClass("classID"))=cstr(classID) Then
childClass=childClass&"<a href="&url&"?"&parent_id&"="&menuid&"&"&"classID="&menuClass(child_id)&"><font color='#ff4444'>"&menuClass(child_title)&"</font></a> "
Else
childClass=childClass&"<a href="&url&"?"&parent_id&"="&menuid&"&"&"classID="&menuClass(child_id)&">"&menuClass(child_title)&"</a> "
End If
Else
nbsp="<br> "
If cstr(menuClass("classID"))=cstr(classID) Then
childClass=childClass &"<a href="&url&"?"&parent_id&"="&menuid&"&"&"classID="&menuClass(child_id)&"><font color='#ff4444'>"&menuClass(child_title)&"</font></a> "
Else
childClass=childClass &"<a href="&url&"?"&parent_id&"="&menuid&"&"&"classID="&menuClass(child_id)&">"&menuClass(child_title)&"</a> "
End If
i=0
End If
menuClass.MoveNext
i=i+1
Loop
menuClass.close
Set menuclass=Nothing
End Function
Function pagetitle(rs,n,URL,text)
dim alpage
%>
<Script Language="JavaScript">
function selectpage(obj){
window.location.href="<%=URL%>page=" + obj.options[obj.selectedIndex].value;
}
</Script>
<% rs.pagesize=n
alpage=request("page")
if isInteger(alpage)=false then
alpage=1
end if
if cint(rs.pagecount)<=cint(alpage) then
alpage=rs.pagecount
end if
If rs.RecordCount>n Then
If alpage="" Then
rs.AbsolutePage=1
Else
rs.AbsolutePage=cint(alpage)
End If
pagetitle="<table width=""100%"" border=""0"" cellpadding=""0"" cellspacing=""0"" class=""text""><tr><td align=""left""> <img src=""images/cha.gIf"" align=""absmiddle"" border=""0""> "
pagetitle=pagetitle&"共有<font color=""#ff0000"">"&rs.RecordCount&"</font>"&text&" 页次：<font color=""#ff0000"">"&rs.AbsolutePage&"</font>/"&rs.PageCount&"页"
pagetitle=pagetitle&" 每页<font color=#ff0000>"&rs.pagesize&"</font>条"
If rs.AbsolutePage>1 Then
pagetitle=pagetitle&" <a href="&URL&"page=1><font face=Webdings>9</font>首页</a>"
Else
pagetitle=pagetitle&" <font face=Webdings>9</font>首页"
End If
If rs.AbsolutePage>1 Then
pagetitle=pagetitle&" <a href="&URL&"page="&rs.AbsolutePage-1&">上一页</a>"
Else
pagetitle=pagetitle&" 上一页"
End If
If rs.AbsolutePage<rs.PageCount Then
pagetitle=pagetitle&" <a href="&URL&"page="&rs.AbsolutePage+1&">下一页</a>"
Else
pagetitle=pagetitle&" 下一页"
End If
If rs.AbsolutePage<rs.PageCount Then
pagetitle=pagetitle&" <a href="&URL&"page="&rs.PageCount&">尾页<font face=Webdings>:</font></a>"
Else
pagetitle=pagetitle&" 尾页<font face=Webdings>:</font>"
End If
pagetitle=pagetitle&" </td><td valign=""middle"" align=""right"">"
pagetitle=pagetitle&"<select name=""pages"" onChange=""selectpage(this)"">"
i=1
For i=1 To rs.pagecount
If i=cint(alpage) Then
pagetitle=pagetitle&"<option value="&i&" selected>第"&i&"页</option>"
Else
pagetitle=pagetitle&"<option value="&i&">第"&i&"页</option>"
End If
Next
pagetitle=pagetitle&"</select> "
pagetitle=pagetitle&"</td></tr></table>"
End If
End Function
Sub UpAndNext(dataTable,id,url,idfield,titlefield,text)
UpSql="SELECT TOP 1 * FROM "&dataTable&" where "&idfield&"<"&id&" and pass=true ORDER BY "&idfield&" DESC"
Set UpRS=Server.CreateObject("ADODB.RecordSet")
UpRS.Open UpSql,connstr,1,1
response.write("<table width=""100%"" border=""0"" cellpadding=""6"" cellspacing=""0"" class=""text""><tr><td style=""line-height:20px;"">")
If UpRS.Eof And UpRS.Bof Then
response.write("上一"&text&"：<font color=#FF0000>没有上一"&text&"</font>")
Else
response.write("上一"&text&"："&"<a href="&url&"?"&idfield&"="&UpRS(idfield)&">"&UpRS(titlefield))
response.write("<a>")
End If
UpRS.Close
response.write("<br>")
Set UpRS=Nothing
Set NextRS=Server.CreateObject("ADODB.RecordSet")
NextSql="SELECT TOP 1 * FROM "&dataTable&" WHERE "&idfield&">"&id&" and pass=true ORDER BY "&idfield&" ASC"
NextRS.Open NextSql,connstr,1,1
If NextRS.Eof And NextRS.Bof Then
response.write("下一"&text&"：<font color=#FF0000>没有下一"&text&"</font>")
Else
response.write("下一"&text&"："&"<a href="&url&"?"&idfield&"="&NextRS(idfield)&">"&NextRS(titlefield))
response.write("<a>")
End If
response.write("</td></tr></table>")
NextRS.close
Set NextRS=Nothing
End Sub
function webInfo(op)
if op=0 then
webInfo=replace("http://"&Request.ServerVariables("SERVER_NAME")&left(Request.ServerVariables("SCRIPT_NAME"),inStrRev(Request.ServerVariables("SCRIPT_NAME"),"/")-1),"/admin","")
elseif op=1 then
webInfo="http://"&Request.ServerVariables("SERVER_NAME")&left(Request.ServerVariables("SCRIPT_NAME"),inStrRev(Request.ServerVariables("SCRIPT_NAME"),"/")-1)
elseif op=2 then
webInfo=Request.ServerVariables("SCRIPT_NAME")
elseif op=3 then
webInfo="ff"&replace(Request.ServerVariables("LOCAL_ADDR"),".","")&Request.ServerVariables("SERVER_NAME")
end if
end function
function reUserType(utype)
if utype="" then
reUserType="游客"
elseif utype=1 then
reUserType="普通会员"
elseif utype=2 then
reUserType="VIP会员"
elseif utype=3 then
reUserType="管理员"
else
reUserType="游客"
end if
end function
function getPop(popStr)
if popStr=0 or popStr="" then
getPop="普通"
elseif popStr=1 then
getPop="会员"
elseif popStr=2 then
getPop="VIP会员"
else
getPop="普通"
end if
end function
function getVurl(id,urlstr,mode_,num)
urlrs=split(urlstr,"|")
for i=0 to ubound(urlrs)
url=split(urlrs(i),"$:")
if mode_=1 then
getVurl=getVurl&"<a href=""javascript:popwin("&id&","&i&")"">"
else
getVurl=getVurl&"<a href=""downDJ.asp?id="&id&"&rsid="&i&""">"
end if
if cstr(ubound(url))<"1" then
getVurl=getVurl&"地址"&i+1&"</a> "
else
getVurl=getVurl&url(1)&"</a> "
end if
if num>0 then
getVurl="javascript:popwin("&id&","&num-1&")"
exit function
end if
next
end function
function getBuyUser(userRS,userS)
getBuyUser=false
if trim(userRS)="" or isNull(userRS) then
getBuyUser=false
exit function
end if
userArr=split(userRS,",")
for i=0 to ubound(userArr)
if userArr(i)=userS then
getBuyUser=true
exit function
end if
next
end function
Function chkFormatDate(dateStr)
If isDate(dateStr)=False Then
chkFormatDate=False
exit Function
End If
If Not IsNull(dateStr) And Trim(dateStr)<>"" Then
dim regEx
set regEx=New RegExp
regEx.Ignorecase=True
regEx.Global=True
regEx.Pattern="([0-9]{4}-([0-9]{1,2})-([0-9]{1,2}))"
retVal=regEx.Test(dateStr)
If retVal Then
chkFormatDate=true
Else
chkFormatDate=false
End If
set regEx=nothing
Else
chkFormatDate=false
End if
End Function
function IsValidEmail(email)
dim names, name, i, c
IsValidEmail = true
names = Split(email, "@")
If UBound(names) <> 1 Then
IsValidEmail = false
exit function
End If
For each name in names
If Len(name) <= 0 Then
IsValidEmail = false
exit function
End If
For i = 1 To Len(name)
c = Lcase(Mid(name, i, 1))
If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) Then
IsValidEmail = false
exit function
End If
Next
If Left(name, 1) = "." or Right(name, 1) = "." Then
IsValidEmail = false
exit function
End If
Next
If InStr(names(1), ".") <= 0 Then
IsValidEmail = false
exit function
End If
i = Len(names(1)) - InStrRev(names(1), ".")
If i <> 2 and i <> 3 Then
IsValidEmail = false
exit function
End If
If InStr(email, "..") > 0 Then
IsValidEmail = false
End If
End function
function isInteger(para)
on error resume next
dim str
dim l,i
if isNUll(para) then
isInteger=false
exit function
end if
str=cstr(para)
if trim(str)="" then
isInteger=false
exit function
end if
l=len(str)
for i=1 to l
if mid(str,i,1)>"9" or mid(str,i,1)<"0" then
isInteger=false
exit function
end if
next
isInteger=true
if err.number<>0 then err.clear
end function
function strLength(str)
ON ERROR RESUME NEXT
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -