My form takes me to an internal error page upon submission. I have all the fields defined, and my SMTP info passing through. It looks as if everything should work. But it simply doesn't.
Any suggestions is appreciated.
<%
'Declaring Variables
Dim smtpserver,youremail,yourpassword,ContactUs_Name,ContactUs_Email
Dim ContactUs_Subject,ContactUs_Body,Action,IsError
' Edit these 3 values accordingly
smtpserver = "mysmtperserver"
youremail = "myemail"
yourpassword = "mypassword"
' Grabbing variables from the form post
ContactUs_Name = Server.HTMLEncode(Request("ContactUs_Name"))
ContactUs_Email = Server.HTMLEncode(Request("ContactUs_Email"))
ContactUs_Subject = Server.HTMLEncode(Request("ContactUs_Subject"))
ContactUs_Body = Server.HTMLEncode(Request("ContactUs_Body"))
ContactUs_Captcha = Request("recaptcha_response_field")
Action = Request("Action")
' Used to check that the email entered is in a valid format
Function IsValidEmail(Email)
Dim ValidFlag,BadFlag,atCount,atLoop,SpecialFlag,UserName,DomainName,atChr,tAry1
ValidFlag = False
If (Email <> "") And (InStr(1, Email, "#") > 0) And (InStr(1, Email, ".") > 0) Then
atCount = 0
SpecialFlag = False
For atLoop = 1 To Len(Email)
atChr = Mid(Email, atLoop, 1)
If atChr = "#" Then atCount = atCount + 1
If (atChr >= Chr(32)) And (atChr <= Chr(44)) Then SpecialFlag = True
If (atChr = Chr(47)) Or (atChr = Chr(96)) Or (atChr >= Chr(123)) Then SpecialFlag = True
If (atChr >= Chr(58)) And (atChr <= Chr(63)) Then SpecialFlag = True
If (atChr >= Chr(91)) And (atChr <= Chr(94)) Then SpecialFlag = True
Next
If (atCount = 1) And (SpecialFlag = False) Then
BadFlag = False
tAry1 = Split(Email, "#")
UserName = tAry1(0)
DomainName = tAry1(1)
If (UserName = "") Or (DomainName = "") Then BadFlag = True
If Mid(DomainName, 1, 1) = "." then BadFlag = True
If Mid(DomainName, Len(DomainName), 1) = "." then BadFlag = True
ValidFlag = True
End If
End If
If BadFlag = True Then ValidFlag = False
IsValidEmail = ValidFlag
End Function
%>
<%
If Action = "SendEmail" Then
' Here we quickly check/validate the information entered
' These checks could easily be improved to look for more things
If IsValidEmail(ContactUs_Email) = "False" Then
IsError = "Yes"
Response.Write("<font color=""red"">Please enter valid Email address.</font><br>")
End If
If ContactUs_Name = "" Then
IsError = "Yes"
Response.Write("<font color=""red"">Please enter your Name.</font><br>")
End If
If ContactUs_Subject = "" Then
IsError = "Yes"
Response.Write("<font color=""red"">Please enter a Subject.</font><br>")
End If
If ContactUs_Body = "" Then
IsError = "Yes"
Response.Write("<font color=""red"">Please include Message.</font><br>")
End If
if ContactUs_Captcha = "" Then
IsError = "Yes"
Response.Write("<font color=""red"">Captcha Required.</font><br>")
End If
End If
' If there were no input errors and the action of the form is "SendEMail" we send the email off
If Action = "SendEmail" And IsError <> "Yes" Then
Dim strBody
' Here we create a nice looking html body for the email
strBody = strBody & "<font face=""Arial"">Contact Us Form submitted at " & Now() & vbCrLf & "<br><br>"
strBody = strBody & "From http://" & Request.ServerVariables("HTTP_HOST") & vbCrLf & "<br>"
strBody = strBody & "IP " & Request.ServerVariables("REMOTE_ADDR") & vbCrLf & "<br>"
strBody = strBody & "Name" & " : " & " " & Replace(ContactUs_Name,vbCr,"<br>") & "<br>"
strBody = strBody & "Email" & " : " & " " & Replace(ContactUs_Email,vbCr,"<br>") & "<br>"
strBody = strBody & "Subject" & " : " & " " & Replace(ContactUs_Subject,vbCr,"<br>") & "<br>"
strBody = strBody & "<br>" & Replace(ContactUs_Body,vbCr,"<br>") & "<br>"
strBody = strBody & "</font>"
Dim ObjSendMail
Set ObjSendMail = CreateObject("CDO.Message")
'This section provides the configuration information for the remote SMTP server.
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'Send the message using the network (SMTP over the network).
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = smtpserver
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False 'Use SSL for the connection (True or False)
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'basic (clear-text) authentication
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusername") = youremail
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = yourpassword
ObjSendMail.Configuration.Fields.Update
'End remote SMTP server configuration section==
ObjSendMail.To = youremail
ObjSendMail.Subject = ContactUs_Subject
ObjSendMail.From = ContactUs_Email
' we are sending a html email.. simply switch the comments around to send a text email instead
ObjSendMail.HTMLBody = strBody
'ObjSendMail.TextBody = strBody
ObjSendMail.Send
Set ObjSendMail = Nothing
' change the success messages below to say or do whatever you like
' you could do a response.redirect or offer a hyperlink somewhere.. etc etc
%>
If you can't do much with custom error pages then you can use "On Error Resume Next" to trap errors, something like:
On Error Resume Next
'Put your code in here
'Write out error messages
If err.number > 0 then
response.write "Error: err.description & " on line number <strong>" & err.line & "</strong>"
END IF
On Error Goto 0
Caveat: I'd just recommend taking this out once you've got your code working as can mask issues if not used carefully. Instead look at getting some proper error handling and logging in place using custom error pages.
Just at a quick glance... this section looks to be missing an END IF
If (atCount = 1) And (SpecialFlag = False) Then
BadFlag = False
tAry1 = Split(Email, "#")
UserName = tAry1(0)
DomainName = tAry1(1)
Related
I'm using classic ASP and sending an email via CDO and i need to send the following as a link in the body of the email.
http://example.co.uk/Uploaded_Files/<%=RealFileName%>
> ' we are sending a text email.. simply switch the comments around to
> send an html email instead ObjSendMail.HTMLBody = "<h2 align=center>"
> & "<a href="http://example.co.uk/Uploaded_Files/" " &
> Request.Form("filenamex") & "">View File</a>"
The above code come back with this error,
Microsoft VBScript compilation error '800a0401'
Expected end of statement
Do the following
<%
html = ""
Set cdoMessage = Server.CreateObject("CDO.Message")
cdoMessage.From = "email_from#domain.com"
cdoMessage.To = "email_to#domain.com"
cdoMessage.Bcc = "email_bcc#domain.com"
cdoMessage.Subject = "subject"
cdoMessage.ReplyTo = "email_replyto#domain.com"
cdoMessage.HTMLBody = html
sch = "http://schemas.microsoft.com/cdo/configuration/"
cdoMessage.Configuration.Fields.Item(sch & "smtpserver") = smtp.domain.com
cdoMessage.Configuration.Fields.Item(sch & "sendusername") = user
cdoMessage.Configuration.Fields.Item(sch & "sendpassword") = pass
cdoMessage.Configuration.Fields.Item(sch & "smtpserverport") = 587
cdoMessage.Configuration.Fields.Item(sch & "smtpusessl") = False
cdoMessage.Configuration.Fields.Item(sch & "smtpconnectiontimeout") = 60
cdoMessage.Configuration.Fields.Item(sch & "smtpauthenticate") = 1
cdoMessage.Configuration.Fields.Item(sch & "sendusing") = 2
cdoMessage.Configuration.Fields.update
cdoMessage.Send
Set cdoMessage = Nothing
%>
The problem is the extra quotation marks, try this:
ObjSendMail.HTMLBody = "<h2 align=center><a href='example.co.uk/Uploaded_Files/" & Request.Form("filenamex") & "'>View File</a>"
I don't know too much about ASP, here is my code:
<%
dim objCmd, objRS1, objRS2, strDate1, strDate2, strName, strStyle, datDate, strLastGroup, datNow
set objCmd = Server.CreateObject("ADODB.Command")
Set objRS1 = Server.CreateObject("ADODB.Recordset")
Set objRS2 = Server.CreateObject("ADODB.Recordset")
set objCmd.ActiveConnection = objConn
objCmd.CommandText = "Select Site_Pages.Filename, HeadingName, MatrixName, Site_Matrices.MatrixID, TurnaroundOverride, TurnaroundName, MAX(Turnaround) AS AutoTurnaround, TurnaroundGroup FROM Site_Headings, Site_Pages, Site_Matrices, Site_Items, Site_Items_Prices, Items WHERE Site_Headings.HeadingID = Site_Pages.HeadingID AND Site_Pages.ProdPageID = Site_Matrices.ProdPageID AND Site_Matrices.MatrixID = Site_Items.MatrixID AND Site_Items.ItemID = Site_Items_Prices.ItemID AND Site_Items_Prices.PriceID = Items.PriceID AND SiteID = 0 AND TurnaroundPage = 1 GROUP BY HeadingName, MatrixName, TurnaroundOverride, TurnaroundName, Site_Pages.Filename, TurnaroundGroup, TurnaroundSortOrder, Site_Matrices.MatrixID ORDER BY TurnaroundGroup, TurnaroundSortOrder, HeadingName, MatrixName, TurnaroundName"
set objRS1 = objCmd.Execute
if not objRS1.eof then
Call NewTable(objRS1("TurnaroundGroup"))
strLastGroup = objRS1("TurnaroundGroup")
end if
do until objRS1.eof
if strLastGroup <> objRS1("TurnaroundGroup") then
Call EndTable()
Call NewTable(objRS1("TurnaroundGroup"))
end if
strLastGroup = objRS1("TurnaroundGroup")
'decide todays date for checking dated turnaround overrides
datNow = dateadd("h", GetSetting("TimeOffset"), now())
'if before 7am, knock off a day
if hour(datnow) < 7 then datnow = dateadd("d", -1, datnow)
objCmd.CommandText = "SELECT Turnaround FROM DatedTurnarounds WHERE MatrixID = " & CLng(objRS1("MatrixID")) & " AND TDate = '" & Year(datNow) & PadWithZeros(Month(datNow)) & PadWithZeros(Day(datNow)) & " 00:00'"
set objRS2 = objCmd.Execute
if objRS1("TurnaroundOverride") = 0 OR IsNull(objRS1("TurnaroundOverride")) then
if objRS2.eof then 'use automatic (3-last)
datDate = AddDays(objRS1("AutoTurnaround")-1)
else 'use dated turnaround override (2-second)
datDate = AddDays(objRS2("Turnaround")-1)
end if
else 'use matrix overrride (1-first - overrides all)
datDate = AddDays(objRS1("TurnaroundOverride")-1)
end if
strDate1 = Left(WeekDayName(DatePart("w", datDate)), 3) & " " & DateSuffix(DatePart("d", datDate)) & " of " & MonthName(DatePart("m", datDate))
if objRS1("TurnaroundOverride") = 0 OR IsNull(objRS1("TurnaroundOverride")) then
if objRS2.eof then 'use automatic (3-last)
datDate = AddDays(objRS1("AutoTurnaround"))
else 'use dated turnaround override (2-second)
datDate = AddDays(objRS2("Turnaround"))
end if
else 'use matrix overrride (1-first - overrides all)
datDate = AddDays(objRS1("TurnaroundOverride"))
end if
objRS2.close
strDate2 = Left(WeekDayName(DatePart("w", datDate)), 3) & " " & DateSuffix(DatePart("d", datDate)) & " of " & MonthName(DatePart("m", datDate))
if objRS1("TurnaroundName") = "" OR IsNull(objRS1("TurnaroundName")) then
if objRS1("MatrixName") = "" OR IsNull(objRS1("MatrixName")) then
strName = objRS1("HeadingName")
else
strName = objRS1("MatrixName")
end if
else
strName = objRS1("TurnaroundName")
end if
if strStyle = "PriceMatrixRow1" then
strStyle = "PriceMatrixRow2"
else
strStyle = "PriceMatrixRow1"
end if
%>
I think the problem should be somewhere here
objCmd.CommandText = "SELECT Turnaround FROM DatedTurnarounds WHERE MatrixID = " & CLng(objRS1("MatrixID")) & " AND TDate = '" & Year(datNow) & PadWithZeros(Month(datNow)) & PadWithZeros(Day(datNow)) & " 00:00'"
set objRS2 = objCmd.Execute
I'm not sure if I can execute another object in an object though
Any help would be very much appreciated.
I want is after i login i want to change my label.text in my home.aspx
what is should i do
.
Problems in VB.net than ASP.net
Always i do is
Home.aspx.label.text = userTxt.text
But on this asp i got a problem on that
If userTxt.Text <> "" And passTxt.Text <> "" Then
cmd = New OleDbCommand("Select * from loginClient where emailaddress = '" & userTxt.Text & "' and password = '" & passTxt.Text & "'", cnn)
rdoleb = cmd.ExecuteReader
Response.Redirect("main.aspx")
rdoleb.Close()
If rdoleb.Read = True Then
If userTxt.Text = rdoleb.Item(2) And passTxt.Text = rdoleb.Item(3) Then
rdoleb.Close()
End If
Also for some reason it was working yesterday but it isn't working today. I don't think its the code but some external matter.
Anyways
Dim virtualFolder As String = "~/Scripts/"
Dim physicalFolder As String = Server.MapPath(virtualFolder)
Dim unixLogin As String = (USERNAME & "#" & COMPUTERNAME & ":" & UNIXSCRIPTNAME)
' Send file to Unix server via pscp
Dim Proc As New System.Diagnostics.Process
Proc.StartInfo = New ProcessStartInfo("C:\Windows\System32\cmd.exe")
'MsgBox("/C C:\pscp.exe -pw " & PASSWORD & " " & physicalFolder & "\" & UNIXSCRIPTNAME & " " & unixLogin)
Proc.StartInfo.Arguments = "C:\pscp.exe -pw " & PASSWORD & " " & physicalFolder & "\" & UNIXSCRIPTNAME & " " & USERNAME & "#" & COMPUTERNAME & ":" & UNIXSCRIPTNAME
Proc.StartInfo.RedirectStandardInput = True
Proc.StartInfo.RedirectStandardOutput = False
Proc.StartInfo.UseShellExecute = False
'Proc.StartInfo.CreateNoWindow = True
Proc.Start()
' Allows script to execute sequentially instead of simultaneously
Proc.WaitForExit()
' Make file executable
Proc.StartInfo = New ProcessStartInfo("C:\plink.exe")
'MsgBox("-ssh -pw " & PASSWORD & " " & USERNAME & "#" & COMPUTERNAME & " chmod u+x ./" & UNIXSCRIPTNAME)
Proc.StartInfo.Arguments = "-ssh -pw " & PASSWORD & " " & USERNAME & "#" & COMPUTERNAME & " chmod u+x ./" & UNIXSCRIPTNAME
Proc.StartInfo.RedirectStandardInput = True
Proc.StartInfo.RedirectStandardOutput = False
Proc.StartInfo.UseShellExecute = False
' Proc.StartInfo.CreateNoWindow = True
Proc.Start()
Proc.WaitForExit()
' Execute File
Proc.StartInfo = New ProcessStartInfo("C:\plink.exe")
Proc.StartInfo.Arguments = "-ssh -pw " & PASSWORD & " " & USERNAME & "#" & COMPUTERNAME & " ./" & UNIXSCRIPTNAME
Proc.StartInfo.RedirectStandardInput = True
Proc.StartInfo.RedirectStandardOutput = False
Proc.StartInfo.UseShellExecute = False
'Proc.StartInfo.CreateNoWindow = True
Proc.Start()
Proc.WaitForExit()
' Remove File
Proc.StartInfo = New ProcessStartInfo("C:\plink.exe")
Proc.StartInfo.Arguments = "-ssh -pw " & PASSWORD & " " & USERNAME & "#" & COMPUTERNAME & " rm ./" & UNIXSCRIPTNAME
Proc.StartInfo.RedirectStandardInput = True
Proc.StartInfo.RedirectStandardOutput = False
Proc.StartInfo.UseShellExecute = False
'Proc.StartInfo.CreateNoWindow = True
Proc.Start()
Proc.WaitForExit()
Can this be shortened?
I am...
1) Sending a file to a unix system
2) Making it executable
3) Running the file (its a script)
4) Deleting it after
You may want to see if this will work for you. I do not have an Unix system to check it on, but it seems to populate the process correctly. I also dummied up default values for your variables for testing purposes. This takes away a lot of the redundancy and shortens the amount of code.
Public Class Form1
Dim USERNAME As String = "USERNAME"
Dim COMPUTERNAME As String = "COMPUTERNAME"
Dim UNIXSCRIPTNAME As String = "UNIXSCRIPTNAME"
Dim PASSWORD As String = "PASSWORD"
Dim virtualFolder As String = "~/Scripts/"
Dim physicalFolder As String = "physicalFolder"
Dim unixLogin As String = (USERNAME & "#" & COMPUTERNAME & ":" & UNIXSCRIPTNAME)
Dim processCmdFileTransfer As String = "C:\pscp.exe -pw " & PASSWORD & " " & physicalFolder & "\" & UNIXSCRIPTNAME & " " & USERNAME & "#" & COMPUTERNAME & ":" & UNIXSCRIPTNAME
Dim processCmdFileActions As String = "-ssh -pw " & PASSWORD & " " & USERNAME & "#" & COMPUTERNAME & "XX" & UNIXSCRIPTNAME
Public Sub New()
' This call is required by the designer.
InitializeComponent()
' Add any initialization after the InitializeComponent() call.
test()
End Sub
Public Sub test()
RunProcess("C:\Windows\System32\cmd.exe", processCmdFileTransfer)
RunProcess("C:\plink.exe", processCmdFileActions, " chmod u+x ./")
RunProcess("C:\plink.exe", processCmdFileActions, " ./")
RunProcess("C:\plink.exe", processCmdFileActions, " rm ./")
End Sub
Private Sub RunProcess(processPath As String, startInfo As String, Optional command As String = "")
Dim Proc As New System.Diagnostics.Process
Proc.StartInfo = New ProcessStartInfo(processPath)
If (InStr(startInfo, "XX") > 0) And (command <> "") Then
startInfo = startInfo.Replace("XX", command)
End If
Proc.StartInfo.Arguments = startInfo
Proc.StartInfo.RedirectStandardInput = True
Proc.StartInfo.RedirectStandardOutput = False
Proc.StartInfo.UseShellExecute = False
Proc.Start()
Proc.WaitForExit()
End Sub
End Class
I'm using this with my server to send mails. Which is working perfectly.I want to try it out on my localhost app that I made.
Set myMail=CreateObject("CDO.Message")
myMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
myMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/bodyformat") = 0 ' 0 - html, 1 - text
myMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/mailformat") = 0 ' 0 - mime, 1 - text
myMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "206.183.108.132"
myMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
myMail.Configuration.Fields.Update
myMail.Subject = "Your New Password for Leave App"
myMail.From = rs("email")
myMail.To = "somename#domain.com"
msgg = msgg & "Dear" & " " & session("Username") & vbcrlf & vbcrlf
msgg = msgg & "This is your new password" & vbcrlf & vbcrlf
msgg = msgg & "YOUR CHANGED PASSWORD" & vbcrlf
msgg = msgg & "- - - - - - - - - - - - - - - - - - - - - - - - - - -" & vbcrlf
msgg = msgg & "User/Login Name :" & session("Username") & vbcrlf
msgg = msgg & "Password :" & request.Form("new_pass2") & vbcrlf
msgg = msgg & "- - - - - - - - - - - - - - - - - - - - - - - - - - -" & vbcrlf & vbcrlf
msgg = msgg & "Please sign in to your account using the user name and password above." & vbcrlf & vbcrlf
msgg = msgg & "Thanks" & vbcrlf
myMail.TextBody = msgg
myMail.Send
set myMail = nothing
Check if your local Machine can reach the SMTP server. It might be blocked in some firewall or router. This website can perform a simple check for you: http://www.canyouseeme.org/
Of course, you might want to check it in the code as well, or via Telnet: http://www.simplescripts.de/smtp-check-port-25-telnet-command.htm
Here is the contents of an include file I created for sending emails:
[note at the top it includes another include that has a fn_dirty() for the purpose of adding things like quotes back in.] ask me if you want that function.
<!-- #INCLUDE FILE = "i_fn_dirty.asp" -->
<%
function email(s_name_from,s_address_from,s_reply_to,s_subject,s_recipients_list,s_msg,s_type_email,s_msg_error_add,s_RemoteHost)
if (s_msg_error_add<>"") then s_msg_error_add = "<hr>" & vbCrLf & s_msg_error_add
if (s_RemoteHost="default") then s_RemoteHost = application("s_mail_server")
'recipients_list = "Scott,scott#changed.net;Andy,andy#changed.net" etc
array_recipients = split(s_recipients_list,";",-1,1)
'so recipients array now looks like this:
'array_recipients(0) = "Scott,scott#changed.net"
'array_recipients(1) = "Andy,andy#changed.net"
'-- Create the Mailer Object
Set Mailer = Server.CreateObject("SoftArtisans.SMTPMail")
'-- Set the Mail Properties
Mailer.RemoteHost = s_RemoteHost
Mailer.FromName = s_name_from
Mailer.FromAddress = s_address_from
if (s_reply_to<>"") then Mailer.ReplyTo = s_reply_to
Mailer.Subject = s_subject
a = ""
For Each Item in array_recipients
array_data = split(Item,",",-1,1)
s_name = array_data(0)
s_email_addr = array_data(1)
if (s_name<>"" and s_email_addr<>"") then
Mailer.AddRecipient s_name, s_email_addr
a = a & "name: " & s_name & ", email: " & s_email_addr & " | "
end if
Next
if (s_type_email = "text") then
Mailer.BodyText = s_msg
else
s_msg_html = replace(s_msg,vbCrLf,"<br>",1,-1,1)
Mailer.HTMLText = s_msg_html
end if
'-- Fire off the email message
if (Mailer.SendMail) then
'yay it worked
Set Mailer = Nothing
else
'try one more time
if (Mailer.SendMail) then
'yay it worked
Set Mailer = Nothing
else
msg = "<br>Error in i_fn_email.asp: " & Mailer.Response & "<br>"
msg = msg & "s_name_from = " & s_name_from & "<br>"
msg = msg & "s_address_from = " & s_address_from & "<br>"
msg = msg & "s_subject = " & s_subject & "<br>"
msg = msg & "recips list = " & a & "<br>"
msg = msg & s_msg_error_add
session("msg") = msg
Set Mailer = Nothing
response.redirect ("error_report.asp")
end if
end if
end function
%>