⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 inc_pub_func.asp

📁 是一个很好用的通信录源码,可以用在同学朋友等的通信上使用!
💻 ASP
📖 第 1 页 / 共 5 页
字号:
	If clsPubDB.intRSNum = 0 Then
		If intFlag = 0 Then
			Call ResultExecute(2,"check pass1","ES_ERR")
		End If
		CheckPass = False
		Exit Function
	Else
	
		If strUserPassword <> clsPubDB.objPubRS("USER_PASSWORD") Then
			If intFlag = 0 Then
				Call ResultExecute(3,"check pass2","ES_ERR")
			End If
			CheckPass = False
			Exit Function
		Else
			'== chech whether or not to verify 
			If clsPubDB.objPubRS("USER_AUTHEN") = 8 Then
				If intFlag = 0 Then
					Call ResultExecute(E_USER_PUB,"对不起,您还尚未通过老乡批准<br>请等待批准或联系管理员","ES_ERR")
				End If
				CheckPass = False
				Exit Function
			End If

			'== Get login user infomation now
			Session.Contents.RemoveAll()  '==???

			strRealName = clsPubDB.objPubRS("USER_REALNAME")
			UserId = clsPubDB.objPubRS("USER_ID")
			strAccount = clsPubDB.objPubRS("USER_ACCOUNT")
			strAuthen = Cint(clsPubDB.objPubRS("USER_AUTHEN"))
			strIsMaster = clsPubDB.objPubRS("USER_IS_MASTER")

			'== Check user access
			If CTL_USER_ACCESS Then
				If Not CheckUserAccess(strUserName,strClew1) Then
					Call ResultExecute(E_USER_PUB,strClew1,"ES_ERR")
					Exit Function
				End If
			End If

			'== Get login user infomation now
			Session(GBL_strCookieURL & "SEN_strUserRealName") = strRealName
			Session(GBL_strCookieURL & "SEN_UserId") = UserId
			Session(GBL_strCookieURL & "SEN_strUserAccount") = strAccount
			Session(GBL_strCookieURL & "SEN_strUserAuthen") = strAuthen
			Session(GBL_strCookieURL & "SEN_strIsMaster") = strIsMaster

			'== Update login user infomation now
			clsPubDB.Clear()
			clsPubDB.TableName = "CLASS_USER"
			clsPubDB.SQLType = "UPDATE"
			clsPubDB.Where = "USER_ACCOUNT='" & strUserName & "'"
			clsPubDB.AddField "USER_LAST_TIME",now()
			clsPubDB.AddSet "USER_LOGIN_COUNT = USER_LOGIN_COUNT + 1"

			'== Get real ip
			If Request.ServerVariables("HTTP_X_FORWARDED_FOR") <> "" Then
				clsPubDB.AddField "USER_LAST_IP", Request.ServerVariables("HTTP_X_FORWARDED_FOR")
			Else
				clsPubDB.AddField "USER_LAST_IP", Request.ServerVariables("REMOTE_ADDR")
			End If

			clsPubDB.SQLRSExecute()
			Call ResultExecute(clsPubDB.intErrNum,"","ES_ERR")

			'== Update level
			Call UpdateLevel(GBL_intLoginLevel)

			CheckPass = True

		End If

	End If

End Function

'===================================================================
'= Function     : CheckUserAccess()
'= Time		    : Created At Jun,28,2004
'= Called by    : 
'= Calls        : 
'= Return       : 
'= Description  : check user access to web
'===================================================================
Function CheckUserAccess(strUserAccount,ByRef strClew)

	CheckUserAccess = True
	'== check user account
	clsPubDB.Clear()
	clsPubDB.AllSQL = "SELECT * FROM CLASS_ACCESS WHERE ACCESS_CONTENT= '" & strUserAccount & "' AND ACCESS_ACTION_TYPE=0 "
	clsPubDB.SQLRSExecute()
	Call ResultExecute(clsPubDB.intErrNum,"check user access","ES_ERR")
	If clsPubDB.intRSNum > 0 Then
		If clsPubDB.objPubRS("ACCESS_TYPE") = 1 Then
			strClew = "您被禁止登陆,"
			If clsPubDB.objPubRS("ACCESS_DESC") <> "" Then
				strClew = strClew & "原因是:<br>" & clsPubDB.objPubRS("ACCESS_DESC")
			End If
			CheckUserAccess = False
			Exit Function
		ElseIf clsPubDB.objPubRS("ACCESS_TYPE") = 0 Then
			Session(GBL_strCookieURL & "SEN_strUserAccess") = 0
			CheckUserAccess = True
			Exit Function
		End If

	End If

	'== check user ip area
	'== Get real ip
	If Request.ServerVariables("HTTP_X_FORWARDED_FOR") <> "" Then
		strUserIp = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
	Else
		strUserIp = Request.ServerVariables("REMOTE_ADDR")
	End If
	arrUserIp = Split(strUserIp,".")
	If Not IsArray(arrUserIp) Then
		Exit Function
	End If
	'== check ip exta
	clsPubDB.Clear()
	clsPubDB.AllSQL = "SELECT * FROM CLASS_ACCESS WHERE ACCESS_CONTENT='" & strUserIp & "' AND ACCESS_ACTION_TYPE=1 "
	clsPubDB.SQLRSExecute()
	Call ResultExecute(clsPubDB.intErrNum,"check user access","ES_ERR")
	If clsPubDB.intRSNum > 0 Then

		If clsPubDB.objPubRS("ACCESS_TYPE") = 1 Then
			strClew = "您被禁止登陆,"
			If clsPubDB.objPubRS("ACCESS_DESC") <> "" Then
				strClew = strClew & "原因是:<br>" & clsPubDB.objPubRS("ACCESS_DESC")
			End If
			CheckUserAccess = False
			Exit Function
		ElseIf  clsPubDB.objPubRS("ACCESS_TYPE") = 0 Then
			Session(GBL_strCookieURL & "SEN_strUserAccess") =_
						Cint(clsPubDB.objPubRS("ACCESS_TYPE"))
			Exit Function
		End If

	End If

	'== check  ip D
	clsPubDB.Clear()
	clsPubDB.AllSQL = "SELECT * FROM CLASS_ACCESS WHERE ACCESS_CONTENT LIKE '%" & arrUserIp(0) & "." & arrUserIp(1) & "." & arrUserIp(2) & "%' AND ACCESS_ACTION_TYPE=2 "
	clsPubDB.SQLRSExecute()
	Call ResultExecute(clsPubDB.intErrNum,"check user access","ES_ERR")
	If clsPubDB.intRSNum > 0 Then

		If clsPubDB.objPubRS("ACCESS_TYPE") = 1 Then
			strClew = "您被禁止登陆,"
			If clsPubDB.objPubRS("ACCESS_DESC") <> "" Then
				strClew = strClew & "原因是:<br>" & clsPubDB.objPubRS("ACCESS_DESC")
			End If
			CheckUserAccess = False
			Exit Function
		ElseIf  clsPubDB.objPubRS("ACCESS_TYPE") = 0 Then
			Session(GBL_strCookieURL & "SEN_strUserAccess") =_
						Cint(clsPubDB.objPubRS("ACCESS_TYPE"))
			Exit Function
		End If

	End If

End Function
'=============== End of Func CheckUserAccess() =====================
'===================================================================
'= Function    : AdminCheck()
'= Time        : Created At DEC,20,2003
'= Input       : None

'= Called by   : 
'= Calls       : 
'= Description : adminstrator check
'===================================================================
Function AdminCheck()

	If Session(GBL_strCookieURL & "SEN_strUserAuThen") <> 1 Or IsEmpty(Session(GBL_strCookieURL & "SEN_strUserAuThen")) Then 
			AdminCheck = FALSE
			Exit Function
	End If

	AdminCheck = TRUE
	
End Function
'=============== End of Function AdminCheck() ======================= 
'====================================================================
'= Function    : AdminCheckExec()
'= Time        : Created At Apr,01,2004
'= Input       : None

'= Called by   : 
'= Calls       : 
'= Description : adminstrator check and execute
'====================================================================
Function AdminCheckExec()
	'If Not AdminCheck() Then
	'	Call ResultExecute(E_USER_PUB,"你不具备管理员权限!!!","ES_ERR")
	'End If
End Function
'============== End of Func AdminCheckExec() ========================
'====================================================================
'= Function    : ResultExecute(intResultId,strAddInfo,strExecMode)
'= Time		   : Created At Aug,10,2003
'= Input       : intResultId	: the error number
'=				 strAddInfo		: the add error information
'=				 strExecMode	: the mode of execute err or succ
'=						"ES_DB_NO"   -- show error info directly of db
'=						"ES_DB_YES"  -- redirect err.asp of db
'=						"ES_ERR"	 -- only deal with error
'=						"ES_SUCC"	 -- only deal with success
'=						"ES_NORMAL"  -- deal with error or succ
'= Output      : Redirect err.asp
'= Return      : The flag of error execute
'= Calls	   : None
'= Called by   : All functions and subs
'= Description : 错误或成功信息格式化处理
'===================================================================
Function ResultExecute(intResultId,strAddInfo,strExecMode)

	Dim strActMode 

	ResultExecute = False	'== Initial result of execute is false

	'== for min err info such as order
	If Left(CONST_PAGE_FILE,18) = "order/order_admin_"  Or Left(CONST_PAGE_FILE,12) = "order/admin_" Or Left(CONST_PAGE_FILE,12) = "admin/admin_" Then
		strActMode = "&ACT_MODE=ACT_ERR_MIN"
	Else
		strActMode = ""
	End If

	Select Case strExecMode
		Case "ES_DB_NO":
				If intResultId = 0 Then
					ResultExecute = True
					Response.Write "<br><p align=center> 本栏目: " & strAddInfo & "记录不存在或已被删除</p>"
				End If
		Case "ES_DB_YES":
				If intResultId = 0 Then
					Set clsPubDB = Nothing
					Response.Redirect GBL_strHomeURL & "err.asp?intErrId=1003" & "&strAddInfo=" & strAddInfo & strActMode
				End If
		Case "ES_SUCC" :
				If intResultId <> 0 Then
					Set clsPubDB = Nothing
					Response.Redirect GBL_strHomeURL & "succ.asp?intSuccId=" & intResultId & "&strAddInfo=" & strAddInfo & strActMode
				End If
		Case "ES_SUCC_NO":

				If intResultId = 0 Then
					ResultExecute = True
					Response.Write "<br><p align=center> 本栏目: " & strAddInfo & "</p>"
				End If
					
		Case "ES_ERR" :
				If intResultId <> 0 Then
					Set clsPubDB = Nothing
					Response.Redirect GBL_strHomeURL & "err.asp?intErrId=" & intResultId & "&strAddInfo=" & strAddInfo & "&pstNowPost=" & Trim(Request.QueryString("action")) & strActMode
				End If
		Case "ES_NORMAL" :
				If intResultId <> 0 Then
					Set clsPubDB = Nothing
					Response.Redirect GBL_strHomeUrl & "err.asp?intErrId=" & intResultId & "&strAddInfo=" & strAddInfo & strActMode
				Else
					Set clsPubDB = Nothing
					Response.Redirect GBL_strHomeUrl & "succ.asp?intSuccId=" & intResultId & "&strAddInfo=" & strAddInfo & strActMode
				End If
		Case Else :
				Set clsPubDB = Nothing
				Response.Redirect GBL_strHomeUrl & "err.asp?intErrId=14&strAddInfo=" & strExecMode & strActMode
	End Select

