admin_import_members.asp

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

<% @ Language=VBScript %>
<% Option Explicit %>
<!--#include file="admin_common.asp" -->
<!--#include file="functions/functions_hash1way.asp" -->
<!--#include file="functions/functions_format_post.asp" -->
<!--#include file="functions/functions_date_time_format.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
'**
'****************************************************************************************



'If in demo mode redirect
If blnDemoMode Then
	Call closeDatabase()
	Response.Redirect("admin_web_wiz_forums_premium.asp" & strQsSID1)
End If




'Set the script timeout to 5 hours incase there are lots of emails addresses to import
Server.ScriptTimeout = 2000000000 'secounds


'Set the response buffer to true as we maybe redirecting
Response.Buffer = False 







'Global variables
Dim lngTotalProcessed		'Counts the number of records processed




'******************************************
'***  	  Import form DB	       ****
'******************************************

'Sub procedure to read in the database subscribers
Public Sub GetDbSubscribers()
	
	Dim adoImportCon 		'Database Connection Variable
	Dim strImportCon		'Holds the connection details to db
	Dim rsImport			'Holds the imported db recordset
	Dim strDBType			'Holds the database type to import
	Dim strImpDatabaseLocation	'Holds the db location
	Dim strDatabasePassword		'Holds the db password
	Dim strDatabaseUsername		'Holds the db username
	Dim strDatabaseServer		'Holds the db server name or IP
	Dim strDatabaseName		'Holds the db database name
	Dim strDatabaseTableName	'Holds the database Table name
	Dim strDatabaseEmailField	'Holds the db email field name
	Dim strDatabaseNameField	'Holds the db member name field name
	Dim strDatabasePasswordField	'Holds the db password field name
	Dim strDatabasePathType		'Holds the db path type to database
	Dim lngMemberImportCount	'Counts the number of members imported
	Dim lngMemberAlreadyImported	'Counts the number of members already imported
	Dim lngNoUsername		'Counts the number of members with no email address
	Dim strEmail			'Holds the email address of the user
	Dim strUserName			'Holds the name of the user
	Dim strPassword			'Holds thepassword for the user
	Dim strSaltValue		'Holds the salt value
	Dim strUserCode			'Holds a user code for the user
	Dim blnMemberExists		'Set to true if the email address is already in the database
	Dim blnEmailOK			'Set to true if the email address is valid
	Dim lngMemberID			'Holds the id number of the new user
	Dim blnHTMLformat		'Holds the email format
	Dim lngTotalRecords		'Holds the total number of record to process
	Dim lngDatabaseTotalRecords
	Dim strDatabaseLocation
	Dim strDatabaseSingnature
	Dim strDatabaseNoOfPosts
	Dim strLocation
	Dim strSingnature
	Dim lngNoOfPosts
	Dim strErrorFieldName
	Dim blnUserCodeOK
	Dim intGroupID
	
	
	
	'Initilise variables
	lngMemberImportCount = 0
	lngMemberAlreadyImported = 0
	lngNoUsername = 0
	lngTotalProcessed = 0
	blnEmailOK = True
	blnMemberExists = false
	
	
	
	
	'Read in the form details
	strDBType = Request.Form("dbType")
	strImpDatabaseLocation = Request.Form("location")
	strDatabasePathType = Request.Form("locType")
	strDatabaseUsername = Request.Form("username")
	strDatabasePassword = Request.Form("password")
	strDatabaseServer = Request.Form("dbServerIP")
	strDatabaseName = Request.Form("dbName")
	strDatabaseTableName = Request.Form("tableName")
	strDatabaseEmailField = Request.Form("emailField")
	strDatabaseNameField = Request.Form("nameField")
	strDatabasePasswordField = Request.Form("passwordField")
	strDatabaseLocation = Request.Form("where")
	strDatabaseSingnature = Request.Form("signature")
	strDatabaseNoOfPosts = Request.Form("Posts")
	intGroupID = Cint(Request.Form("GID"))
	
	
	
	'Create a connection odject
	Set adoImportCon = Server.CreateObject("ADODB.Connection")
	
	'If this is an access database then setup the database connection
	If strDBType = "access" OR strDBType = "access97" Then
		
		
		'If this is a path from the application to the database use the mapPath method
		If strDatabasePathType = "virtual" Then strImpDatabaseLocation = Server.MapPath(strImpDatabaseLocation)   
		
		
		'If a username and password are required then pass them across (uses slower generic db access driver
		If strDatabasePassword <> "" OR strDatabaseUsername <> "" Then
		
			strImportCon = "DRIVER={Microsoft Access Driver (*.mdb)};uid=" & strDatabaseUsername & ";pwd=" & strDatabasePassword & "; DBQ=" & strImpDatabaseLocation & "/" & strDatabaseName
		
		
		'If this is access 97 then use the jet3 db driver
		ElseIf strDBType = "access97" Then 
			
			strImportCon = "Provider=Microsoft.Jet.OLEDB.3.51; Data Source=" & strImpDatabaseLocation & "/" & strDatabaseName
		
		'Else use the jet 4 driver
		Else
			strImportCon = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & strImpDatabaseLocation & "/" & strDatabaseName
		End If
	
	
	'Else if this is MS SQL server then setup db connection string
	ElseIf strDBType = "SQLServer" Then 
	
		'MS SQL Server OLE Driver
		strImportCon = "Provider=SQLOLEDB;Server=" & strDatabaseServer & ";User ID=" & strDatabaseUsername & ";Password=" & strDatabasePassword & ";Database=" & strDatabaseName & ";"
	
	'Else if this is mySQL then setup db connection string
	ElseIf strDBType = "mySQL" Then 
	
		'My SQL ODBC Driver
		strImportCon = "Driver={mySQL};Server=" & strDatabaseServer & ";Port=3306;Option=4;Database=" & strDatabaseName & ";Uid=" & strDatabaseUsername & ";Pwd=" & strDatabasePassword & ";"
	End If
	
	
	
	'Set error trapping
	On Error Resume Next
	
	'Open database connection
	adoImportCon.connectionstring = strImportCon
	
	'Set an active connection to the Connection object
	adoImportCon.Open
	
	'If an error has occurred while connecting to database let the user know
	If Err.Number <> 0 Then
	
		Response.Write("<script language=""JavaScript"">" & _
		vbCrLf & "	document.getElementById('displayState').innerHTML = 'Database import process stopped. See detailed error message below.';" & _
		vbCrLf & "	document.getElementById('errMsg').value = document.getElementById('errMsg').value +  'Error connecting to database,\nError: " & errorDescription(err.description) & "\n';" & _
		vbCrLf & "</script>")
		
		Call closeDatabase()
		
		Response.Flush
		Response.End
	End If
	
	

	
	'Get details from database
	Set rsImport = Server.CreateObject("ADODB.Recordset")
	
	
	
	'First count the number of subscribers to import
	strSQL = "SELECT COUNT(*) AS TotalRecords FROM " & strDatabaseTableName & ";"
	
	
	'Query the database
	rsImport.Open strSQL, adoImportCon
	
	'If an error has occurred while getting table data let the user know
	If Err.Number <> 0 Then
	
		Response.Write("<script language=""JavaScript"">" & _
		vbCrLf & "	document.getElementById('displayState').innerHTML = 'Database import process stopped. See detailed error message below.';" & _
		vbCrLf & "	document.getElementById('errMsg').value = document.getElementById('errMsg').value +  'Error, incorrect table name,\nError: " & errorDescription(err.description) & "\n';" & _
		vbCrLf & "</script>")
		
		Call closeDatabase()
		
		Response.Flush
		Response.End
	End If
	
	'Disable error trapping
	On Error goto 0
	
	
	'Get the totla records from db
	lngTotalRecords = rsImport("TotalRecords")
	
	'Display on page number of subscribers to import
	Response.Write("<script language=""JavaScript"">" & _
	vbCrLf & "	document.getElementById('displayState').innerHTML = 'Initialising database import process...';" & _
	vbCrLf & "	document.getElementById('subscribers').innerHTML = '" & lngTotalRecords & "';" & _
	vbCrLf & "</script>")
	
	'Close the recordset
	rsImport.Close
	
	
	
	'Build SQL query
	strSQL = "SELECT * FROM " & strDatabaseTableName & ";"
	
	'Query the database
	rsImport.Open strSQL, adoImportCon
	
	
	'Loop through recordset
	Do While NOT  rsImport.EOF
	
		'Initilise variables
		blnEmailOK = True
		blnMemberExists = false
		strErrorFieldName = ""
		blnUserCodeOK = false
		
		'Count the number of records processed
		lngTotalProcessed = lngTotalProcessed + 1
		
		
		'Set error trapping
		On Error Resume Next
	
		'Read in the details from the database
	
		strUserName = rsImport(strDatabaseNameField)
		If strUserName <> "" Then strUserName = formatSQLInput(strUserName)
		If Err.Number <> 0 Then strErrorFieldName = strErrorFieldName & "\'Name Source Field\', "
		Err.Number = 0
		
		If strDatabasePasswordField <> "" Then 
			strPassword = rsImport(strDatabasePasswordField)
			If strPassword <> "" Then strPassword = removeAllTags(strPassword)
			If Err.Number <> 0 Then strErrorFieldName = strErrorFieldName & "\'Password Source Field\', "
		End If
		Err.Number = 0
		
		If strDatabaseEmailField <> "" Then 
			strEmail = LCase(rsImport(strDatabaseEmailField))
			If strEmail <> "" Then strEmail = removeAllTags(strEmail)
			If Err.Number <> 0 Then strErrorFieldName = "\'Email Address Source Field\', "
		End If
		Err.Number = 0
		
		If strDatabaseLocation <> "" Then 
			strLocation = rsImport(strDatabaseLocation)
			If strLocation <> "" Then strLocation = removeAllTags(strLocation)
			If Err.Number <> 0 Then strErrorFieldName = strErrorFieldName & "\'Location Source Field\', "
		End If
		Err.Number = 0
		
		If strDatabaseNoOfPosts <> "" Then