common.asp

电子商务网络购物系统

<%
Private Function userCode(ByVal strUsername)
	Randomize Timer
	strUserCode = strUsername & hexValue(15)
	strUserCode = formatSQLInput(strUserCode)
	strUserCode = Replace(strUserCode, "''", "'", 1, -1, 1)
	userCode = strUserCode
End Function

Private Function hexValue(ByVal intHexLength)
	Dim intLoopCounter
	Dim strHexValue
	Randomize Timer()
	For intLoopCounter = 1 to intHexLength
		intHexLength = CInt(Rnd * 1000) Mod 16
		Select Case intHexLength
			Case 1
				strHexValue = "1"
			Case 2
				strHexValue = "2"
			Case 3
				strHexValue = "3"
			Case 4
				strHexValue = "4"
			Case 5
				strHexValue = "5"
			Case 6
				strHexValue = "6"
			Case 7
				strHexValue = "7"
			Case 8
				strHexValue = "8"
			Case 9
				strHexValue = "9"
			Case 10
				strHexValue = "A"
			Case 11
				strHexValue = "B"
			Case 12
				strHexValue = "C"
			Case 13
				strHexValue = "D"
			Case 14
				strHexValue = "E"
			Case 15
				strHexValue = "F"
			Case Else
				strHexValue = "Z"
		End Select
		hexValue = hexValue & strHexValue
	Next
End Function

Private Function IEWin()
	Dim strUserAgent
	strUserAgent = Request.ServerVariables("HTTP_USER_AGENT")
	If InStr(1, strUserAgent, "MsiE", 1)  AND InStr(1, strUserAgent, "MAC", 1) = 0 AND InStr(1, strUserAgent, "Opera", 1) = 0 Then
		If Trim(Mid(strUserAgent, CInt(inStr(1, strUserAgent, "MsiE", 1)+5), 1)) => 5 Then
			IEWin = True
		Else
			IEWin = False
		End If
	Else
		IEWin = False
	End If
End Function


Private Function BrowserType()
	Dim strUserAgent
	Dim strBrowserUserType
	strUserAgent = Request.ServerVariables("HTTP_USER_AGENT")
	If InStr(1, strUserAgent, "Opera 3", 1) Then
		strBrowserUserType = "Opera 3"
	ElseIf InStr(1, strUserAgent, "Opera 4", 1) Then
		strBrowserUserType = "Opera 4"
	ElseIf InStr(1, strUserAgent, "Opera 5", 1) Then
		strBrowserUserType = "Opera 5"
	ElseIf InStr(1, strUserAgent, "Opera 6", 1) Then
		strBrowserUserType = "Opera 6"
	ElseIf InStr(1, strUserAgent, "Opera", 1) Then
		strBrowserUserType = "Opera"
	ElseIf inStr(1, strUserAgent, "MsiE 6", 1) Then
		strBrowserUserType = "Microsoft IE 6"
	ElseIf inStr(1, strUserAgent, "MsiE 5", 1) Then
		strBrowserUserType = "Microsoft IE 5"
	ElseIf inStr(1, strUserAgent, "MsiE 4", 1) Then
		strBrowserUserType = "Microsoft IE 4"
	ElseIf inStr(1, strUserAgent, "MsiE 3", 1) Then
		strBrowserUserType = "Microsoft IE 3"
	ElseIf inStr(1, strUserAgent, "Gecko/20030", 1) OR inStr(1, strUserAgent, "Netscape/7", 1) Then
		strBrowserUserType = "Netscape 7"
	ElseIf inStr(1, strUserAgent, "Mozilla/5", 1) OR inStr(1, strUserAgent, "Netscape6", 1) Then
		strBrowserUserType = "Netscape 6"
	ElseIf inStr(1, strUserAgent, "Mozilla/4", 1) Then
		strBrowserUserType = "Netscape 4"
	ElseIf inStr(1, strUserAgent, "Mozilla/3", 1) Then
		strBrowserUserType = "Netscape 3"
	Else
		strBrowserUserType = "Unknown"
	End If
	BrowserType = strBrowserUserType
End Function


