📄 function.asp
字号:
GetLevelName="游客"
elseif UserLevel=0 then
GetLevelName="所有用户"
else
set rsLevel=conn.execute("select LevelName from PE_UserLevel where UserLevel=" & UserLevel & "")
if rsLevel.bof and rsLevel.eof then
GetLevelName="未知"
else
GetLevelName=rsLevel(0)
end if
set rsLevel=nothing
end if
end function
function GetPurview_Option(ShowType,CurrentPurview)
dim strPurview,sqlLevel,rsLevel
if ShowType<=2 then
strPurview="<option value='5'"
if CurrentPurview=5 then strPurview=strPurview & " selected"
strPurview=strPurview & ">管理员</option>"
else
strPurview="<option value='0'"
if CurrentPurview=0 then strPurview=strPurview & " selected"
strPurview=strPurview & ">全部用户</option>"
end if
sqlLevel="select * from PE_UserLevel order by UserLevel asc"
set rsLevel=server.createobject("adodb.recordset")
rsLevel.open sqlLevel,Conn,1,1
do while not rsLevel.eof
strPurview=strPurview & "<option value='" & rsLevel("UserLevel") & "'"
if rsLevel("UserLevel")=CurrentPurview then strPurview=strPurview & " selected"
strPurview=strPurview & ">" & rsLevel("LevelName") & "</option>"
rsLevel.movenext
loop
rsLevel.close
set rsLevel=nothing
if ShowType=1 then
strPurview=strPurview & "<option value='9999'"
if CurrentPurview=9999 then strPurview=strPurview & " selected"
strPurview=strPurview & ">游客</option>"
end if
GetPurview_Option=strPurview
end function
function GetOrderType_Option(OrderType)
dim strOrderType
strOrderType=strOrderType & "<option value='1'"
if OrderType=1 then strOrderType=strOrderType & " selected"
strOrderType=strOrderType & ">" & ChannelShortName & "ID（降序）</option>"
strOrderType=strOrderType & "<option value='2'"
if OrderType=2 then strOrderType=strOrderType & " selected"
strOrderType=strOrderType & ">" & ChannelShortName & "ID（升序）</option>"
strOrderType=strOrderType & "<option value='3'"
if OrderType=3 then strOrderType=strOrderType & " selected"
strOrderType=strOrderType & ">更新时间（降序）</option>"
strOrderType=strOrderType & "<option value='4'"
if OrderType=4 then strOrderType=strOrderType & " selected"
strOrderType=strOrderType & ">更新时间（升序）</option>"
strOrderType=strOrderType & "<option value='5'"
if OrderType=5 then strOrderType=strOrderType & " selected"
strOrderType=strOrderType & ">点击次数（降序）</option>"
strOrderType=strOrderType & "<option value='6'"
if OrderType=6 then strOrderType=strOrderType & " selected"
strOrderType=strOrderType & ">点击次数（升序）</option>"
GetOrderType_Option=strOrderType
end function
function GetNumber_Option(MinNum,MaxNum,CurrentNum)
dim strNumber,i
for i=MinNum to MaxNum
if i=CurrentNum then
strNumber=strNumber & "<option value='" & i & "' selected> " & i & " </option>"
else
strNumber=strNumber & "<option value='" & i & "'> " & i & " </option>"
end if
next
GetNumber_Option=strNumber
end function
'**************************************************
'函数名：strLength
'作 用：求字符串长度。汉字算两个字符，英文算一个字符。
'参 数：str ----要求长度的字符串
'返回值：字符串长度
'**************************************************
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
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
if err.number<>0 then err.clear
end function
'**************************************************
'函数名：IsValidEmail
'作 用：检查Email地址合法性
'参 数：email ----要检查的Email地址
'返回值：True ----Email地址合法
' False ----Email地址不合法
'**************************************************
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
'==================================================
'函数名：ShowUserLogin
'作 用：显示用户登录表单
'参 数：ShowType ------显示样式，1为纵向式，2为横向式
'==================================================
Function ShowUserLogin(ShowType)
Dim strLogin
If CheckUserLogined() = False Then
strLogin = "<table align='center' width='100%' border='0' cellspacing='0' cellpadding='0'>" & vbCrLf
If UserTableType="MyPower" then
strLogin = strLogin & "<form action='" & strInstallDir & "User/User_ChkLogin.asp' method='post' name='UserLogin' onSubmit='return CheckLoginForm();' target='_top'><tr>" & vbCrLf
Else
strLogin = strLogin & "<form action='" & strInstallDir & Forum_Dir&"Login.asp?action=chk' method='post' name='UserLogin' onSubmit='return CheckLoginForm();' target='_top'><tr>" & vbCrLf
End if
strLogin = strLogin & "<td height='25' align='right'>用户名：</td><td height='25'><input name='UserName' type='text' id='UserName' size='10' maxlength='20'></td>" & vbCrLf
if ShowType=1 then strLogin = strLogin & "</tr><tr>"
strLogin = strLogin & "<td height='25' align='right'>密 码：</td><td height='25'><input name='Password' type='password' id='Password' size='10' maxlength='20'></td>" & vbCrLf
if ShowType=1 then strLogin = strLogin & "</tr><tr>"
strLogin = strLogin & "<td height='25' align='right'>Cookie：</td><td height='25'><select name=CookieDate><option selected value=0>不保存</option><option value=1>保存一天</option>" & vbCrLf
strLogin = strLogin & "<option value=2>保存一月</option><option value=3>保存一年</option></select></td>" & vbCrLf
if ShowType=1 then
strLogin = strLogin & "</tr><tr align='center'><td height='30' colspan='2'>"
else
strLogin = strLogin & "</td><td height='25'>"
end if
strLogin = strLogin & "<input type='hidden' name='ComeUrl' value='" & ComeUrl & "'>"
strLogin = strLogin & "<input name='Login' type='submit' id='Login' value=' 登录 '> <input name='Reset' type='reset' id='Reset' value=' 清除 '>" & vbCrLf
if ShowType=1 then
strLogin = strLogin & "<br><br>"
else
strLogin = strLogin & "</td><td height='25'>"
end if
If UserTableType="MyPower" then
strLogin = strLogin & "<a href='" & strInstallDir & "Reg/User_Reg.asp' target='_blank'>新用户注册</a> <a href='" & strInstallDir & "User/User_GetPassword.asp' target='_blank'>忘记密码？</a></td>" & vbCrLf
Else
strLogin = strLogin & "<a href='" & strInstallDir & "Reg/User_Reg.asp' target='_blank'>新用户注册</a> <a href='" & strInstallDir & Forum_Dir&"lostpass.asp' target='_blank'>忘记密码？</a></td>" & vbCrLf
End if
strLogin = strLogin & "</tr></form></table>" & vbCrLf
strLogin = strLogin & "<script language=javascript>" & vbCrLf
strLogin = strLogin & " function CheckLoginForm(){" & vbCrLf
strLogin = strLogin & " if(document.UserLogin.UserName.value==''){" & vbCrLf
strLogin = strLogin & " alert('请输入用户名！');" & vbCrLf
strLogin = strLogin & " document.UserLogin.UserName.focus();" & vbCrLf
strLogin = strLogin & " return false;" & vbCrLf
strLogin = strLogin & " }" & vbCrLf
strLogin = strLogin & " if(document.UserLogin.Password.value == ''){" & vbCrLf
strLogin = strLogin & " alert('请输入密码！');" & vbCrLf
strLogin = strLogin & " document.UserLogin.Password.focus();" & vbCrLf
strLogin = strLogin & " return false;" & vbCrLf
strLogin = strLogin & " }" & vbCrLf
strLogin = strLogin & " }" & vbCrLf
strLogin = strLogin & " function openScript(url, width, height){" & vbCrLf
strLogin = strLogin & " var Win = window.open(url,'UserControlPad','width=' + width + ',height=' + height + ',resizable=1,scrollbars=yes,menubar=yes,status=yes' );" & vbCrLf
strLogin = strLogin & " }" & vbCrLf
strLogin = strLogin & "</script>" & vbCrLf
Else
strLogin = "<table align='center' width='100%' border='0' cellspacing='0' cellpadding='5'><tr><td> <font color=green><b>" & UserName & "</b></font>，"
if(hour(now) < 6) Then
strLogin = strLogin & "<font color=##0066FF>凌晨好!</font>"
elseif (hour(now) < 9) Then
strLogin = strLogin & "<font color=##000099>早上好!</font>"
elseif (hour(now) < 12) Then
strLogin = strLogin & "<font color=##FF6699>上午好!</font>"
elseif (hour(now) < 14) Then
strLogin = strLogin & "<font color=##FF6600>中午好!</font>"
elseif (hour(now) < 17) Then
strLogin = strLogin & "<font color=##FF00FF>下午好!</font>"
elseif (hour(now) < 18) Then
strLogin = strLogin & "<font color=##0033FF>傍晚好!</font>"
else
strLogin = strLogin & "<font color=##ff0000>晚上好!</font>"
end if
if ShowType=1 then
strLogin = strLogin & "<br> 您的身份：" & GetLevelName(UserLevel)
if ShowType=1 then
strLogin = strLogin & "<br>"
else
strLogin = strLogin & "</td><td>"
end if
strLogin = strLogin & " 计费方式："
If ChargeType = 1 Then
If UserPoint > 0 Then
strLogin = strLogin & "扣点数<br> 可用点数： <b><font color=blue>" & UserPoint & "</font></b> 点"
If UserPoint <= 10 Then
strLogin = strLogin & "<br><font color=red>你的可用点数已不多，请及时联系我们进行充值！</font>"
End If
Else
strLogin = strLogin & "扣点数<br> 可用点数： <b><font color=red>" & UserPoint & "</font></b> 点"
strLogin = strLogin & "<br><font color=red>你的可用点数已经用完，请联系我们进行充值，否则你将不能阅读收费内容。</font>"
End If
Else
If ValidDaysType=0 Then
strLogin = strLogin & "有效期<br> 有效天数： <b><font color=blue>无限期</font></b>"
Else
If ValidDays > 0 Then
strLogin = strLogin & "有效期<br> 有效天数： <b><font color=blue>" & ValidDays & "</font></b> 天"
If ValidDays <= 10 Then
strLogin = strLogin & "<br><font color=red>你的有效期时间已不长，请及时联系我们进行充值！</font>"
End If
Else
strLogin = strLogin & "有效期<br> 有效天数： <b><font color=red>" & ValidDays & "</font></b> 天"
strLogin = strLogin & "<br><font color=red>你的有效期已经过期，请联系我们进行充值，否则你将不能阅读收费内容。</font>"
End If
End If
End If
if SystemVersion = 3 then
strLogin = strLogin & "<br> 待签收文章：" & vbCrLf
if UserReceive>0 then
strLogin = strLogin & " <b><font color=red>" & UserReceive & "</font></b> 篇"
else
strLogin = strLogin & " <b><font color=gray>0</font></b> 篇"
end if
end if
' strLogin = strLogin & "<br> 我的收件箱：" & vbCrLf
' if Cint(newincept(UserName))>Cint(0) then
' strLogin = strLogin & " <b><font color=red>" & newincept(UserName) & "</font></b> 条"
' else
' strLogin = strLogin & " <b><font color=gray>0</font></b> 条"
' end if
strLogin = strLogin & "<br>"
else
strLogin = strLogin & "</td><td>"
end if
strLogin = strLogin & "<font color=#037FA8> 【<b> 用户控制面板 </b>】</font>" & vbCrLf
if ShowType=1 then
strLogin = strLogin & "<br>"
else
strLogin = strLogin & ""
end if
strLogin = strLogin & " <a href=""JavaScript:openScript('" & strInstallDir & "User/User_ControlPad.asp?Action=ArticleAdd')"">发表文章</a>" & vbCrLf
strLogin = strLogin & " <a href=""JavaScript:openScript('" & strInstallDir & "User/User_ControlPad.asp?Action=ArticleManage')"">文章管理</a>" & vbCrLf
if ShowType=1 then
strLogin = strLogin & "<br>"
else
strLogin = strLogin & ""
end if
strLogin = strLogin & " <a href=""JavaScript:openScript('" & strInstallDir & "User/User_ControlPad.asp?Action=ModifyPwd')"">修改密码</a>" & vbCrLf
strLogin = strLogin & " <a href=""JavaScript:openScript('" & strInstallDir & "User/User_ControlPad.asp?Action=ModifyInfo')"">个人信息</a>" & vbCrLf
if ShowType=1 then
if SystemVersion = 3 then
strLogin = strLogin & "<br> <a href=""JavaScript:openScript('" & strInstallDir & "User/User_ControlPad.asp?Action=Receive')"">签收文章</a>" & vbCrLf
If UserTableType="MyPower" then
strLogin = strLogin & " <a href='" & strInstallDir & "User/User_Logout.asp' target='_top'>注销登录</a>" & vbCrLf
else
strLogin = strLogin & " <a href='" & strInstallDir & Forum_Dir & "Logout.asp' target='_self'>注销登录</a>" & vbCrLf
End if
else
If UserTableType="MyPower" then
strLogin = strLogin & "<br><div align='center'><a href='" & strInstallDir & "User/User_Logout.asp' target='_top'>【注销登录】</a></div>" & vbCrLf
else
strLogin = strLogin & "<br><div align='center'><a href='" & strInstallDir & Forum_Dir & "Logout.asp' target='_self'>【注销登录】</a></div>" & vbCrLf
End if
end if
else
if SystemVersion = 3 then
strLogin = strLogin & " <a href=""JavaScript:openScript('" & strInstallDir & "User/User_ControlPad.asp?Action=Receive')"">签收文章</a>" & vbCrLf
end if
If UserTableType="MyPower" then
strLogin = strLogin & " <a href='" & strInstallDir & "User/User_Logout.asp' target='_top'>【注销登录】</a>"
else
strLogin = strLogin & " <a href='" & strInstallDir & Forum_Dir & "Logout.asp' target='_self'>【注销登录】</a>"
End if
end if
strLogin = strLogin & "</td></tr></table>" & vbCrLf
strLogin = strLogin & "<script language=javascript>" & vbCrLf
strLogin = strLogin & " function openScript(url){" & vbCrLf
strLogin = strLogin & " var Win = window.open(url,'UserControlPad');" & vbCrLf
strLogin = strLogin & " }" & vbCrLf
strLogin = strLogin & " function openScript2(url, width, height){" & vbCrLf
strLogin = strLogin & " var Win = window.open(url,'UserControlPad','width=' + width + ',height=' + height + ',resizable=1,scrollbars=yes,menubar=yes,status=yes' );" & vbCrLf
strLogin = strLogin & " }" & vbCrLf
strLogin = strLogin & "</script>" & vbCrLf
End If
ShowUserLogin = strLogin
End Function
Function NewIncept(iUserName)
dim rs
Set rs = conn_User.Execute("Select Count(ID) From " & db_Message_Table & " Where Flag=0 and IsSend=1 and DelR=0 And Incept='" & iUserName & "'")
NewIncept = rs(0)
Set rs = Nothing
If IsNull(NewIncept) Then NewIncept = 0
End Function
Function InceptID(stype, iUserName)
dim rs
Set rs = conn_User.Execute("Select top 1 ID,Sender From " & db_Message_Table & " Where Flag=0 and IsSend=1 and DelR=0 And Incept='" & iUserName & "'")
If stype = 1 Then
InceptID = rs(0)
Else
InceptID = rs(1)
End If
Set rs = Nothing
End Function
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -