Hazır Function Kodları

Arkadaşlar yabancı bir sitede buldum. Güzel functionlar var işinize yarayanı kullanabilirsiniz.


<%
Function LoseHTML(strHTML)
On Error Resume Next
Dim objRegExp, strOutput
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "<.+?>"
strHTML = strHTML & ""
if strHTML="" Then LoseHTML="":Exit Function
strOutput = objRegExp.Replace(strHTML, "")
strOutput = Replace(strOutput, "<", "<")
strOutput = Replace(strOutput, ">", ">")
strOutput = Replace(strOutput, " ", "")
strOutput = Replace(strOutput, "•", "·")
LoseHTML = Trim(strOutput)
Set objRegExp = Nothing
End Function

Public Function Checkstr(Str)
If Isnull(Str) or str = "" Then
CheckStr = ""
Exit Function
End If
Str = Replace(Str,Chr(0),"")
Str = Replace(Str,Chr(10),"")
Str = Replace(Str,Chr(13),"")
CheckStr = Replace(Str,"'","''")

End Function

Rem 空字段则赋值为零长度字符串
Function ChkIsNull(str)
If IsNull(str) then
ChkIsNull = ""
Else
ChkIsNull = str
End If
End Function


function JoinChar(strUrl)
if strUrl="" then
JoinChar=""
exit function
end if
if InStr(strUrl,"?") if InStr(strUrl,"?")>1 then
if InStr(strUrl,"&") JoinChar=strUrl & "&"
else
JoinChar=strUrl
end if
else
JoinChar=strUrl & "?"
end if
else
JoinChar=strUrl
end if
end function


Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function

Function getver(Classstr)
On Error Resume Next
getver=""
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(Classstr)
If 0 = Err Then getver=xtesTobj.version
Set xTestObj = Nothing
Err = 0
End Function

'*************************************
'反转换HTML代码
'*************************************
Function HTMLDecode(ByVal reString)
Dim Str:Str=reString
If Not IsNull(Str) Then
Str = Replace(Str, ">", ">")
Str = Replace(Str, "<", "<")
Str = Replace(Str, " ", CHR(9))
Str = Replace(Str, "    ", CHR(9))
Str = Replace(Str, "'", CHR(39))
Str = Replace(Str, """, CHR(34))
Str = Replace(Str, "", CHR(13))
Str = Replace(Str, "

", CHR(10) & CHR(10))
Str = Replace(Str, "
", CHR(10))
HTMLDecode = Str
End If
End Function

Function HTMLEncode(ByVal fString)
If Not IsNull(fString) Then
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = Replace(fString, CHR(32), " ")
fString = Replace(fString, CHR(9), " ")
fString = Replace(fString, CHR(34), """)
fString = Replace(fString, CHR(39), "'")
fString = Replace(fString, CHR(13), "")
HTMLEncode = fString
End If
End Function

Function ServerHTMLEncode(ByVal str)
If Not IsNull(str) Then
ServerHTMLEncode = Server.HTMLEncode(str)
Else
ServerHTMLEncode = ""
End If
End Function

Sub MsgBox(str, stype, ac)
response.write "<script>"
If chkisnull(str)<>"" Then
response.write "alert('"&str&"');"
End If
select case stype
case "back"
response.write "history.go(-1);"
case "gourl"
response.write "window.location='"&ac&"';"
case "close"
response.write "window.opener=self;window.close();"
Case Else
response.write ac
end select
response.write "</script>"
response.write ""
response.end
End Sub

'*************************************
'检测是否只包含英文和数字
'*************************************
Function IsValidChars(str)
Dim re,chkstr
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
re.Pattern="[^_\.a-zA-Z\d]"
IsValidChars=True
chkstr=re.Replace(str,"")
if chkstr<>str then IsValidChars=False
set re=nothing
End Function