Private Function OSType ()
	Dim strUserAgent
	Dim strOS
	strUserAgent = Request.ServerVariables("HTTP_USER_AGENT")
	If inStr(1, strUserAgent, "NT 5.1", 1) Or inStr(1, strUserAgent, "Windows XP", 1) Then
		strOS = "Windows XP"
	ElseIf inStr(1, strUserAgent, "NT 5", 1) Or inStr(1, strUserAgent, "Windows 2000", 1) Then
		strOS = "Windows 2000"
	ElseIf inStr(1, strUserAgent, "NT", 1) Or inStr(1, strUserAgent, "WinNT", 1) Then
		strOS = "Windows  NT 4"
	ElseIf inStr(1, strUserAgent, "95", 1) Or inStr(1, strUserAgent, "Win95", 1) Then
		strOS = "Windows 95"
	ElseIf inStr(1, strUserAgent, "Win 9x 4.90", 1) Then
		strOS = "Windows ME"
	ElseIf inStr(1, strUserAgent, "98", 1) Or inStr(1, strUserAgent, "Win98", 1) Then
		strOS = "Windows 98"
	ElseIf Instr(1, strUserAgent, "Windows 3.1", 1) or Instr(1, strUserAgent, "Win16", 1) Then
		strOS = "Windows 3.x"
	ElseIf inStr(1, strUserAgent, "Macintosh", 1) OR inStr(1, strUserAgent, "Mac", 1) OR inStr(1, strUserAgent, "Macintosh;", 1) Then
		strOS = "Macintosh"
	ElseIf inStr(1, strUserAgent, "Linux", 1) Then
		strOS = "Linux"
	ElseIf inStr(1, strUserAgent, "Unix", 1) OR inStr(1, strUserAgent, "sunos", 1) OR inStr(1, strUserAgent, "X11", 1) Then
		strOS = "Unix"
	ElseIf inStr(1, strUserAgent, "WebTV", 1) OR inStr(1, strUserAgent, "AOL_TV", 1) Then
		strOS = "Web TV"
	Else
		strOS = "Unknown"
	End If
	OSType = strOS
End Function

Private Function updateTopicPostCount(ByVal intForumID)
	Dim rsCount
	Dim lngNumberOfTopics
	Dim lngNumberOfPosts
	lngNumberOfTopics = 0
	lngNumberOfPosts = 0
	Set rsCount = Server.CreateObject("ADODB.Recordset")
		strSQL = "SELECT Count(timestopic.bbsid) AS Topic_Count "
		strSQL = strSQL & "From timestopic "
		strSQL = strSQL & "WHERE timestopic.bbsid = " & intForumID & " "
	rsCount.Open strSQL, adoCon
	If NOT rsCount.EOF Then lngNumberOfTopics = CLng(rsCount("Topic_Count"))
	rsCount.Close
		strSQL = "SELECT Count(timespost.postid) AS Thread_Count "
		strSQL = strSQL & "FROM timestopic INNER JOIN timespost ON timestopic.topicid = timespost.topicid "
		strSQL = strSQL & "GROUP BY timestopic.bbsid "
		strSQL = strSQL & "HAVING (((timestopic.bbsid)=" & intForumID & "));"
	rsCount.Open strSQL, adoCon
	If NOT rsCount.EOF Then lngNumberOfPosts = CLng(rsCount("Thread_Count"))
	rsCount.Close
	Set rsCount = Nothing
	strSQL = "UPDATE timesbbs SET "
	strSQL = strSQL & "timesbbs.topicnum = " & lngNumberOfTopics & ", timesbbs.postnum = " & lngNumberOfPosts
	strSQL = strSQL & " WHERE timesbbs.bbsid= " & intForumID & ";"
	adoCon.Execute(strSQL)
End Function

