-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathenviar_correo2.asp
169 lines (123 loc) · 4.66 KB
/
enviar_correo2.asp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
<%
Dim objUpload 'stores an Upload control object
Dim objEmail 'stores a Mailer control object
Dim strPath 'stores path to a directory we create at same level as this ASP page
dim autor
dim opcion
dim db
'The SendMail function will throw an exception if the operation is
' unsuccessful, so we enable inline error trapping
On Error Resume Next
set db = server.CreateObject("SQLComandos.Comandos")
Set objUpload = Server.CreateObject("Dundas.Upload.2")
'Quitado
'Set objEmail = Server.CreateObject("Dundas.Mailer")
Set oMail = Server.CreateObject ("CDONTS.NewMail")
oMail.BodyFormat=0
oMail.MailFormat=0
'create a directory at same level as this ASP page
'this directory is used to store the uploaded files (which are renamed with a GUID preceding
'the original filename)
'NOTE: to delete these files you would have to use the ImpersonateUser method of
'the Upload control since the IUSR_ account SHOULD NOT have permission to delete files
strPath = Server.MapPath(".") & "\temp"
objUpload.DirectoryCreate strPath
destino = ""
'save the uploaded files. THIS POPULATES THE UPLOAD CONTROL'S COLLECTIONS!
objUpload.Save strPath
' opcion = objUpload.Form("opcion")
autor = objUpload.Form("autor")
copia = objUpload.Form("copia")
tema = objUpload.Form("tema")
contenido = objUpload.Form("contenido")
destino = objUpload.Form("lstus")
oMail.Value("Reply-To") = "[email protected]"
'especifica el destinatario del mensaje
'QUITADO
'objEmail.TOs.Add destino,nombre_completo
oMail.To = destino
'especifica la dirección a la que se enviara una copia
if len(copia) > 0 then
'Quitado
'objEmail.CCs.Add copia
oMail.Cc = copia
end if
'especifica el tema del mensaje
tema = objUpload.Form("tema")
'Quitado
'objEmail.Subject = tema
oMail.Subject = tema
'especifica el remitente del correo
'Quitado
'objEmail.FromAddress = "[email protected]"
oMail.From = "[email protected]"
'specify an SMTP Relay server. This increases the speed and reliability of the operation
'Quitado
'objEmail.SMTPRelayServers.Add "216.230.138.254"
'initialize the HtmlBody property, we'll throw a header into it
contenido = objUpload.Form("contenido")
'Quitado
HTMLBody = "<Html><Head></Head><Body><H2>" & contenido
'oMail.Body = contenido
'oMail.Body = HTML
For Each Item in objUpload.Files
'verifica que el campo del archivo sea el valido
If (Item.TagName = "txtarchivo") Then
'Quitado
' objEmail.HtmlEmbeddedObjs.Add Item.Path, 1, Item.OriginalPath
HTMLBody = HTMLBody & "<a href=cid:1>Documento</a>"
oMail.AttachFile(Item.Path)
End If
If (Item.TagName = "txtImage") Then
If InStr(1,Item.ContentType,"image") Then
'Quitado
'objEmail.HtmlEmbeddedObjs.Add Item.Path, 2, Item.OriginalPath
HTMLBody = HTMLBody & "<IMG SRC=cid:2>"
oMail.AttachFile(Item.Path)
End If
End If
Next
'terminar html body colocando las etiquetas html finales
'Quitado
HTMLBody = HTMLBody & "</body></html>"
oMail.Body = HTMLBody
'oMail.AttachURL ("http://www.sat.gob.gt")
'enviar el correo
'QUITADO
'objEmail.SendMail
''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''
sql = "select mail from usuario where id in (" & destino & ") and recibir_mail = 'SI'"
set rs = db.SQLSelect("DBBAECYS",sql)
correo = ""
if not rs.eof then
while rs.eof <> true
correo = correo & rs("mail") & ","
'Prueba El exito/fallo
If Err.Number <> 0 Then
Response.Write "No se pudo enviar el mensaje, el siguiente error ocurrio: " & Err.Description
'Response.Redirect ("previewforo.asp?desc="&"No se pudo enviar el mensaje, el siguiente error ocurrio: " & Err.Description)
Else
'Exito
Response.Write "The correo html fue enviado exitosamente."
'Response.Redirect ("previewforo.asp?desc="&"The correo html fue enviado exitosamente.")
End If
rs.movenext
wend
end if
correo = left(correo,(len(correo)-1))
oMail.To = correo
''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''
oMail.Send
set oMail = Nothing
Set objUpload = Nothing
set rs = nothing
set db = nothing
'Prueba El exito/fallo
If Err.Number <> 0 Then
Response.Redirect ("./previewforo.asp?desc="&"No se pudo enviar el mensaje, el siguiente error ocurrio: " & Err.Description)
Else
Response.Redirect ("./previewforo.asp?desc="&opcion&"El correo html fue enviado exitosamente.")
End If
%>