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

📄 httpapi.asp

📁 简单的asp论坛源码系统,很适用于初学者!界面简洁,功能齐全
💻 ASP
📖 第 1 页 / 共 5 页
字号:
				Else
					strErrorDescription = "No topics found"
				End If
			
			'Else forums are found so write XML	
			Else
				
				'Loop through records
				DO WHILE NOT rsCommon.EOF
					
					ReDim Preserve sarryRecords(intRecordLoop)
					
					sarryRecords(intRecordLoop) = ("" & _
					vbCrLf & "   <TopicName><![CDATA[" & rsCommon("Subject") & "]]></TopicName>" & _
					vbCrLf & "   <TopicID>" & rsCommon("Topic_ID") & "</TopicID>" & _
					vbCrLf & "   <ForumName>" & Server.HTMLEncode(rsCommon("Forum_name")) & "</ForumName>" & _
					vbCrLf & "   <ForumID>" & rsCommon("Forum_ID") & "</ForumID>" & _
					vbCrLf & "   <TopicLocked>" & CBool(rsCommon("Locked")) & "</TopicLocked>" & _
					vbCrLf & "   <ReplyCount>" & rsCommon("No_of_replies") & "</ReplyCount>")
					If isDate(rsCommon("Event_date")) Then sarryRecords(intRecordLoop) = sarryRecords(intRecordLoop) & vbCrLf & "   <EventDateStart>" & internationalDateTime(CDate(rsCommon("Event_date"))) & "</EventDateStart>" Else sarryRecords(intRecordLoop) = sarryRecords(intRecordLoop) & vbCrLf & "   <EventDateStart/>"
					If isDate(rsCommon("Event_date_end")) Then sarryRecords(intRecordLoop) = sarryRecords(intRecordLoop) & vbCrLf & "   <EventDateEnd>" & internationalDateTime(CDate(rsCommon("Event_date_end"))) & "</EventDateEnd>" Else sarryRecords(intRecordLoop) = sarryRecords(intRecordLoop) & vbCrLf & "   <EventDateEnd/>"
					sarryRecords(intRecordLoop) = sarryRecords(intRecordLoop) & ("" & _
					vbCrLf & "   <ViewCount>" & rsCommon("No_of_views") & "</ViewCount>")
					
					intRecordLoop = intRecordLoop + 1
					
					'Move to next record
					rsCommon.MoveNext
				Loop
			
			End If
			
			'Reset Server Objects
			rsCommon.Close
		
		
				
		
			
			
			
		'******  GetLastPosts  OR GetLastPostsByForumID  ******
		Case "GetLastPosts", "GetLastPostsByForumID"
			
			'Read in the max results
			If isNumeric(Request("MaxResults")) Then
				
				'Get the max results to show, trim this to a 3 figure number, as only 50 allowed, and prevent errors
				intMaxResults = Trim(Mid(Request("MaxResults"), 1, 3))
				
				'Convert into integer
				intMaxResults = IntC(intMaxResults)
				
				'Set some defaults if out of range
				If intMaxResults > 50 Then intMaxResults = 50
				If intMaxResults < 1 Then intMaxResults = 1
			End If
			
			'If GetLastPostsByForumID then read in the forum ID
			If strApiAction = "GetLastPostsByForumID" Then
				If isNumeric(Request("ForumID")) Then
					intForumID =  LngC(Request("ForumID"))
				Else
					intForumID = -1
				End If
				
			End If
			
			
			'SQL
			strSQL = "" & _
			"SELECT "
			If strDatabaseType = "SQLServer" OR strDatabaseType = "Access" Then
				strSQL = strSQL & " TOP " & intMaxResults & " "
			End If
			strSQL = strSQL & _
			"" & strDbTable & "Forum.Forum_name, " & strDbTable & "Topic.*, " & strDbTable & "Thread.Thread_ID, " & strDbTable & "Thread.Message_date, " & strDbTable & "Author.Author_ID, " & strDbTable & "Author.Username, " & strDbTable & "Thread.Message  " & _
			"FROM " & strDbTable & "Forum, " & strDbTable & "Topic, " & strDbTable & "Author, " & strDbTable & "Thread " & _
			"WHERE " & strDbTable & "Forum.Forum_ID = " & strDbTable & "Topic.Forum_ID " & _
				"AND " & strDbTable & "Topic.Topic_ID = " & strDbTable & "Thread.Topic_ID " & _
				"AND " & strDbTable & "Author.Author_ID = " & strDbTable & "Thread.Author_ID "
			
			'If looking at a forum only, only get posts from tha forum
			If intForumID <> 0 Then strSQL = strSQL & "AND " & strDbTable & "Topic.Forum_ID = " & intForumID & " "
			
			
			strSQL = strSQL & "AND (" & strDbTable & "Topic.Hide = " & strDBFalse & " AND " & strDbTable & "Thread.Hide = " & strDBFalse & ") " & _
			"ORDER BY " & strDbTable & "Thread.Thread_ID DESC"
			
			'mySQL limit operator
			If strDatabaseType = "mySQL" Then
				strSQL = strSQL & " LIMIT " & intMaxResults
			End If
			
			'Query the database
			rsCommon.Open strSQL, adoCon
			
			'If nothing returned then an error
			If rsCommon.EOF Then
				
				intErrorCode = -150
				If strApiAction = "GetLastPostsByForumID" Then
					strErrorDescription = "Forum not found or no posts in forum"
				Else
					strErrorDescription = "No posts found"
				End If
			
			'Else forums are found so write XML	
			Else
				
				'Loop through records
				DO WHILE NOT rsCommon.EOF
					
					ReDim Preserve sarryRecords(intRecordLoop)
					
					sarryRecords(intRecordLoop) = ("" & _
					vbCrLf & "   <TopicName><![CDATA[" & rsCommon("Subject") & "]]></TopicName>" & _
					vbCrLf & "   <TopicID>" & rsCommon("Topic_ID") & "</TopicID>" & _
					vbCrLf & "   <ForumName>" & Server.HTMLEncode(rsCommon("Forum_name")) & "</ForumName>" & _
					vbCrLf & "   <ForumID>" & rsCommon("Forum_ID") & "</ForumID>" & _
					vbCrLf & "   <TopicLocked>" & CBool(rsCommon("Locked")) & "</TopicLocked>" & _
					vbCrLf & "   <ReplyCount>" & rsCommon("No_of_replies") & "</ReplyCount>")
					If isDate(rsCommon("Event_date")) Then sarryRecords(intRecordLoop) = sarryRecords(intRecordLoop) & vbCrLf & "   <EventDateStart>" & internationalDateTime(CDate(rsCommon("Event_date"))) & "</EventDateStart>" Else sarryRecords(intRecordLoop) = sarryRecords(intRecordLoop) & vbCrLf & "   <EventDateStart/>"
					If isDate(rsCommon("Event_date_end")) Then sarryRecords(intRecordLoop) = sarryRecords(intRecordLoop) & vbCrLf & "   <EventDateEnd>" & internationalDateTime(CDate(rsCommon("Event_date_end"))) & "</EventDateEnd>" Else sarryRecords(intRecordLoop) = sarryRecords(intRecordLoop) & vbCrLf & "   <EventDateEnd/>"
					sarryRecords(intRecordLoop) = sarryRecords(intRecordLoop) & ("" & _
					vbCrLf & "   <PostID>" & rsCommon("Thread_ID") & "</PostID>")
					If isDate(rsCommon("Message_date")) Then sarryRecords(intRecordLoop) = sarryRecords(intRecordLoop) & vbCrLf & "   <PostDate>" & internationalDateTime(CDate(rsCommon("Message_date"))) & "</PostDate>" Else sarryRecords(intRecordLoop) = sarryRecords(intRecordLoop) & vbCrLf & "   <PostDate/>"
					sarryRecords(intRecordLoop) = sarryRecords(intRecordLoop) & ("" & _
					vbCrLf & "   <MemberID>" & rsCommon("Author_ID") & "</MemberID>" & _
					vbCrLf & "   <MemberName>" & Server.HTMLEncode(rsCommon("Username")) & "</MemberName>" & _
					vbCrLf & "   <Post><![CDATA[" & rsCommon("Message") & "]]></Post>")
					
					intRecordLoop = intRecordLoop + 1
					
					'Move to next record
					rsCommon.MoveNext
				Loop
			
			End If
			
			'Reset Server Objects
			rsCommon.Close
			
		
		
		
		'******  ChangeMemberPassword  ******
		Case "ChangeMemberPassword"
			
			
			'Read in username
			strMemberName = Trim(Mid(Request("MemberName"), 1, 20))
			strMemberName = formatSQLInput(strMemberName)
			
			'Read in password
			strNewPassword = LCase(Trim(Mid(Request("NewPassword"), 1, 15)))
			
			
			'SQL
			strSQL = "SELECT " & strDbTable & "Author.Author_ID, " & strDbTable & "Author.Username, " & strDbTable & "Author.Password, " & strDbTable & "Author.Salt " & _
			"FROM " & strDbTable & "Author" & strDBNoLock & " " & _
			"WHERE " & strDbTable & "Author.Username = '" & strMemberName & "'; "
			
			'Query the database
			rsCommon.Open strSQL, adoCon
			
			'If nothing returned then an error
			If rsCommon.EOF Then
				
				intErrorCode = -150
				strErrorDescription = "Member not found"
			
			'If no password 
			ElseIf Len(strNewPassword) < 2 Then
				
				intErrorCode = -200
				strErrorDescription = "Password length is to short"
			
			'Else member is found so write XML	
			Else
				ReDim Preserve sarryRecords(0)
				
				 'Encrypt password
				If strNewPassword <> "" Then
					
					'Encrypt password
					If blnEncryptedPasswords Then																							
				
						'Genrate a slat value
					       	strSalt = getSalt(Len(strNewPassword))
					
					       'Concatenate salt value to the password
					       strNewPassword = strNewPassword & strSalt
					
					       'Encrypt the password
					       strNewPassword = HashEncode(strNewPassword)
					
					'Else the password is not set to be encrypted so make sure it is SQL safe
					Else
				
						strNewPassword = formatSQLInput(strNewPassword)
					End If
				End If
				
				'Generate new usercode for user
				strMemberCode = userCode(strMemberName)
				
					
				'Update db
				strSQL = "UPDATE " & strDbTable & "Author" & strRowLock & " " & _
				"SET " & _
				strDbTable & "Author.User_code = '" & strMemberCode & "', " & _
				strDbTable & "Author.Password = '" & strNewPassword & "', " & _
				strDbTable & "Author.Salt = '" & strSalt & "' " & _
				"WHERE " & strDbTable & "Author.Username = '" & strMemberName & "'; "
					
				'Write to the database
				adoCon.Execute(strSQL)
					
					
				sarryRecords(0) = ("" & _
				vbCrLf & "   <Username>" & Server.HTMLEncode(rsCommon("Username")) & "</Username>" & _
				vbCrLf & "   <UserID>" & rsCommon("Author_ID") & "</UserID>")
				If blnEncryptedPasswords Then	
					sarryRecords(0) = sarryRecords(0) & ("" & _
					vbCrLf & "   <EncryptedPassword>" & strNewPassword & "</EncryptedPassword>" & _
					vbCrLf & "   <Salt>" & strSalt & "</Salt>")
				Else
					sarryRecords(0) = sarryRecords(0) & ("" & _
					vbCrLf & "   <Password>" & strNewPassword & "</Password>")
				End If	
				sarryRecords(0) = sarryRecords(0) & ("" & _
				vbCrLf & "   <MemberCode>" & strMemberCode & "</MemberCode>")
				
			
			End If
			
			'Reset Server Objects
			rsCommon.Close
			
		
		
		
		
		
		
		'******  LoginMemberCookie  ******
		Case "LoginMemberCookie"
			
			
			'Read in username
			strMemberName = Trim(Mid(Request("MemberName"), 1, 20))
			strMemberName = formatSQLInput(strMemberName)
			
			'Read in password
			strPassword = LCase(Trim(Mid(Request("MemberPassword"), 1, 15)))
			
			
			'SQL
			strSQL = "SELECT " & strDbTable & "Author.Author_ID, " & strDbTable & "Author.Username, " & strDbTable & "Author.User_code, " & strDbTable & "Author.Password, " & strDbTable & "Author.Salt " & _
			"FROM " & strDbTable & "Author" & strDBNoLock & " " & _
			"WHERE " & strDbTable & "Author.Username = '" & strMemberName & "'; "
			
			'Query the database
			rsCommon.Open strSQL, adoCon
			
			'If nothing returned then an error
			If rsCommon.EOF Then
				
				intErrorCode = -150
				strErrorDescription = "Member not found"
			
			'Else member is found so write XML	
			Else
				
				'If password is enetred then check it
				If strPassword <> "" Then
					
					'Only encrypt password if this is enabled
					If blnEncryptedPasswords Then
						
						'Encrypt password so we can check it against the encypted password in the database
						'Read in the salt
						strPassword = strPassword & rsCommon("Salt")
				
						'Encrypt the entered password
						strPassword = HashEncode(strPassword)
					End If
					
					'If password is wrong then tell the user
					If strPassword <> rsCommon("Password") Then
						
						intErrorCode = -160
						strErrorDescription = "Member password incorrect"
					End If
				End If
			
				'If no error from the password check then display login details for the user
				If intErrorCode = 0 Then
				
					ReDim Preserve sarryRecords(0)
						
					sarryRecords(0) = ("" & _
					vbCrLf & "   <Username>" & Server.HTMLEncode(rsCommon("Username")) & "</Username>" & _
					vbCrLf & "   <UserID>" & rsCommon("Author_ID") & "</UserID>" & _
					vbCrLf & "   <CookieName>" & strCookiePrefix & "sLID</CookieName>" & _
					vbCrLf & "   <CookieKey>UID</CookieKey>" & _
					vbCrLf & "   <CookieData>" &  rsCommon("User_code") & "</CookieData>" & _
					vbCrLf & "   <CookiePath>" & strCookiePath & "</CookiePath>" & _
					vbCrLf & "   <ForumPath>" & strForumPath & "</ForumPath>")
				End If
			
			End If
			
			'Reset Server Objects
			rsCommon.Close
		
		
		
		
		
		'******  LogoutMember  ******
		Case "LogoutMember"
			
			
			'Read in username
			strMemberName = Trim(Mid(Request("MemberName"), 1, 20))
			strMemberName = formatSQLInput(strMemberName)
			
			
			'SQL
			strSQL = "SELECT " & strDbTable & "Author.Author_ID, " & strDbTable & "Author.Username, " & strDbTable & "Author.User_code " & _
			"FROM " & strDbTable & "Author" & strDBNoLock & " " & _
			"WHERE " & strDbTable & "Author.Username = '" & strMemberName & "'; "
			
			'Query the database
			rsCommon.Open strSQL, adoCon
			
			'If nothing returned then an error
			If rsCommon.EOF Then
				
				intErrorCode = -150
				strErrorDescription = "Member not found"
			
			'Else member is found so write XML	
			Else
				ReDim Preserve sarryRecords(0)
				
				'Generate new usercode for user
				strMemberCode = userCode(strMemberName)
				
					
				'Update db

⌨️ 快捷键说明

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