'*************************************
'检测是否包含在允许的字符范围
'*************************************
Function IsvalidValue(ArrayN,Str)
IsvalidValue = false
Dim GName
For Each GName in ArrayN
If Str = GName Then
IsvalidValue = true
Exit For
End If
Next
End Function

'*************************************
'检测是否有效的数字
'*************************************
Function IsInteger(Para)
IsInteger=False
If Not (IsNull(Para) Or Trim(Para)="" Or Not IsNumeric(Para)) Then
IsInteger=True
End If
End Function


'*************************************
'计算随机数
'*************************************
function randomStr(intLength)
dim strSeed,seedLength,pos,str,i
strSeed = "abcdefghijklmnopqrstuvwxyz1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ!@#$&"
seedLength=len(strSeed)
str=""
Randomize
for i=1 to intLength
str=str+mid(strSeed,int(seedLength*rnd)+1,1)
next
randomStr=str
end function

'***********************************************
'过程名：showpage
'作 用：显示“上一页 下一页”等信息
'参 数：sfilename ----链接地址
' totalnumber ----总数量
' maxperpage ----每页数量
' ShowTotal ----是否显示总数量
' ShowAllPages ---是否用下拉列表显示所有页面以供跳转。有某些页面不能使用，否则会出现JS错误。
' strUnit ----计数单位
'***********************************************
sub showpage(sfilename,totalnumber,maxperpage,ShowTotal,ShowAllPages,strUnit)
dim n, i,strTemp,strUrl
if totalnumber mod maxperpage=0 then
n= totalnumber \ maxperpage
else
n= totalnumber \ maxperpage+1
end If
strTemp= ""
If ShowAllPages Then strTemp= "

"
if ShowTotal=true then
strTemp=strTemp & "共 " & totalnumber & " " & strUnit & "  "
end if
strUrl=JoinChar(sfilename)
if CurrentPage<2 then
strTemp=strTemp & "首页 上一页 "
else
strTemp=strTemp & "首页 "
strTemp=strTemp & "上一页 "
end if

if n-currentpage<1 then
strTemp=strTemp & "下一页 尾页"
else
strTemp=strTemp & "下一页 "
strTemp=strTemp & "尾页"
end if
strTemp=strTemp & " 页次：" & CurrentPage & "/" & n & "页 "
strTemp=strTemp & " " & maxperpage & "" & strUnit & "/页"
if ShowAllPages=True then
strTemp=strTemp & " 转到： for i = 1 to n
strTemp=strTemp & " if cint(CurrentPage)=cint(i) then strTemp=strTemp & " selected "
strTemp=strTemp & ">第" & i & "页"
next
strTemp=strTemp & ""
strTemp=strTemp & "

"
end if

response.write strTemp
end Sub

Function GotTopic(Str,Strlen)
if Strlen = "" then Strlen = 0
If Str="" or IsNull(Str) or Cint(Strlen) < 1 Then
GotTopic = Str
Exit Function
End If
Dim l,t,c, i
l=Len(Str)
t=0
For i=1 To l
c=Abs(Asc(Mid(Str,i,1)))
If c>255 Then
t=t+2
Else
t=t+1
End If
If t>=Strlen Then
GotTopic=Left(Str,i)
Exit For
Else
GotTopic=Str
End If
Next
End Function

Function RequestForm(str)
Dim Temp
Temp = Request.Form(str)
Temp = ChkIsNull(Temp)
Temp = Checkstr(Temp)
RequestForm = Trim(Temp)
End Function

' 获取拼音
Function PinYin(ByVal Chinese)
Chinese = Replace(Chinese,"/","") : Chinese = Replace(Chinese,"\","")
Chinese = Replace(Chinese,"*","") : Chinese = Replace(Chinese,"]","")
Chinese = Replace(Chinese,"[","") : Chinese = Replace(Chinese,"}","")
Chinese = Replace(Chinese,"{","") : Chinese = Replace(Chinese,"'","")
Dim Pinyinstr,iStr,iIsCn,IsCn
Dim PinyinConn,i,X
On Error Resume Next
Set PinyinConn = Server.Createobject("Adodb.Connection")
PinyinConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&server.mappath(SystemDirectory & "/Inc/Pinyin.Asp")
If Err Then PinYin = "" : Set PinyinConn = Nothing : Exit Function
IsCN = True
For i = 1 To Len(Chinese)
iIsCn = IsCn ' 获取上次是不是中文的值
iStr = Mid(Chinese,i,1)
X = Asc(iStr)
If (X>=65 And X<=90) Or (X>=97 And X<=122) Or (X>=48 And X<=57) Or iStr = " " Then
IsCn = False ' 这些是英文,数字(保留字符),不改动
If iStr = " " Then iStr = "-"
Else
Set Rs = PinyinConn.Execute("Select Top 1 [Pinyin] From [5U_Pinyin] Where [Content] like '%"&iStr&"%';")
If Not Rs.eof Then
iStr = Rs(0) : IsCn = True ' 中文
Else
IsCn = False
If iStr = " " Then iStr = "-" Else iStr = "" ' 将空格转换成-,如果是其他字符则清除
End If
Rs.Close : Set Rs = Nothing
End If
If iIsCn = IsCn Then Pinyinstr=Pinyinstr & iStr Else Pinyinstr = Pinyinstr & "-" & iStr
Pinyinstr = Replace(Pinyinstr,"--","-")
Pinyinstr = Replace(Pinyinstr,"__","_")
Next
If Right(Pinyinstr,1) = "-" Then Pinyinstr = Left(Pinyinstr,Len(Pinyinstr)-1)
If Right(Pinyinstr,1) = "_" Then Pinyinstr = Left(Pinyinstr,Len(Pinyinstr)-1)
If Left(Pinyinstr,1) = "-" Then Pinyinstr = Right(Pinyinstr,Len(Pinyinstr)-1)
If Left(Pinyinstr,1) = "_" Then Pinyinstr = Right(Pinyinstr,Len(Pinyinstr)-1)
PinyinConn.Close
Set PinyinConn = Nothing
PinYin = Trim(Pinyinstr)
End Function

Sub DeleteBlankFolder(vPath)
Dim temp, FS, Fo
temp = vPath
If temp="" Or temp="/" Then Exit Sub
temp = server.MapPath(temp)
Set FS = Server.CreateObject(Lone_FSO)
If FS.FolderExists(temp) Then
Set Fo = FS.getFolder(temp)
If Fo.Files.Count=0 And Fo.SubFolders.Count=0 Then
Fo.Delete
temp = Left(temp, InstrRev(temp, "/"))
DeleteBlankFolder(temp)
End If
Set Fo = Nothing
End If
Set FS = Nothing
End Sub

Function chkFolderExist(byVal folderName)
On Error Resume Next
chkFolderExist = False
Dim FSO, Folder
Set fso=CreateObject("Scripting.FileSystemObject")
Folder = Left(folderName, InstrRev(folderName, "/"))
Folder = Server.MapPath(Folder)
If FSO.FolderExists(Folder) Then chkFolderExist = True
Set FSO = Nothing
End Function


Function Binary2String(binstr, charset)
Dim Objstream
Set Objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode = 3
objstream.Open
objstream.Write binstr
objstream.Position = 0
objstream.Type = 2
objstream.Charset = charset
StringReturn = objstream.ReadText
objstream.Close
set objstream = nothing
Binary2String = StringReturn
End Function


Function ScriptHtml(Byval ConStr,TagName,FType)
Dim Re
Set Re=new RegExp
Re.IgnoreCase =true
Re.Global=True
Select Case FType
Case 1
Re.Pattern="<" & TagName & "([^>])*>"
ConStr=Re.Replace(ConStr,"")
Case 2
Re.Pattern="<" & TagName & "([^>])*>.*?])*>"
ConStr=Re.Replace(ConStr,"")
Case 3
Re.Pattern="<" & TagName & "([^>])*>"
ConStr=Re.Replace(ConStr,"")
Re.Pattern="])*>"
ConStr=Re.Replace(ConStr,"")
End Select
ScriptHtml=ConStr
Set Re=Nothing
End Function

'
Function NoWrap(ByVal Str)
Dim temp
temp = chkIsNull(Str)
If temp<>"" Then
temp = Replace(temp, vbNewLine, "")
temp = Replace(temp, Chr(0), "")
temp = Replace(temp, Chr(10), "")
temp = Replace(temp, Chr(13), "")
End If
NoWrap = Trim(temp)
End Function

Function UpNumber(ByVal Number)
Dim Result, strNumber, lngNumberLen, strTmp
Dim strFirst, strEnd, lngI, lngJ, lngTmp
Dim strNum, strUnit
If Not IsInteger(Number) Then Exit Function
strNum = Split("零 一 二 三 四 五 六 七 八 九 ")
strUnit = Split(" 十 百 千 万 十 百 千 亿 十 百 千 万 十 百 千 ")
Result = "" : strFirst = "" : lngI = 0
strNumber = Trim(CStr(Number))
lngNumberLen = Len(strNumber)
For lngJ = lngNumberLen To 1 Step -1
lngTmp = CLng(Mid(strNumber, lngJ, 1))

If lngTmp>0 Then
Result = strNum(lngTmp) & strUnit(lngI) & Result
Else
If lngI = 0 Or lngI = 4 Or lngI = 8 Or lngI = 12 Then '超过 16 位不支持
Result = strNum(lngTmp) & strUnit(lngI) & Result
Else
Result = strNum(lngTmp) & Result
End If
End If
lngI = lngI + 1
Next
Result = Replace(Result, strNum(0) & strNum(0), strNum(0))
If Number>0 And Right(Result, 1) = strNum(0) Then Result=Left(Result, Len(Result)-1)
If Number>9 And Number<20 Then Result = Mid(Result, 2)
UpNumber = Result
End Function

Function GetVolumeName(ByVal PlayURL)
Dim PlayURLs
If Left(PlayURL, 7)="qvod://" Then
PlayURLs=Split(PlayURL, "|")
GetVolumeName = PlayURLs(UBound(PlayURLs)-1)
Else
PlayURLs=Split(PlayURL, "/")
GetVolumeName = PlayURLs(UBound(PlayURLs))
End If
End Function

%>

Çok 是否用下拉列表显示所有 paylaşım olmuş. :) Arşive attım, sağolun. Site adını da vermeniz mümkün müdür, bulamadım ama.

