?? function.asp
字號:
' ShowAllPages ---是否用下拉列表顯示所有頁面以供跳轉(zhuǎn)。有某些頁面不能使用，否則會出現(xiàn)JS錯誤。
' strUnit ----計數(shù)單位
'**************************************************
sub showpage(sfilename,totalnumber,maxperpage,ShowTotal,ShowAllPages,strUnit)
dim n, i,strTemp,strUrl
if totalnumber mod maxperpage=0 then
n= totalnumber \ maxperpage
else
n= totalnumber \ maxperpage+1
end if
strTemp= "<table align='center'><tr><td>"
strTemp=strTemp & "共 <font color=blue><b>" & totalnumber & "</b></font> " & strUnit & " "
strUrl=JoinChar(sfilename)
if CurrentPage<2 then
strTemp=strTemp & "首頁 上一頁 "
else
strTemp=strTemp & "<a href='" & strUrl & "page=1'>首頁</a> "
strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage-1) & "'>上一頁</a> "
end if
if n-currentpage<1 then
strTemp=strTemp & "下一頁 尾頁"
else
strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage+1) & "'>下一頁</a> "
strTemp=strTemp & "<a href='" & strUrl & "page=" & n & "'>尾頁</a>"
end if
strTemp=strTemp & " 頁次：<strong><font color=red>" & CurrentPage & "</font>/" & n & "</strong>頁 "
strTemp=strTemp & " <b>" & maxperpage & "</b>" & strUnit & "/頁"
if ShowAllPages=True then
strTemp=strTemp & " 轉(zhuǎn)到：<select name='page' size='1' onchange=""javascript:window.location='" & strUrl & "page=" & "'+this.options[this.selectedIndex].value;"">"
for i = 1 to n
strTemp=strTemp & "<option value='" & i & "'"
if cint(CurrentPage)=cint(i) then strTemp=strTemp & " selected "
strTemp=strTemp & ">第" & i & "頁</option>"
next
strTemp=strTemp & "</select>"
end if
strTemp=strTemp & "</td></tr></table>"
response.write strTemp
end sub
'**************************************************
'函數(shù)名：IsValidEmail
'作 用：檢查Email地址合法性
'參 數(shù)：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
'**************************************************
'函數(shù)名：IsObjInstalled
'作 用：檢查組件是否已經(jīng)安裝
'參 數(shù)：strClassString ----組件名
'返回值：True ----已經(jīng)安裝
' False ----沒有安裝
'**************************************************
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function
'------------------檢查某一目錄是否存在-------------------
Function CheckDir(FolderPath)
dim fso
folderpath=Server.MapPath(".")&"\"&folderpath
Set fso1 = Server.CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(FolderPath) then
'存在
CheckDir = True
Else
'不存在
CheckDir = False
End if
Set fso = nothing
End Function
'-------------根據(jù)指定名稱生成目錄---------
Function MakeNewsDir(foldername)
dim fso,f
Set fso = Server.CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateFolder(foldername)
MakeNewsDir = True
Set fso = nothing
End Function
'**************************************************
'函數(shù)名：SendMail
'作 用：用Jmail組件發(fā)送郵件
'參 數(shù)：MailtoAddress ----收信人地址
' MailtoName -----收信人姓名
' Subject -----主題
' MailBody -----信件內(nèi)容
' FromName -----發(fā)信人姓名
' MailFrom -----發(fā)信人地址
' Priority -----信件優(yōu)先級
'**************************************************
function SendMail(MailtoAddress,MailtoName,Subject,MailBody,FromName,MailFrom,Priority)
on error resume next
Dim JMail
Set JMail=Server.CreateObject("JMail.Message")
if err then
SendMail= "<br><li>沒有安裝JMail組件</li>"
err.clear
exit function
end if
JMail.Charset="gb2312" '郵件編碼
JMail.silent=true
JMail.ContentType = "text/html" '郵件正文格式
'JMail.ServerAddress=nt2003.Site_Setting(18) '用來發(fā)送郵件的SMTP服務(wù)器
'如果服務(wù)器需要SMTP身份驗證則還需指定以下參數(shù)
JMail.MailServerUserName = nt2003.Site_Setting(19) '登錄用戶名
JMail.MailServerPassWord = nt2003.Site_Setting(20) '登錄密碼
JMail.MailDomain = nt2003.Site_Setting(21) '域名（如果用“name@domain.com”這樣的用戶名登錄時，請指明domain.com
JMail.AddRecipient MailtoAddress,MailtoName '收信人
JMail.Subject=Subject '主題
JMail.HMTLBody=MailBody '郵件正文（HTML格式）
JMail.Body=MailBody '郵件正文（純文本格式）
JMail.FromName=FromName '發(fā)信人姓名
JMail.From = MailFrom '發(fā)信人Email
JMail.Priority=Priority '郵件等級，1為加急，3為普通，5為低級
JMail.Send(nt2003.site_setting(18))
SendMail =JMail.ErrorMessage
JMail.Close
Set JMail=nothing
end function
'**************************************************
'過程名：WriteErrMsg
'作 用：顯示錯誤提示信息
'參 數(shù)：無
'**************************************************
sub WriteErrMsg()
dim strErr
strErr=strErr & "<html><head><title>錯誤信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbcrlf
strErr=strErr & "<link href='style.css' rel='stylesheet' type='text/css'></head><body><br><br>" & vbcrlf
strErr=strErr & "<table cellpadding=2 cellspacing=1 border=0 width=400 class='border' align=center>" & vbcrlf
strErr=strErr & " <tr align='center' class='title'><td height='22'><strong>錯誤信息</strong></td></tr>" & vbcrlf
strErr=strErr & " <tr class='tdbg'><td height='100' valign='top'><b>產(chǎn)生錯誤的可能原因：</b>" & errmsg &"</td></tr>" & vbcrlf
strErr=strErr & " <tr align='center' class='tdbg'><td><a href='javascript:history.go(-1)'><< 返回上一頁</a></td></tr>" & vbcrlf
strErr=strErr & "</table>" & vbcrlf
strErr=strErr & "</body></html>" & vbcrlf
response.write strErr
end sub
'**************************************************
'過程名：WriteSuccessMsg
'作 用：顯示成功提示信息
'參 數(shù)：無
'**************************************************
sub WriteSuccessMsg(SuccessMsg)
dim strSuccess
strSuccess=strSuccess & "<html><head><title>成功信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbcrlf
strSuccess=strSuccess & "<link href='style.css' rel='stylesheet' type='text/css'></head><body><br><br>" & vbcrlf
strSuccess=strSuccess & "<table cellpadding=2 cellspacing=1 border=0 width=400 class='border' align=center>" & vbcrlf
strSuccess=strSuccess & " <tr align='center' class='title'><td height='22'><strong>恭喜你！</strong></td></tr>" & vbcrlf
strSuccess=strSuccess & " <tr class='tdbg'><td height='100' valign='top'><br>" & SuccessMsg &"</td></tr>" & vbcrlf
strSuccess=strSuccess & " <tr align='center' class='tdbg'><td> </td></tr>" & vbcrlf
strSuccess=strSuccess & "</table>" & vbcrlf
strSuccess=strSuccess & "</body></html>" & vbcrlf
response.write strSuccess
end sub
'**************************************************
'函數(shù)名：CheckUserLogined
'作 用：檢查用戶是否登錄
'參 數(shù)：無
'返回值：True ----已經(jīng)登錄
' False ---沒有登錄
'**************************************************
function CheckUserLogined()
dim Logined,Password,rsLogin,sqlLogin
Logined=True
UserName=Request.Cookies("asp163")("UserName")
Password=Request.Cookies("asp163")("Password")
UserLevel=Request.Cookies("asp163")("UserLevel")
if UserName="" then
Logined=False
end if
if Password="" then
Logined=False
end if
if UserLevel="" then
Logined=False
UserLevel=9999
end if
if Logined=True then
username=replace(trim(username),"'","")
password=replace(trim(password),"'","")
UserLevel=Cint(trim(UserLevel))
set rsLogin=server.createobject("adodb.recordset")
sqlLogin="select * from " & db_User_Table & " where " & db_User_LockUser & "=False and " & db_User_Name & "='" & username & "' and " & db_User_Password & "='" & password &"'"
rsLogin.open sqlLogin,Conn_User,1,1
if rsLogin.bof and rsLogin.eof then
Logined=False
else
if password<>rsLogin(db_User_Password) or UserLevel<rsLogin(db_User_UserLevel) then
Logined=False
end if
UserName=rsLogin(db_User_Name)
UserLevel=rsLogin(db_User_UserLevel)
ChargeType=rsLogin(db_User_ChargeType)
UserPoint=rsLogin(db_User_UserPoint)
if rsLogin(db_User_Valid_Unit)=1 then
ValidDays=rsLogin(db_User_Valid_Num)
elseif rsLogin(db_User_Valid_Unit)=2 then
ValidDays=rsLogin(db_User_Valid_Num)*30
elseif rsLogin(db_User_Valid_Unit)=3 then
ValidDays=rsLogin(db_User_Valid_Num)*365
end if
ValidDays=ValidDays-DateDiff("D",rsLogin(db_User_BeginDate),now())
end if
rsLogin.close
set rsLogin=nothing
end if
if session("AdminName")<>"" then
Logined=True
end if
CheckUserLogined=Logined
end function
'**************************************************
'函數(shù)名：ReplaceBadChar
'作 用：過濾非法的SQL字符
'參 數(shù)：strChar-----要過濾的字符
'返回值：過濾后的字符
'**************************************************
function ReplaceBadChar(strChar)
if strChar="" then
ReplaceBadChar=""
else
ReplaceBadChar=replace(replace(replace(replace(replace(replace(replace(strChar,"'",""),"*",""),"?",""),"(",""),")",""),"<",""),".","")
end if
end function
'**************************************************
'函數(shù)名：CheckLevel
'作 用：檢查用戶級別
'參 數(shù)：LevelNum-----要檢查的級別值
'返回值：級別名稱
'**************************************************
function CheckLevel(LevelNum)
select case LevelNum
case 9999
CheckLevel="游客"
case 999
CheckLevel="注冊用戶"
case 99
CheckLevel="收費用戶"
case 9
CheckLevel="VIP用戶"
case 5
CheckLevel="管理員"
end select
end function
'==================================================
'過程名：ShowAnnounce
'作 用：顯示本站公告信息
'參 數(shù)：ShowType ------顯示方式，1為縱向，2為橫向
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -