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

📄 inc_pub_func.asp

📁 1] 校友多种方式注册认证[直接注册,答问注册,认证注册] 2] 校友论坛 小巧而实用的论坛,支持UBB标签,快速回复,帖子搜索,灵活的将帖子置顶,设置精华 3] 校友相册 相片上传[方便上传
💻 ASP
📖 第 1 页 / 共 5 页
字号:
🔍
12345 
	Dim clsTable
	Dim intOnline			'== now online all
	Dim intOnlineUser		'== now online user
	Dim intOnlineGuest		'== now online guest
	Dim strGetIp

	'Exit Function	'== 04/02

	'== 06/27
	If CONST_PAGE_FILE <> "/index1.asp" Then
		Exit Function
	End If

	clsPubDB.Clear()
	clsPubDB.TableName = "CLASS_ONLINE"
	clsPubDB.SQLType = "DELETE"
	If CONST_DB_TYPE = 1 Or CONST_DB_TYPE = 2 Then
		clsPubDB.Where = "ONLINE_ACTIVE_TIME<'" & Cstr(DateAdd("n",-20,Now())) & "' "
	Else
		clsPubDB.Where = "ONLINE_ACTIVE_TIME<#" & Cstr(DateAdd("n",-20,Now())) & "# "
	End If
	clsPubDB.SQLExecute()
	Call ResultExecute(clsPubDB.intErrNum,"del timed out online user"&clsPubDB.returnsql,"ES_ERR")

	clsPubDB.Clear()
	clsPubDB.TableName = "CLASS_ONLINE"
	clsPubDB.SQLType = "SELECT"
	clsPubDB.Where = "ONLINE_SESSION_ID=" & Session.SessionId
	clsPubDB.AddField "*",""
	clsPubDB.SQLRSExecute()
	Call ResultExecute(clsPubDB.intErrNum,"check now online user"&clsPubdb.returnsql,"ES_ERR")

	If clsPubDB.intRSNum = 0 Then

		clsPubDB.Clear()
		clsPubDB.TableName = "CLASS_ONLINE"
		clsPubDB.SQLType = "INSERT"
		clsPubDB.AddField "ONLINE_USER","guest"
		clsPubDB.AddField "ONLINE_LOGIN_TIME",Now()
		clsPubDB.AddField "ONLINE_USER_AUTHEN",3
		clsPubDB.AddField "ONLINE_SESSION_ID",Session.SessionId
		clsPubDB.AddField "ONLINE_ACTIVE_TIME",Now()
		clsPubDB.SQLExecute()
		Call ResultExecute(clsPubDB.intErrNum,"add a new online guest"&clsPubdb.returnsql,"ES_ERR")

	Else

		intSessionId = clsPubDB.objPubRS("ONLINE_SESSION_ID")
		clsPubDB.Clear()
		clsPubDB.TableName = "CLASS_ONLINE"
		clsPubDB.SQLType = "UPDATE"
		clsPubDB.Where = "ONLINE_SESSION_ID=" & intSessionId
		If Session(GBL_strCookieURL & "SEN_strUserRealName") = "" Or IsNull(Session(GBL_strCookieURL & "SEN_strUserRealName")) Then
			clsPubDB.AddField "ONLINE_USER","guest"
			clsPubDB.AddField "ONLINE_USER_AUTHEN",3
		Else
			clsPubDB.AddField "ONLINE_USER",Session(GBL_strCookieURL & "SEN_strUserRealName")
			clsPubDB.AddField "ONLINE_USER_AUTHEN",0
			clsPubDB.AddField "ONLINE_USER_ID",GBL_intUserId
		End If
		clsPubDB.AddField "ONLINE_ACTIVE_TIME",Now()

		clsPubDB.SQLExecute()
		Call ResultExecute(clsPubDB.intErrNum,"add a new online user"&clsPubDB.ReturnSQL,"ES_ERR")

	End If

End Function
'================== End of Function GetNowOnline() =================
'=====================================================================
'= Function     : Constellation(tBirths,strConstellation)
'= Time		    : Created At DEC,21,2003
'= Input        : None
'= Output       : None
'= Called by    : 
'= Calls        : 
'= Return       : the img of constellation
'= Description  : show user's constellation
'=====================================================================
Function Constellation(tBirths,ByRef strConstellation)

	Dim tBirth
	Dim tBirthDay,tBirthMonth

	tBirth = tBirths
	tBirthDay = Day(tBirth)
	tBirthMonth = Month(tBirth)

	Constellation = "<img width=15 height=15 src=" & GBL_strHomeURL & "images/Constellation/z"
	strImg = "<img  src=" & GBL_strHomeURL & "images/Constellation/z"
	Select Case tBirthMonth
	Case 1
		If tBirthDay >= 21 Then
			Constellation = Constellation & "11.gif alt='水瓶座(" & tBirth & ")<br>" & strImg & "11b.gif>' align=absmiddle>"
			strConstellation = "水瓶座"
		Else
			Constellation = Constellation & "10.gif alt='魔羯座(" & tBirth & ")<br>" & strImg & "10b.gif>' align=absmiddle>"
			strConstellation = "魔羯座"
		End If
	Case 2
		If tBirthDay>=20 Then
			Constellation = Constellation & "12.gif alt='双鱼座(" & tBirth & ")<br>" & strImg & "12b.gif>' align=absmiddle>"
			strConstellation = "双鱼座"
		Else
			Constellation = Constellation & "11.gif alt='水瓶座(" & tBirth & ")<br>" & strImg & "11b.gif>' align=absmiddle>"
			strConstellation = "水瓶座"
		End If
	Case 3
		If tBirthDay>=21 Then
			Constellation = Constellation & "1.gif alt='白羊座 (" & tBirth & ")<br>" & strImg & "1b.gif>' align=absmiddle>"
			strConstellation = "白羊座"
		Else
			Constellation = Constellation & "12.gif alt='双鱼座(" & tBirth & ")<br>" & strImg & "12b.gif>' align=absmiddle>"
			strConstellation = "双鱼座"
		End If
	Case 4
		If tBirthDay>=21 Then
			Constellation = Constellation & "2.gif alt='金牛座 (" & tBirth & ")<br>" & strImg & "2b.gif>' align=absmiddle>"
			strConstellation = "金牛座"
		Else
			Constellation = Constellation & "1.gif alt='白羊座 (" & tBirth & ")<br>" & strImg & "1b.gif>' align=absmiddle>"
			strConstellation = "白羊座"
		End If
	Case 5
		If tBirthDay>=22 Then
			Constellation = Constellation & "3.gif alt='双子座 (" & tBirth & ")<br>" & strImg & "3b.gif>' align=absmiddle>"
			strConstellation = "双子座"
		Else
			Constellation = Constellation & "2.gif alt='金牛座 (" & tBirth & ")<br>" & strImg & "2b.gif>' align=absmiddle>"
			strConstellation = "金牛座"
		End If
	Case 6
		If tBirthDay>=22 Then
			Constellation = Constellation & "4.gif alt='巨蟹座 (" & tBirth & ")<br>" & strImg & "4b.gif>' align=absmiddle>"
			strConstellation = "巨蟹座"
		Else
			Constellation = Constellation & "3.gif alt='双子座 (" & tBirth & ")<br>" & strImg & "3b.gif>' align=absmiddle>"
			strConstellation = "双子座"
		End If
	Case 7
		If tBirthDay>=23 Then
			Constellation = Constellation & "5.gif alt='狮子座 (" & tBirth & ")<br>" & strImg & "5b.gif>' align=absmiddle>"
			strConstellation = "狮子座"
		Else
			Constellation = Constellation & "4.gif alt='巨蟹座 (" & tBirth & ")<br>" & strImg & "4b.gif>' align=absmiddle>"
			strConstellation = "巨蟹座"
		End If
	Case 8
		If tBirthDay>=24 Then
			Constellation = Constellation & "6.gif alt='处女座 (" & tBirth & ")<br>" & strImg & "6b.gif>' align=absmiddle>"
			strConstellation = "处女座"
		Else
			Constellation = Constellation & "5.gif alt='狮子座 (" & tBirth & ")<br>" & strImg & "5b.gif>' align=absmiddle>"
			strConstellation = "狮子座"
		End If
	Case 9
		If tBirthDay>=24 Then
			Constellation = Constellation & "7.gif alt='天秤座 (" & tBirth & ")<br>" & strImg & "7b.gif>' align=absmiddle>"
			strConstellation = "天秤座"
		Else
			Constellation = Constellation & "6.gif alt='处女座 (" & tBirth & ")<br>" & strImg & "6b.gif>' align=absmiddle>"
			strConstellation = "处女座"
		End If
	Case 10
		If tBirthDay>=24 Then
			Constellation = Constellation & "8.gif alt='天蝎座 (" & tBirth & ")<br>" & strImg & "8b.gif>' align=absmiddle>"
			strConstellation = "天蝎座"
		Else
			Constellation = Constellation & "7.gif alt='天秤座 (" & tBirth & ")<br>" & strImg & "7b.gif>' align=absmiddle>"
			strConstellation = "天秤座"
		End If
	Case 11
		If tBirthDay>=23 Then
			Constellation = Constellation & "9.gif alt='射手座 (" & tBirth & ")<br>" & strImg & "9b.gif>' align=absmiddle>"
			strConstellation = "射手座"
		Else
			Constellation = Constellation & "8.gif alt='天蝎座 (" & tBirth & ")<br>" & strImg & "8b.gif>' align=absmiddle>"
			strConstellation = "天蝎座"
		End If
	Case 12
		If tBirthDay>=22 Then
			Constellation = Constellation & "10.gif alt='魔羯座 (" & tBirth & ")<br>" & strImg & "10b.gif>' align=absmiddle>"
			strConstellation = "魔羯座"
		Else
			Constellation = Constellation & "9.gif alt='射手座 (" & tBirth & ")<br>" & strImg & "9b.gif>' align=absmiddle>"
			strConstellation = "射手座"
		End If
	Case Else
		Constellation=""
	End Select

End Function
'============= End of Func Constellatio() ===========================
'=====================================================================
'= Function     : DisplayBirthAnimal(tBirthYear,strAnimal)
'= Time		    : Created At DEC,21,2003
'= Input        : None
'= Output       : None
'= Called by    : 
'= Calls        : 
'= Return       : the img of birth animal
'= Description  : show user's birth animal
'=====================================================================
Function DisplayBirthAnimal(tBirths,ByRef strAnimal)

	Dim intTemp,strTmp

	intTemp = Cint(Year(tBirths)) mod 12
	strTmp = "<img width=15 height=15 src=" & GBL_strHomeURL & "images/" & "sx/sx"
	strTmp1 = "<img src=" & GBL_strHomeURL & "images/" & "sx/sx"
	Select Case intTemp
		Case 0: strTmp = strTmp & "9s.gif align=absmiddle alt='申猴(" & tBirths & ")<br>" & strTmp1 & "9.gif>' align=absmiddle>"
				strAnimal = "申猴"
		Case 1: strTmp = strTmp & "10s.gif align=absmiddle alt='酉鸡(" & tBirths & ")<br>" & strTmp1 & "10.gif>' align=absmiddle>"
				strAnimal = "酉鸡"
		Case 2: strTmp = strTmp & "11s.gif align=absmiddle alt='戌狗(" & tBirths & ")<br>" & strTmp1 & "11.gif>' align=absmiddle>"
				strAnimal = "戌狗"
		Case 3: strTmp = strTmp & "12s.gif align=absmiddle alt='亥猪(" & tBirths & ")<br>" & strTmp1 & "12.gif>' align=absmiddle>"
				strAnimal = "亥猪"
		Case 4: strTmp = strTmp & "1s.gif align=absmiddle alt='子鼠(" & tBirths & ")<br>" & strTmp1 & "1.gif>' align=absmiddle>"
				strAnimal = "子鼠"
		Case 5: strTmp = strTmp & "2s.gif align=absmiddle alt='丑牛(" & tBirths & ")<br>" & strTmp1 & "2.gif>' align=absmiddle>"
				strAnimal = "丑牛"
		Case 6: strTmp = strTmp & "3s.gif align=absmiddle alt='寅虎(" & tBirths & ")<br>" & strTmp1 & "3.gif>' align=absmiddle>"
				strAnimal = "寅虎"
		Case 7: strTmp = strTmp & "4s.gif align=absmiddle alt='卯兔(" & tBirths & ")<br>" & strTmp1 & "4.gif>' align=absmiddle>"
				strAnimal = "卯兔"
		Case 8: strTmp = strTmp & "5s.gif align=absmiddle alt='辰龙(" & tBirths & ")<br>" & strTmp1 & "5.gif>' align=absmiddle>"
				strAnimal = "辰龙"
		Case 9: strTmp = strTmp & "6s.gif align=absmiddle alt='巳蛇(" & tBirths & ")<br>" & strTmp1 & "6.gif>' align=absmiddle>"
				strAnimal = "巳蛇"
		Case 10: strTmp = strTmp & "7s.gif align=absmiddle alt='午马(" & tBirths & ")<br>" & strTmp1 & "7.gif>' align=absmiddle>"
				strAnimal = "午马"
		Case 11: strTmp = strTmp & "8s.gif align=absmiddle alt='未羊(" & tBirths & ")<br>" & strTmp1 & "8.gif>' align=absmiddle>"
				strAnimal = "未羊"
		Case Else: strTmp = ""
	End Select
	
	DisplayBirthAnimal = strTmp

End Function
'=============== End of Func DisplayBirthAnimal() ==================
'===================================================================
'= Function     : GetNextRS(strOutField,strTabName,strWhere,strOrder)
'= Time		    : Created At DEC,28,2003
'= Input        : strOutField: out filed 
'=				  strWhere	: where
'=				  strTabName: now table name
'=				  strOrder	: order conditions
'= Output       : None
'= Called by    : album_func.asp
'= Calls        : 
'= Return       : next id
'= Description  : get next or pre rs
'===================================================================
Function GetNextRS(strOutField,strTabName,strWhere,strOrder)
	
	clsPubDB.Clear()
	clsPubDB.TableName = strTabName
	clsPubDB.SQLType = "SELECT"
	clsPubDB.AddField " Top 1 " & strOutField,""
	If Trim(strWhere) <> "" Then
		clsPubDB.Where = strWhere
	End If
	If Trim(strOrder) <> "" Then
		clsPubDB.Order = strOrder
	End If
	clsPubDB.SQLRSExecute()
	Call ResultExecute(clsPubDB.intErrNum,"get next rs","ES_ERR")
	'== no find the record
	If clsPubDB.intRSNum <= 0 Then
		GetNextRS = -1
		Exit Function
	Else
		GetNextRS = clsPubDB.objPubRS(strOutField)
	End If

End Function
'=============== End of Func GetNextId() ===========================
'===================================================================
'= Function     : CheckObjInstalled(strClassString,ByRef strClew)
'= Time		    : Created At DEC,28,2003
'= Input        : strClassString : obj name
'= Output       : strClew	: success or err information of obj
'= Called by    : 
'= Calls        : 
'= Return       : installed or not flag
'= Description  : check obj is or not installed
'===================================================================
Function CheckObjInstalled(strClassString,ByRef strClew)

	On Error Resume Next

	Dim intInstallFlag
	Err = 0
	Dim objTmp

	Set objTmp = Server.CreateObject(strClassString)
	intInstallFlag = Err
	If intInstallFlag = 0 Then
		CheckObjInstalled = True
		strClew = "支持此组件"
	ElseIf intInstallFlag = -2147221005 Then
		strClew = "组件未安装"
		CheckObjInstalled = False
	ElseIf intInstallFlag = -2147221477 Then
		strClew = "支持此组件"
		CheckObjInstalled = True
	ElseIf intInstallFlag = 1 Then
		strClew = "未知的错误，组件可能未正确安装"
		CheckObjInstalled = False
	End If
	Err.Clear
	Set objTmp = Nothing
	Err = 0

End Function
'=============== End of Func CheckObjInstalled() ===================
'===================================================================
'= Function     : MakeQQShow(intQQ)
'= Time		    : Created At Jun,22,2004
'= Input        : qq
'= Called by    : 
'= Calls        : 
'= Return       : 
'= Description  : make qq show
'===================================================================
Function MakeQQShow(intQQ)

	MakeQQShow = "http://qqshow-user.tencent.com/" & intQQ & "/10/00/"

End Function
'=============== End Of Func MakeQQShow() ==========================
'===================================================================
'= Function     : ReloadStyleInfo(ID)
'= Time		    : Created At July,3,2004
'= Input        : Id :style id
'= Output       : 
'= Called by    : 
'= Calls        : 
'= Return       : 
'= Description  : reload style info of the special
'===================================================================
Sub ReloadStyleInfo(ID)
	
	Dim Rs,Temp

	'If GBL_ConFlag = 0 Then Exit Sub
	clsPubDB.Clear()
	clsPubDB.AllSQL = "Select top 1 T1.StyleID,T1.ScreenWidth,T1.DisplayTopicLength,T1.DefineImage,T1.SiteHeadString,T1.SiteBottomString,T1.TableHeadString,T1.TableBottomString,T1.ShowBottomSure,T1.TempletID,T2.TempletFlag from CLASS_Skin as T1 Left Join CLASS_Templet as T2 on T1.TempletID=T2.ID Where T1.StyleID=" & ID
	clsPubDB.SQLRSExeCute()
	If clsPubDB.intErrNum < 0 Then
		Response.Write "风格设置错误，请联系管理员!!!"
		Exit Sub
	End If

	If clsPubDB.objPubRS.Eof Then
		clsPubDB.objPubRS.Close
		Set clsPubDB.objPubRS = Nothing
		GBL_Board_BoardLimit = 0
		Application.Lock
		Application(GBL_strCookieURL & "Style" & ID) = "yes"
		Application.UnLock
		Exit Sub
	Else
		DEF_WEB_ScreenWidth = clsPubDB.objPubRS(2)
		GBL_strHomeURLAlt = "<GBL_strHomeURL>"
		GBL_SiteHeadString = Replace(clsPubDB.objPubRS(4),"/leadbbs/",G
12345

⌨️ 快捷键说明

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