httpapi.asp

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

<% @ Language=VBScript %>
<% Option Explicit %>
<!--#include file="common.asp" -->
<!--#include file="functions/functions_format_post.asp" -->
<!--#include file="includes/emoticons_inc.asp" -->
<%


'****************************************************************************************
'**  Copyright Notice    
'**
'**  Web Wiz Forums(TM)
'**  http://www.webwizforums.com
'**                            
'**  Copyright (C)2001-2008 Web Wiz(TM). All Rights Reserved.
'**  
'**  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS UNDER LICENSE FROM 'WEB WIZ'.
'**  
'**  IF YOU DO NOT AGREE TO THE LICENSE AGREEMENT THEN 'WEB WIZ' IS UNWILLING TO LICENSE 
'**  THE SOFTWARE TO YOU, AND YOU SHOULD DESTROY ALL COPIES YOU HOLD OF 'WEB WIZ' SOFTWARE
'**  AND DERIVATIVE WORKS IMMEDIATELY.
'**  
'**  If you have not received a copy of the license with this work then a copy of the latest
'**  license contract can be found at:-
'**
'**  http://www.webwizguide.com/license
'**
'**  For more information about this software and for licensing information please contact
'**  'Web Wiz' at the address and website below:-
'**
'**  Web Wiz, Unit 10E, Dawkins Road Industrial Estate, Poole, Dorset, BH15 4JD, England
'**  http://www.webwizguide.com
'**
'**  Removal or modification of this copyright notice will violate the license contract.
'**
'****************************************************************************************



'*************************** SOFTWARE AND CODE MODIFICATIONS **************************** 
'**
'** MODIFICATION OF THE FREE EDITIONS OF THIS SOFTWARE IS A VIOLATION OF THE LICENSE  
'** AGREEMENT AND IS STRICTLY PROHIBITED
'**
'** If you wish to modify any part of this software a license must be purchased
'**
'****************************************************************************************



'Set the response buffer to true as we maybe redirecting and setting a cookie
Response.Buffer = true

'Make sure this page is not cached
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 2
Response.AddHeader "pragma","no-cache"
Response.AddHeader "cache-control","private"
Response.CacheControl = "No-Store"



'If API is disabled
If blnHttpXmlApi = False Then 
	
	Call closeDatabase()
	
	'Reponse
	Response.Write("The Web Wiz Forums HTTP XML API is currently disabled.<br /><br />To enable edit in notepad the file 'includes/setup_options.asp' and set the variable 'blnHttpXmlApi' to 'True'")
	
	'End the response	
	Response.Flush
	Response.End
End If





Dim strAPIversion	'Holds the version number of the API
Dim strApiAction	'Holds the API command
Dim strAdminUsername	'Holds the username of the admin account
Dim strAdminPassword	'Holds the passowrd of the admin account
Dim intErrorCode	'Holds the error code
Dim strErrorDescription	'Holds the error discription
Dim intRecordCount	'Holds the record count
Dim sarryRecords()	'Array holding all records returned for API method
Dim intRecordLoop
Dim strMemberName	'Holds the username 
Dim lngMemberID		'Holds the member ID
Dim lngTopicID
Dim intMaxResults	'Holds the max results to return
Dim strNewPassword	'New Password for member
Dim strSalt
Dim strMemberCode
Dim strUsername
Dim strPassword
Dim strEmail
Dim strRealName
Dim strGender
Dim strHomepage
Dim strSignature
Dim strICQNum
Dim blnShowEmail
Dim blnPMNotify
Dim blnAutoLogin
Dim blnUserActive 
Dim intUsersGroupID 
Dim lngPosts 
Dim strMemberTitle 
Dim blnSuspended 
Dim strAdminNotes 
Dim strAvatar
Dim strUserCode
Dim intForumStartingGroup
Dim blnNewsletter
Dim strEncryptedPassword




'API version
strAPIversion = "1.0"

'Intliase
intErrorCode = 0
lngMemberID = 0
intRecordLoop = 0
intMaxResults = 50

'Read in teh action to perform
strApiAction = Trim(Mid(Request("action"), 1, 25))


