<% function EnviaMail(MFrom,MTo,MSubject,MBody,MCC) dim oMail,NWL,EmailFrom,EmailTo,EmailSubject,Emailbody,EmailCC NWL = "" & CHR(10) EmailFrom = Trim(Mfrom) EmailTo = Trim(Mto) EmailSubject = Trim(MSubject) Emailbody = Trim(MBody) EmailCC = Trim(MCC) if trim(EmailTo)="" or trim(EmailSubject)="" then EnviaMail="Error : Destino y Subject son obligatorios" exit function end if If EmailFrom="" then EmailFrom="UsuarioDesconocido" end if set oMail=server.CreateObject("CDONTS.NewMail") oMail.From = EmailFrom oMail.To = EmailTo oMail.Subject = EmailSubject oMail.Body = EmailBody oMail.BodyFormat=0 oMail.MailFormat = 0 if EmailCC <> "" then oMail.Cc = EmailCC end if oMail.Importance = 1 oMail.Send If err.number <> 0 Then EnviaMail="Error: " & err.number else EnviaMail="" End If On Error Goto 0 set oMail=nothing end function function Mailing(ISource,Ifrom,ISubject,IBody) 'Input: ISOurce;origen de la lista de mail, se cuenta desde la ruta del sitio ' ejemplo: Isource="lista/lista.txt" significa Disco:\inetpub\wwwroot\sitio\lista\lista.txt, ' Ifrom; texto de quien viene el mailing, ' Isubject;Subject del mailing, ' Ibody; cuerpo de mensaje en html 'Output: numero de mail enviados ""= Error 'Descripcion: se recorre un archivo con mails y se envía un mail predefinido a todo ellos 'Autor: VLG 'fecha: 08/02/2001 Dim fso, f 'as filesistem dim strMail,strDesde,strPara,strSubject,strBody,strCC,strResul 'as string dim strArchivo dim NWL 'as string dim intCont 'as integer Set fso = CreateObject("Scripting.FileSystemObject") strArchivo=trim(Request.ServerVariables("APPL_PHYSICAL_PATH")) & Isource 'variación para desarrollo 'strArchivo=iSource Set f = fso.OpenTextFile(strArchivo) intCont=1 strBody=IBody Response.Write(now() & "
") Do While f.AtEndOfStream <> True strMail = f.ReadLine NWL = "" & CHR(10) strDesde=Ifrom strPara=trim(strmail) strSubject=ISubject strCC="" if strDesde<>"" then strResul=EnviaMail(strDesde,strPara,strSubject,strBody,strCC) if strResul="" then Response.Write("
" & intCont) Response.Flush else Response.Write("
No se pudo: " & intCont) Response.Flush end if end if intCont=intCont+1 Loop f.Close Mailing=intCont-1 Response.Write(now() & "
") end function Function GetRs(strSQL, conn) 'Input: strSQL, consulta sql 'Output: recordset 'Descripcion: Dependiendo de la base a conectar según parámetro de ingreso ' SIRE o DIRECTORIO se abre la conexión, si no hay problemas retorna ' un objeto de conexión. Si hay problemas retorna el objeto en nothing 'Autor: VLG 'fecha: 2/11/2000 Dim rsett 'as adodb.recordset Set rsett = Server.CreateObject("ADODB.RecordSet") rsett.Open strSQL, conn, 1,3 Set Getrs = rsett End Function Function CloseRs(rsAux) rsAux.close set rsAux=nothing end function Function GrabaLog(strLogTxt,strErrorNum)'as boolean 'Input: strLogTxt,Texo a guardar en el log; strErrorNum, error rescatado de la ejecución (0 indica no error) 'Output: True o false indicando si se guardó el log o no 'Descripcion: actualiza un archivo de log ingresando un nuevo evento en él 'indicando un numero de error estándar VB, el nombre del archivo de error es logDDMMAAAA.log 'el formato de strlogtxt debe ser Accion;NombreTabla;CampoaGuardar;CampoaGuardar;...; 'Autor: VLG 'fecha: 9/11/2000 dim strArchivo, strName,strDate,strLog 'as string dim fsoLog 'as Scripting.FileSystemObject dim otfLog 'as fsoLog.OpenTextFile on error resume next err.clear strLog=strLogTxt & ";" & time() & ";" & strErrorNum strDate=now() strName=day(strDate) & "_" & month(strDate) & "_" & year(strDate) & ".csv" strArchivo="D:\Archivo_de_Ford\" & strName Set fsoLog = CreateObject("Scripting.FileSystemObject") Set otfLog = fsoLog.OpenTextFile(strArchivo,8,true) otfLog.writeline(strLog) otfLog.close set otfLog=nothing set fsoLog=nothing if err.number<>0 then GrabaLog=false else GrabaLog=true end if end function %>