End Function
'============== End Of Function ResultExecute() ====================
'===================================================================
'= Function    : MakeLink(strLink,strText,strTitle)
'= Time		   : Created At Nov,2,2003
'= Input       : strLink	: the link address
'=				 strText	: the link's show text
'=				 strTitle	: the link's clew
'= Output      : 
'= Return      : The html code as "<a href=>..</a>"
'= Calls	   : None
'= Called by   : All functions and subs
'= Description : Making link include href,title,text
'===================================================================
Function MakeLink(strLink,strText,strTitle)

	Dim strHtmlCode
	If Trim(strLink) <> "" Then
		strHtmlCode = "<a href='" & GBL_strHomeURL & strLink & "' " & " title='" & strTitle & "' >" & strText & "</a>" 
	Else
		strHtmlCode = "<a href='#' " & " title='" & strTitle & "' >" & strText & "</a>"
	End If

	MakeLink = strHtmlCode 

End Function
'=============== End of Function MakeLink() ========================
'===================================================================
'= Function    : MakeLinkClew(strLink,strText,strTitle,strClewAct)
'= Time		   : Created At Nov,2,2003
'= Input       : strLink	: the link address
'=				 strText	: the link's show text
'=				 strTitle	: the link's clew
'= Output      : 
'= Return      : The html code as "<a href=>..</a>"
'= Calls	   : None
'= Called by   : All functions and subs
'= Description : Making link include href,title,text with clew
'===================================================================
Function MakeLinkClew(strLink,strText,strTitle,strClewAct)

	Dim strHtmlCode
	If Trim(strLink) <> "" And Trim(strLink) <> "#" Then
		strHtmlCode = "<a href='" & GBL_strHomeURL & strLink & "' " & " title='" & strTitle & "' " & strClewAct &">" & strText & "</a>" 
	ElseIf Trim(strLink) = "#" Then
		strHtmlCode = "<a href='#' " & " title='" & strTitle & "' " & strClewAct &">" & strText & "</a>" 
	Else
		strHtmlCode = "<a href='#' " & " title='" & strTitle & "' >" & strText & "</a>"
	End If

	MakeLinkClew = strHtmlCode 

End Function
'=============== End of Function MakeLinkClew() ====================
'===================================================================
'= Function    : MakeImg(strImgPath,strAlt)
'= Time		   : Created At Nov,4,2003
'= Input       : strImgPath	: the image's realitively path
'=				 strAlt		: the image's alt
'= Output      : 
'= Return      : The html code as "<img src= alt=>"
'= Calls	   : None
'= Called by   : All functions and subs
'= Description : Making link of image
'===================================================================
Function MakeImg(strImgPath,strAlt)

	Dim strHtmlCode

	strHtmlCode = "<img src=" & GBL_strHomeURL & strImgPath  & " alt='" & strAlt & "' border='0' align='absmiddle' valign='middle'>" 
	MakeImg = strHtmlCode 

End Function
'=============== End of Function MakeImg() =========================
'===================================================================
'= Function    : MakeTitle(strTitle)
'= Time		   : Created At Nov,4,2003
'= Input       : strTitle  : the title of form or column
'= Output      : 
'= Return      : The html code as "XX title XX"
'= Calls	   : None
'= Called by   : All functions and subs
'= Description : Making decorate of title
'===================================================================
Function MakeTitle(strTitle)

	Dim strHtmlCode

	strHtmlCode = CONST_TITLE_CHAR & "&nbsp;" & strTitle & "&nbsp;" & CONST_TITLE_CHAR 
	MakeTitle = strHtmlCode 

End Function
'=============== End of Function MakeImg() =========================
Function GetConfig(strAim,strNow)

	Const CONST_DIVIDER = "|||"
	Dim arrTmp,arrTmp2
	Dim i

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -