I am getting some errors on my classic asp website. When the website runs for the first time it sometimes does an Internal Server Error. Then a refresh would fix it. I decided to check my IIS logs to see what the problem is but i can't interpret it. Here is the log line
2013-12-09 15:29:00 xx.xx.xx.xx GET / |37|80070005|Access_is_denied.__ 80 - xx.xxx.xx.xx Mozilla/5.0+(Windows+NT+6.1;+WOW64)+AppleWebKit/537.36+(KHTML,+like+Gecko)+Chrome/31.0.1650.63+Safari/537.36 500 0 0 702
How about setup custom pages for handle 500 and 500 100 errors?
Create some folder, let's say D:\InetPub\Web01\Err\
Add IUSR_Web01 user with write permission
In IIS for Web01 web site (sample for IIS 6.0)
Put following code in file 500.asp and 500100.asp
Option Explicit
Response.Buffer = True
Response.Expires = -1
Response.ExpiresAbsolute = #Jan 31,2000 12:30:00#
Response.Clear
Dim FS, TF, N, ASPErr
N = Now
Set ASPErr = Server.GetLastError()
Set FS = CreateObject ("Scripting.FileSystemObject")
Set TF = FS.CreateTextFile ("D:\InetPub\1click.lv\Err\500 " & "Error" & Right ("0" & Year (N), 4) & Right ("0" & Month (N), 2) & Right ("0" & Day (N), 2) & "_" & Right ("0" & Hour (N), 2) & Right ("0" & Minute (N), 2) & Right ("0" & Second (N), 2) & ".txt", True, False)
TF.Write MyErrorInfo (ASPErr, False, False, "1click.lv", "")
TF.Close
Set FS = Nothing
Response.Write MyErrorInfo (ASPErr, True, True, "1click.lv", "zam#1click.lv")
Err.Clear
The function:
Function MyErrorInfo (ASPErr, AsHTML, ShowContactInfo, WebTitle, AdminEmail)
Dim Result
Result = ""
If AsHTML = True Then
Result = Result & "<html><head><title>Error occur</title></head><body><font face=Verdana size=2>"
If (ShowContactInfo = True) Then
Result = Result & "<p align=center>"
Result = Result & "<font size=4>"
Result = Result & "<font color=""#008000"">" & WebTitle & "</font><br>"
Result = Result & "<font color=""#800000"">500 Error occur</font><br>"
Result = Result & "Please contact us by email at " & AdminEmail & " and inform about this error<br><br>"
Result = Result & "Thank you for your support!"
Result = Result & "</font>"
Result = Result & "</p>"
End If
Result = Result & "<hr>"
Result = Result & "Error number: <b>" & ASPErr.Number & "</b><br>"
Result = Result & "Error source: <b>" & ASPErr.Source & "</b><br>"
Result = Result & "Error description: <b>" & ASPErr.Description & "</b><br>"
Result = Result & "Error line: <b>" & ASPErr.Line & "</b><br>"
Result = Result & "Client IP: <b>" & Request.ServerVariables ("REMOTE_ADDR") & "</b><br>"
Result = Result & "Client Browser: <b>" & Request.ServerVariables ("HTTP_USER_AGENT") & "</b><br>"
Result = Result & "Client Referer: <b>" & Request.ServerVariables ("HTTP_REFERER") & "</b><br>"
Result = Result & "Path: <b>" & Request.ServerVariables ("PATH_INFO") & "</b><br>"
Result = Result & "Request method: <b>" & Request.ServerVariables ("REQUEST_METHOD") & "</b><br>"
Result = Result & "Request FORM: <b>" & Request.Form & "</b><br>"
Result = Result & "Request QUERY: <b>" & Request.QueryString & "</b><br>"
Result = Result & "<hr>"
Result = Result & "</font></body></html>"
Else
Result = Result & WebTitle & vbCrLf
Result = Result & "Error number: " & ASPErr.Number & vbCrLf
Result = Result & "Error source: " & ASPErr.Source & vbCrLf
Result = Result & "Error description: " & ASPErr.Description & vbCrLf
Result = Result & "Error line: " & ASPErr.Line & vbCrLf
Result = Result & "Client IP: " & Request.ServerVariables ("REMOTE_ADDR") & vbCrLf
Result = Result & "Client Browser: " & Request.ServerVariables ("HTTP_USER_AGENT") & vbCrLf
Result = Result & "Client Referer: " & Request.ServerVariables ("HTTP_REFERER") & vbCrLf
Result = Result & "Path: " & Request.ServerVariables ("PATH_INFO") & vbCrLf
Result = Result & "Request method: " & Request.ServerVariables ("REQUEST_METHOD") & vbCrLf
Result = Result & "Request FORM: " & Request.Form & vbCrLf
Result = Result & "Request QUERY: " & Request.QueryString & vbCrLf
End If
MyErrorInfo = Result
End Function
Related
I'm trying to find a match in a column, return the range of that match, then display a message box with values derived from cells offset from that match's range. But I get error code 91 when I run this. I'm not a great coder, so any extra details you can provide would be really appreciated, as sometimes I struggle to understand the answers provided if it's too jargony.
I was using the find function, but occasionally, the match I want to find is hidden via filters in the spreadsheet, and I read somewhere that the match function won't be affected by whether the cells are filtered or not.
Sub GetInfo2()
Dim Item As String
Dim FindRng As Range
Item = InputBox("What is the item number?", "Item Number")
FindRng = Application.Match(Item, Worksheets("Current Week Summary").Columns(1), 0)
If Not FindRng Is Nothing Then
MsgBox ("Description: " & FindRng.Offset(0, 4).Value & vbCrLf & _
"Flyer/FEM: " & FindRng.Offset(0, 1).Value & vbCrLf & _
"Margin Maker: " & FindRng.Offset(0, 2).Value & vbCrLf & _
"ISR Week: " & FindRng.Offset(0, 3).Value & vbCrLf & _
"Amount To Sell: " & Round(FindRng.Offset(0, 7).Value, 0) & vbCrLf & _
"Cost: $" & FindRng.Offset(0, 18).Value & vbCrLf & _
"Months of Supply: " & Round(FindRng.Offset(0, 35).Value, 0) & vbCrLf & _
"E&O Qty: " & FindRng.Offset(0, 17)), vbOKOnly, Item
End If
End Sub
I did overcome the issue of not being able to search in filtered rows. I ended up using the VLookup Function to find my matches. It apparently searches whether it's filtered or not. I'm still stumped on how to use the match function, so I'd love to know how to do that. But this solved my problem in the interim.
Sub GetInfo()
Dim Item As String
Dim Description As String
Dim FlyerFEM As String
Dim MargMak As String
Dim ISR As String
Dim ATS As String
Dim Cost As String
Dim Supply As String
Dim EAO As String
Item = InputBox("What is the item number?", "Item Number")
Description = WorksheetFunction.VLookup(Item, Range("A:AJ"), 5, False)
FlyerFEM = WorksheetFunction.VLookup(Item, Range("A:AJ"), 2, False)
MargMak = WorksheetFunction.VLookup(Item, Range("A:AJ"), 3, False)
ISR = WorksheetFunction.VLookup(Item, Range("A:AJ"), 4, False)
ATC = WorksheetFunction.VLookup(Item, Range("A:AJ"), 8, False)
Cost = WorksheetFunction.VLookup(Item, Range("A:AJ"), 19, False)
Supply = WorksheetFunction.VLookup(Item, Range("A:AJ"), 36, False)
EAO = WorksheetFunction.VLookup(Item, Range("A:AJ"), 18, False)
MsgBox ("Description: " & Description & vbCrLf & _
"Flyer/FEM: " & FlyerFEM & _
"Margin Maker: " & MargMak & vbCrLf & _
"ISR Week: " & ISR & vbCrLf & _
"Amount To Sell: " & Round(ATC, 0) & vbCrLf & _
"Cost: $" & Cost & vbCrLf & _
"Months of Supply: " & Supply & vbCrLf & _
"E&O Qty: " & Round(EAO, 0)), vbOKOnly, Item
End Sub
Set RsItem = Conn.Execute("EXEC E_UpdateDevBehaviourSmalls #ClientID=" & Session("ClientID") & " ,#UserID=" & Session("EUserID")& " ,#cCompID=" & cCompetenceid & " ,#reason=" &reason & " ,#comptype=" & comptype &",#GID=" & GID & " ,#Behaviour='" & MakeSendable(Behaviour) & "' ,#Deadline='" & deadlinedatetime & "' ,#DevBehaviour='" & MakeSendable(DevBehaviour) & "' ,#Why='" & MakeSendable(Why) & "' ,#ExtraNote='" & MakeSendable(ExtraNote) & "'")
if GID = 0 then
if not RsItem.eof then
GID = RsItem.fields(0).value
if reason = 0 then
'add dummy devbehaviour detail
Set RsItem =Conn.Execute("EXEC E_UpdateDevBehaviourDetail #ClientID=" & Session("ClientID") & " ,#UserID=" & Session("EUserID") & " ,#GID=" & GID & " ,#DID=0 ,#TextField1='dummy' ,#educ= 0 ,#TextField2='dummy' ,#TextField3='dummy' ,#TextField4='dummy'")
end if
end if
end if
When I try to execute the code above (full code below) I got the following error:
(It gets stuck at the following part: if not RsItem.fields(0).value)
ADODB.Recordset error '800a0e78'
Operation is not allowed when the object is closed.
Can anyone help me with this error?
<%
Dim DID
Dim GID
Dim cCompetenceid
Dim Behaviour
Dim Deadline
Dim DevBehaviour
Dim Why
Dim ExtraNote
MakeConn
Session("OnlinePageID") = 106
InsertLogItem "S:12"
If Session("EUserType")=1 Then
If UCase(Request("Action"))="SAVEDETAIL" Then
If not Request("DID")="" Then
DID = Request("DID")
Else
DID = 0
End If
Conn.Execute("EXEC E_UpdateDevBehaviourDetail #ClientID=" & Session("ClientID") & " ,#UserID=" & Session("EUserID") & " ,#GID=" & Request("GID") & " ,#DID=" & DID & " ,#TextField1='" & MakeSendable(Request("TextField1")) & "' ,#TextField2='" & MakeSendable(Request("TextField2")) & "' ,#TextField3='" & MakeSendable(Request("TextField3")) & "' ,#TextField4='" & MakeSendable(Request("TextField4")) & "'")
Conn.Execute("EXEC E_SignIDP #ClientID=" & Session("ClientID") & " ,#UserID=" & Session("EUserID") & " ,#SignStatus=0")
End If
End If
'response.write Session("EUserType") & "<br>"
If Session("EUserType")=1 Then
Select Case UCase(Request("Action"))
Case "EDIT"
If not Request("GID")="" Then
'response.write "EXEC E_GetDevBehavior #ClientID=" & Session("ClientID") & " ,#UserID=" & Session("EUserID") & " ,#GID=" & Request("GID") & "<br>"
Set RsItem = Conn.Execute("EXEC E_GetDevBehavior #ClientID=" & Session("ClientID") & " ,#UserID=" & Session("EUserID") & " ,#GID=" & Request("GID"))
If not RsItem.EOF Then
Behaviour = Replace (RsItem("Behaviour"),"''","'")
Deadline = RsItem("Deadline")
DevBehaviour = Replace (RsItem("DevBehaviour"),"''","'")
Why = Replace (RsItem("Why"),"''","'")
ExtraNote = Replace (RsItem("ExtraNote"),"''","'")
Else
Response.End
End If
'RsItem.close
'Set RsItem = nothing
Else
End If
Case "SAVE"
If not Request("GID")="" Then
Set RsItem = Conn.Execute("EXEC E_GetDevBehavior #ClientID=" & Session("ClientID") & " ,#UserID=" & Session("EUserID") & " ,#GID=" & Request("GID"))
If not RsItem.EOF Then
Behaviour = Replace (RsItem("Behaviour"),"''","'")
Deadline = RsItem("Deadline")
DevBehaviour = Replace (RsItem("DevBehaviour"),"''","'")
Why = Replace (RsItem("Why"),"''","'")
ExtraNote = Replace (RsItem("ExtraNote"),"''","'")
Else
Response.End
End If
'RsItem.close
'Set RsItem = nothing
end if
dag = Day(Now())
maand = Month(Now())
jaar = Year(Now())
uur = Hour(Time)
minuten = Minute(Time)
seconden = Second(Time)
if len(dag)< 2 then dag ="0" & dag
if len(maand) < 2 then maand ="0" & maand
if len(uur) < 2 then uur ="0" & uur
if len(minuten) < 2 then minuten ="0" & minuten
if len(seconden) < 2 then seconden ="0" & seconden
datum= jaar & "-" & maand & "-" & dag
tijd = uur & ":" & minuten& ":" & seconden
datumtijd = datum & " " & tijd
Conn.Execute("EXEC E_UpdatePOPStartDate #ClientID=" & Session("ClientID") & " ,#UserID=" & Session("EUserID"))
Conn.Execute("EXEC E_UpdateStartDate #ClientID=" & Session("ClientID") & " ,#UserID=" & Session("EUserID") & " ,#StartDate='" & datumtijd & "'")
If not Request("GID")="" Then
GID = Request("GID")
newcomp = false
Else
GID = 0
Deadline = CDate(FormatDate("31/12/"&year(now)))
newcomp = true
End If
'response.write Request("cCompetenceid") &"<br>"
if not Request("cCompetenceid") = "" then
cCompetenceid = Request("cCompetenceid")
else
cCompetenceid = 0
end if
if not Request("reason") = "" then
reason = Request("reason")
else
reason = 0
end if
if not Request("comptype") = "" then
comptype = Request("comptype")
else
comptype = 1
end if
Select Case (Request("COMPID"))
Case 1460
Behaviour = Request("Behaviour")
Case 1461
Deadline = Request("DeadlineDay") & "-" & Request("DeadlineMonth") & "-" & Request("DeadlineYear")
Deadline = CDate(FormatDate(Deadline))
Case 1462
DevBehaviour = Request("DevBehaviour")
Case 1463
Why = Request("Why")
Case 1464
ExtraNote = Request("ExtraNote")
End Select
deadlinedate = CDate(Deadline)
deadlineyear = year(deadlinedate)
deadlinemonth = month(deadlinedate)
deadlineday = day(deadlinedate)
deadlinedatetime = deadlineyear & "-" & deadlinemonth & "-" & deadlineday & " 00:00:00"
'response.write "EXEC E_UpdateDevBehaviourSmalls #ClientID=" & Session("ClientID") & " ,#UserID=" & Session("EUserID")& " ,#cCompID=" & cCompetenceid & " ,#reason=" &reason & " ,#comptype=" & comptype &",#GID=" & GID & " ,#Behaviour='" & MakeSendable(Behaviour) & "' ,#Deadline='" & deadlinedatetime & "' ,#DevBehaviour='" & MakeSendable(DevBehaviour) & "' ,#Why='" & MakeSendable(Why) & "' ,#ExtraNote='" & MakeSendable(ExtraNote) & "'"
'response.end
Set RsItem = Conn.Execute("EXEC E_UpdateDevBehaviourSmalls #ClientID=" & Session("ClientID") & " ,#UserID=" & Session("EUserID")& " ,#cCompID=" & cCompetenceid & " ,#reason=" &reason & " ,#comptype=" & comptype &",#GID=" & GID & " ,#Behaviour='" & MakeSendable(Behaviour) & "' ,#Deadline='" & deadlinedatetime & "' ,#DevBehaviour='" & MakeSendable(DevBehaviour) & "' ,#Why='" & MakeSendable(Why) & "' ,#ExtraNote='" & MakeSendable(ExtraNote) & "'")
if GID = 0 then
if not RsItem.eof then
GID = RsItem.fields(0).value
if reason = 0 then
' add dummy devbehaviour detail
Set RsItem =Conn.Execute("EXEC E_UpdateDevBehaviourDetail #ClientID=" & Session("ClientID") & " ,#UserID=" & Session("EUserID") & " ,#GID=" & GID & " ,#DID=0 ,#TextField1='dummy' ,#educ= 0 ,#TextField2='dummy' ,#TextField3='dummy' ,#TextField4='dummy'")
end if
end if
end if
'RsItem.close
'Set RsItem = nothing
Conn.Execute("EXEC E_SignIDP #ClientID=" & Session("ClientID") & " ,#UserID=" & Session("EUserID") & " ,#SignStatus=0")
if newcomp = true then
tempstr = "../popoverview.asp"
ClientScript("parent.location.href = '../bottomframe.asp?GID=" & GID & "&" & SetID &"&ViewID=4'" )
else
response.write " in"
tempstr = "compoverview.asp?Action=Edit&GID="&GID
response.redirect tempstr
' ClientScript("location.href =" & tempstr)
end if
End Select
End If
conn.close
set conn= nothing
%>
Stored procedure:
USE [Q]
GO
/****** Object: StoredProcedure [dbo].[E_UpdateDevBehaviourSmalls] Script Date: 17/10/2013 15:05:53 ******/
SET ANSI_NULLS OFF
GO
SET QUOTED_IDENTIFIER ON
GO
ALTER PROCEDURE [dbo].[E_UpdateDevBehaviourSmalls]
(#ClientID int,
#UserID int,
#cCompID int,
#reason int,
#comptype int,
#GID int,
#Behaviour varchar(250),
#Deadline datetime,
#DevBehaviour text,
#Why text,
#ExtraNote text)
AS
If (#GID = 0)
BEGIN
INSERT INTO DevBehaviour(ClientID,UserID,Behaviour,Deadline,DevBehaviour,Why,ExtraNote,cCompId,reason,comptype)
VALUES(#ClientID,#UserID,#Behaviour,#Deadline,#DevBehaviour,#Why,#ExtraNote, #cCompID,#reason,#comptype)
SELECT ##identity
END
Else
BEGIN
UPDATE DevBehaviour
SET Behaviour=#Behaviour, Deadline=#Deadline, DevBehaviour=#DevBehaviour, Why=#Why, ExtraNote=#ExtraNote, cCompId = #cCompID, reason = #reason, comptype = #comptype
WHERE (ClientID = #ClientID) AND (UserID = #UserID) AND (GID = #GID)
END
I was able to reproduce your problem. Please try the stored proc below (using nocount)
USE [Q]
GO
/****** Object: StoredProcedure [dbo].[E_UpdateDevBehaviourSmalls] Script Date: 17/10/2013 15:05:53 ******/
SET ANSI_NULLS OFF
GO
SET QUOTED_IDENTIFIER ON
GO
ALTER PROCEDURE [dbo].[E_UpdateDevBehaviourSmalls]
(#ClientID int,
#UserID int,
#cCompID int,
#reason int,
#comptype int,
#GID int,
#Behaviour varchar(250),
#Deadline datetime,
#DevBehaviour text,
#Why text,
#ExtraNote text)
AS
set nocount on
If (#GID = 0)
BEGIN
INSERT INTO DevBehaviour(ClientID,UserID,Behaviour,Deadline,DevBehaviour,Why,ExtraNote,cCompId,reason,comptype)
VALUES(#ClientID,#UserID,#Behaviour,#Deadline,#DevBehaviour,#Why,#ExtraNote, #cCompID,#reason,#comptype)
SELECT ##identity
END
Else
BEGIN
UPDATE DevBehaviour
SET Behaviour=#Behaviour, Deadline=#Deadline, DevBehaviour=#DevBehaviour, Why=#Why, ExtraNote=#ExtraNote, cCompId = #cCompID, reason = #reason, comptype = #comptype
WHERE (ClientID = #ClientID) AND (UserID = #UserID) AND (GID = #GID)
END
set nocount off
I'm new to VbScript. I have to make a form for uploading a file and sending to specified email as attachment.
For uploading I used this script http://www.freeaspupload.net/freeaspupload/viewsource.asp
Now my application saves file to server.
The second part looks like this:
<% OPTION EXPLICIT
If Request.Cookies("QuoteRequest") = "Quote" THEN
Dim fileName
Dim strMsg
Dim mail
Dim strSubject
Dim strFrom
Dim strReply
Dim strChoice
Dim AddCheck
Dim MyCheckDate
Dim strMailBlindCopy
Dim smtpserver
Dim youremail
Dim public_mailer
Dim public_password
smtpserver = ""
youremail = ""
public_mailer = ""
public_password = ""
AddCheck = Request.Form("Str_xxrand234Myanswer")
'Use this next line if you want a blind copy send for your records
'strMailBlindCopy = "info#ciupac.com"
'IF AddCheck = "" or NULL THEN
IF len(AddCheck)>2 OR len(AddCheck)<1 OR IsNumeric(AddCheck)=FALSE THEN
response.write "<h2>Sorry an error has occurred, please click here to return to the form</h2>" & AddCheck
Else
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
' If your server requires outgoing authentication uncomment the lines bleow and use a valid email address and password.
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") = public_mailer
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = public_password
ObjSendMail.Configuration.Fields.Update
strFrom = "Quote Request Form"
strReply = Request.Form("txtemail")
strSubject = "Quote Request Form"
strMsg = strMsg & "<b>Your Name:</b> " & Request.Form("txtname") & vbCrLF & vbCrLF & "<BR>" & "<BR>"
strMsg = strMsg & "<b>Your Company Name:</b> " & Request.Form("txtcompany") & vbCrLF & vbCrLF & "<BR>" & "<BR>"
strMsg = strMsg & "<b>Your Order Number:</b> " & Request.Form("txtyourorder") & vbCrLF & vbCrLF & "<BR>" & "<BR>"
strMsg = strMsg & "<b>Our Order Number:</b> " & Request.Form("txtourorder") & vbCrLF & vbCrLF & "<BR>" & "<BR>"
strMsg = strMsg & "<b>Destination Postal Code:</b> " & Request.Form("txtpostal") & vbCrLF & vbCrLF & "<BR>" & "<BR>"
strMsg = strMsg & "<b>Order Date:</b> " & Request.Form("txtdate") & vbCrLF & vbCrLF & "<BR>" & "<BR>"
strMsg = strMsg & "<b>Your E-mail Address:</b> " & Request.Form("txtemail") & vbCrLF & vbCrLF & "<BR>" & "<BR>"
strMsg = strMsg & "<b>Telephone #:</b> " & Request.Form("txtphone") & vbCrLF & vbCrLF & "<BR>" & "<BR>"
strMsg = strMsg & "<b>Comments:</b> " & Request.Form("txtcomments") & vbCrLF & vbCrLF & "<BR>" & "<BR>"
strMsg = strMsg & "<b>Market Served:</b> " & Request.Form("option1") & ", " & Request.Form("option2") & ", " & Request.Form("option3") & ", " & Request.Form("option4") & ", " & Request.Form("option5") & ", " & Request.Form("option6") & ", " & Request.Form("option7") & ", " & Request.Form("option8") & ", " & Request.Form("option9") & ", " & Request.Form("option10") & ", " & Request.Form("option11") & ", " & Request.Form("option12") & ", " & Request.Form("option13") & ", " & Request.Form("option14") & vbCrLF & vbCrLF & "<BR>" & "<BR>"
strMsg = strMsg & "<b>Topic of Interest:</b> " & Request.Form("option15") & ", " & Request.Form("option16") & ", " & Request.Form("option17") & ", " & Request.Form("option18") & ", " & Request.Form("option19") & ", " & Request.Form("option20") & ", " & Request.Form("option21") & ", " & Request.Form("option22") & ", " & Request.Form("option23") & ", " & Request.Form("option24") & ", " & Request.Form("option25") & ", " & Request.Form("option26") & ", " & Request.Form("option27") & ", " & Request.Form("option28") & ", " & Request.Form("option29") & ", " & Request.Form("option30") & ", " & Request.Form("option31") & ", " & Request.Form("option32") & vbCrLF & vbCrLF
fileName = Request.Form("file")
Dim strMailTo
strMailTo =""
ObjSendMail.To = strMailTo
ObjSendMail.Subject = strSubject
ObjSendMail.From = strReply
ObjSendMail.HTMLBody = strMsg
If Len(fileName)Then
ObjSendMail.AddAttachment "C:\attachments\" & fileName
End If
ObjSendMail.Send
Set ObjSendMail = Nothing
Response.Redirect("thank-you.asp")
END IF
ELSE
Dim txtname
Response.Write "ERROR <P>"
fname=Request.Cookies("QuoteRequest")
response.write("QuoteRequest=" & txtname)
END IF
%>
These two scripts work well independently, but when I try to include the email send part to upload the Cannot use Request.Form collection after calling BinaryRead error appears.
How do I need to call the email sender?
Due to the special ENCTYPE="multipart/form-data" attribute of your form, you cannot use the Reqest.Form collection. Use Upload.Form instead, but only after you call Upload.Save (SaveVirtual, SaveToMemory).
I created an application to show a press release once the target date and time have been reached and wanted to know if this is getting the time from the server or the client because I'd like to use the server's time so that someone doesn't just change their clock in order to see it.
Here's my code:
<%
dim strDate
dim strTime
dim strTarget_time
dim strTarget_date
dim strBreak
dim strRuleBreak
dim strToday
strDate = Date()
strTime = Time()
strright_now = Now()
strTarget_time = "3:27:00 PM"
strTarget_date = "6/26/2012"
strBreak = "<br />"
strRuleBreak = "<br /><hr><br />"
strToday = Now()
response.write("<h2>TEST VARIABLES</h2>")
response.write("<p><strong>Today's date:</strong> " & strDate & strBreak)
response.write("<strong>Current time:</strong> " & strTime & strBreak)
response.write("<strong>Target date:</strong> " & strTarget_date & strBreak)
response.write("<strong>Target time:</strong> " & strTarget_time & "</p>")
response.write(strRuleBreak)
'TIME TESTER
response.write("<h2>TIME TESTER</h2>")
response.write("<p><nobr>Testing to see if it is past the target time of: " & strTarget_time & "</nobr></p>")
if strTime >= cdate(strTarget_time) then
response.write("<p>Yes, it is now " & Now() & ", which <strong>IS</strong> past the target time of: " & strTarget_time & "</p>")
else
response.write("<p>No, it is now " & Now() & ", which is <strong>NOT</strong> past the target time of: " & strTarget_time & "</p>")
end if
response.write(strRuleBreak)
'DATE TESTER
response.write("<h2>DATE TESTER</h2>")
response.write("<p><nobr>Testing to see if it is past the target date of: " & strTarget_date & "</nobr></p>")
if strToday >= cdate(strTarget_date) then
response.write("<p>Yes, it is now " & Now() & ", which <strong>IS</strong> past the target date of: " & strTarget_date & "</p>")
else
response.write("<p>No, it is now " & Now() & ", which is <strong>NOT</strong> past the target date of: " & strTarget_date & "</p>")
end if
response.write(strRuleBreak)
'DATE AND TIME TESTER
response.write("<h2>DATE AND TIME TESTER</h2>")
response.write("<p><nobr>Testing to see if it is past the target of: " & strTarget_date & " - " & strTarget_time & "</nobr></p>" & strBreak)
if strToday >= cdate(strTarget_date) AND strTime >= cdate(strTarget_time) then
response.write("<p>Yes, it is now " & Now() & ", which <strong>IS</strong> past the target of: " & strTarget_date & " - " & strTarget_time & "</p>")
else
response.write("<p>No, it is now " & Now() & ", which is <strong>NOT</strong> past the target of: " & strTarget_date & " - " & strTarget_time & "</p>")
end if
response.write(strRuleBreak)
%>
So in this case, if the time and date is AFTER 6/26/2012 3:27 PM, then the section will show. I'm mainly asking because I want to clarify whether this is client or server side time being used.
This is going to be server-side, as that is where ASP code is executed. In order to get the client-side datetime, you would need to use a script to run in the browser - generally JavaScript.
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
%>