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
Related
Here is a picture of error
Keep Getting error
input string was not in correct format
strSQLStatement = "INSERT INTO Cart (CartID, ProductID, ProductName, Quantity, Price) values('" & strCartID & "', '" & Trim(lblProductNo.Text) & "', '" & lblProductName.Text & "', " & CInt(tbQuantity.Text) & ", " & decPrice & ")"
My guess is the CInt but it works in another similar application . Not sure what is going on . Here is the code
product-detail.aspx.vb
Imports System.Data
Imports System.Data.SqlClient
Partial Class HTML_Product_Detail
Inherits System.Web.UI.Page
Protected Sub Page_Load(sender As Object, e As EventArgs) Handles Me.Load
If Request.QueryString("ProductID") <> "" Then
Dim strConn As String = System.Configuration.ConfigurationManager.ConnectionStrings("ConnectionStringOnlineStore").ConnectionString
Dim connProduct As SqlConnection
Dim cmdProduct As SqlCommand
Dim drProduct As SqlDataReader
Dim strSQL As String = "Select * from Product Where ProductID = " & Request.QueryString("ProductID")
connProduct = New SqlConnection(strConn)
cmdProduct = New SqlCommand(strSQL, connProduct)
connProduct.Open()
drProduct = cmdProduct.ExecuteReader(CommandBehavior.CloseConnection)
'drProduct.Read()
If drProduct.Read() Then
lblProductName.Text = drProduct.Item("ProductName")
lblProductDescription.Text = drProduct.Item("ProductName")
lblPrice.Text = drProduct.Item("Price")
lblProductNo.Text = drProduct.Item("ProductNo")
imgProduct.ImageUrl = "images/product-detail/" + Trim(drProduct.Item("ProductNo")) + ".jpg"
End If
End If
End Sub
Protected Sub btnAdd_Click(sender As Object, e As EventArgs) Handles btnAdd.Click
' *** get product price
Dim dr As SqlDataReader
Dim strSQLStatement As String
Dim cmdSQL As SqlCommand
Dim strConnectionString As String = System.Configuration.ConfigurationManager.ConnectionStrings("ConnectionStringOnlineStore").ConnectionString
strSQLStatement = "SELECT * FROM Product WHERE ProductNo = '" & lblProductNo.Text & "'"
Dim conn As New SqlConnection(strConnectionString)
conn.Open()
cmdSQL = New SqlCommand(strSQLStatement, conn)
dr = cmdSQL.ExecuteReader()
Dim decPrice As Decimal
If dr.Read() Then
decPrice = dr.Item("Price")
End If
conn.Close()
'*** get CartID
Dim strCartID As String
If HttpContext.Current.Request.Cookies("CartID") Is Nothing Then
strCartID = GetRandomCartIDUsingGUID(10)
Dim CookieTo As New HttpCookie("CartID", strCartID)
HttpContext.Current.Response.AppendCookie(CookieTo)
Else
Dim CookieBack As HttpCookie
CookieBack = HttpContext.Current.Request.Cookies("CartID")
strCartID = CookieBack.Value
End If
'Check if this product already exist in the cart
Dim dr2 As SqlDataReader
Dim strSQLStatement2 As String
Dim cmdSQL2 As SqlCommand
strSQLStatement2 = "SELECT * FROM cart WHERE CartID ='" & strCartID & "' and ProductID = '" & Trim(lblProductNo.Text) & "'"
'Reponse.Write(strSQlStatement2)
Dim conn2 As New SqlConnection(strConnectionString)
cmdSQL2 = New SqlCommand(strSQLStatement2, conn2)
conn2.Open()
dr2 = cmdSQL2.ExecuteReader()
If dr2.Read() Then
Dim intQuantityNew As Integer = dr2.Item("Quantity") + CInt(tbQuantity.Text)
strSQLStatement = ""
cmdSQL = New SqlCommand(strSQLStatement, conn)
Else
Dim dr3 As SqlDataReader
Dim strSQLStatement3 As String
Dim cmdSQL3 As SqlCommand
strSQLStatement = "INSERT INTO Cart (CartID, ProductID, ProductName, Quantity, Price) values('" & strCartID & "', '" & Trim(lblProductNo.Text) & "', '" & lblProductName.Text & "', " & CInt(tbQuantity.Text) & ", " & decPrice & ")"
'Response.Write(strSQLStatement3)
Dim conn3 As New SqlConnection(strConnectionString)
conn3.Open()
cmdSQL3 = New SqlCommand(strSQLStatement3, conn3)
dr3 = cmdSQL3.ExecuteReader()
End If
'Response.Redirect("ViewCart.aspx")
End Sub
Public Function GetRandomCartIDUsingGUID(ByVal length As Integer) As String
'Get the GUID
Dim guidResult As String = System.Guid.NewGuid().ToString()
'Remove the hyphens
guidResult = guidResult.Replace("-", String.Empty)
'Make sure length is valid
If length <= 0 OrElse length > guidResult.Length Then
Throw New ArgumentException("Length must be between 1 and " & guidResult.Length)
End If
'Return the first length bytes
Return guidResult.Substring(0, length)
End Function
End Class
The issue is almost certainly here:
CInt(tbQuantity.Text)
The exception information even says:
Conversion from string "" to type 'Integer' is not valid.
You cannot convert a String to an Integer if the text doesn't represent a valid value and an empty string obviously doesn't represent a number. Validate the data first or else validate and convert in one go using Integer.Tryparse.
In this threat help me with the each row ( Make a for each using SqlDataReader vb.net)
But when i wanna save the data ( on GM.AsigDupla(Txtfecha.Text, cboPlanta0.SelectedValue, cboPlanta0.SelectedItem.Text, cboAlmacen.SelectedValue, cboAlmacen.SelectedItem.Text, mater, lot)
the varibles od the arrarys mater and lot show the error : value of type 1-dimensional array cannot be converted to string
Dim mater() As String
Dim planta() As String
Dim almacen() As String
Dim lot() As String
Dim cantidad() As String
Dim cantadiat() As String
Dim undad() As String
Dim Cantidadc() As String
Dim CantidadB() As String
Dim Session1() As String
Dim fecha() As String
Dim RowCounter As Integer = 0
RowCounter.ToString()
Dim Con34 As New Data.SqlClient.SqlConnection
Con34.ConnectionString = C.GetAppConfiguracion("Inventario", "ConnInventario")
'Dim editCustQuery As String = "select Idmaterial , IdLote from s_RptInventarioSAP where idPlanta = '" & cboPlanta0.SelectedValue & "' and IdAlmacen = '" & cboAlmacen.SelectedValue & "'"
Dim editCustQuery As String = "select * from dbo.s_RptInventarioSAP"
Con34.Open()
Dim CustCommand As New SqlCommand(editCustQuery, Con34)
Dim sqladapter As SqlDataAdapter = New SqlDataAdapter(CustCommand)
Dim tableresult As New DataTable(editCustQuery)
sqladapter.Fill(tableresult)
Con34.Close()
For Each TableRow As DataRow In tableresult.Rows
mater = tableresult.Rows.Item(RowCounter).Item(0)
planta = tableresult.Rows.Item(RowCounter).Item(1)
almacen = tableresult.Rows.Item(RowCounter).Item(2)
lot = tableresult.Rows.Item(RowCounter).Item(3)
cantidad = tableresult.Rows.Item(RowCounter).Item(4)
cantadiat = tableresult.Rows.Item(RowCounter).Item(5)
undad = tableresult.Rows.Item(RowCounter).Item(6)
Cantidadc = tableresult.Rows.Item(RowCounter).Item(7)
CantidadB = tableresult.Rows.Item(RowCounter).Item(8)
Session1 = tableresult.Rows.Item(RowCounter).Item(9)
fecha = tableresult.Rows.Item(RowCounter).Item(10)
RowCounter = RowCounter + 1
Next
Dim resultado As String
resultado = GM.AsigDupla(Txtfecha.Text, cboPlanta0.SelectedValue, cboPlanta0.SelectedItem.Text, cboAlmacen.SelectedValue, cboAlmacen.SelectedItem.Text, mater, lot)
'i = i + 1
With lbError0
.Visible = True
.Text = resultado
End With
Catch ex As Exception
lbError0.Text = ex.Message
End Try
End If
End Sub
Ok I see a couple errors.
Dim mater() As String
Dim planta() As String
Dim almacen() As String
Dim lot() As String
Dim cantidad() As String
Dim cantadiat() As String
Dim undad() As String
Dim Cantidadc() As String
Dim CantidadB() As String
Dim Session1() As String
Dim fecha() As String
Dim resultado() As String
Dim RowCounter As Integer = 0
Dim Con34 As New Data.SqlClient.SqlConnection
Con34.ConnectionString = C.GetAppConfiguracion("Inventario", "ConnInventario")
'Dim editCustQuery As String = "select Idmaterial , IdLote from s_RptInventarioSAP where idPlanta = '" & cboPlanta0.SelectedValue & "' and IdAlmacen = '" & cboAlmacen.SelectedValue & "'"
Dim editCustQuery As String = "select * from dbo.s_RptInventarioSAP"
Con34.Open()
Dim CustCommand As New SqlCommand(editCustQuery, Con34)
Dim sqladapter As SqlDataAdapter = New SqlDataAdapter(CustCommand)
Dim tableresult As New DataTable(editCustQuery)
sqladapter.Fill(tableresult)
Con34.Close()
For Each TableRow As DataRow In tableresult.Rows
mater(RowCounter) = tableresult.Rows.Item(RowCounter).Item(0).toString
planta(RowCounter) = tableresult.Rows.Item(RowCounter).Item(1).toString
almacen(RowCounter) = tableresult.Rows.Item(RowCounter).Item(2).toString
lot(RowCounter) = tableresult.Rows.Item(RowCounter).Item(3).toString
cantidad(RowCounter) = tableresult.Rows.Item(RowCounter).Item(4).toString
cantadiat(RowCounter) = tableresult.Rows.Item(RowCounter).Item(5).toString
undad(RowCounter) = tableresult.Rows.Item(RowCounter).Item(6).toString
Cantidadc(RowCounter) = tableresult.Rows.Item(RowCounter).Item(7).toString
CantidadB(RowCounter) = tableresult.Rows.Item(RowCounter).Item(8).toString
Session1(RowCounter) = tableresult.Rows.Item(RowCounter).Item(9).toString
fecha(RowCounter) = tableresult.Rows.Item(RowCounter).Item(10).toString
resultado(RowCounter) = GM.AsigDupla(Txtfecha.Text, cboPlanta0.SelectedValue, cboPlanta0.SelectedItem.Text, cboAlmacen.SelectedValue, cboAlmacen.SelectedItem.Text, mater(RowCounter), lot(RowCounter))
RowCounter = RowCounter + 1
Next
'i = i + 1
With lbError0
.Visible = True
.Text = resultado
End With
Catch ex As Exception
lbError0.Text = ex.Message
End Try
End If
End Sub
Ok this should work but there is something I don't understand you are displaying the result in a textbox I presume. but here is the trick. As I answer on the previous thread, the variable mater and lot are arrays, you can not call mater or lot directly. You have to specify what item of the array. With the modifications I did, resultado is another array so you can not call it directly you have to specify the item resultado().
I need more information what you will do with resultado.
For Each TableRow3 In tableresult3.Rows
mater3 = tableresult3.Rows.Item(RowCounter3).Item(0).ToString
lote3 = tableresult3.Rows.Item(RowCounter3).Item(1).ToString
Dim Con5 As New Data.SqlClient.SqlConnection
Dim StrSQL4 As String
Con5.ConnectionString = C.GetAppConfiguracion("Inventario", "ConnInventario")
StrSQL4 = "EXEC P_AsigDupla2 '" & Txtfecha.Text & "', '" & cboPlanta0.SelectedValue & "', '" & cboPlanta0.SelectedItem.Text & "', '" & cboAlmacen.SelectedValue & "', '" & cboAlmacen.SelectedItem.Text & "', '" & mater3 & "', '" & lote3 & "', '" & tbDupla.Text.ToUpper & "','" & estatus & "'"
Con5.Open()
Dim CmdAd As New Data.SqlClient.SqlCommand(StrSQL4, Con5)
CmdAd.ExecuteNonQuery()
Con5.Close()
RowCounter3 = RowCounter3 + 1
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
I want to change the last value of a asp:repeater > table > tr > asp:label. If a condition is true. To be more expecific, i have the values of the bbdd stored in lblJournee and lblDateFormation. I have another lblDateFormation2 to take the value of the last date. I want to change the value of the last row in my repeater if this condition is made. I hope is understood my problem, i am quite new and trying to learn.
CODE FOR .aspx:
<asp:repeater id="rep_Dates" runat="server">
<HeaderTemplate>
<table id="tblRepDates">
<tr>
<th rowspan="1" colspan="2">Dates</th>
</tr>
</HeaderTemplate>
<ItemTemplate>
<tr>
<td class="sombre">
<asp:label runat="server" id="lbl_DateFormation" text='<%# Eval("[DateFormation]")%>'></asp:label>
</td>
<td class="sombre">
<asp:label runat="server" id="lbl_DemiJournee" text='<%# Eval("[DemiJournee]")%>'></asp:label>
</td>
</tr>
</ItemTemplate>
<FooterTemplate>
</table>
</FooterTemplate>
</asp:repeater>
CODE FOR .aspx.vb:
Private Sub BindRepeaterData(ByVal noformationL As String)
Dim conSQL As New System.Data.SqlClient.SqlConnection
Dim cmdSQL As New System.Data.SqlClient.SqlCommand
conSQL.ConnectionString = Application("BACKstr")
conSQL.Open()
cmdSQL.Connection = conSQL
cmdSQL.CommandText = "select convert(char,[DateFormation],103) AS DateFormation,[DemiJournee] from [EXT$FORM_FormationDates] where NoFormation='" & Replace(noformationL, "'", "''") & "' and TypeDates = 0 order by DateFormation,DemiJourneeInt"
Dim ds As New System.Data.DataSet()
Dim da As New Data.SqlClient.SqlDataAdapter(cmdSQL)
da.Fill(ds)
If ds.Tables(0).Rows.Count > 0 Then
Dim lblDateFormation As New Label
Dim lblJournee As New Label
Dim lblDateFormation2 As String = ""
Dim index As Integer = 0
rep_Dates.Visible = True
rep_Dates.DataSource = ds
rep_Dates.DataBind()
'je mets (1) parce que c'est le deuxieme element du repeater
lblDateFormation = rep_Dates.Controls(1).FindControl("lbl_DateFormation")
lblJournee = rep_Dates.Controls(1).FindControl("lbl_DemiJournee")
For Each item As RepeaterItem In rep_Dates.Items
lblDateFormation = item.FindControl("lbl_DateFormation")
lblJournee = item.FindControl("lbl_DemiJournee")
'si les dates sont les memes on met une seule ligne avec lblJournee = "Journee"
'il faut mettre que la premiere date quelque soit la lblJournee reste M
'item.ItemIndex = 0
'Pour tous les elements on peut se retrouver avec:
' - Le premier element est Matin ou AM est la date sera prise
' - Si le deuxieme element est AM et la date est egale a la premiere...on efface la ligne et le premier element prend la valeur JOURNEE
' - Si le deuxieme element est AM et la date est different...On ecrit AM
' - Si le deuxieme element est Matin on ecrit Matin
If item.ItemIndex = 0 Then
If lblJournee.Text = "Matin" Then
lblJournee.Text = "Matin"
lblDateFormation2 = lblDateFormation.Text
index = item.ItemIndex
Else
lblJournee.Text = "Après-midi"
lblDateFormation2 = lblDateFormation.Text
index = item.ItemIndex
End If
Else
If lblJournee.Text = "Après-midi" And lblDateFormation2 = lblDateFormation.Text Then
item.Visible = False
'Por cada fila que contenga Matin la cambiamos por journee
'Eliminamos la ultima linea y el valor journee sera el de esta o eliminamos esta linea y cambiamos matin por journée
lblDateFormation2 = lblDateFormation.Text
index = item.ItemIndex
ElseIf lblJournee.Text = "Après-midi" And lblDateFormation2 <> lblDateFormation.Text Then
lblJournee.Text = "Après-midi"
lblDateFormation2 = lblDateFormation.Text
index = item.ItemIndex
ElseIf lblJournee.Text = "Matin" Then
lblJournee.Text = "Matin"
lblDateFormation2 = lblDateFormation.Text
index = item.ItemIndex
End If
End If
Next
Else
rep_Dates.Visible = False
End If
conSQL.Close()
End Sub
I hope is all clear. Thanks in advance to any help
Additional code for ItemDataBound event (taken from comment below for clarity)
Sub R1_ItemDataBound(ByVal Sender As Object, ByVal e As RepeaterItemEventArgs) Handles rep_Dates.ItemDataBound()
Dim lblJournee As New Label
Dim lblDateFormation As New Label
If (e.Item.ItemType = ListItemType.Item) Then
If e.Item.ItemIndex = Session("dataRowCount") And lblJournee.Text = "Après-midi" Then
lblJournee.Text = "Journée"
End If
End If
End Sub
OK Rafael.. It seems that I got confused with your requirement. I thought you only wanted to change the data in last row. I now can see that you wish to compare two rows at a time until you have compared all rows. The way to achieve this is to have 2 datasets. The 1st is populated with data from SQL. The second is populated as we compare each pair of rows. All this is done as you thought in your BindRepeaterData Sub. Forget all I said about the ItemDataBound event.
Here is my solution which I have checked with the data you supplied.
Private Sub BindRepeaterData()
'For test I removed param
Dim conSQL As New System.Data.SqlClient.SqlConnection
Dim cmdSQL As New System.Data.SqlClient.SqlCommand
conSQL.ConnectionString = ConfigurationManager.ConnectionStrings("TestConn").ToString
'Change your connection string...
conSQL.Open()
cmdSQL.Connection = conSQL
cmdSQL.CommandText = "select convert(char,[DateFormation],103) AS DateFormation,[DemiJournee] from [TblTest] order by DateFormation"
'Change your Sql
Dim ds As New System.Data.DataSet()
Dim da As New Data.SqlClient.SqlDataAdapter(cmdSQL)
da.Fill(ds)
If ds.Tables(0).Rows.Count > 0 Then
'Create a new dataset with table where we will store final data
Dim dsfinal As New DataSet()
dsfinal.Tables.Add("FinalData")
dsfinal.Tables("FinalData").Columns.Add("DateFormation")
dsfinal.Tables("FinalData").Columns.Add("DemiJournee")
'Now we will go through ds comparing rows and adding as appropriate to dsfinal then bind dsfinal to repeater.
Dim totalrows = ds.Tables(0).Rows.Count
Dim rowpointer As Integer = 0
Dim r = 0
If totalrows > 2 Then
'We have more than two rows
'We compare one row against the next row until we get to the last two rows.
Do While r < totalrows - 2
If ds.Tables(0).Rows(r).Item("DateFormation") = ds.Tables(0).Rows(r + 1).Item("DateFormation") Then
'Both compared rows have same date
'We add just one row to table
dsfinal.Tables("FinalData").Rows.Add(ds.Tables(0).Rows(r).Item("DateFormation"), "Journée")
r += 2 'add 2 to r
rowpointer = r 'add 2 to rowpointer
Else
'The two rows have different dates
'add first comparitor as a row.
'we leave the next row to make comparision with the row after it
dsfinal.Tables("FinalData").Rows.Add(ds.Tables(0).Rows(r).Item("DateFormation"), ds.Tables(0).Rows(r).Item("DemiJournee"))
r += 1
rowpointer = r
End If
Loop
End If
If rowpointer < totalrows - 1 Then
'We need to compare the remaining two rows
If ds.Tables(0).Rows(rowpointer).Item("DateFormation") = ds.Tables(0).Rows(rowpointer + 1).Item("DateFormation") Then
'Both compared rows have same date
'We add just one row to table
dsfinal.Tables("FinalData").Rows.Add(ds.Tables(0).Rows(rowpointer).Item("DateFormation"), "Journée")
Else
'The two rows have different dates
'add both rows
dsfinal.Tables("FinalData").Rows.Add(ds.Tables(0).Rows(rowpointer).Item("DateFormation"), ds.Tables(0).Rows(rowpointer).Item("DemiJournee"))
dsfinal.Tables("FinalData").Rows.Add(ds.Tables(0).Rows(rowpointer + 1).Item("DateFormation"), ds.Tables(0).Rows(rowpointer + 1).Item("DemiJournee"))
End If
Else
'We only have one record
dsfinal.Tables("FinalData").Rows.Add(ds.Tables(0).Rows(rowpointer).Item("DateFormation"), ds.Tables(0).Rows(rowpointer).Item("DemiJournee"))
End If
'dsfinal now contains the correct data.
'clear original ds
ds = Nothing
rep_Dates.Visible = True
rep_Dates.DataSource = dsfinal
rep_Dates.DataBind()
dsfinal = Nothing
Else
rep_Dates.Visible = False
End If
conSQL.Close()
End Sub
Sorry for confusion.
I would bind as normal and then have an ItemDataBound event which will fire as each item is bound. You could then check if the item is the last item and make your change to that items label.
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.