'If there is an action then run the page as XML
If strApiAction <> "" Then
	
	'Read in the admin username and password
	strAdminUsername = LCase(Trim(Mid(Request("Username"), 1, 20)))
	strAdminPassword = LCase(Trim(Mid(Request("Password"), 1, 20)))


	'Set the response to XML
	Response.ContentType = "application/xml"
	
	'Set the top line of the page
	Response.Write("<?xml version=""1.0"" encoding=""" & strPageEncoding & """ ?>")
	
	
	
	'******  Admin Account Login Check *******

	'First checkout the username and password is OK
	'Get the master admin username and password from the db (Author_ID = 1), don't use the user imput in the SQL to prevent SQL injections
	strSQL = "SELECT " & strDbTable & "Author.Password, " & strDbTable & "Author.Salt, " & strDbTable & "Author.Username " & _
	"FROM " & strDbTable & "Author" & strDBNoLock & " " & _
	"WHERE " & strDbTable & "Author.Author_ID = 1;"
	
	'Set error trapping
	On Error Resume Next
		
	'Query the database
	rsCommon.Open strSQL, adoCon

	'If an error has occurred write an error to the page
	If Err.Number <> 0 Then	Call errorMsg("An error has occurred while executing SQL query on database.", "get_master_admin_account", "HttpAPI.asp")
				
	'Disable error trapping
	On Error goto 0	
	
	
	'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
		strAdminPassword = strAdminPassword & rsCommon("Salt")
	
		'Encrypt the entered password
		strAdminPassword = HashEncode(strAdminPassword)
	End If
	
	
	
	'If th admin username and password are incorrect return a fail
	If NOT strAdminUsername = LCase(rsCommon("Username")) OR NOT strAdminPassword = rsCommon("Password") Then
		
		
		'Reset Server Objects
		rsCommon.Close
		Call closeDatabase()
		
		Response.Write("" & _
		vbCrLf & "<ApiResponse>" & _
		vbCrLf & " <ErrorCode>-100</ErrorCode>" & _
		vbCrLf & " <ErrorDescription>Admin Login Fail</ErrorDescription>" & _
		vbCrLf & " <ResultData/>" & _
		vbCrLf & "</ApiResponse>")
		
		'End the response
		Response.Flush
		Response.End
		
	End If
	
	'Close recordset
	rsCommon.Close
	
	
	'Select API cation
	Select Case strApiAction
	
		'******  APIVersion *******
		Case "APIVersion" 
			
			ReDim Preserve sarryRecords(0)
			
			sarryRecords(0) =  vbCrLf & "   <ApiVersion>" & strApiVersion & "</ApiVersion>"
		
		
			
			
		'******  WebWizForumsVersion ******
		Case "WebWizForumsVersion"
			
			ReDim Preserve sarryRecords(0)
			
			sarryRecords(0) = ("" & _
			vbCrLf & "   <Software>Web Wiz Forums(TM)</Software>" & _
			vbCrLf & "   <Version>" & strVersion & "</Version>" & _
			vbCrLf & "   <ApiVersion>" & strApiVersion & "</ApiVersion>" & _
			vbCrLf & "   <Copyright>(C)2001-2008 Web Wiz(TM). All rights reserved</Copyright>" & _
			vbCrLf & "   <BoardName>" & Server.HTMLEncode(strMainForumName) & "</BoardName>" & _
			vbCrLf & "   <URL>" & strForumPath & "</URL>" & _
			vbCrLf & "   <Email>" & strForumEmailAddress & "</Email>" & _
			vbCrLf & "   <Database>" & strDatabaseType & "</Database>" & _
			vbCrLf & "   <InstallID>" & strInstallID & "</InstallID>" & _
			vbCrLf & "   <NewsPad>" & blnWebWizNewsPad & "</NewsPad>" & _
			vbCrLf & "   <NewsPadURL>" & strWebWizNewsPadURL & "</NewsPadURL>")
			
		
		
		
		
		
		
		'******  GetMemberByName OR GetMemberByID ******
		Case "GetMemberByName", "GetMemberByID"
			
			If strApiAction = "GetMemberByName" Then
				'Read in username
				strMemberName = Trim(Mid(Request("MemberName"), 1, 20))
				strMemberName = formatSQLInput(strMemberName)
			Else
				If isNumeric(Request("MemberID")) Then
				
					lngMemberID =  LngC(Request("MemberID"))
				Else
					lngMemberID = -1
				End If
			End If
			
			'SQL
			strSQL = "SELECT " & strDbTable & "Author.*, " & strDbTable & "Group.* " & _
			"FROM " & strDbTable & "Author" & strDBNoLock & ", " & strDbTable & "Group" & strDBNoLock & " " & _
			"WHERE " & strDbTable & "Author.Group_ID = " & strDbTable & "Group.Group_ID "
			If strApiAction = "GetMemberByName" Then
				strSQL = strSQL & "AND " & strDbTable & "Author.Username = '" & strMemberName & "'; "
			Else
				strSQL = strSQL & "AND " & strDbTable & "Author.Author_ID = " & lngMemberID & ";"
			End If
			
			'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)
				
				sarryRecords(0) = ("" & _
				vbCrLf & "   <Username>" & Server.HTMLEncode(rsCommon("Username")) & "</Username>" & _
				vbCrLf & "   <UserID>" & rsCommon("Author_ID") & "</UserID>" & _
				vbCrLf & "   <Group>" & Server.HTMLEncode(rsCommon("Name")) & "</Group>" & _
				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 If
			
			'Reset Server Objects
			rsCommon.Close
			
			
			
			
			
		
		'******  ActivateMember  ******
		Case "ActivateMember"
			
			
			'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.Active " & _
			"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)
				
				'Update user status to active
				strSQL = "UPDATE " & strDbTable & "Author" & strRowLock & " " & _
				"SET " & strDbTable & "Author.Active = " & strDBTrue & " " & _