title image


Smiley Re: Form to Mail
Hallo,

danke für deine Antwort, habe bereits eine Lösung

gefunden - CDONTS hat, wie du es schon erwähntest,

nicht funktioniert.

Die METADATA Zeilen dürften das Geheimnis sein, obwohl

ich nicht weiss, was diese Ziffernkombinationen aussagen

sollen, aber egal.

Einziges Manko: dieses Skript funktioniert ohne dass ich

etwas ändere manchmal nicht, dann wieder schon. Das dürfte

aber mit dem Mailserver zusammenhängen, wahrscheinlich ein

Timeout oder so. Wenn du dafür noch etwas weisst, etwa wie

ich in diesem Skript festlege, dass länger gewartet wird,

dann bitte schreibe es mir.

MFG.



















<% '***************************************************************************

'* ASP FormMail *

'* *

'* Do not remove this notice. *

'* *

'* Copyright 1999-2002 by Mike Hall. *

'* Please see http://www.brainjar.com for documentation and terms of use. *

'***************************************************************************



'- Customization of these values is required, see documentation. -----------



referers = Array("commonprint","commonprint.nls.at")

mailComp = "CDOSYS"

smtpServer = "192.168.0.1"

fromAddr = "root@server.net"



'- End required customization section. -------------------------------------



Response.Buffer = true

errorMsgs = Array()



'Check for form data.



if Request.ServerVariables("Content_Length") = 0 then

call AddErrorMsg("Keine Formulardaten vorhanden.")

end if



'Check if referer is allowed.



if UBound(referers) >= 0 then

validReferer = false

referer = GetHost(Request.ServerVariables("HTTP_REFERER"))

for each host in referers

if host = referer then

validReferer = true

end if

next

if not validReferer then

if referer = "" then

call AddErrorMsg("Kein Referer vorhanden.")

else

call AddErrorMsg("Ungültiger Referer: '" & referer & "'.")

end if

end if

end if



'Check for the recipients field.



if Request.Form("_recipients") = "" then

call AddErrorMsg("Kein e-mail Empfänger vorhanden.")

end if



'Check all recipient email addresses.



recipients = Split(Request.Form("_recipients"), ",")

for each name in recipients

name = Trim(name)

if not IsValidEmailAddress(name) then

call AddErrorMsg("Ungültige E-Mail Adresse in der Empfängerliste: " & name & ".")

end if

next

recipients = Join(recipients, ",")



'Get replyTo email address from specified field, if given, and check it.



name = Trim(Request.Form("_replyToField"))

if name "" then

replyTo = Request.Form(name)

else

replyTo = Request.Form("_replyTo")

end if

if replyTo "" then

if not IsValidEmailAddress(replyTo) then

call AddErrorMsg("Ungültige E-Mail Adresse im reply-to Feld: " & replyTo & ".")

end if

end if



'Ceck email address from specified field in the form.



name = Trim(Request.Form("Email"))

if name "" then

if not IsValidEmailAddress(name) then

call AddErrorMsg("Ungültige E-Mail Adresse: " & name & ".")

end if

end if



'Get subject text.



subject = Request.Form("_subject")



'If required fields are specified, check for them.



if Request.Form("_requiredFields") "" then

required = Split(Request.Form("_requiredFields"), ",")

for each name in required

name = Trim(name)

if Left(name, 1) "_" and Request.Form(name) = "" then

call AddErrorMsg("Wert für " & name & " fehlt.")

end if

next

end if



'If a field order was given, use it. Otherwise use the order the fields were

'received in.



str = ""

if Request.Form("_fieldOrder") "" then

fieldOrder = Split(Request.Form("_fieldOrder"), ",")

for each name in fieldOrder

if str "" then

str = str & ","

end if

str = str & Trim(name)

next

fieldOrder = Split(str, ",")

else

fieldOrder = FormFieldList()

end if



'If there were no errors, build the email note and send it.



if UBound(errorMsgs) < 0 then



'Build table of form fields and values.



body = "" & vbCrLf

for each name in fieldOrder

body = body _

& "" _

& "" & name & ":" _

& "" & Request.Form(name) & "" _

& "" & vbCrLf

next

body = body & "" & vbCrLf



'Add a table for any requested environmental variables.



if Request.Form("_envars") "" then

body = body _

& " " & vbCrLf _

& "" & vbCrLf

envars = Split(Request.Form("_envars"), ",")

for each name in envars

name = Trim(name)

body = body _

& "" _

& "" & name & ":" _

& "" & Request.ServerVariables(name) & "" _

& "" & vbCrLf

next

body = body & "" & vbCrLf

end if



'Send it.



str = SendMail()

if str "" then

AddErrorMsg(str)

end if



'Redirect if a URL was given.



if Request.Form("_redirect") "" then

Response.Redirect(Request.Form("_redirect"))

end if



end if %>













Form Mail





body {

background-color: #ffffff;

color: #000000;

font-family: Arial, Helvetica, sans-serif;

font-size: 11pt;

}



table {

border: solid 1px #000000;

border-collapse: collapse;

}



td, th {

border: solid 1px #000000;

border-collapse: collapse;

font-family: Arial, Helvetica, sans-serif;

font-size: 10pt;

padding: 2px;

padding-left: 8px;

padding-right: 8px;

}



th {

background-color: #c0c0c0;

}



.error {

color: #c00000;

}













= 0 then %>

Formular konnte wegen folgender Fehler nicht verarbeitet werden:



















Folgende Informationen wurden gesendet:

































<% '---------------------------------------------------------------------------

' Subroutines and functions.

'---------------------------------------------------------------------------



sub AddErrorMsg(msg)



dim n



'Add an error message to the list.



n = UBound(errorMsgs)

Redim Preserve errorMsgs(n + 1)

errorMsgs(n + 1) = msg



end sub



function GetHost(url)



dim i, s



GetHost = ""



'Strip down to host or IP address and port number, if any.



if Left(url, 7) = "http://" then

s = Mid(url, 8)

elseif Left(url, 8) = "https://" then

s = Mid(url, 9)

end if

i = InStr(s, "/")

if i > 1 then

s = Mid(s, 1, i - 1)

end if



getHost = s



end function



'Define the global list of valid TLDs.



dim validTlds



function IsValidEmailAddress(emailAddr)



dim i, localPart, domain, charCode, subdomain, subdomains, tld



'Check for valid syntax in an email address.



IsValidEmailAddress = true



'Parse out the local part and the domain.



i = InStrRev(emailAddr, "@")

if i <= 1 then

IsValidEmailAddress = false

exit function

end if

localPart = Left(emailAddr, i - 1)

domain = Mid(emailAddr, i + 1)

if Len(localPart) < 1 or Len(domain) < 3 then

IsValidEmailAddress = false

exit function

end if



'Check for invalid characters in the local part.



for i = 1 to Len(localPart)

charCode = Asc(Mid(localPart, i, 1))

if charCode = 127 then

IsValidEmailAddress = false

exit function

end if

next



'Check for invalid characters in the domain.



domain = LCase(domain)

for i = 1 to Len(domain)

charCode = Asc(Mid(domain, i, 1))

if not ((charCode >= 97 and charCode = 48 and charCode <= 57) or charCode = 45 or charCode = 46) then

IsValidEmailAddress = false

exit function

end if

next



'Check each subdomain.



subdomains = Split(domain, ".")

for each subdomain in subdomains

if Len(subdomain) < 1 then

IsValidEmailAddress = false

exit function

end if

next



'Last subdomain should be a TDL.



tld = subdomains(UBound(subdomains))

if not IsArray(validTlds) then

call SetValidTlds()

end if

for i = LBound(validTlds) to UBound(validTlds)

if tld = validTlds(i) then

exit function

end if

next

IsValidEmailAddress = false



end function



sub setValidTlds()



'Load the global list of valid TLDs.



validTlds = Array("aero", "biz", "com", "coop", "edu", "gov", "info", "int", "mil", "museum", "name", "net", "org", "pro", _

"ac", "ad", "ae", "af", "ag", "ai", "al", "am", "an", "ao", "aq", "ar", "as", "at", "au", "aw", "az", _

"ba", "bb", "bd", "be", "bf", "bg", "bh", "bi", "bj", "bm", "bn", "bo", "br", "bs", "bt", "bv", "bw", "by", "bz", _

"ca", "cc", "cd", "cf", "cg", "ch", "ci", "ck", "cl", "cm", "cn", "co", "cr", "cu", "cv", "cx", "cy", "cz", _

"de", "dj", "dk", "dm", "do", "dz", "ec", "ee", "eg", "eh", "er", "es", "et", _

"fi", "fj", "fk", "fm", "fo", "fr", _

"ga", "gd", "ge", "gf", "gg", "gh", "gi", "gl", "gm", "gn", "gp", "gq", "gr", "gs", "gt", "gu", "gw", "gy", _

"hk", "hm", "hn", "hr", "ht", "hu", _

"id", "ie", "il", "im", "in", "io", "iq", "ir", "is", "it", _

"je", "jm", "jo", "jp", _

"ke", "kg", "kh", "ki", "km", "kn", "kp", "kr", "kw", "ky", "kz", _

"la", "lb", "lc", "li", "lk", "lr", "ls", "lt", "lu", "lv", "ly", _

"ma", "mc", "md", "mg", "mh", "mk", "ml", "mm", "mn", "mo", "mp", "mq", "mr", "ms", "mt", "mu", "mv", "mw ", "mx", "my", "mz", _

"na", "nc", "ne", "nf", "ng", "ni", "nl", "no", "np", "nr", "nu", "nz", _

"om", _

"pa", "pe", "pf", "pg", "ph", "pk", "pl", "pm", "pn", "pr", "ps", "pt", "pw", "py", _

"qa", _

"re", "ro", "ru", "rw", _

"sa", "sb", "sc", "sd", "se", "sg", "sh", "si", "sj", "sk", "sl", "sm", "sn", "so", "sr", "st", "sv", "sy", "sz", _

"tc", "td", "tf", "tg", "th", "tj", "tk", "tm", "tn", "to", "tp", "tr", "tt", "tv", "tw", "tz", _

"ua", "ug", "uk", "um", "us", "uy", "uz", _

"va", "vc", "ve", "vg", "vi", "vn", "vu", _

"wf", "ws", _

"ye", "yt", "yu", _

"za", "zm", "zw")



