httpapi.asp

简单的asp论坛源码系统,很适用于初学者!界面简洁,功能齐全

				strSQL = "UPDATE " & strDbTable & "Author" & strRowLock & " " & _
				"SET " & _
				strDbTable & "Author.User_code = '" & strMemberCode & "' " & _
				"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>" & _
				vbCrLf & "   <MemberCode>" & strMemberCode & "</MemberCode>" & _
				vbCrLf & "   <LoggedOut>True</LoggedOut>")
			
			End If
			
			'Reset Server Objects
			rsCommon.Close
			
			
			
			
		
		
		'******  CreateMember  ******
		Case "CreateNewMember"
			
			
			'Read in username
			strMemberName = Trim(Mid(Request("MemberName"), 1, 20))
			strMemberName = formatSQLInput(strMemberName)
			
			
			
			'******************************************
			'***   Get the starting group ID	***
			'******************************************
	
			'Get the starting group ID number
	
			'Initalise the strSQL variable with an SQL statement to query the database
			strSQL = "SELECT " & strDbTable & "Group.Group_ID " & _
			"FROM " & strDbTable & "Group" & strDBNoLock & " " & _
			"WHERE " & strDbTable & "Group.Starting_group = " & strDBTrue & ";"
	
			'Query the database
			rsCommon.Open strSQL, adoCon
	
			'Get the forum starting group ID number
			intForumStartingGroup = CInt(rsCommon("Group_ID"))
	
			'Close the recordset
			rsCommon.Close
			
			
			
			
			'******************************************
			'***  Read in member details from form	***
			'******************************************
		
		        'Read in the users details from the form
		        strUsername = Trim(Mid(Request("MemberName"), 1, 20))
		        strPassword = LCase(Trim(Mid(Request("MemberPassword"), 1, 15)))
			strEmail = Trim(Mid(Request("Email"), 1, 60))
			strRealName = Trim(Mid(Request("RealName"), 1, 27))
			strGender = Trim(Mid(Request("Gender"), 1, 10))
			strHomepage = Trim(Mid(Request("Homepage"), 1, 48))
			strSignature = Mid(Request("Signature"), 1, 200)
			If isBool(Request("SignatureAttach")) Then blnAttachSignature = BoolC(Request("SignatureAttach"))  Else blnAttachSignature = True 
			'Check that the ICQ number is a number before reading it in
			If isNumeric(Request("ICQ")) Then strICQNum = Trim(Mid(Request("ICQ"), 1, 15))
			blnShowEmail = False
			blnPMNotify = True
			strDateFormat = Trim(Mid(Request("DateFormat"), 1, 10))
			strTimeOffSet = "+"
			intTimeOffSet = 0
			blnReplyNotify = False
			If isBool(Request("WYSIWYGeditor")) Then blnWYSIWYGEditor = BoolC(Request("WYSIWYGeditor")) Else blnWYSIWYGEditor = True
			If isBool(Request("Active")) Then blnUserActive = BoolC(Request("Active")) Else blnUserActive = True 
		        If isNumeric(Request("GroupID")) Then intUsersGroupID = IntC(Request("GroupID")) Else intUsersGroupID = intForumStartingGroup 
		        If isNumeric(Request("NoOfPosts")) = "" Then lngPosts = LngC(Request("NoOfPosts")) Else lngPosts = 0 
		        strMemberTitle = Trim(Mid(Request("MemberTitle"), 1, 40))
		        If isBool(Request("Suspended")) Then blnSuspended = BoolC(Request("Suspended")) Else blnSuspended = False 
		        strAdminNotes = Trim(Mid(removeAllTags(Request("AdminNotes")), 1, 255))
		        If isBool(Request("Newsletter")) Then blnNewsletter = BoolC(Request("Newsletter")) Else blnNewsletter = False 
		
		
		
		        '******************************************
			'***     Read in the avatar		***
			'******************************************
		
		       strAvatar = Trim(Mid(Request("Avatar"), 1, 95))
		
		       'If the avatar is the blank image then the user doesn't want one
		       If strAvatar = strImagePath & "blank.gif" Then strAvatar = ""
		        
		
		
		        '******************************************
			'***     Clean up member details	***
			'******************************************
		
		        'Clean up user input
			strRealName = removeAllTags(strRealName)
			strRealName = formatInput(strRealName)
			strGender = removeAllTags(strGender)
			strGender = formatInput(strGender)
			        
			'Call the function to format the signature
			strSignature = FormatPost(strSignature)
			
			'Call the function to format forum codes
			strSignature = FormatForumCodes(strSignature)
			
			 'Call the filters to remove malcious HTML code
			 strSignature = HTMLsafe(strSignature)
			
			
			'If the user has not entered a hoempage then make sure the homepage variable is blank
			If strHomepage = "http://" Then strHomepage = ""
			
		            
			strMemberTitle = removeAllTags(strMemberTitle) 
			strMemberTitle = formatInput(strMemberTitle)
			
			
		
			'******************************************
			'***     Check the avatar is OK		***
			'******************************************
			'If there is no . in the link then there is no extenison and so can't be an image
		        If inStr(1, strAvatar, ".", 1) = 0 Then
		                  strAvatar = ""
		               
		         'Else remove malicious code and check the extension is an image extension
		         Else
		                'Call the filter for the image
		                strAvatar = formatInput(strAvatar)
		         End If
				
		
			'******************************************
			'*** 	     Create a usercode 		***
			'******************************************
		
		        'Calculate a code for the user
		        strUserCode = userCode(strUsername)
		
			
		
			'******************************************
			'*** 		Encrypt password	***
			'******************************************
		
		        'Encrypt password
			If strPassword <> "" Then
				
				'Encrypt password
				If blnEncryptedPasswords Then																							
			
					'Genrate a slat value
				       	strSalt = getSalt(Len(strPassword))
				
				       'Concatenate salt value to the password
				       strEncryptedPassword = strPassword & strSalt
				
				       'Encrypt the password
				       strEncryptedPassword = HashEncode(strEncryptedPassword)
				
				'Else the password is not set to be encrypted so place the un-encrypted password into the strEncryptedPassword variable
				Else
			
					strEncryptedPassword = strPassword
				End If
			 End If
			
			'******************************************
			'*** 		Date Format	***
			'******************************************
			
			Select Case strDateFormat
					
				'Format dd/mm/yy
				Case "dd/mm/yy"
					strDateFormat = "dd/mm/yy"
					
				'Format mm/dd/yy
				Case "mm/dd/yy"
					strDateFormat = "mm/dd/yy"	
				
				'Format yy/dd/mm
				Case "yy/dd/mm"
					strDateFormat = "yy/dd/mm"
					
				'Format yy/mm/dd
				Case "yy/mm/dd"
					strDateFormat = "yy/mm/dd"
				
				Case Else
					strDateFormat = "dd/mm/yy"		
			
			End Select
			
			
			'SQL
			'Intialise the strSQL variable with an SQL string to open a record set for the Author table
		        strSQL = "SELECT " & strDbTable & "Author.Author_ID, " & strDbTable & "Author.Group_ID, " & strDbTable & "Author.Username, " & strDbTable & "Author.Real_name, " & strDbTable & "Author.Gender, " & strDbTable & "Author.User_code, " & strDbTable & "Author.Password, " & strDbTable & "Author.Salt, " & strDbTable & "Author.Author_email, " & strDbTable & "Author.Homepage, " & strDbTable & "Author.Location, " & strDbTable & "Author.MSN, " & strDbTable & "Author.Yahoo, " & strDbTable & "Author.ICQ, " & strDbTable & "Author.AIM, " & strDbTable & "Author.Occupation, " & strDbTable & "Author.Interests, " & strDbTable & "Author.DOB, " & strDbTable & "Author.Signature, " & strDbTable & "Author.No_of_posts, " & strDbTable & "Author.No_of_PM, " & strDbTable & "Author.Join_date, " & strDbTable & "Author.Avatar, " & strDbTable & "Author.Avatar_title, " & strDbTable & "Author.Last_visit, " & strDbTable & "Author.Time_offset, " & strDbTable & "Author.Time_offset_hours, " & strDbTable & "Author.Date_format, " & strDbTable & "Author.Show_email, " & strDbTable & "Author.Attach_signature, " & strDbTable & "Author.Active, " & strDbTable & "Author.Rich_editor, " & strDbTable & "Author.Reply_notify, " & strDbTable & "Author.PM_notify, " & strDbTable & "Author.Skype, " & strDbTable & "Author.Login_attempt, " & strDbTable & "Author.Banned, " & strDbTable & "Author.Info, " & strDbTable & "Author.Newsletter " &_
			"FROM " & strDbTable & "Author" & strRowLock & " " & _
			"WHERE " & strDbTable & "Author.Username = '" & strMemberName & "'; "
		
		        'Set the cursor type property of the record set to Dynamic so we can navigate through the record set
		        rsCommon.CursorType = 2
		
		        'Set the Lock Type for the records so that the record set is only locked when it is updated
		        rsCommon.LockType = 3
		
		        'Open the author table
		        rsCommon.Open strSQL, adoCon
				
			
			'If a member is returned then they already exist
			If NOT rsCommon.EOF OR Len(strMemberName) < 2 Then
				
				intErrorCode = -250
				strErrorDescription = "Member already exists"
			
			'If member name less than 3
			ElseIf Len(strMemberName) < 3 Then
				
				intErrorCode = -260
				strErrorDescription = "Member Username to short"
			
			'If password is less than 4
			ElseIf  Len(strPassword) < 4 Then
				
				intErrorCode = -270
				strErrorDescription = "Password to short"
			
			'Else member is found so write XML	
			Else
				ReDim Preserve sarryRecords(0)
				
				With rsCommon
				
					.AddNew
					
					.Fields("Username") = strUsername
	                   		.Fields("Join_date") = internationalDateTime(Now())
					.Fields("Last_visit") = internationalDateTime(Now())
					.Fields("Password") = strEncryptedPassword
				        .Fields("Salt") = strSalt
			                .Fields("User_code") = strUserCode
			                .Fields("Author_email") = strEmail
		                        .Fields("Real_name") = strRealName
		                        .Fields("Gender") = strGender
				       	.Fields("Avatar") = strAvatar
				        .Fields("Homepage") = strHomepage
				        .Fields("Signature") = strSignature
				        .Fields("Attach_signature") = blnAttachSignature
			             	.Fields("Date_format") = strDateFormat
					.Fields("Time_offset") = strTimeOffSet
		 			.Fields("Time_offset_hours") = intTimeOffSet
			    		.Fields("Reply_notify") = blnReplyNotify
			          	.Fields("Rich_editor") = blnWYSIWYGEditor
			          	.Fields("PM_notify") = blnPMNotify
			       		.Fields("Show_email") = blnShowEmail 
		                        .Fields("Newsletter") = blnNewsletter
					.Fields("Group_ID") = intUsersGroupID
					.Fields("Active") = blnUserActive
					.Fields("Banned") = blnSuspended
		                        .Fields("Avatar_title") = strMemberTitle
					.Fields("No_of_posts") = lngPosts
					.Fields("Info") = strAdminNotes
		                	
		
		                        'Update the database with the new user's details (needed for MS Access which can be slow updating)
		                        .Update
		
		                        'Re-run the query to read in the updated recordset from the database
		                        .Requery
		                        
		                        
		                        sarryRecords(0) = ("" & _
					vbCrLf & "   <Username>" & Server.HTMLEncode(rsCommon("Username")) & "</Username>" & _
					vbCrLf & "   <UserID>" & rsCommon("Author_ID") & "</UserID>" & _
					vbCrLf & "   <GroupID>" & rsCommon("Group_ID") & "</GroupID>" & _
					vbCrLf & "   <MemberCode>" & rsCommon("User_code") & "</MemberCode>")
					If blnEncryptedPasswords Then	
						sarryRecords(0) = sarryRecords(0) & ("" & _
						vbCrLf & "   <EncryptedPassword>" & rsCommon("Password") & "</EncryptedPassword>" & _
						vbCrLf & "   <Salt>" & rsCommon("Salt") & "</Salt>")
					Else
						sarryRecords(0) = sarryRecords(0) & ("" & _
						vbCrLf & "   <Password>" & rsCommon("Password") & "</Password>")
					End If	
					sarryRecords(0) = sarryRecords(0) & ("" & _
					vbCrLf & "   <Active>" & CBool(rsCommon("Active")) & "</Active>" & _
					vbCrLf & "   <Suspened>" & CBool(rsCommon("Banned"))  & "</Suspened>")
					If isDate(rsCommon("Join_date")) Then sarryRecords(0) = sarryRecords(0) & vbCrLf & "   <Joined>" & internationalDateTime(CDate(rsCommon("Join_date"))) & "</Joined>" Else sarryRecords(0) = sarryRecords(0) & vbCrLf & "   <Joined/>"
					If isDate(rsCommon("Last_visit")) Then sarryRecords(0) = sarryRecords(0) & vbCrLf & "   <LastVisit>" & internationalDateTime(CDate(rsCommon("Last_visit"))) & "</LastVisit>" Else sarryRecords(0) = sarryRecords(0) & vbCrLf & "   <LastVisit/>"
					sarryRecords(0) = sarryRecords(0) & ("" & _
					vbCrLf & "   <Email>" & rsCommon("Author_email") & "</Email>" & _
					vbCrLf & "   <Name>" & Server.HTMLEncode(rsCommon("Real_name")) & "</Name>")
					If isDate(rsCommon("DOB")) Then sarryRecords(0) = sarryRecords(0) & vbCrLf & "   <DOB>" & internationalDateTime(CDate(rsCommon("DOB"))) & "</DOB>" Else sarryRecords(0) = sarryRecords(0) & vbCrLf & "   <DOB/>"
					sarryRecords(0) = sarryRecords(0) & ("" & _
					vbCrLf & "   <Gender>" & Server.HTMLEncode(rsCommon("Gender")) & "</Gender>" & _
					vbCrLf & "   <PostCount>" & rsCommon("No_of_posts") & "</PostCount>" & _
					vbCrLf & "   <Newsletter>" & CBool(rsCommon("Newsletter")) & "</Newsletter>")
				End with
			
			End If
			
			'Reset Server Objects
			rsCommon.Close
		
		
		
			
		
		'Else no action found
		Case Else
			
			intErrorCode = -400
			strErrorDescription = "Unable to find method '" & strApiAction & "'"
			
	End Select
	
	
	'Close DB
	Call closeDatabase()
	
	
	
	
	
	'******  write XML *******
	
	'If an error has occured display is
	If intErrorCode <> 0 Then
		Response.Write("" & _
		vbCrLf & "<ApiResponse>" & _
		vbCrLf & " <ErrorCode>" & intErrorCode & "</ErrorCode>" & _
		vbCrLf & " <ErrorDescription>" & strErrorDescription & "</ErrorDescription>" & _
		vbCrLf & " <ResultData/>" & _
		vbCrLf & "</ApiResponse>")
		
	
	'Else no error has occured
	Else