codice:
<%
destinatario = request.form("destinatario")
oggetto = request.form("oggetto")
corpo = request.form("corpo")
priorita = request.form("priorita")
htmlen = request.form("htmlen")
urlremoto = request.form("urlremoto")
if htmlen = "false" then
htmlen = false
else
htmlen = true
end if
if corpo = "" and urlremoto <> "" then
htmlen = true
if mid(urlremoto,1,7) <> "http://" then urlremoto = "http://" & urlremoto
Set xml = Server.CreateObject("Microsoft.XMLHTTP")
' per la versione 3.0 di XMLHTTP, usare:
' Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.Open "GET", urlremoto, False
on error resume next
xml.Send
if err.number = 0 then
corpo = xml.responseText
sistemalink()
else
response.redirect "mailing.asp?err=2"
end if
end if
select case destinatario
case "1" sql = "SELECT Mail, Nome, Cognome FROM Utenti where Rivenditore = True"
case "2" sql = "SELECT Mail, Nome, Cognome FROM Utenti where Rivenditore = False"
case "3" sql = "SELECT Mail, Nome, Cognome FROM Utenti"
case "4" sql = "SELECT Mail, Nome, Cognome FROM Utenti where Admin = True"
End select
Set rs = Server.CreateObject("ADODB.Recordset")
rs.Open sql, conn ,3,3
if rs.eof then
response.redirect "mailing.asp?err=3"
else
rs.movefirst
end if
'######################INVIO CON ASPEMAIL. DECOMMENTARE PER UTILIZZARE
'set email = server.createObject("Persits.MailSender")
'email.Host= MailServer
'email.From= MailAdmin
'email.FromName= UrlEcom
'email.Subject= oggetto
'email.Body= corpo
'email.IsHtml=htmlen 'false
'email.Priority=priorita '1 hight, 3 normal , 5 low
'do while not(rs.eof)
'email.AddAddress rs("Mail"), rs("Cognome") &" "& rs("Nome")
'rs.movenext
'loop
'on error resume next
'email.send()
'if err.number <> 0 then errore = true
'set email = nothing
'######################INVIO CON CDOSYS. DECOMMENTARE PER UTILIZZARE
stringamail = ""
'do while not(rs.eof)
' if stringamail = "" then
' stringamail = rs("Mail")
' else
' stringamail = stringamail & ";" & rs("Mail")
' end if
' rs.movenext
'loop
'dim oMessaggioTEXT
'set oMessaggioTEXT = server.CreateObject("CDO.Message")
'sBodyTEXT ="Visita http://www.theglasser.com"
'With oMessaggioTEXT
' .To = stringamail
' .From = MailAdmin
' .Subject = oggetto
' .Fields("urn:schemas:httpmail:importance").Value = cdoImpHig
' .Fields("urn:schemas:httpmail:priority").Value = cdoPriorityUrgent
' .Fields("urn:schemas:mailheader:X-Priority").Value = priorita
' .Fields.update()
'End With
'if htmlen = true then
' oMessaggioTEXT.HTMLBody = corpo
'else
' oMessaggioTEXT.TEXTBody = corpo
'end if
'on error resume next
'oMessaggioTEXT.Send
'if err.number <> 0 then errore = true
'set oMessaggioTEXT=nothing
'Chiusura del database
rs.Close
set rs = Nothing
conn.Close
set conn = Nothing
if errore <> true then
response.redirect "ok.asp"
else
response.write err.description
response.end
response.redirect "mailing.asp?err=1"
end if
function sistemalink()
dim linkdef(1000,2)
dim imgdef(1000,2)
dim sfondidef(1000,2)
dim scridef(1000,2)
temp = right(urlremoto,(len(urlremoto)-7))
inturl = split(temp,"/")
'CORREGGO I LINK
corpo = replace(corpo,"HREF","href")
corpo = replace(corpo,"A href","a href")
link = split(corpo,"href=""")
contalink = 0
for i = 1 to ubound(link)
if mid(link(i),1,7) <> "http://" and mid(link(i),1,6) <> "mailto" then
contalink = contalink + 1
temp = split(link(i),""">")
linkdef(contalink,1) = temp(0)
end if
next
contaback = 0
for i = 1 to contalink
contaback = instr(linkdef(i,1),"../")
for j = 0 to (ubound(inturl) - contaback - 1)
linkdef(i,2) = linkdef(i,2) & "/" & inturl(j)
next
linkdef(i,2) = "http:/" & linkdef(i,2) & "/" & linkdef(i,1)
next
'CORREGGO LE IMG
corpo = replace(corpo,"IMG","img")
corpo = replace(corpo,"SRC","src")
img = split(corpo,"[img][/img] "http://" then
contaimg = contaimg + 1
temp1 = split(img(i),">")
imgdef(contaimg,1) = temp1(0)
end if
next
contaback = 0
for i = 1 to contaimg
contaback = instr(imgdef(i,1),"../")
for j = 0 to (ubound(inturl) - contaback - 1)
imgdef(i,2) = imgdef(i,2) & "/" & inturl(j)
next
imgdef(i,2) = "http:/" & imgdef(i,2) & "/" & imgdef(i,1)
next
'CORREGGO SFONDI
sfondi = split(corpo,"background=")
contasfondi = 0
for i = 1 to ubound(sfondi)
sfondi(i) = replace(sfondi(i),"""","")
next
for i = 1 to ubound(sfondi)
if instr(mid(sfondi(i),1,8),"http://") <= 0 then
contasfondi = contasfondi + 1
temp2 = split(sfondi(i),">")
sfondidef(contasfondi,1) = temp2(0)
end if
next
contaback = 0
for i = 1 to contasfondi
contaback = instr(sfondidef(i,1),"../")
for j = 0 to (ubound(inturl) - contaback - 1)
sfondidef(i,2) = sfondidef(i,2) & "/" & inturl(j)
next
sfondidef(i,2) = "http:/" & sfondidef(i,2) & "/" & sfondidef(i,1)
next
'CORREGGO SCRIPT
scri = split(corpo,"src=""")
contascri = 0
for i = 1 to ubound(scri)
if mid(scri(i),1,7) <> "http://" then
contascri = contascri + 1
temp3 = split(scri(i),">")
scridef(contascri,1) = temp3(0)
end if
next
contaback = 0
for i = 1 to contascri
contaback = instr(scridef(i,1),"../")
for j = 0 to (ubound(inturl) - contaback - 1)
scridef(i,2) = scridef(i,2) & "/" & inturl(j)
next
scridef(i,2) = "http:/" & scridef(i,2) & "/" & scridef(i,1)
next
'EFFETTUO LE SOSTITUZIONI
for i = 1 to contalink
orig = "href=""" & linkdef(i,1) & """>"
newurl = "href=""" & linkdef(i,2) & """>"
corpo = replace(corpo,orig,newurl)
next
for i = 1 to contaimg
orig = "[img][/img]"
newimg = "[img][/img]"
corpo = replace(corpo,orig,newimg)
next
for i = 1 to contasfondi
orig = "background=" & sfondidef(i,1) & ">"
newimg = "background=" & sfondidef(i,2) & ">"
corpo = replace(corpo,orig,newimg)
orig = "background=""" & sfondidef(i,1) & """>"
newimg = "background=""" & sfondidef(i,2) & """>"
corpo = replace(corpo,orig,newimg)
next
for i = 1 to contascri
orig = "src=""" & scridef(i,1) & ">"
newimg = "src=""" & scridef(i,2) & ">"
corpo = replace(corpo,orig,newimg)
next
end function
%>
Rispondi quotando
