Is any possibility to use TLS to send mail using ASP classic using a free lib?
I have used CDO but i think that not allow TLS.
Thanks for all, and sorry for the question. I can send mail using Gmail without problem, but now i need to send mail using a server that only allow Tls authentication. I dont find in the api or in internet the way to send a mail using TLS.
Function bCorreoEnviarGeneral(objCorreo, bPorSeparado, sSep, sMailFrom, sMailTo, sAsunto, sCuerpo, sBCC, sAdjunto)
dim i,j,iNumDest
dim bSalida
dim Mailer
dim arrayMailTo
dim objMessage
dim ArrayBCC
dim mailFrom,mailSmtp,mailUser,mailPassword,mailSSL,mailPort
call DatosServidorCorreo (mailFrom,mailSmtp,mailUser,mailPassword,mailSSL,mailPort)
on error resume next
Const cdoSendUsingPickup = 1 'Send message using the local SMTP service pickup directory.
Const cdoSendUsingPort = 2 'Send the message using the network (SMTP over the network).
Const cdoAnonymous = 0 'Do not authenticate
Const cdoBasic = 1 'basic (clear-text) authentication
Const cdoNTLM = 2 'NTLM
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = sAsunto
objMessage.From = "SIG"
if sMailFrom<>"" then
objMessage.From = sMailFrom
else
objMessage.From = mailFrom
end if
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = mailSmtp
'Type of authentication, NONE, Basic (Base64 encoded), NTLM
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
'Your UserID on the SMTP server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = mailUser
'Your password on the SMTP server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = mailPassword
'Server port (typically 25)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = mailPort
'Use SSL for the connection (False or True)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = mailSSL
'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
objMessage.Configuration.Fields.Update
'==End remote SMTP server configuration section==
if instr(lcase(sCuerpo),"<html>")<>0 then
objMessage.HTMLBody = sCuerpo
else
objMessage.TextBody = sCuerpo
end if
if sAdjunto<>"" then
' arrayAdjuntos = Split(Adjunto,sSep)
' for i=0 to uBound(arrayAdjuntos)
objMessage.AddAttachment sAdjunto 'arrayAdjuntos(i)
' next
end if
if session("idpersona")=1038 then
if sAdjunto<>"" then Response.Write "<br>"+sAdjunto+"<br>"
end if
arrayMailTo = Split(sMailTo,sSep)
iNumDest = ubound(arrayMailTo)
if iNumDest < 0 then
objMessage.To = sMailFrom
objMessage.Send
if err.number = 0 then
'if propCorreoVerMensajes then Response.Write "Mail enviado..."
else
bSalida = false
Response.Write "Envío de mail fallido. El error es " + err.description + mailSmtp
end if
elseif bPorSeparado then
for i=0 to iNumDest
objMessage.To = arrayMailTo(i)
if i=iNumDest and trim(sBCC)<>"" then
arrayBCC = Split(sBCC,sSep)
for j=0 to uBound(arrayBCC)
objMessage.BCC = arrayBCC(j)
next
end if
objMessage.Send
if err.number = 0 then
' if propCorreoVerMensajes then Response.Write "Mail enviado..."
else
bSalida = false
Response.Write "Envío de mail fallido. El error es " + err.description
end if
next
else
if trim(sBCC)<>"" then
arrayBCC = Split(sBCC,sSep)
for i=0 to uBound(arrayBCC)
objMessage.BCC = arrayBCC(i)
next
end if
for i=0 to iNumDest
objMessage.To = arrayMailTo(i)
next
on error resume next
objMessage.Send
if err.number = 0 then
'if propCorreoVerMensajes then Response.Write "Mail enviado..."
else
bSalida = false
Response.Write "Envío de mail fallido. El error es " + err.description
end if
on error goto 0
end if
set objMessage = nothing
bCorreoEnviarGeneral = True
End Function
With this code you allow, send with SSL, TLS, without them, attach one file, send to multiples address, send without BCC..... the only problem is that you need to use ASPemail lib of pay.
function DatosServidorCorreo(mailFrom,mailSmtp,mailUser,mailPassword,mailTLS,mailPort,mailSSL)
dim sql,reg
set BD=session("conn")
'BD="Provider=MSDASQL.1;Data Source=dsnSig;Extended Properties=Chr(39)DSN=dsnSig;DBQ=C:\bd\SIG_Tecnoy_BBDD.mdb;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;Chr(39)"
sql="select * from SIG_PARAMETROS"
if not BDRegCrear(BD,reg,sql) then
call dialogo ("Error conexión BD")
call BDErrorMostrar("No se puede acceder a los datos del servidor")
DatosServidorCorreo=false
exit function
end if
do while not reg.eof
if trim(reg.fields("Nombre")) = "MailFrom" then
mailFrom = trim(reg.fields("Valor"))
elseif trim(reg.fields("Nombre")) = "MailSmtp" then
mailSmtp = trim(reg.fields("Valor"))
elseif trim(reg.fields("Nombre")) = "MailUser" then
mailUser = trim(reg.fields("Valor"))
elseif trim(reg.fields("Nombre")) = "MailPassword" then
mailPassword = trim(reg.fields("Valor"))
elseif trim(reg.fields("Nombre")) = "MailTLS" then
mailTLS = trim(reg.fields("Valor"))
elseif trim(reg.fields("Nombre")) = "MailPort" then
mailPort = trim(reg.fields("Valor"))
elseif trim(reg.fields("Nombre")) = "MailSSL" then
mailSSL = trim(reg.fields("Valor"))
end if
reg.movenext
loop
set BD=nothing
call BDRegLiberar(reg)
end function
Function bCorreoEnviarGeneral(objCorreo, bPorSeparado, sSep, sMailFrom, sMailTo, sAsunto, sCuerpo, sBCC, sAdjunto)
dim i,j,iNumDest
dim bSalida
dim objMessage
dim Mail
dim mailFrom,mailSmtp,mailUser,mailPassword,mailTLS,mailPort,mailSSL
call DatosServidorCorreo (mailFrom,mailSmtp,mailUser,mailPassword,mailTLS,mailPort,mailSSL)
on error resume next
if (mailTLS = "True" ) then
' Envio de correo con encriptacion TLS
bSalida = true
Set Mail = Server.CreateObject("Persits.MailSender")
Mail.Host = mailSmtp
Mail.Username = mailUser
Mail.Password = mailPassword
Mail.Port= mailPort
Mail.TLS = mailTLS
Mail.Subject = sAsunto
'Mail.AddAddress sMailTo
Mail.From = mailFrom
' Si manda el sistema el correo el remitente será el recogido en la BBDD, si el remitente es un usuario el remitente será ese usuario
if sMailFrom<>"" then
Mail.From = sMailFrom
else
Mail.From = mailFrom
end if
' Los mensajes pueden ir en texto plano o en formato html con el siguiente IF si el mensaje es HTML se le atribuye a la propiedad booleana IsHTML el valor True (False por defecto en texto plano)
if instr(lcase(sCuerpo),"<html>")<>0 then
Mail.IsHTML = True
Mail.Body = sCuerpo
else
Mail.Body = sCuerpo
end if
' Sistema de archivos adjuntos (Solo uno como máximo por correo)
if sAdjunto<>"" then
Mail.AddAttachment sAdjunto
end if
arrayMailTo = Split(sMailTo,sSep)
iNumDest = ubound(arrayMailTo)
if session("idpersona")=1038 then
if sAdjunto<>"" then Response.Write "<br>"+sAdjunto+"<br>"
end if
arrayMailTo = Split(sMailTo,sSep)
iNumDest = ubound(arrayMailTo)
if iNumDest < 0 then
Mail.AddAddress sMailFrom
Mail.Send
if err.number = 0 then
'if propCorreoVerMensajes then Response.Write "Mail enviado..."
else
bSalida = false
Response.Write "Envío de mail fallido. El error es " + err.description + mailSmtp
end if
elseif bPorSeparado then
for i=0 to iNumDest
'Para cada uno de los destinatarios en la matríz, enviamos un mensaje
Mail.AddAddress arrayMailTo(i)
'Si se envian los mails por separado, sólo se envia con copia el último, porque sino
'a los destinatarios en sBCC les llegarían n correos repetidos:
'Se añaden los Bcc en el último puesto que no hay posibilidad con éste objeto de borrar(clear)
'el recipiente de Bcc.
if i=iNumDest and trim(sBCC)<>"" then
arrayBCC = Split(sBCC,sSep)
for j=0 to uBound(arrayBCC)
Mail.AddBcc arrayBCC(j)
next
end if
Mail.Send
if err.number = 0 then
' if propCorreoVerMensajes then Response.Write "Mail enviado..."
else
bSalida = false
Response.Write "Envío de mail fallido. El error es " + err.description
end if
next
else
'Destinatarios con copia:
if trim(sBCC)<>"" then
arrayBCC = Split(sBCC,sSep)
for i=0 to uBound(arrayBCC)
Mail.AddBcc arrayBCC(i)
next
end if
Mail.AddAddress sMailTo
on error resume next
Mail.Send
if err.number = 0 then
'if propCorreoVerMensajes then Response.Write "Mail enviado..."
else
bSalida = false
Response.Write "Envío de mail fallido. El error es " + err.description
end if
on error goto 0
end if
set Mail = nothing
else
' Mensaje con encriptacion SSL o libre de ella.
bSalida = true
Const cdoSendUsingPickup = 1 'Send message using the local SMTP service pickup directory.
Const cdoSendUsingPort = 2 'Send the message using the network (SMTP over the network).
Const cdoAnonymous = 0 'Do not authenticate
Const cdoBasic = 1 'basic (clear-text) authentication
Const cdoNTLM = 2 'NTLM
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = sAsunto
'objMessage.To = sMailTo
if sMailFrom<>"" then
objMessage.From = sMailFrom
else
objMessage.From = mailFrom
end if
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = mailSmtp
'Type of authentication, NONE, Basic (Base64 encoded), NTLM
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
'Your UserID on the SMTP server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = mailUser
'Your password on the SMTP server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = mailPassword
'Server port (typically 25)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = mailPort
'Use SSL for the connection (False or True)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = mailSSL
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 120
objMessage.Configuration.Fields.Update
'==End remote SMTP server configuration section==
if instr(lcase(sCuerpo),"<html>")<>0 then
objMessage.HTMLBody = sCuerpo
else
objMessage.TextBody = sCuerpo
end if
if sAdjunto<>"" then
' arrayAdjuntos = Split(Adjunto,sSep)
' for i=0 to uBound(arrayAdjuntos)
objMessage.AddAttachment (sAdjunto) 'arrayAdjuntos(i)
' next
end if
if session("idpersona")=1038 then
if sAdjunto<>"" then Response.Write "<br>"+sAdjunto+"<br>"
end if
arrayMailTo = Split(sMailTo,sSep)
iNumDest = ubound(arrayMailTo)
if iNumDest < 0 then
objMessage.To = sMailFrom
objMessage.Send
if err.number = 0 then
'if propCorreoVerMensajes then Response.Write "Mail enviado..."
else
bSalida = false
Response.Write "Envío de mail fallido. El error es " + err.description + mailSmtp
end if
elseif bPorSeparado then
for i=0 to iNumDest
'Para cada uno de los destinatarios en la matríz, enviamos un mensaje
objMessage.To = arrayMailTo(i)
'Si se envian los mails por separado, sólo se envia con copia el último, porque sino
'a los destinatarios en sBCC les llegarían n correos repetidos:
'Se añaden los Bcc en el último puesto que no hay posibilidad con éste objeto de borrar(clear)
'el recipiente de Bcc.
if i=iNumDest and trim(sBCC)<>"" then
arrayBCC = Split(sBCC,sSep)
for j=0 to uBound(arrayBCC)
objMessage.BCC = arrayBCC(j)
next
end if
objMessage.Send
if err.number = 0 then
' if propCorreoVerMensajes then Response.Write "Mail enviado..."
else
bSalida = false
Response.Write "Envío de mail fallido. El error es " + err.description
end if
next
else
'Destinatarios con copia:
if trim(sBCC)<>"" then
arrayBCC = Split(sBCC,sSep)
for i=0 to uBound(arrayBCC)
objMessage.BCC = arrayBCC(i)
next
end if
objMessage.To = sMailTo
on error resume next
objMessage.Send
if err.number = 0 then
'if propCorreoVerMensajes then Response.Write "Mail enviado..."
else
bSalida = false
Response.Write "Envío de mail fallido. El error es " + err.description
end if
on error goto 0
end if
set objMessage = nothing
end if
bCorreoEnviarGeneral = bSalida
End Function
No need for external libs.
Change
'Use SSL for the connection (False or True)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = mailSSL
with
'Use TLS for the connection (False or True)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendtls") = mailSSL
Related
I'm writing a code for a shopping cart. I need to check if the cookie already has de id of a selected item so that it won't duplicate it.
Code:
Dim cookie_carrito As HttpCookie = Request.Cookies("CkEntregas")
Dim i_docid As Integer = iddoc_print.Text
If cookie_carrito IsNot Nothing Then
Dim valor_galleta As String = cookie_carrito.Value
Dim galleticas As String() = valor_galleta.Split(","c)
For Each item In galleticas
Dim id_documento = item
If id_documento = i_docid Then
l_resultados_carrito.Text = "<div class='Col100'><div class='notificacionesCT'><i class='fa fa-bell fa-fw'></i> Este documento ya se encuentra en tu carrito de entregas.<a href='encriptar-documento.aspx?actid=2&docid=" & i_docid & "'><i class='fa fa-window-close fa-fw'></i></a></div></div>"
Else
Dim hoy As DateTime = DateTime.Now.Date.ToUniversalTime.AddHours(-5)
Dim cookie_actual As HttpCookie = Request.Cookies("CkEntregas")
Dim cookie_carrito_u As HttpCookie = New HttpCookie("CkEntregas")
cookie_carrito_u.Value = i_docid & "," & cookie_actual.Value
cookie_carrito_u.Expires = hoy.AddHours(72)
Response.Cookies.Add(cookie_carrito_u)
'resultados.Text = "Cookie actualizada: " & cookie_carrito_u.Value
l_resultados_carrito.Text = "<div class='Col100'><div class='notificacionesOK'><i class='fa fa-check fa-fw'></i> ¡Listo! El documento fue agregado con éxito al carrito de entregas.<a href='encriptar-documento.aspx?actid=2&docid=" & i_docid & "'><i class='fa fa-window-close fa-fw'></i></a></div></div>"
Exit For
End If
Next
Else
Dim hoy As DateTime = DateTime.Now.Date.ToUniversalTime.AddHours(-5)
Dim cookie_carrito_n As HttpCookie = New HttpCookie("CkEntregas")
cookie_carrito_n.Value = i_docid
cookie_carrito_n.Expires = hoy.AddHours(72)
Response.Cookies.Add(cookie_carrito_n)
'resultados.Text = "Cookie creada: " & cookie_carrito_n.Value
l_resultados_carrito.Text = "<div class='Col100'><div class='notificacionesOK'><i class='fa fa-check fa-fw'></i> ¡Listo! El documento fue agregado con éxito al carrito de entregas.<a href='encriptar-documento.aspx?actid=2&docid=" & i_docid & "'><i class='fa fa-window-close fa-fw'></i></a></div></div>"
End If
The logic that I'm using is to check each comma splitted value, so if that value is contained in the cookie items (list) it won't add it, but if the value is not there it will add it and break the loop.
It's not working, because if the first value in the cookie is different than the selected item, it will add it, but it may be in the second position of the list.
How can I check if a determined value is already in the cookie?
The cookie stores values in this format: 1,5,3,9,
I solved it checking the value of the cookie as a String, using the string.Contains() method:
Dim cookie_carrito As HttpCookie = Request.Cookies("CkEntregas")
Dim i_docid As Integer = iddoc_print.Text
If cookie_carrito IsNot Nothing Then
Dim valor_galleta As String = cookie_carrito.Value
Dim galleticas As String() = valor_galleta.Split(","c)
If valor_galleta.Contains(i_docid) Then
l_resultados_carrito.Text = "<div class='Col100'><div class='notificacionesCT'><i class='fa fa-bell fa-fw'></i> Este documento ya se encuentra en tu carrito de entregas.<a href='encriptar-documento.aspx?actid=2&docid=" & i_docid & "'><i class='fa fa-window-close fa-fw'></i></a></div></div>"
Else
Dim hoy As DateTime = DateTime.Now.Date.ToUniversalTime.AddHours(-5)
Dim cookie_actual As HttpCookie = Request.Cookies("CkEntregas")
Dim cookie_carrito_u As HttpCookie = New HttpCookie("CkEntregas")
cookie_carrito_u.Value = i_docid & "," & cookie_actual.Value
cookie_carrito_u.Expires = hoy.AddHours(72)
Response.Cookies.Add(cookie_carrito_u)
l_resultados_carrito.Text = "<div class='Col100'><div class='notificacionesOK'><i class='fa fa-check fa-fw'></i> ¡Listo! El documento fue agregado con éxito al carrito de entregas.<a href='encriptar-documento.aspx?actid=2&docid=" & i_docid & "'><i class='fa fa-window-close fa-fw'></i></a></div></div>"
End If
Else
Dim hoy As DateTime = DateTime.Now.Date.ToUniversalTime.AddHours(-5)
Dim cookie_carrito_n As HttpCookie = New HttpCookie("CkEntregas")
cookie_carrito_n.Value = i_docid
cookie_carrito_n.Expires = hoy.AddHours(72)
Response.Cookies.Add(cookie_carrito_n)
l_resultados_carrito.Text = "<div class='Col100'><div class='notificacionesOK'><i class='fa fa-check fa-fw'></i> ¡Listo! El documento fue agregado con éxito al carrito de entregas.<a href='encriptar-documento.aspx?actid=2&docid=" & i_docid & "'><i class='fa fa-window-close fa-fw'></i></a></div></div>"
End If
This question already has answers here:
Accessing a request's body using classic ASP?
(3 answers)
Closed 3 years ago.
am using Request.ServerVariables to get webhook response from GoCardless in classic asp which is calling a page on my server http:/www.example.com/webhook.asp
My code in webhook.asp:
For Each var in Request.ServerVariables
WriteLog var & " = " & Request.ServerVariables(var) , "gocardless"
Next
the output is ok, i can read
Content-Length: 353
Content-Type: application/json
Accept: */*
Accept-Encoding: gzip;q=1.0,deflate;q=0.6,identity;q=0.3
Host: admin.controle-reglementaire.fr
User-Agent: gocardless-webhook-service/1.1
Origin: https://api.gocardless.com
Webhook-Signature: 71ef0f915569e082f090f5150fdf4144be4fed242b1253ad620544c4dd8d615a
my code works fine but am not able to retrive the json coming with
i must get the full response information as shown in Gocardless Guide
Originhttps://api.gocardless.com
User-Agentgocardless-webhook-service/1.1
Content-Typeapplication/json
Webhook-Signature71ef0f915569e082f090f5150fdf4144be4fed242b1253ad620544c4dd8d615a
Corps
{
"events": [
{
"id": "EVTESTC4TEBZP2",
"created_at": "2019-12-21T10:18:30.168Z",
"resource_type": "payments",
"action": "failed",
"links": {
"payment": "index_ID_123"
},
"details": {
"origin": "bank",
"cause": "insufficient_funds",
"scheme": "sepa_core",
"reason_code": "AM04",
"description": "The customer's account had insufficient funds to make this payment."
},
"metadata": {}
}
]
}
what code should i add to get the json response located in the header
thx
well after more than 48 hours of google search this fixed my problem
Dim lngBytesCount, bstring
If Request.TotalBytes > 0 Then
lngBytesCount = Request.TotalBytes
bstring= BytesToStr(Request.BinaryRead(lngBytesCount))
response.Clear
WriteLog bstring , "gocardless"
end if
Function BytesToStr(bytes)
Dim Stream
Set Stream = Server.CreateObject("Adodb.Stream")
Stream.Type = 1 'adTypeBinary
Stream.Open
Stream.Write bytes
Stream.Position = 0
Stream.Type = 2 'adTypeText
Stream.Charset = "UTF-8"
BytesToStr = Stream.ReadText
try = BytesToStr
Stream.Close
Set Stream = Nothing
End Function
ok guys thanks all for your hel but this is the complete solution that helped solving my problem and it works great
<!-- #include file="aspJSON1.17.asp"-->
<%
dim filename : filename = Request.ServerVariables("HTTP_Webhook-Signature")
'response.write "filename = " & filename
'---------------------------------------------------------------------------------------------------
Dim lngBytesCount, bstring
If Request.TotalBytes > 0 Then
lngBytesCount = Request.TotalBytes
response.ContentType = "application/json;charset=UTF-8"
bstring= BytesToStr(Request.BinaryRead(lngBytesCount))
'response.Clear
end if
'response.write bstring
'---------------------------------------------------------------------------------------------------
WriteLog bstring , filename
'---------------------------------------------------------------------------------------------------
Set oJSON = New aspJSON
oJSON.loadJSON bstring
For Each record In oJSON.data("events")
Set this = oJSON.data("events").item(record)
Response.Write "<p>" & this.item("id") '& " | " & this.item("charge_date") & " | " & this.item("amount") & " | " & this.item("description") & " | " & this.item("status") & " | " & this.item("links")("mandate") & " | " & this.item("links")("subscription") & "<p>"
Next
Set oJSON = Nothing
'---------------------------------------------------------------------------------------------------
Function BytesToStr(bytes)
Dim Stream
Set Stream = Server.CreateObject("Adodb.Stream")
Stream.Type = 1 'adTypeBinary
Stream.Open
Stream.Write bytes
Stream.Position = 0
Stream.Type = 2 'adTypeText
Stream.Charset = "UTF-8"
BytesToStr = Stream.ReadText
try = BytesToStr
Stream.Close
Set Stream = Nothing
End Function
'---------------------------------------------------------------------------------------------------
sub WriteLog(LogInfo, FileName)
dim FSO, Inf, dir, Fnm
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
dir = "D:\webserver\experthost\trace"
Fnm = dir & "\" & FileName & ".json"
' Ouverture du fichier
' Fnm : nom du fichier
' 8 : mode append
' true : le fichier est crée s'il n'existe pas
set inF = FSO.OpenTextFile(Fnm,2,true)
'*******************************************
inF.writeLine LogInfo
inF.close
set inF = nothing
end sub
%>
I apologise if I have posted this before, but I am struggling with this script to push data into Active Directory. The following code works, i.e. it does not produce any errors, but it doesn't update the directory. I have the following code:
<%# Language=VBScript %>
<% response.Buffer = True
'Define the AD OU that contains our users
dim ADUser, user, firstname, lastname, email, telephonenumber, mobile, description
'This initializes all of our variables
user = request.querystring("account_name")
'This puts the value of the account_name into a variable
if len(user) = 0 then
'If the length of the username is equal to 0
response.write "Please supply a username in the query string"
elseif len(user) > 0 then
'Else is length of user is greater than 0
ADUser = "LDAP://OU=RBC Staff,OU=RBC Users,DC=rugby,DC=internal"
' Make AD connection and run query
Set objCon = Server.CreateObject("ADODB.Connection")
objCon.provider ="ADsDSOObject"
objCon.Properties("User ID") = "EXAMPLE\User"
objCon.Properties("Password") = "Password01"
objCon.Properties("Encrypt Password") = TRUE
objCon.open "Active Directory Provider"
Set objCom = CreateObject("ADODB.Command")
Set objCom.ActiveConnection = objCon
objCom.CommandText ="select givenName,sn,mail,telephonenumber,mobile,description, sAMAccountName, cn FROM '"+ ADUser +"' where sAMAccountname='"& user &"'"
Set objRS = objCom.Execute
If IsNull(objRS.Fields("Description").Value) Then
sDesc = ""
else
For Each item In objRS.Fields("description").Value
sDesc = item
Next
end if
if isNull(objRS("givenName")) then
firstname = ""
else
firstname = objRS("givenName")
end if
if isNull(objRS("sn")) then
lastname = ""
else
lastname = objRS("sn")
end if
if isNull(objRS("mail")) then
email = ""
else
email = objRS("mail")
end if
if isNull(objRS("telephonenumber")) then
telephonenumber = ""
else
telephonenumber = objRS("telephonenumber")
end if
if isNull(objRS("mobile")) then
mobile = ""
else
mobile = objRS("mobile")
end if
Response.Write "<form action='editentry.asp?account_name=" & user &"' method='POST'>"
Response.Write "<table>"
Response.Write "<tr>"
Response.Write "<td><label for='firstname'>Firstname</label></td>"
Response.Write "<td><input type='text' id='firstname' value='" + firstname + "' name='firstname'></td>"
Response.Write "</tr>"
Response.Write "<tr>"
Response.Write "<td><label for='lastname'>Lastname</label></td>"
Response.Write "<td><input type='text' id='lastname' value='" & lastname & "' name='lastname'></td>"
Response.Write "</tr>"
Response.Write "<tr>"
Response.Write "<td><label for='email'>E-Mail Address</label></td>"
Response.Write "<td><input type='email' id='email' value='" + email + "' name='email'></td>"
Response.Write "</tr>"
Response.Write "<tr>"
Response.Write "<td><label for='description'>Description</label></td>"
Response.Write "<td><input type='text' id='description' value='" + sDesc + "' name='description'></td>"
Response.Write "</tr>"
Response.Write "<tr>"
Response.Write "<td><label for='mobile'>Mobile</label></td>"
Response.Write "<td><input type='text' name='mobile' value='" + mobile + "' id='mobile'></td>"
Response.Write "</tr>"
Response.Write "<tr>"
Response.Write "<td><label for='telephonenumber'>Telephone Number</label></td>"
Response.Write "<td><input type='text' id='telephonenumber' value='" + telephonenumber + "' name='telephonenumber'></td>"
Response.Write "</tr>"
Response.Write "<tr>"
Response.Write "<td><input type='hidden' name='subval' value='1'></td>"
Response.Write "<td><input type='submit' name='submit''></td>"
Response.Write "</tr>" + vbCrLf
Response.Write "</table>"
Response.Write "</form>"
if request.form("subval")=1 then
'If the subval field equals 1, we know the form has been submitted OK
firstname = request.form("firstname")
lastname = request.form("lastname")
email = request.form("email")
telephonenumber = request.form("telephonenumber")
mobile = request.form("mobile")
Set update = CreateObject("ADODB.Command")
Set update.ActiveConnection = objCon
update.CommandText ="select ADsPath, givenName,sn,mail,telephonenumber,mobile,sAMAccountName FROM '"+ ADUser +"' where sAMAccountname='"& user & "'"
Set update.ActiveConnection = objCon
update.Properties("searchscope") = ADS_SCOPE_ONELEVEL
set writeLDAP = update.Execute
Do While Not writeLDAP.EOF
Set usr = GetObject(writeLDAP.Fields("ADsPath").Value)
usr.Put "gjvenName", firstname
usr.Put "sn", lastname
usr.Put "mail", email
usr.Put "mobile", mobile
usr.Put "telephonenumber", telephonenumber
usr.SetInfo
writeLDAP.MoveNext
loop
response.write "This form has been submitted"
writeLDAP.Close
end if
end if
' Clean up
objRS.Close
objCon.Close
Set objRS = Nothing
Set objCom = Nothing
%>]
The only thing I can think of is that, the login I used wasn't a domain admin account.
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)
I'm trying to send emails using asp.net. Here's what i've got so far:
objEmail = New Email
With objEmail
If (IsDBNull(rsConfigEmail.Fields("smtp").Value)) Then
Dim sSmtp As String = CarregarSMTP()
If (sSmtp = "") Then
'Throw New Exception("Não existem SMTPs cadastrados.")
MsgBox.Disparar("Erro ao enviar email. SMTP não cadastrado.")
Exit Sub
End If
.SMTP = sSmtp
Else
.SMTP = rsConfigEmail.Fields("smtp").Value
End If
.Remetente = Trim(rsConfigEmail.Fields("Remetente").Value)
.Titulo = Trim(rsConfigEmail.Fields("assunto").Value)
.Destinatario = sEmail
corpoEmail = rsConfigEmail.Fields("Mensagem").Value.ToString()
corpoEmail = corpoEmail.Replace("<guia>", sGuia)
corpoEmail = corpoEmail.Replace("<origem>", dplOrgao.SelectedItem.Text)
corpoEmail = corpoEmail.Replace("<destino>", Trim(rsDadosEmail.Fields("sigla").Value.ToString()) + " - " + Trim(rsDadosEmail.Fields("descricao").Value.ToString()))
Dim tabela As String = ""
tabela += "<table width='100%'><tr><td>Número Processo</td><td>Número Documento Origem</td><td>Assunto</td><td>Complemento</td><td>Interessado</td><td>Parecer</td></tr>"
Do While Not rsConfirmados.EOF
tabela += "<tr><td>" + rsConfirmados.Fields(0).Value.ToString() + "</td><td>" + rsConfirmados.Fields(1).Value.ToString() + "</td><td>" + rsConfirmados.Fields(2).Value.ToString() + "</td><td>" + rsConfirmados(3).Value.ToString() + "</td><td>" + rsConfirmados.Fields(4).Value.ToString() + "</td><td>" + rsConfirmados.Fields(5).Value.ToString() + "</td></tr>"
rsConfirmados.MoveNext()
Loop
tabela += "</table>"
corpoEmail = corpoEmail.Replace("<corpo>", tabela)
corpoEmail = corpoEmail.Replace("<total>", rsConfirmados.RecordCount.ToString())
.Mensagem = corpoEmail
.Enviar()
End With
When the 'Enviar' method is called (Send()), an exception is thrown saying that At least one of the fields 'from' or 'to' is required. But i'm setting values to these properties when i do this:
.Remetente = Trim(rsConfigEmail.Fields("Remetente").Value)
.Destinatario = sEmail
From and To fields respectively. Could it be something wrong with my smtp address?
Here's the Enviar() method in my Email class:
Public Sub Enviar()
Dim mail As MailMessage
Dim TemDestinatario As Boolean
Try
If sSMTP.Trim <> "" Then
SmtpMail.SmtpServer = sSMTP
Else
Throw New Exception("Falta o SMTP.")
End If
mail = New MailMessage
If sRemetente <> "" Then
mail.From = sRemetente
Else
Throw New Exception("Falta o Remetente.")
End If
TemDestinatario = False
If sDestinatario <> "" Then
mail.To = sDestinatario
TemDestinatario = True
End If
If sDestinatarioCCO <> "" Then
mail.Bcc = sDestinatarioCCO
TemDestinatario = True
End If
If Not TemDestinatario Then
Throw New Exception("Falta o Destino.")
End If
mail.Subject = sTitulo
mail.Body = sTexto
mail.BodyEncoding = System.Text.Encoding.UTF8
mail.BodyFormat = MailFormat.Text
If Not vetAnexo Is Nothing AndAlso UBound(vetAnexo) > 0 Then
Dim intContador As Integer
For intContador = 0 To UBound(vetAnexo) - 1
mail.Attachments.Add(New MailAttachment(vetAnexo(intContador)))
Next
End If
'se houver algum problema no envio, tenta outros SMTPs
Try
SmtpMail.Send(mail)
Catch ex As Exception
Dim cSig As Object
Dim rsSmtp As ADODB.Recordset
cSig = CreateObject("prSIG.cSMTP")
rsSmtp = cSig.ConsultarSMTP()
If (rsSmtp.RecordCount > 0) Then
Dim bEnviado As Boolean
'pega todos menos o que ja tentou, e ordena pela 'ordem'
rsSmtp.Filter = "smtp <> '" + SmtpMail.SmtpServer + "'"
rsSmtp.Sort = "ordem"
rsSmtp.MoveFirst()
Do While Not rsSmtp.EOF And Not bEnviado
Try
SmtpMail.SmtpServer = rsSmtp.Fields("smtp").Value
SmtpMail.Send(mail)
bEnviado = True
Catch
End Try
rsSmtp.MoveNext()
Loop
If (Not bEnviado) Then
Throw ex
End If
Else
Throw ex
End If
End Try
Catch ex As Exception
If ex.Message = "Could not access 'CDO.Message' object." Then
Throw New Exception("Falha ao acessar o SMTP (" + sSMTP + ").")
Else
Throw ex
End If
Finally
mail = Nothing
End Try
End Sub
Both of my SMTP adresses were not working. Had to ask for another STMP address. Now it works.