Bunlar ne işe yarıyor acaba? Yani örnek olarak var mı? Bilmediğim için soruyorum teşekkürler.

Örnek verecek olursak


<%
Function LoseHTML(strHTML)
On Error Resume Next
Dim objRegExp, strOutput
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "<.+?>"
strHTML = strHTML & ""
if strHTML="" Then LoseHTML="":Exit Function
strOutput = objRegExp.Replace(strHTML, "")
strOutput = Replace(strOutput, "<", "<")
strOutput = Replace(strOutput, ">", ">")
strOutput = Replace(strOutput, " ", "")
strOutput = Replace(strOutput, "•", "·")
LoseHTML = Trim(strOutput)
Set objRegExp = Nothing
End Function
<%

Yukarıdaki fonksiyon <%server.htmlencode("deger")%> ile aynı görevi görür. Bu fonksiyonda html tagları sitede görülmez nerede kullanılıyor derseniz bir çok alanda kullanabilirsiniz. Ben kendi sitemde bu fonksiyonu farklı yerlerde kullanıyorum.

Kullanım gayet basit <%=loseHTML("deger")%>
Buradaki değer "

Denemedir
123

" şeklinde gelen degeri denemedir 123 şeklinde gösterir. Umarım anlatabilmişimdir.

Ek Olarak: Buyrun bunlarda benim arşivimden.


