<%@LANGUAGE="VBSCRIPT"%>
<%
' FileName="Connection_ado_conn_string.htm"
' Type="ADO"
' DesigntimeType="ADO"
' HTTP="false"
' Catalog=""
' Schema=""
Dim MM_IACCDA_STRING
'MM_IACCDA_STRING = "Provider=SQLOLEDB;Initial Catalog=IADA_CC_DB;Data Source=192.168.1.15;Persist Security Info=True;User ID=iaccdadw5929;Password=7sYywwm~lovt"
'MM_IACCDA_STRING = "Provider=SQLOLEDB;Initial Catalog=IADA_CC_DB;Data Source=192.168.1.15;Persist Security Info=True;User ID=iaccdadw5929;Password=7sYywwm~lovt"
MM_IACCDA_STRING = Application("MM_IACCDA_STRING")
%>
<%
Function SendMail(strFrom, strTo, strSubject, strBody)
Dim objMail
Dim intErr
Dim SendOK
'On Error Resume Next
' Bad email
If chkEmail(strFrom) = 1 Then
SendMail = False
Exit Function
End If
' Bad email
If chkEmail(strTo) = 1 Then
SendMail = False
Exit Function
End If
'--- Create an instance of the ASPMail SMTP objMail object.
'Set objMail = Server.CreateObject("SMTPsvg.Mailer")
'objMail.FromName = "iada-cc.com"
'objMail.FromAddress = strFrom
'objMail.RemoteHost = "mail.iada-cc.com"
'objMail.AddRecipient strTo, strTo
'objMail.ContentType = "text/html"
'objMail.Subject = strSubject
'objMail.BodyText = strBody
Set objMail = Server.CreateObject("Persits.MailSender")
objMail.FromName = strFrom
objMail.From = strFrom
objMail.AddReplyTo strFrom
objMail.Host = "mail.iada-cc.com"
objMail.Username = "webmail@iada-cc.com"
objMail.Password = "zu@ie6jseKI"
objMail.AddAddress strTo
objMail.Subject = strSubject
objMail.Body = strBody
objMail.IsHTML = True
'on error resume next '## Ignore Errors
objMail.SendToQueue
'If Err <> 0 Then
' SendMail = False
' 'Err_Msg = Err_Msg & "
Your request was not sent due to the following error: " & Err.Description & "
"
'Else
SendMail = True
'End if
'Response.Write objMail.FromName & " "
'Response.Write objMail.FromAddress & " "
'Response.Write objMail.RemoteHost & " "
'Response.Write strTo & " "
'on error resume next '## Ignore Errors
'SendOk = objMail.SendMail
'Response.Write CInt(SendOk) & " "
'If not(SendOk) <> 0 Then
' SendMail = objMail.Response
'Else
' SendMail = True
'End if
'Set objMail = Server.CreateObject("SoftArtisans.SMTPMail")
'--- Set the Remote SMTP Host through which to send the email.
'objMail.RemoteHost = "localhost"
'objMail.FromAddress = strFrom
'objMail.AddRecipient "" , strTo
'objMail.Subject = strSubject
'objMail.HtmlText = strBody
'If objMail.SendMail Then
' SendMail = True
'Else
' SendMail = objMail.response
'End if
'response.write "SMTP Response " & CInt(SendOK) & " "
'Set objMail = CreateObject("CDONTS.NewMail")
'objMail.From = strFrom
'objMail.To = strTo
'objMail.Subject = strSubject
'objMail.BodyFormat = 0
'objMail.MailFormat = 0
'objMail.Body = strBody
'objMail.Send
'If Err.Number = 0 Then
' SendMail = True
'Else
' SendMail = False
'End If
Set objMail = Nothing
End Function
'Check for valid email
function chkEmail(strAddress)
' checks for a vaild email
' returns 1 for invalid addresses
' returns 0 for valid addresses
dim atCnt
chkEmail = 0
' chk length
if len(strAddress) < 5 then
' a@b.c should be the shortest an
' address could be
chkEmail = 1
' chk format
' has at least one "@"
elseif instr(strAddress,"@") = 0 then
chkEmail = 1
' has at least one "."
elseif instr(strAddress,".") = 0 then
chkEmail = 1
' has no more than 3 chars after last "."
elseif len(strAddress) - instrrev(strAddress,".") > 3 then
chkEmail = 1
' has no "_" after the "@"
elseif instr(strAddress,"_") <> 0 and _
instrrev(strAddress,"_") > instrrev(strAddress,"@") then
chkEmail = 1
else
' has only one "@"
atCnt = 0
for i = 1 to len(strAddress)
if mid(strAddress,i,1) = "@" then
atCnt = atCnt + 1
end if
next
if atCnt > 1 then
chkEmail = 1
end if
' chk each char for validity
for i = 1 to len(strAddress)
if not isnumeric(mid(strAddress,i,1)) and _
(lcase(mid(strAddress,i,1)) < "a" or _
lcase(mid(strAddress,i,1)) > "z") and _
mid(strAddress,i,1) <> "_" and _
mid(strAddress,i,1) <> "." and _
mid(strAddress,i,1) <> "@" and _
mid(strAddress,i,1) <> "-" then
chkEmail = 1
end if
next
end if
end function
Sub SendAccountApproved(ID)
Dim Email, Username, Password, FirstName, LastName, Approved
If Not GetMemberEmailInfo(ID, Email, Username, Password, FirstName, LastName, MemberType, Approved) Then
'Response.Write "Member Not Found"
Exit Sub
End If
'Response.Write Email & " " & Username & " " & Password & " " & FirstName & " " & MemberType & " " & Approved
strFrom = Application("RegisterMailTo")
strTo = Email
If Approved Then
strSubject = "IADA-CC " & MemberType & " Membership Accepted"
strBody = "" & vbCrLf _
& "" & vbCrLf _
& "" & vbCrLf _
& "IADA-CC Membership Information" & vbCrLf _
& "" & vbCrLf _
& "" & vbCrLf _
& "" & vbCrLf _
& "Your Membership has been accepted and your Member login has been activated
www.iada-cc.com" & vbCrLf _
& "" & vbCrLf _
& "" & vbCrLf
End If
SendMail strFrom, strTo, strSubject, strBody
'Response.Write strFrom & " " & strTo
End Sub
Function EmailMembers(EmailFrom,EmailSubject,EmailMsg,MemberType,Approved)
Dim rsMem
Dim SQL
Dim strBody, strTo
Dim i
SQL = "SELECT Email, UserName, Password, FirstName, LastName, Company FROM Member WHERE MemberType IN(" & MemberType & ") AND " & Approved
Set rsMem = Server.CreateObject("ADODB.Recordset")
rsMem.ActiveConnection = Application("MM_IACCDA_STRING")
rsMem.Source = SQL
rsMem.CursorType = 0
rsMem.CursorLocation = 2
rsMem.LockType = 1
rsMem.Open()
i = 0
While Not rsMem.EOF
' Send Email
strBody = "" & vbCrLf _
& "" & vbCrLf _
& "" & vbCrLf _
& "IADA-CC Membership Information" & vbCrLf _
& "" & vbCrLf _
& "" & vbCrLf _
& "" & vbCrLf _
& EmailMsg & vbCrLf _
& "
Your Account Username: " & rsMem("UserName") & " Password: " & rsMem("Password") & vbCrLf _
& "" & vbCrLf _
& "" & vbCrLf
i = i + 1
strTo = rsMem("Email")
SendMail EmailFrom, strTo, EmailSubject, strBody
rsMem.MoveNext
Wend
rsMem.Close
Set rsMem = Nothing
EmailMembers = i
End Function
Function GetMemberEmailInfo(ID, Email, Username, Password, FirstName, LastName, MemberType, Approved)
Dim rsMem
Dim MemFound
Set rsMem = Server.CreateObject("ADODB.Recordset")
MemFound = False
rsMem.ActiveConnection = Application("MM_IACCDA_STRING")
rsMem.Source = "SELECT Email, Username, Password, FirstName, LastName, MemberType, Approved FROM Member WHERE MemberID=" & ID
rsMem.CursorType = 0
rsMem.CursorLocation = 2
rsMem.LockType = 1
rsMem.Open()
If Not rsMem.EOF Or Not rsMem.BOF Then
Email = rsMem("Email")
Username = rsMem("Username")
Password = rsMem("Password")
FirstName = rsMem("FirstName")
LastName = rsMem("LastName")
MemberType = rsMem("MemberType")
Approved = rsMem("Approved")
MemFound = True
End If
GetMemberEmailInfo = MemFound
rsMem.Close
Set rsMem = Nothing
End Function
%>
<%
' *** Edit Operations: declare variables
Dim MM_editAction
Dim MM_abortEdit
Dim MM_editQuery
Dim MM_editCmd
Dim MM_editConnection
Dim MM_editTable
Dim MM_editRedirectUrl
Dim MM_editColumn
Dim MM_recordId
Dim MM_fieldsStr
Dim MM_columnsStr
Dim MM_fields
Dim MM_columns
Dim MM_typeArray
Dim MM_formVal
Dim MM_delim
Dim MM_altVal
Dim MM_emptyVal
Dim MM_i
MM_editAction = CStr(Request.ServerVariables("SCRIPT_NAME"))
If (Request.QueryString <> "") Then
MM_editAction = MM_editAction & "?" & Request.QueryString
End If
' boolean to abort record edit
MM_abortEdit = false
' query string to execute
MM_editQuery = ""
%>
<%
' *** Insert Record: set variables
If (CStr(Request("MM_insert")) = "frmContact") Then
MM_editConnection = Application("MM_IACCDA_STRING")
MM_editTable = "dbo.Contacts"
MM_editRedirectUrl = ""
MM_fieldsStr = "ContactName|value|Email|value|Company|value|Address|value|City|value|State|value|Zip|value|Country|value|Phone|value|Comments|value"
MM_columnsStr = "ContactName|',none,''|Email|',none,''|Company|',none,''|Address|',none,''|City|',none,''|State|',none,''|Zip|',none,''|Country|',none,''|Phone|',none,''|Comments|',none,''"
' create the MM_fields and MM_columns arrays
MM_fields = Split(MM_fieldsStr, "|")
MM_columns = Split(MM_columnsStr, "|")
' set the form values
For MM_i = LBound(MM_fields) To UBound(MM_fields) Step 2
MM_fields(MM_i+1) = CStr(Request.Form(MM_fields(MM_i)))
Next
' append the query string to the redirect URL
If (MM_editRedirectUrl <> "" And Request.QueryString <> "") Then
If (InStr(1, MM_editRedirectUrl, "?", vbTextCompare) = 0 And Request.QueryString <> "") Then
MM_editRedirectUrl = MM_editRedirectUrl & "?" & Request.QueryString
Else
MM_editRedirectUrl = MM_editRedirectUrl & "&" & Request.QueryString
End If
End If
End If
%>
<%
' *** Insert Record: construct a sql insert statement and execute it
Dim MM_tableValues
Dim MM_dbValues
If (CStr(Request("MM_insert")) <> "") Then
' create the sql insert statement
MM_tableValues = ""
MM_dbValues = ""
For MM_i = LBound(MM_fields) To UBound(MM_fields) Step 2
MM_formVal = MM_fields(MM_i+1)
MM_typeArray = Split(MM_columns(MM_i+1),",")
MM_delim = MM_typeArray(0)
If (MM_delim = "none") Then MM_delim = ""
MM_altVal = MM_typeArray(1)
If (MM_altVal = "none") Then MM_altVal = ""
MM_emptyVal = MM_typeArray(2)
If (MM_emptyVal = "none") Then MM_emptyVal = ""
If (MM_formVal = "") Then
MM_formVal = MM_emptyVal
Else
If (MM_altVal <> "") Then
MM_formVal = MM_altVal
ElseIf (MM_delim = "'") Then ' escape quotes
MM_formVal = "'" & Replace(MM_formVal,"'","''") & "'"
Else
MM_formVal = MM_delim + MM_formVal + MM_delim
End If
End If
If (MM_i <> LBound(MM_fields)) Then
MM_tableValues = MM_tableValues & ","
MM_dbValues = MM_dbValues & ","
End If
MM_tableValues = MM_tableValues & MM_columns(MM_i)
MM_dbValues = MM_dbValues & MM_formVal
Next
MM_editQuery = "insert into " & MM_editTable & " (" & MM_tableValues & ") values (" & MM_dbValues & ")"
If (Not MM_abortEdit) Then
' execute the insert
Set MM_editCmd = Server.CreateObject("ADODB.Command")
MM_editCmd.ActiveConnection = MM_editConnection
MM_editCmd.CommandText = MM_editQuery
MM_editCmd.Execute
MM_editCmd.ActiveConnection.Close
If (MM_editRedirectUrl <> "") Then
Response.Redirect(MM_editRedirectUrl)
End If
End If
End If
%>
<%
Dim SendResults
Sub ProcessSendRequest
Dim strBody
Dim strFrom
strBody = "" & vbCrLf _
& "" & vbCrLf _
& "
<% If (CStr(Request("MM_insert")) = "frmContact") Then %>
<% Call ProcessSendRequest %>
<% If SendResults Then %>
Thank you for requesting more information. Someone will contact you shortly.
<% Else %>
We are unable to send your request due to send error <%= SendResults %>
<% End If %>
<% Else %>
<% End If %>
[an error occurred while processing this directive]
