15/11/2004, 11:59
|
 | | | Fecha de Ingreso: mayo-2003 Ubicación: Panama city, Panama, Panama
Mensajes: 1.154
Antigüedad: 22 años Puntos: 5 | |
default.asp
Código:
<!--#include file="uploadtomessage.asp"-->
<title>Enviar E-Mails a los Miembros del Sitio</title>
<script language="javascript">
function enviaremails() {
var f = document.form1
if (f.txtnombre.value == "") {
alert("Debe colocar su Nombre al Mensaje.")
f.txtnombre.focus()
return false
}
if (f.txtasunto.value == "") {
alert("Debe colocar un Asunto al Mensaje.")
f.txtasunto.focus()
return false
}
if (f.txtcontenido.value == "") {
alert("Debe colocar el Contenido del Mensaje.")
f.txtcontenido.focus()
return false
}
return true
}
</script>
<%
server.ScriptTimeout = 100000000
Set Master = Server.CreateObject("ADODB.Connection")
Master.Open("DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath(strDBPath))
Dim Uploader, File
Set Uploader = New FileUploader
Uploader.Upload()
nombre = Uploader.form("txtnombre")
asunto = Uploader.form("txtasunto")
contenido = Uploader.form("txtcontenido")
Ruta = strMainDir & "scripts/newsletter/"
if nombre <> "" then
If Uploader.Files.Count <> 0 Then
For Each File In Uploader.Files.Items
File.SaveToDisk Server.MapPath(Ruta)
Next
end if
sSQL = "select * from clientes"
set RSUsuarios = Master.Execute(sSQL)
sSQL = "select * from parametros"
set RSParametros = Master.Execute(sSQL)
if RSUsuarios.bof=false and RSUsuarios.eof=false then
while not RSUsuarios.eof
mensaje = ""
mensaje = "Hola " & RSUsuarios("nombreclien") & "." & VbCrLf
mensaje = mensaje & nombre & " le ha enviado la siguiente información:" & VbCrLf & VbCrLf
mensaje = mensaje & contenido & "." & VbCrLf & VbCrLf
mensaje = mensaje & "Sus amigos de " & strCompanyName & VbCrLf
mensaje = mensaje & "---------------------------------------" & VbCrLf
mensaje = mensaje & "Enviado desde " & strCompanyName
Set Mailer = Server.CreateObject("SMTPsvg.Mailer")
Mailer.FromName = FromName
Mailer.FromAddress= RSParametros("emailsend")
Mailer.RemoteHost = RemoteHost
Mailer.AddRecipient RSUsuarios("nombreclien"), RSUsuarios("emailclien")
Mailer.Subject = asunto
Mailer.ContentType = "text/html"
Mailer.BodyText = mensaje
If Uploader.Files.Count <> 0 Then
For Each File In Uploader.Files.Items
Mailer.AddAttachment Server.MapPath(Ruta & File.FileName)
archivo = File.FileName
Next
end if
Mailer.SendMail
RSUsuarios.movenext
wend
end if
end if
if nombre = "" then
%>
<form action="newsletter.asp" method="post" enctype="multipart/form-data" name="form1" onSubmit="return enviaremails()">
<table width="95%" border="0" align="center" cellpadding="0" cellspacing="0" class="TablasTitulo">
<tr>
<td width="84%" height="20"> Enviar E-Mails a los Miembros del Sitio</td>
<td width="16%"><div align="right"><a href="<%=(strMainDir)%>scripts/admin.asp"><img src="<%=(strMainDir)%>_gui/icon_salir.gif" border="0"></a></div></td>
</tr>
</table>
<table width="95%" border="0" cellspacing="0" cellpadding="0" class="Tablas">
<tr>
<td width="18%" height="22"> Su Nombre: </td>
<td width="82%" height="22"><input name="txtnombre" type="text" size="60" maxlength="50"></td>
</tr>
<tr>
<td height="22"> Asunto: </td>
<td height="22"><input name="txtasunto" type="text" size="60" maxlength="50"></td>
</tr>
<tr>
<td height="22"> Datos Adjuntos : </td>
<td height="22"><input name="file1" type="file" size="60"></td>
</tr>
<tr>
<td> Mensaje: </td>
<td><textarea name="txtcontenido" cols="60" rows="6"></textarea>
<br>
<br></td>
</tr>
</table>
<br>
<br>
<input type="submit" name="Submit" value="Enviar" class="Botones">
</form>
<%
else
%>
<table width="95%" border="0" cellspacing="0" cellpadding="0" class="TablasTitulo">
<tr>
<td height="20"> Enviar E-Mails a los Miembros del Sitio</td>
</tr>
</table>
<table width="95%" border="0" cellspacing="0" cellpadding="0" class="Tablas">
<tr>
<td height="46"><div align="center">El Mensaje se ha enviado correctamente a todos los miembros del Sitio</div></td>
</tr>
</table>
<br>
<input type="button" name="Submit2" value="Regresar" onClick="document.location.href='newsletter.asp'" class="Botones">
<%
end if
%>
Código:
<%
Class FileUploader
Public Files
Private mcolFormElem
Private Sub Class_Initialize()
Set Files = Server.CreateObject("Scripting.Dictionary")
Set mcolFormElem = Server.CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
If IsObject(Files) Then
Files.RemoveAll()
Set Files = Nothing
End If
If IsObject(mcolFormElem) Then
mcolFormElem.RemoveAll()
Set mcolFormElem = Nothing
End If
End Sub
Public Property Get Form(sIndex)
Form = ""
If mcolFormElem.Exists(LCase(sIndex)) Then Form = mcolFormElem.Item(LCase(sIndex))
End Property
Public Default Sub Upload()
Dim biData, sInputName
Dim nPosBegin, nPosEnd, nPos, vDataBounds, nDataBoundPos
Dim nPosFile, nPosBound
biData = Request.BinaryRead(Request.TotalBytes)
nPosBegin = 1
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))
If (nPosEnd-nPosBegin) <= 0 Then Exit Sub
vDataBounds = MidB(biData, nPosBegin, nPosEnd-nPosBegin)
nDataBoundPos = InstrB(1, biData, vDataBounds)
Do Until nDataBoundPos = InstrB(biData, vDataBounds & CByteString("--"))
nPos = InstrB(nDataBoundPos, biData, CByteString("Content-Disposition"))
nPos = InstrB(nPos, biData, CByteString("name="))
nPosBegin = nPos + 6
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(34)))
sInputName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
nPosFile = InstrB(nDataBoundPos, biData, CByteString("filename="))
nPosBound = InstrB(nPosEnd, biData, vDataBounds)
If nPosFile <> 0 And nPosFile < nPosBound Then
Dim oUploadFile, sFileName
Set oUploadFile = New UploadedFile
nPosBegin = nPosFile + 10
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(34)))
sFileName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
oUploadFile.FileName = Right(sFileName, Len(sFileName)-InStrRev(sFileName, "\"))
nPos = InstrB(nPosEnd, biData, CByteString("Content-Type:"))
nPosBegin = nPos + 14
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))
oUploadFile.ContentType = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
nPosBegin = nPosEnd+4
nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
oUploadFile.FileData = MidB(biData, nPosBegin, nPosEnd-nPosBegin)
If oUploadFile.FileSize > 0 Then Files.Add LCase(sInputName), oUploadFile
Else
nPos = InstrB(nPos, biData, CByteString(Chr(13)))
nPosBegin = nPos + 4
nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
If Not mcolFormElem.Exists(LCase(sInputName)) Then mcolFormElem.Add LCase(sInputName), CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
End If
nDataBoundPos = InstrB(nDataBoundPos + LenB(vDataBounds), biData, vDataBounds)
Loop
End Sub
'String to byte string conversion
Private Function CByteString(sString)
Dim nIndex
For nIndex = 1 to Len(sString)
CByteString = CByteString & ChrB(AscB(Mid(sString,nIndex,1)))
Next
End Function
'Byte string to string conversion
Private Function CWideString(bsString)
Dim nIndex
CWideString =""
For nIndex = 1 to LenB(bsString)
CWideString = CWideString & Chr(AscB(MidB(bsString,nIndex,1)))
Next
End Function
End Class
Class UploadedFile
Public ContentType
Public FileName
Public FileData
Public Property Get FileSize()
FileSize = LenB(FileData)
End Property
Public Sub SaveToDisk(sPath)
Dim oFS, oFile
Dim nIndex
If sPath = "" Or FileName = "" Then Exit Sub
If Mid(sPath, Len(sPath)) <> "\" Then sPath = sPath & "\"
Set oFS = Server.CreateObject("Scripting.FileSystemObject")
If Not oFS.FolderExists(sPath) Then Exit Sub
Set oFile = oFS.CreateTextFile(sPath & FileName, True)
For nIndex = 1 to LenB(FileData)
oFile.Write Chr(AscB(MidB(FileData,nIndex,1)))
Next
oFile.Close
End Sub
Public Sub SaveToDatabase(ByRef oField)
If LenB(FileData) = 0 Then Exit Sub
If IsObject(oField) Then
oField.AppendChunk FileData
End If
End Sub
End Class
%>
__________________
Saruman
One Ring to rule them all, One Ring to find them, One Ring to bring them all and in the darkness bind them. |