<%
Function sifreuret(Uzunluk)
if uzunluk = "" then exit function
Karakterler = "1234567890" '0123456789abcdefghijklmnoprqstuvyzABCDEFGHIJKLMNOPRQSTUVYZ-_
Randomize
KarakterBoyu = Len(Karakterler)
For z = 1 To Uzunluk
KacinciKarakter = Int((KarakterBoyu * Rnd) + 1)
UretilenSifre = UretilenSifre & Mid(Karakterler,KacinciKarakter,1)
Next
sifreuret = UretilenSifre
End Function
%>

<%
Function RemoveSpace(StrSpace)
if StrSpace = "" then exit function
StrSpace = replace(StrSpace, Chr(0), "", 1, -1, 1)
StrSpace = replace(StrSpace, Chr(10), "", 1, -1, 1)
StrSpace = replace(StrSpace, Chr(13), "", 1, -1, 1)
StrSpace = replace(StrSpace, vbCrLf, " ", 1, -1, 1)
RemoveSpace = Trim(StrSpace)
End Function

Function RemoveHTML(strHTML)
On Error Resume Next
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "<[^>]*(>|$)"
strHTML = strHTML & ""
If strHTML = "" Then RemoveHTML = "":Exit Function
strHTML = objRegExp.Replace(strHTML, "")
strHTML = Replace(strHTML, " ", " ")
strHTML = Replace(strHTML, "•", " ")
strHTML = Replace(strHTML, """, " ")
strHTML = Replace(strHTML, "<", "<")
strHTML = Replace(strHTML, ">", ">")
RemoveHTML = RemoveSpace(strHTML)
Set objRegExp = Nothing
End Function
%>


<%
Function RemoveText(strText)
nPos1 = InStr(strText, "<")
Do While nPos1 > 0
nPos2 = InStr(nPos1 + 1, strText, ">")
If nPos2 > 0 Then
strText = Left(strText, nPos1 - 1) & Mid(strText, nPos2 + 1)
Else
Exit Do
End If
nPos1 = InStr(strText, "<")
Loop
RemoveText = strText
End Function
%>

<%
function sqlinj(temizle)
if temizle = "" then exit function
temizle = replace (temizle ,"`","",1,-1,1)
temizle = replace (temizle ,"'","",1,-1,1)
temizle = replace (temizle ,"&","",1,-1,1)
temizle = replace (temizle ,"*","",1,-1,1)
temizle = replace (temizle ,"+","",1,-1,1)
temizle = replace (temizle ,"-","",1,-1,1)
temizle = replace (temizle ,"%","",1,-1,1)
temizle = replace (temizle ,"=","",1,-1,1)
temizle = replace (temizle ,"<","",1,-1,1)
temizle = replace (temizle ,">","",1,-1,1)
temizle = replace (temizle ,"(","",1,-1,1)
temizle = replace (temizle ,")","",1,-1,1)
temizle = replace (temizle ,"/","",1,-1,1)
temizle = replace (temizle ,"\","",1,-1,1)
sqlinj = temizle
end function
%>

<%
Function Cevir(Str)
if Str = "" then exit function
Str = Replace(Str, "!", "", 1,-1,0)
Str = Replace(Str, "<", "", 1,-1,0)
Str = Replace(Str, ">", "", 1,-1,0)
Str = Replace(Str, "&", "", 1,-1,0)
Str = Replace(Str, "%", "", 1,-1,0)
Str = Replace(Str, "*", "", 1,-1,0)
Str = Replace(Str, "/", "", 1,-1,0)
Str = Replace(Str, "(", "", 1,-1,0)
Str = Replace(Str, ")", "", 1,-1,0)
Str = Replace(Str, "?", "", 1,-1,0)
Str = Replace(Str, "#", "", 1,-1,0)
Str = Replace(Str, "+", "", 1,-1,0)
Str = Replace(Str, "^", "", 1,-1,0)
Str = Replace(Str, "’", "", 1,-1,0)
Str = Replace(Str, "'", "", 1,-1,0)
Str = Replace(Str, ",", "", 1,-1,0)
Str = Replace(Str, ".", "", 1,-1,0)
Str = Replace(Str, ":", "", 1,-1,0)
Str = Replace(Str, " ", "-", 1,-1,0)
Str = Replace(Str, "ç", "c", 1,-1,0)
Str = Replace(Str, "Ç", "c", 1,-1,0)
Str = Replace(Str, "ğ", "g", 1,-1,0)
Str = Replace(Str, "Ğ", "g", 1,-1,0)
Str = Replace(Str, "ı", "i", 1,-1,0)
Str = Replace(Str, "I", "i", 1,-1,0)
Str = Replace(Str, "İ", "i", 1,-1,0)
Str = Replace(Str, "ö", "o", 1,-1,0)
Str = Replace(Str, "Ö", "o", 1,-1,0)
Str = Replace(Str, "ş", "s", 1,-1,0)
Str = Replace(Str, "Ş", "s", 1,-1,0)
Str = Replace(Str, "ü", "u", 1,-1,0)
Str = Replace(Str, "Ü", "u", 1,-1,0)
Cevir = Str
End Function
%>

<%
Function tren(degistir)
if degistir = "" then exit function
degistir = replace(degistir, "ç", "ç", 1,-1,1)
degistir = replace(degistir, "äÿ", "ğ", 1,-1,0)
degistir = replace(degistir, "ĞŸ", "ğ", 1,-1,0)
degistir = replace(degistir, "ı", "ı", 1,-1,0)
degistir = replace(degistir, "ö", "ö", 1,-1,0)
degistir = replace(degistir, "Åÿ", "ş", 1,-1,0)
degistir = replace(degistir, "ŞŸ", "ş", 1,-1,0)
degistir = replace(degistir, "ü", "ü", 1,-1,0)
degistir = replace(degistir, "Ç", "Ç", 1,-1,0)
degistir = replace(degistir, "Ä", "Ğ", 1,-1,0)
degistir = replace(degistir, "Ö", "Ö", 1,-1,0)
degistir = replace(degistir, "Å", "Ş", 1,-1,0)
degistir = replace(degistir, "Ãœ", "Ü", 1,-1,0)
degistir = replace(degistir, "-", " ", 1,-1,0)
degistir = replace(degistir, "ý", "ı", 1,-1,0)
degistir = replace(degistir, "þ", "ş", 1,-1,0)
degistir = replace(degistir, "ð", "ğ", 1,-1,0)
degistir = replace(degistir, "Ý", "İ", 1,-1,0)
tren = degistir
End Function
%>

<%
Function bosluk(stryeni)
if stryeni = "" then exit function
stryeni = replace(stryeni, vbCrLf, "
", 1, -1, 1)
stryeni = replace(stryeni, Chr(10), "
", 1, -1, 1)
stryeni = replace(stryeni, Chr(13), "
", 1, -1, 1)
stryeni = replace(stryeni, "/n", "
", 1, -1, 1)
bosluk = stryeni
End Function
%>

<%
Function cckemail(email)
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
%>

<%
function kes(str,max)
max_karakter = max
uzars = "..."
If len(str)>max_karakter Then
yenistr = mid(str,1,max_karakter - len(uzars))
yenistr = yenistr + uzars
else
yenistr = str
End If
kes = yenistr
end function
%>

<%
Function BKarakterYap(byval hedef)
hedef=Replace(hedef,"i" ,"İ" )
hedef=Replace(hedef,"ı" ,"I" )
BKarakterYap = UCase(hedef)
End Function

Function karakterbuyut(byval veri)
dim parcala, k
parcala = Split(veri," ")
For k = 0 To Ubound(parcala)
karakterbuyut = karakterbuyut & BKarakterYap(Left(parcala(k), 1)) & KKarakterYap(Mid(parcala(k), 2))& " "
Next
End Function
%>


<%
Function KKarakterYap(hedef)
hedef = Replace(hedef,"İ" ,"i" )
hedef = Replace(hedef,"I" ,"ı" )
KKarakterYap = LCase(hedef)
End Function
%>

<%
Function ilklerbuyuk(metin)
If metin = "" then exit function
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))
xstletter = Replace(xstletter,"i","İ", 1, -1) 'Y
xmetin = Right(xmetin, Len(xarr(i)) - 1)

xmetin = Replace(xmetin,"İ","i", 1, -1) 'Y
xmetin = xstletter & xmetin
End If
zmetin = zmetin & " " & xmetin
Next
End If
ilklerbuyuk = zmetin
end function
%>

<%
Public Function FormatDate(data,hideHour)
If Not IsDate(data) Then Exit Function
gun = Weekday(data)
ay = Month(data)
yil = Year(data)
aygunu = Day(data)
saat = Hour(data)
dakika = Minute(data)
saniye = Second(data)
Dim gunler(7)
gunler(1) = "Pazar"
gunler(2) = "Pazartesi"
gunler(3) = "Salı"
gunler(4) = "Çarşamba"
gunler(5) = "Perşembe"
gunler(6) = "Cuma"
gunler(7) = "Cumartesi"
Dim aylar(12)
aylar(1) = "Ocak"
aylar(2) = "Subat"
aylar(3) = "Mart"
aylar(4) = "Nisan"
aylar(5) = "Mayıs"
aylar(6) = "Haziran"
aylar(7) = "Temmuz"
aylar(8) = "Ağustos"
aylar(9) = "Eylül"
aylar(10) = "Ekim"
aylar(11) = "Kasım"
aylar(12) = "Aralık"
If saat > 12 Then
ampm = "PM"
Else
ampm = "AM"
End If
If hideHour = False Then
t_part = saat & ":" & dakika & ":" & saniye & " " & ampm
Else
t_part = ""
End If
FormatDate = aygunu & " " & aylar(ay) & " " & yil & ", " & gunler(gun) & " " & t_part
End Function
%>

<%
Function kontrol(deger)
If deger = "" then exit function
If isnull(deger) then
kontrol = true
Elseif deger = "" then
kontrol = true
else
kontrol = false
End If
End Function
%>

<%
Function gizle(icerik)
Dizi = split(icerik," ")
For i = 0 to ubound(Dizi)
If instr(lcase(Dizi(i)), "http://") > 0 or instr(lcase(Dizi(i)), "www.") > 0 Then
Response.write "* Linkleri görebilmek için lütfen giriş yapın."
Else
Response.write Dizi(i)
Response.write " "
End if
Next
End Function
%>

<%
Function zamanbul(strveri)
if strveri = "" then exit function
GecenSaniye = DateDiff("s", strveri, Now())
If GecenSaniye = 0 Then
zamanbul = "az önce"
ElseIf gecenSaniye >= 1 And gecenSaniye < 60 Then
zamanbul = ""&gecenSaniye&" saniye önce"
ElseIf gecenSaniye >= 60 And gecenSaniye < 3600 Then
zamanbul = ""&Int(gecenSaniye/60)&" dakika önce "
ElseIf gecenSaniye >= 3600 And gecenSaniye < 86400 Then
zamanbul = ""&Int(gecenSaniye/3600)&" saat önce "
ElseIf gecenSaniye >= 86400 And gecenSaniye < 604800 Then
zamanbul = ""&Int(gecenSaniye/86400)&" gün önce "
ElseIf gecenSaniye >= 604800 And gecenSaniye < 2592000 Then
zamanbul = ""&Int(gecenSaniye/604800)&" hafta önce "
ElseIf gecenSaniye >= 2592000 And gecenSaniye < 31104000 Then
zamanbul = ""&Int(gecenSaniye/2592000)&" ay önce "
ElseIf gecenSaniye >= 31104000 Then
zamanbul = ""&Int(gecenSaniye/31104000)&" yıl önce"
End If
End Function
%>