<% @ Language=VBScript %> <% Option Explicit %> <% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide - Web Wiz Mailing List '** '** Copyright 2001-2004 Bruce Corkhill All Rights Reserved. '** '** This program is free software; you can modify (at your own risk) any part of it '** under the terms of the License that accompanies this software and use it both '** privately and commercially. '** '** All copyright notices must remain in tacked in the scripts and the '** outputted HTML. '** '** You may use parts of this program in your own private work, but you may NOT '** redistribute, repackage, or sell the whole or any part of this program even '** if it is modified or reverse engineered in whole or in part without express '** permission from the author. '** '** You may not pass the whole or any part of this application off as your own work. '** '** All links to Web Wiz Guide and powered by logo's must remain unchanged and in place '** and must remain visible when the pages are viewed unless permission is first granted '** by the copyright holder. '** '** This program is distributed in the hope that it will be useful, '** but WITHOUT ANY WARRANTY; without even the implied warranty of '** MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER '** WARRANTIES WHETHER EXPRESSED OR IMPLIED. '** '** You should have received a copy of the License along with this program; '** if not, write to:- Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom. '** '** '** No official support is available for this program but you may post support questions at: - '** http://www.webwizguide.info/forum '** '** Support questions are NOT answered by e-mail ever! '** '** For correspondence or non support questions contact: - '** info@webwizguide.info '** '** or at: - '** '** Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom '** '**************************************************************************************** 'Set the response buffer to true as we maybe redirecting Response.Buffer = False 'If the session variable is False or does not exsist then redirect the user to the unauthorised user page If Session("blnIsUserGood") = False or IsNull(Session("blnIsUserGood")) = True OR Session("blnSuperAdmin") = False then 'Reset Server Variables Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing 'Redirect to unathorised user page Response.Redirect"unauthorised_user_page.htm" End If 'Set the script timeout to 6 hours incase there are lots of e-mails to send Server.ScriptTimeout = 21600 %> Import Mailing List from Database
Import Mailing List from Database
Return to the the Administration Menu


Your Mailing List is being Imported. Now!!

Do not close this window while this task is being carried out.

There are new members imported to your Mailing List.


<% 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 strDatabaseLocation '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 blnEncryptedPasswords 'Holds if passwords should be encrypted Dim strDatabasePathType 'Holds the db path type to database Dim lngMemberImportCount 'Counts the number of members imported Dim strEmail 'Holds the email address of the user Dim strName '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 blnEmailExists '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 laryCatID 'Holds the cat ID 'Initilise variables lngMemberImportCount = 0 blnEmailOK = True blnEmailExists = false 'Read in the form details strDBType = Request.Form("dbType") strDatabaseLocation = 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") blnEncryptedPasswords = CBool(Request.Form("encrypt")) blnHTMLformat = CBool(Request.Form("HTMLformat")) '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 strDatabaseLocation = Server.MapPath(strDatabaseLocation) '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=" & strDatabaseLocation 'If this is access 97 then use the jet3 db driver ElseIf strDBType = "access97" Then strImportCon = "Provider=Microsoft.Jet.OLEDB.3.51; Data Source=" & strDatabaseLocation 'Else use the jet 4 driver Else strImportCon = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & strDatabaseLocation 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 adoImportCon.connectionstring = strImportCon 'Set an active connection to the Connection object adoImportCon.Open 'Get details from database Set rsImport = Server.CreateObject("ADODB.Recordset") 'Build SQL query strSQL = "SELECT * FROM " & strDatabaseTableName & ";" 'Query the database rsImport.Open strSQL, adoImportCon 'Get all the details from the current database to make sure that ID codes are unique and double entries are not entered strSQL = "SELECT " & strDbTable & "Members.* FROM " & strDbTable & "Members;" '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 'Query the database rsCommon.Open strSQL, adoCon 'Loop through recordset Do While NOT rsImport.EOF 'Initilise variables blnEmailOK = True blnEmailExists = false 'Read in the details from the database strEmail = rsImport(strDatabaseEmailField) If strEmail <> "" Then removeAllTags(strEmail) If strDatabaseNameField <> "" Then strName = rsImport(strDatabaseNameField) If strName <> "" Then removeAllTags(strName) End If If strDatabasePasswordField <> "" Then strPassword = rsImport(strDatabasePasswordField) If strPassword <> "" Then removeAllTags(strPassword) End If 'only run if an email address is returned If strEmail <> "" Then 'Create a user code for the user strUserCode = hexValue(20) With rsCommon 'Loop through all the records in the recordset to check that the user id and the e-mail address are not already in the database Do While NOT .EOF 'If there is no user code or it is already in the database make a new one and serch the recordset from the begining again If strUserCode = .fields("ID_Code") Then 'Calculate a code for the user strUserCode = hexValue(20) 'Move to the first record to make sure the new user code is not in the database .MoveFirst End If 'If the e-mail address is already in the database then this is an update so exit loop If strEmail = .fields("Email") Then 'Set the blnEmailExists variable to true blnEmailExists = true 'Exit the for loop Exit Do End If 'Move to the next record in the recordset .MoveNext Loop 'If the email doesn't already exsist then enter the email into the database If blnEmailExists = False Then 'Create password if there are none If strDatabaseNameField = "" OR strPassword = "" Then strPassword = hexValue(7) 'If the passowrds need to be encrypted then create a slat value and encrypt passords If blnEncryptedPasswords Then 'generate a salt value strSaltValue = hexValue(8) 'Concatenate salt value to the password strPassword = strPassword & strSaltValue 'Encrypt the password strPassword = HashEncode(strPassword & strSaltValue) End If 'Add new record to a new recorset .AddNew 'Set database fields .Fields("Email") = strEmail If strName <> "" Then .Fields("Name") = strName .Fields("Password") = strPassword If blnEncryptPasswords Then .Fields("Salt") = strSaltValue .Fields("ID_Code") = strUserCode .Fields("HTMLformat") = blnHTMLformat .Fields("Active") = True 'Update the database .Update 'Requery database to get the new id number .Requery 'Move to the last record .MoveLast 'Get the id number lngMemberID = CLng(.fields("Mail_ID")) 'Increment the number of users imported by 1 lngMemberImportCount = lngMemberImportCount + 1 'Update the text box displaying the number of imported mebers Response.Write(vbCrLf & "") End If 'Move back to first record .MoveFirst End With 'If the email doesn't already exsist then enter the category details into the database If blnEmailExists = False Then 'Add the category details to the database For each laryCatID in Request.Form("catID") 'Add cat choices strSQL = "INSERT INTO " & strDbTable & "MemCat " & _ "(" & _ "[Mail_ID], " & _ "[Cat_ID] " & _ ") " & _ "VALUES " & _ "('" & lngMemberID & "', " & _ "'" & CLng(laryCatID) & "' " & _ ")" 'Write to database adoCon.Execute(strSQL) Next End If End If 'Move to next record rsImport.MoveNext Loop 'Clean up rsCommon.Close adoImportCon.Close Set adoImportCon = Nothing 'Clean up Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing 'Write a message saying that all the e-mails have been sent Response.Write(vbCrLf & "
Your Mailing List has finshed being imported ") %>