end sub



function FormFieldList()



dim str, i, name



'Build an array of form field names ordered as they were received.



str = ""

for i = 1 to Request.Form.Count

for each name in Request.Form

if Left(name, 1) "_" and Request.Form(name) is Request.Form(i) then

if str "" then

str = str & ","

end if

str = str & name

exit for

end if

next

next

FormFieldList = Split(str, ",")



end function



function SendMail()



dim mailObj, cdoMessage, cdoConfig

dim addrList



'Send email based on mail component. Uses global variables for parameters

'because there are so many.



SendMail = ""



'Send email (CDONTS version). Note: CDONTS has no error checking.



if mailComp = "CDONTS" then

set mailObj = Server.CreateObject("CDONTS.NewMail")

mailObj.BodyFormat = 0

mailObj.MailFormat = 0

mailObj.From = fromAddr

mailObj.Value("Reply-To") = replyTo

mailObj.To = recipients

mailObj.Subject = subject

mailObj.Body = body

mailObj.Send

set mailObj = Nothing

exit function

end if



'Send email (CDOSYS version).



if mailComp = "CDOSYS" then

set cdoMessage = CreateObject("CDO.Message")

set cdoConfig = CreateObject("CDO.Configuration")

cdoConfig.Fields(cdoSendUsingMethod) = cdoSendUsingPort

cdoConfig.Fields(cdoSMTPServer) = smtpServer

cdoConfig.Fields(cdoSMTPServerPort) = 25

cdoConfig.Fields(cdoSMTPAuthenticate) = cdoAnonymous

cdoConfig.Fields.Update

set cdoMessage.Configuration = cdoConfig

cdoMessage.From = fromAddr

cdoMessage.ReplyTo = replyTo

cdoMessage.To = recipients

cdoMessage.Subject = subject

cdoMessage.HtmlBody = body

on error resume next

cdoMessage.Send

if Err.Number 0 then

SendMail = "E-Mail konnte nicht gesendet werden: " & Err.Description & "."

end if

set cdoMessage = Nothing

set cdoConfig = Nothing

exit function

end if



'Send email (JMail version).



if mailComp = "JMail" then

set mailObj = Server.CreateObject("JMail.SMTPMail")

mailObj.Silent = true

mailObj.ServerAddress = smtpServer

mailObj.Sender = fromAddr

mailObj.ReplyTo = replyTo

mailObj.Subject = subject

addrList = Split(recipients, ",")

for each addr in addrList

mailObj.AddRecipient Trim(addr)

next

mailObj.ContentType = "text/html"

mailObj.Body = body

if not mailObj.Execute then

SendMail = "Email send failed: " & mailObj.ErrorMessage & "."

end if

exit function

end if



'Send email (ASPMail version).



if mailComp = "ASPMail" then

set mailObj = Server.CreateObject("SMTPsvg.Mailer")

mailObj.RemoteHost = smtpServer

mailObj.FromAddress = fromAddr

mailObj.ReplyTo = replyTo

for each addr in Split(recipients, ",")

mailObj.AddRecipient "", Trim(addr)

next

mailObj.Subject = subject

mailObj.ContentType = "text/html"

mailObj.BodyText = body

if not mailObj.SendMail then

SendMail = "Email send failed: " & mailObj.Response & "."

end if

exit function

end if



end function %>

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: