📄 admin_import_members.asp
字号:
lngNoOfPosts = rsImport(strDatabaseNoOfPosts)
If lngNoOfPosts <> "" Then lngNoOfPosts = CLng(lngNoOfPosts)
If Err.Number <> 0 Then strErrorFieldName = strErrorFieldName & "\'No Of Posts Source Field\', "
End If
Err.Number = 0
If strDatabaseSingnature <> "" Then
strSingnature = rsImport(strDatabaseSingnature)
If strSingnature <> "" Then strSingnature = HTMLsafe(strSingnature)
If Err.Number <> 0 Then strErrorFieldName = strErrorFieldName & "\'Signature Source Field\', "
End If
Err.Number = 0
'If an error has occurred while getting data let the user know
If strErrorFieldName <> "" 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 " & strErrorFieldName & "\nError: " & errorDescription(err.description) & "\n';" & _
vbCrLf & "</script>")
Call closeDatabase()
Response.Flush
Response.End
End If
'Disable error trapping
On Error goto 0
'If no email address then increament the no email address count
If strUserName = "" OR isNull(strUserName) Then
lngNoUsername = lngNoUsername + 1
'Run if email address is returned
Else
'Initalise the strSQL variable with an SQL statement to query the database
strSQL = "SELECT " & strDbTable & "Author.* " & _
"FROM " & strDbTable & "Author " & _
"WHERE " & strDbTable & "Author.Username = '" & strUserName & "';"
'Remove SQL safe single quote double up set in the format SQL function
strUsername = Replace(strUsername, "''", "'", 1, -1, 1)
strUsername = Replace(strUsername, "\'", "'", 1, -1, 1)
With rsCommon
'Set the cursor type property of the record set to Dynamic so we can navigate through the record set
.CursorType = 2
'Set the Lock Type for the records so that the record set is only locked when it is updated
.LockType = 3
'Query the database
.Open strSQL, adoCon
'If a record is returned this email address is already in the database
If NOT .EOF Then
blnMemberExists = true
'Increment the already imported number
lngMemberAlreadyImported = lngMemberAlreadyImported + 1
End If
'If the email doesn't already exsist then enter the email into the database
If blnMemberExists = 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("Username") = Trim(Mid(strUserName, 1, 20))
.Fields("Password") = strPassword
If blnEncryptedPasswords Then .Fields("Salt") = strSaltValue
.Fields("User_code") = userCode(strUsername)
.Fields("Author_email") = Trim(Mid(strEmail, 1, 50))
.Fields("Group_ID") = intGroupID
.Fields("Join_date") = internationalDateTime(Now())
.Fields("Last_visit") = internationalDateTime(Now())
.Fields("Banned") = False
.Fields("Info") = "" 'This is to prevent errors in mySQL
.Fields("Active") = True
If strDatabaseLocation <> "" Then .Fields("Location") = Trim(Mid(strLocation, 1, 60))
If strDatabaseSingnature <> "" Then .Fields("Signature") = Trim(Mid(strSingnature, 1, 245))
If strDatabaseNoOfPosts <> "" Then .Fields("No_of_posts") = CLng(lngNoOfPosts)
.Fields("Date_format") = saryDateTimeData(1,0)
.Fields("Time_offset") = saryDateTimeData(19,0)
.Fields("Time_offset_hours") = saryDateTimeData(20,0)
.Fields("Reply_notify") = False
.Fields("Rich_editor") = blnRTEEditor
.Fields("PM_notify") = False
.Fields("Show_email") = False
.Fields("Attach_signature") = True
'Update the database
.Update
'Increment the number of users imported by 1
lngMemberImportCount = lngMemberImportCount + 1
End If
'Close rs
.Close
End With
End If
'Display on page number of subscribers to import
Response.Write(vbCrLf & "<script language=""JavaScript"">" & _
vbCrLf & " document.getElementById('displayState').innerHTML = 'Importing member...';" & _
vbCrLf & " document.getElementById('imported').innerHTML = '" & lngMemberImportCount & "';" & _
vbCrLf & " document.getElementById('done').innerHTML = '" & lngMemberAlreadyImported & "';" & _
vbCrLf & " document.getElementById('noname').innerHTML = '" & lngNoUsername & "';" & _
vbCrLf & " document.getElementById('total').innerHTML = '" & lngTotalProcessed & "';" & _
vbCrLf & " document.getElementById('progress').innerHTML = '" & percentageCalculate(lngTotalProcessed, lngTotalRecords, 0) & "';" & _
vbCrLf & " document.getElementById('progressBar').style.width = '" & percentageCalculate(lngTotalProcessed, lngTotalRecords, 3) & "';" & _
vbCrLf & "</script>")
'Move to next record
rsImport.MoveNext
Loop
'Display on page number of subscribers to import
Response.Write("<script language=""JavaScript"">" & _
vbCrLf & " document.getElementById('displayState').innerHTML = 'Database import process complete.';" & _
vbCrLf & "</script>")
'Clean up
adoImportCon.Close
Set adoImportCon = Nothing
End Sub
'******************************************
'*** Calculate Percentage ****
'******************************************
Private Function percentageCalculate(ByRef lngNumberProcessed, ByRef lngTotalToProcess, ByRef intDecPlaces)
'If there are no newsletters sent yet then format the percent by 0 otherwise an overflow error will happen
If lngTotalProcessed = 0 Then
percentageCalculate = FormatPercent(0, 0)
'Else read in the the percentage of newsletters sent
Else
percentageCalculate = FormatPercent((lngNumberProcessed / lngTotalToProcess), intDecPlaces)
End If
End Function
'******************************************
'*** Format Error Description ****
'******************************************
Private Function errorDescription(strErrorDescription)
'Format the error description for javascrip
strErrorDescription = Replace(strErrorDescription, vbCrLf, "", 1, -1, 1)
strErrorDescription = Replace(strErrorDescription, "\", "\\", 1, -1, 1)
strErrorDescription = Replace(strErrorDescription, "'", "\'", 1, -1, 1)
'Return the function result
errorDescription = strErrorDescription
End Function
%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>Import Members</title>
<%
'***** START WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ******
Response.Write("<!--//" & _
vbCrLf & "/* *******************************************************" & _
vbCrLf & "Software: Web Wiz Forums(TM) ver. " & strVersion & "" & _
vbCrLf & "Info: http://www.webwizforums.com" & _
vbCrLf & "Copyright: (C)2001-2008 Web Wiz(TM). All rights reserved" & _
vbCrLf & "******************************************************* */" & _
vbCrLf & "//-->")
'***** END WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ******
%>
<link href="<% = strCSSfile %>default_style.css" rel="stylesheet" type="text/css" />
</head>
<body>
<!-- #include file="includes/admin_header_inc.asp" -->
<h1>Import Members </h1>
<a href="admin_menu.asp" target="_self">Return to the the Admin Control Panel Menu</a><br />
<br />
Youmembers are being Imported.<br />
<span class="lgText">Do not close this window while this task is being carried out. </span><br />
<br />
<table width="100%" border="0" align="center" cellpadding="5" cellspacing="0" class="tableBorder">
<tr>
<td align="left" class="tableLedger">Importing members... </td>
</tr>
<tr class="tableRow">
<td align="left"><table width="72%" border="0" align="center" cellpadding="6" cellspacing="0">
<tr>
<td width="20%" rowspan="10" class="tableRow"> </td>
<td width="7%" class="tableRow"><span id="subscribers"></span></td>
<td width="53%" class="tableRow">Total Records Found</td>
<td width="20%" rowspan="8" class="tableRow"> </td>
</tr>
<tr>
<td class="tableRow"><span id="noname"></span></td>
<td class="tableRow">Records With No Username</td>
</tr>
<tr>
<td class="tableRow"><span id="done"></span></td>
<td class="tableRow">Members Already Imported</td>
</tr>
<tr>
<td class="tableRow"><span id="imported"></span></td>
<td class="tableRow">Members Imported </td>
</tr>
<tr>
<td class="tableRow"><strong><span id="total"></span></strong></td>
<td class="tableRow"><strong>Total Processed </strong></td>
</tr>
<tr>
<td class="tableRow"> </td>
<td class="tableRow"> </td>
</tr>
<tr>
<td colspan="2" class="tableRow"><span id="progress">0%</span> Progress</td>
</tr>
<tr>
<td colspan="2" class="tableRow"><table width="300" border="0" cellpadding="0" cellspacing="1" bgcolor="#999999">
<tr>
<td height="17" background="<% = strImagePath %>progress_bar_bg.gif"><img src="<% = strImagePath %>progress_bar.gif" alt="Progress Bar" height="17" style="width:0%;"id="progressBar" /></td>
</tr>
</table></td>
</tr>
<tr>
<td colspan="3" class="tableRow"><strong>Status: <span id="displayState"></span></strong></td>
</tr>
</table></td>
</tr>
<tr>
<td align="left" class="tableLedger">Error Details</td>
</tr>
<tr>
<td align="left" class="tableRow">Below are the details of any error messages returned by the server<br />
<textarea name="errMsg" cols="80" rows="10" id="errMsg" readonly="readonly">Error messages:-
</textarea></td>
</tr>
</table>
<strong><br />
<br />
<br />
<!-- #include file="includes/admin_footer_inc.asp" -->
<%
'Call sub to do databse import
Call GetDbSubscribers()
'Clean up
Call closeDatabase()
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -