29. november 2006 - 09:24
Der er
4 kommentarer
Funktion til at tjekke om variabel indeholder email adresse
Hej,
Jeg står i den situation at jeg skal have analyseret en række variabler, og hvis de indeholder en email adresse (ingen bestemt, men bare noget der ligner fx. xxx@yyy.zz) så skal den reagere ved at printe den pågældende email adresse den finder.
Helt konkret anvender jeg det i forbindelse med udsending af mit nyhedsbrev. Her har jeg en forholdsvismæssig stor modtagerliste, og jeg vil gerne sortere modtagere fra, hvis emails bouncer tilbage og landet i min c:\inetpub\rootmail\badmail -mappe fra.
Derfor looper jeg alt indhold igennem, i denne mappe, med et asp script, som I lige kan få:
<code>
<%
path = "C:\inetpub\mailroot\badmail\"
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(path)
Set objFiles = objFolder.Files %>
Filer i mappen <b><%=path%></b><hr>
<%
For Each file In objFiles
response.write file.name & "<br>"
if right(file.name,3) ="BAD" then
Set objTextStream = objFS.OpenTextFile(path & file.name, 1)
strIndhold = objTextStream.ReadAll
' analyser strIndhold for spor af email adresse (mangler)
objTextStream.Close
Set objTextStream = Nothing
end if
objFS.DeleteFile(path & file.name)
Next
%>
</code>
Det smarte er naturligvis, at disse badmails samtidig også bliver slettet fra badmail-mappen så jeg ikke skal gøre det manuelt.
Nå... det var lidt offtrack. Jeg har altså brug for en smart funktion, der kan finde noget der ligner emailadresser i en variabel, og returnere det til mig så jeg kan gå ind og fjerne den pågældende modtager fra nyhedsbrevlisten.
Jeg ser frem til at høre fra jer :-)
29. november 2006 - 09:31
#1
Måske dette kan hjælpe. Skal nok rettes noget til :-) Og ja, køn kode er det ikke. Det kan nok gøres meget bedre med Regex.
Function ScreenString(Text, Email)
Email = LCase(Email)
Text = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(LCase(Text), " ", ""), "-", ""), "!", ""), "#", ""), "¤", ""), "%", ""), "&", ""), "/", ""), "(", ""), ")", ""), "=", ""), "´", ""), "|", "¨"), "^", ""), "'", ""), "_", ""), ",", ""), "<", ""), ">", ""), "\", ""), ".", ""), ":", ""), ";", ""), "£", ""), "$", ""), "{", ""), "[", ""), "]", ""), "}", ""), "+", ""), "`", "")
'Response.Write(Email & "<br>" & Text)
Dim Username
Dim Domain
Dim Country
Dim MidPosition
Dim DotPosition
MidPosition = InStr(Email, "@")
DotPosition = InStrRev(Email, ".")
Username = Left(Email, MidPosition-1)
Domain = Mid(Email, MidPosition+1, DotPosition - (MidPosition+1))
Country = Mid(Email, DotPosition+1, Len(Email) - (DotPosition))
LikeMSN1 = InStr(Text, Username)
LikeMSN2 = InStr(Text, Domain)
LikeMSN3 = InStr(Text, "hotcom")
LikeMSN4 = InStr(Text, "." & Country)
LikeMSN5 = InStr(Text, "@")
LikeMSN6 = InStr(Text, "hotmail")
LikeMSN7 = InStr(Text, "hotmai")
LikeMSN8 = InStr(Text, ".dk")
'Response.Write(Username & "-" & Domain & "-" & Country & "-" & "Username: " & LikeMSN1 & " Domain:" & LikeMSN2 & " Country:" & LikeMSN4 & " HotCom" & LikeMSN5)
If (LikeMSN1 = 0 or LikeMSN2 = 0) and LikeMSN3 = 0 and LikeMSN6 = 0 and LikeMSN5 = 0 and LikeMSN7 = 0 and LikeMSN8 = 0 THEN
ScreenString = 0
ELSE
ScreenString = 1
END IF
End Function
30. november 2006 - 23:55
#4
hov
posofsnabela = Instr(strIndhold,"@")
if posofsnabela > 0 then
firstpart = left(strindhold,posofsnabela)
mellemrum1 =0
for i=1 to posofsnabela
if mid(firstpart,i,1) = " " then mellemrum1 = i
next
end if
mellemrum2 = Instr(right(strindhold,len(strindhold)-posofsnabela-1)," ")
emailadresse = mid(strindhold,mellemrum2-mellemrum1,mellemrum1+1)