Public Function forumPermisisons(ByVal intForumID, ByVal intGroupID, ByVal intRead, ByVal intPost, ByVal intReply, ByVal intEdit, ByVal intDelete, ByVal intPriority, ByVal intPollCreate, ByVal intVote, ByVal intAttachments, ByVal intImageUpload)
	Dim rsPermissions
	blnRead = False
	blnPost = False
	blnReply = False
	blnEdit = False
	blnDelete = False
	blnPriority = False
	blnPollCreate = False
	blnVote = False
	blnAttachments = False
	blnImageUpload = False
	blnModerator = False

	Set rsPermissions = Server.CreateObject("ADODB.Recordset")
		strSQL = "SELECT timesaccess.* "
		strSQL = strSQL & "FROM timesaccess "
		strSQL = strSQL & "WHERE timesaccess.grpid = " & intGroupID & " AND timesaccess.bbsid = " & intForumID & ";"
	rsPermissions.Open strSQL, adoCon
	If NOT rsPermissions.EOF Then
		blnRead = CBool(rsPermissions("Read"))
		blnPost = CBool(rsPermissions("Post"))
		blnReply = CBool(rsPermissions("replypost"))
		blnEdit = CBool(rsPermissions("editpost"))
		blnDelete = CBool(rsPermissions("delpost"))
		blnPriority = CBool(rsPermissions("toppost"))
		blnPollCreate = CBool(rsPermissions("addpoll"))
		blnVote = CBool(rsPermissions("Vote"))
		blnAttachments = CBool(rsPermissions("Attachments"))
		blnImageUpload = CBool(rsPermissions("imgup"))
		blnModerator = CBool(rsPermissions("Moderate"))
	Else
		If intRead = 1 OR (intRead = 2 AND intGroupID <> 2) OR (blnAdmin) Then blnRead = True
		If intPost = 1 OR (intPost = 2 AND intGroupID <> 2) OR (blnAdmin) Then blnPost = True
		If intReply = 1 OR (intReply = 2 AND intGroupID <> 2) OR (blnAdmin) Then blnReply = True
		If intEdit = 1 OR (intEdit = 2 AND intGroupID <> 2) OR (blnAdmin) Then blnEdit = True
		If intDelete = 1 OR (intDelete = 2 AND intGroupID <> 2) OR (blnAdmin) Then blnDelete = True
		If intPriority = 1 OR (intPriority = 2 AND intGroupID <> 2) OR (blnAdmin) Then blnPriority = True
		If (intPollCreate = 1 OR (intPollCreate = 2 AND intGroupID <> 2) OR (blnAdmin)) AND intPollCreate <> 0 Then blnPollCreate = True
		If (intVote = 1 OR (intVote = 2 AND intGroupID <> 2) OR (blnAdmin)) AND intVote <> 0 Then blnVote = True
		If (intAttachments = 1 OR (intAttachments = 2 AND intGroupID <> 2) OR (blnAdmin)) AND intAttachments <> 0 Then blnAttachments = True
		If (intImageUpload = 1 OR (intImageUpload = 2 AND intGroupID <> 2) OR (blnAdmin)) AND intImageUpload <> 0 Then blnImageUpload = True
	End If
	rsPermissions.Close
	Set rsPermissions = Nothing
End Function


Private Function isModerator(ByVal intForumID, ByVal intGroupID)
	Dim rsPermissions
	Dim blnModerator
	blnModerator = False
	Set rsPermissions = Server.CreateObject("ADODB.Recordset")
		strSQL = "SELECT timesaccess.* "
		strSQL = strSQL & "FROM timesaccess "
		strSQL = strSQL & "WHERE timesaccess.grpid = " & intGroupID & " AND timesaccess.bbsid = " & intForumID & ";"
	rsPermissions.Open strSQL, adoCon
	If NOT rsPermissions.EOF Then blnModerator = CBool(rsPermissions("Moderate"))
	rsPermissions.Close
	Set rsPermissions = Nothing
	isModerator = blnModerator
End Function

Private Function disallowedMemberNames(ByVal strUserName)
	strUsername = Replace(strUsername, "salt", "", 1, -1, 1)
	strUsername = Replace(strUsername, "password", "", 1, -1, 1)
	strUsername = Replace(strUsername, "author", "", 1, -1, 1)
	strUsername = Replace(strUsername, "code", "", 1, -1, 1)
	strUsername = Replace(strUsername, "username", "", 1, -1, 1)
	strUsername = Replace(strUsername, "N0act", "", 1, -1, 1)
	disallowedMemberNames = strUsername
End Function

Private Function bannedIP()
	Dim rsIPAddr
	Dim strCheckIPAddress
	Dim strUserIPAddress
	Dim blnIPMatched
	blnIPMatched = False
	strUserIPAddress = Request.ServerVariables("REMOTE_ADDR")
	Set rsIPAddr = Server.CreateObject("ADODB.Recordset")
	strSQL = "SELECT timesfilter.IP FROM timesfilter WHERE timesfilter.IP Is Not Null;"
	rsIPAddr.Open strSQL, adoCon
	Do while NOT rsIPAddr.EOF
		strCheckIPAddress = rsIPAddr("IP")
		If Right(strCheckIPAddress, 1) = "*" Then
			strCheckIPAddress = Replace(strCheckIPAddress, "*", "", 1, -1, 1)
			strUserIPAddress = Mid(strUserIPAddress, 1, Len(strCheckIPAddress))
			If strCheckIPAddress = strUserIPAddress Then blnIPMatched = True	
		Else
			If strCheckIPAddress = strUserIPAddress Then blnIPMatched = True	
		End If
		rsIPAddr.MoveNext
	Loop
	rsIPAddr.Close
	Set rsIPAddr = Nothing
	bannedIP = blnIPMatched
End Function

Private Function checkSessionID(lngAspSessionID)
	If lngAspSessionID <> Session.SessionID Then
	        Set rsConn = Nothing
		adoCon.Close
		Set adoCon = Nothing
	        Response.Redirect("nopermission.asp?fid=" & intForumID & "&M=sID")
	End If
        	
End Function
%>