E-Posta Geçerlilik Kontrolü

Girilen e-posta adresinin geçerli olup olmadığının kontrolünü gerçekleştiren bir uygulamadır.

[HTML]<%
Function cckEmail(email)
Dim regEx, Match, Matches
If email <> "" Then
Set regEx = New RegExp
regEx.Pattern = "^([a-zA-Z0-9_\-\.]+)@((\[[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.)|(([a-zA-Z0-9\-]+\.)+))([a-zA-Z]{2,4}|[0-9]{1,3})(\]?)$"
regEx.IgnoreCase = True
If regEx.Test(email) Then cckEmail = True Else cckEmail = False
End If
End Function
%>[/HTML]

__________________
free web directory | youtube, video izle

Bileşene Göre E-Posta Gönderimi

Düzenlerseniz daha yararlı olabilir. Mesela, tabloda bilesen adında bir hücre açarak, ordaki değere bileşen kullanabilirsiniz.

[HTML]<%
'on error resume next

Function MailSender(FromEmail,FromName,YourEmail,YourName,S ubject,Body,MailType)

MailServer = "kullaniciadi:sifre@smtp.host.com"
MailHost = "smtp.host.com"
MailUsername = "kullanici@host.com"
MailPassword = "sifre"

Select Case MailType
Case "Jmail"

set objNewMail = server.createobject("JMail.message")
objNewMail.charset = "windows-1254"
objNewMail.From = FromEmail
objNewMail.FromName = FromName
objNewMail.AddRecipient YourEmail,YourName
objNewMail.Subject = Subject
objNewMail.HTMLBody = Body
objNewMail.Send(MailServer)
Set objNewMail = Nothing

Case "CDonts"

Set objmail=Server.CreateObject("cdonts.newmail")
objmail.From = FromEmail
objmail.To = YourEmail
objmail.Subject = Subject
objmail.Body = Body
objmail.Send
set objmail= nothing

Case "ASPmail"

Set objNewMail = Server.CreateObject("SMTPsvg.Mailer")
objNewMail.FromName = FromName
objNewMail.FromAddress = FromEmail
objNewMail.RemoteHost = MailServer
objNewMail.AddRecipient YourEmail, YourEmail
objNewMail.Subject = Subject
objNewMail.BodyText = Body
SendOk = objNewMail.SendMail

Case "ASPEmail"

Set objNewMail = CreateObject("Persits.MailSender")
objNewMail.Host = MailHost
objNewMail.Username = MailUsername
objNewMail.Password = MailPassword
objNewMail.From = FromEmail
objNewMail.FromName = FromName
objNewMail.AddAddress YourEmail
objNewMail.Subject = Subject
objNewMail.Body = body
objNewMail.IsHTML = TRUE
objNewMail.Send

Case "Jmail2"

set objNewMail = server.createobject("JMail.SMTPMail")
objNewMail.Sender = FromEmail
objNewMail.ServerAddress = MailServer
objNewMail.AddRecipient YourEmail
objNewMail.Subject = Subject
objNewMail.ContentType = "text/html"
objNewMail.Body = body
objNewMail.execute

Case "OCXmail"

Set objNewMail = Server.CreateObject("ASPMail.ASPMailCtrl.1")
SendEmail = objNewMail.SendMail(MailServer, YourEmail, FromEmail, Subject, body)
Set objNewMail = Nothing

End Select

if err.number = 0 then

MailSender = "Mesaj gönderildi..."

elseif err.number = -2147220979 then

MailSender = "Lütfen gerekli bilgileri eksiksiz doldurunuz."

else

MailSender = "Sunucumuzdaki bir sorundan dolayı öneriniz gönderilemedi... Lütfen daha sonra tekrar deneyiniz... " & err.description & "<br>" & objNewMail.errormessage

end if

End Function
%>[/HTML]

__________________
free web directory | youtube, video izle

İlk Harf Büyütme

Kelimelerin ilk harfini büyültüp, diğerleri küçülten işlevsel bir fonksiyon.
Forumlarınızda, konu başlıklarının büyük harflerle yazılmasını bu fonksiyon ile önleyebilirsiniz.

[HTML]
<%
Function complex(metin)
splitter = " "
If metin <> "" Then
xarr = Split(metin, splitter)
For i = 0 to Ubound(xarr)
xmetin = Trim(xarr(i))
If xmetin <> "" Then
xmetin = Lcase(xmetin)
xstletter = Ucase(Left(xmetin,1))
'// You can add here your language characters
xstletter = Replace(xstletter,"i","İ", 1, -1) '&Yacute;
xmetin = Right(xmetin, Len(xarr(i)) - 1)
'// You can add here your language characters
xmetin = Replace(xmetin,"İ","i", 1, -1) '&Yacute;
xmetin = xstletter & xmetin
End if
zmetin = zmetin & " " & xmetin
Next
End if
complex = zmetin
End Function
%>[/HTML]

__________________
free web directory | youtube, video izle

Harf-Rakam Karışık Güvenlik Numarası

Bu fonksiyon sayesinde, harf rakam karışık güvenlik kodu oluşturabilirsiniz. Form gönderimlerinde (tekrar önleme), işinize yarayabilir.

[HTML]<%

Dim Password
Dim RandomPassword
Dim nCharacters

Dim array_cod(35)
array_cod(0) = "0"
array_cod(1) = "1"
array_cod(2) = "2"
array_cod(3) = "3"
array_cod(4) = "4"
array_cod(5) = "5"
array_cod(6) = "6"
array_cod(7) = "7"
array_cod(8) = "8"
array_cod(9) = "9"
array_cod(10) = "a"
array_cod(11) = "b"
array_cod(12) = "c"
array_cod(13) = "d"
array_cod(14) = "e"
array_cod(15) = "f"
array_cod(16) = "g"
array_cod(17) = "h"
array_cod(18) = "i"
array_cod(19) = "j"
array_cod(20) = "k"
array_cod(21) = "l"
array_cod(22) = "m"
array_cod(23) = "n"
array_cod(24) = "o"
array_cod(25) = "p"
array_cod(26) = "q"
array_cod(27) = "r"
array_cod(28) = "s"
array_cod(29) = "t"
array_cod(30) = "u"
array_cod(31) = "v"
array_cod(32) = "w"
array_cod(33) = "x"
array_cod(34) = "y"
array_cod(35) = "z"

for cod=0 to 9
MaxCod = 35
MinCod = 0
Randomize


RandomPassword = CStr(RandomPassword & array_cod(Int(Rnd * MaxCod) - MinCod))
next

Password = RandomPassword


response.write "<b>" & Password & "</b>"

%>[/HTML]

__________________
free web directory | youtube, video izle

Sunucuda Yüklü Bileşenler

Sunucuda yüklü bileşenleri görüntülemeyi sağlar.

[HTML]<%
'// Telif: Fabricioc

Dim aComponents(68)
aComponents(1) = "ADODB.Command"
aComponents(2) = "ADODB.Connection"
aComponents(3) = "ADODB.Recordset"
aComponents(4) = "ADODB.Stream"
aComponents(5) = "ADOX.Catalog"
aComponents(6) = "AspDNS.Lookup"
aComponents(7) = "ASPExec.Execute"
aComponents(8) = "AspHTTP.Conn"
aComponents(9) = "AspImage.Image"
aComponents(10) = "AspMX.Lookup"
aComponents(11) = "AspNNTP.Conn"
aComponents(12) = "AspPing.Conn"
aComponents(13) = "AspSock.Conn"
aComponents(14) = "CDO.MESSAGE"
aComponents(15) = "CDONTS.NewMail"
aComponents(16) = "Dundas.Mailer"
aComponents(17) = "Dundas.PieChartServer"
aComponents(18) = "Dundas.PieChartServer.2"
aComponents(19) = "Dundas.Upload"
aComponents(20) = "Dundas.Upload.2"
aComponents(21) = "Dundas.UploadProgress"
aComponents(22) = "ECHOCom.Echo"
aComponents(23) = "GuidMakr.GUID"
aComponents(24) = "ImgSize.Check"
aComponents(25) = "ixsso.Query"
aComponents(26) = "ixsso.Util"
aComponents(27) = "JMAil.Message"
aComponents(28) = "JMail.POP3"
aComponents(29) = "JMail.SMTPMail"
aComponents(30) = "JRO.JetEngine"
aComponents(31) = "Microsoft.DiskQuota.1"
aComponents(32) = "microsoft.XMLDOM"
aComponents(33) = "Microsoft.XMLHTTP"
aComponents(34) = "MSWC.AdRotator"
aComponents(35) = "MSWC.BrowserType"
aComponents(36) = "MSWC.ContentRotator"
aComponents(37) = "MSWC.Counters"
aComponents(38) = "MSWC.IISLog"
aComponents(39) = "MSWC.MyInfo"
aComponents(40) = "MSWC.MyInfo"
aComponents(41) = "MSWC.NextLink"
aComponents(42) = "MSWC.PageCounter"
aComponents(43) = "MSWC.PermissionChecker"
aComponents(44) = "MSWC.Status"
aComponents(45) = "MSWC.Tools"
aComponents(46) = "MSXML.DomDocument"
aComponents(47) = "MSXML2.DOMDocument"
aComponents(48) = "MSXML2.DOMDocument.3.0"
aComponents(49) = "Msxml2.FreeThreadedDOMDocument.3.0"
aComponents(50) = "MSXML2.ServerXMLHTTP"
aComponents(51) = "MSXML2.ServerXMLHTTP.3.0"
aComponents(52) = "MSXML2.XSLTemplate"
aComponents(53) = "Persits.Grid"
aComponents(54) = "Persits.Jpeg"
aComponents(55) = "Persits.MailSender"
aComponents(56) = "Persits.Upload"
aComponents(57) = "Persits.Upload.1"
aComponents(58) = "Persits.UploadProgress"
aComponents(59) = "POP3svg.Mailer"
aComponents(60) = "Scripting.Dictionary"
aComponents(61) = "Scripting.FileSystemObject"
aComponents(62) = "Scriptlet.TypeLib"
aComponents(63) = "SMTPsvg.Mailer"
aComponents(64) = "SOFTWING.AspTear"
aComponents(65) = "VBScript.RegExp"
aComponents(66) = "WinHttp.WinHttpRequest.5.1"
aComponents(67) = "WScript.Network"
aComponents(68) = "WScript.Shell"
Response.write("Yüklü Bilesenler:<BR><BR>")
On Error Resume Next
For i=1 To Ubound(aComponents)

Set obj = Server.CreateObject(aComponents(i))
if err.number = 0 Then
Set obj = nothing
Response.write(aComponents(i) & "<BR>")
End if
err.clear
next
%>[/HTML]

__________________
free web directory | youtube, video izle

Belirli Karakterden Sonraki Yazıların Sonuna "..." Koyma

Fonksiyon sayesinde, metnin belirleyeceğiniz karakterden büyük olması halinde sonuna üç nokta(...) koyabilirsiniz.

[HTML]function buda(str,max)
max_karakter = max
istif = "..."
If len(str)>max_karakter Then
yenistr = mid(str,1,max_karakter - len(istif))
yenistr = yenistr + istif
else
yenistr = str
End If
buda = yenistr
end function
[/HTML]

Kullanımı :

[HTML]<%= buda(string,30)%>[/HTML]

Yukarıdaki kod içinde verilen 30, o karakterden sonra üç nokta(...) koyulmasını istediğimiz sayıdır. Kendinize göre değiştirebilirsiniz.

__________________
free web directory | youtube, video izle

Metin Alanlarında Bir Alt Satıra Geçme

Form alanlarında işinize yarayacak, kullanışlı bir fonksiyondur.

[HTML]
<%
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Alt Satıra Geçme Fonksiyonu
' Murat.Yavuz ****.a doronty37
' W: http://www.mydesign.gen.tr
' @: mydesign@mydesign.gen.tr
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Function Satir(byVal strVeri)

If strVeri = "" Then Exit Function

strVeri = Replace(strVeri, vbCrLf, "<br/>", 1, -1, 1)
strVeri = Replace(strVeri, Chr(13), "<br/>", 1, -1, 1)

Satir = strVeri

End Function
%>
[/HTML]

Kullanımı :

[HTML]<%
Response.Write Satir(Request.Form("Mesaj"))
%>[/HTML]

__________________
free web directory | youtube, video izle

Otomatik Link Oluşturma

Forumlardaki otomatik link oluşturma işlemini gerçekleştirir.

[HTML]
'// Copyright (c) 2000, Lewis Moten (modified by Ferruh Mavituna). All rights reserved.
Function LinkURLs(ByVal asContent)
Dim loRegExp' Regular Expression Object (Requires vbScript 5.0 and above)

' If no content was received, exit the function
If asContent = "" Then Exit Function
'asContent=asContent&" "

Set loRegExp = New RegExp
loRegExp.Global = True
loRegExp.IgnoreCase = True

'//-- by Ferruh Mavituna {http://ferruh.mavituna.com}
'1/29/2004
'"www" added
'"www." fixed
'"www" fixed etc.
loRegExp.Pattern = "((((ht|f)tps?://)|www\.)\S+[^\.*](\s)?)"


'loRegExp.Pattern = "((((ht|f)tps?://)|www\.)\S+[^\.*]\s)"
'loRegExp.Pattern = "((((ht|f)tps?://)|(www\.))\S+[/]?[^\.*]\s)"

' Link URLs
LinkURLs = loRegExp.Replace(asContent, "<a href=""$1"">$1</a>")
' // --

' Look for email addresses
loRegExp.Pattern = "(\S+@\S+.\.\S\S\S?)"

' Link email addresses
LinkURLs = loRegExp.Replace(LinkURLs, "<a href=""mailto:$1"">$1</a>")

' Release regular expression object
Set loRegExp = Nothing
End Function
[/HTML]

__________________
free web directory | youtube, video izle

Ajax ile Gelen Verilerin Türkçe Karakter Sorununu Düzenleme

Ajax ile gelen verilerde, Türkçe karakter problemi vardır. Bu fonksiyon sayesinde bunu önleyebilirsiniz.

[HTML]' Ajax Turkish Character Set
Function ajaxTurkish(sData) ajaxTurkish = Replace(Replace(Replace(Replace(Replace(Replace(Re place(Replace(Replace(Replace(Replace(Replace(sDat a,"Ãœ","Ü"),"Åž","Ş"),"Äž","Ğ"),"Ç","Ç"),"Ä°"," İ" ),"Ö","Ö"),"ü","ü"),"ÅŸ","ş"),"ÄŸ","ğ"),"ç"," ç" ),"ı","ı"),"ö","ö")
End Function [/HTML]

__________________
free web directory | youtube, video izle