lostyazilim
tr.link

Hazır Function Kodları

4 Mesajlar 1.104 Okunma
acebozum
tr.link

Arafa Arafa WM Aracı Banlı Kullanıcı
  • Üyelik 03.02.2014
  • Yaş/Cinsiyet 40 / E
  • Meslek xxxxxxxxxxx
  • Konum Kırklareli
  • Ad Soyad A** K**
  • Mesajlar 152
  • Beğeniler 6 / 11
  • Ticaret 0, (%0)
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 & " 转到:"
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

%>
 

 

elektronikssl
webimgo

monelogg monelogg <> Kullanıcı
  • Üyelik 06.03.2014
  • Yaş/Cinsiyet 33 / E
  • Meslek Öğrenci
  • Konum Diğer
  • Ad Soyad M** B**
  • Mesajlar 658
  • Beğeniler 78 / 125
  • Ticaret 0, (%0)
Çok 是否用下拉列表显示所有 paylaşım olmuş. :) Arşive attım, sağolun. Site adını da vermeniz mümkün müdür, bulamadım ama.
 

 

UNKEF UNKEF WM Aracı Kullanıcı
  • Üyelik 06.03.2015
  • Yaş/Cinsiyet 35 / E
  • Meslek ARGE
  • Konum Balıkesir
  • Ad Soyad F** Ç**
  • Mesajlar 2422
  • Beğeniler 995 / 744
  • Ticaret 17, (%100)

monelogg adlı üyeden alıntı

Ç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.
 

 

Arafa Arafa WM Aracı Banlı Kullanıcı
  • Üyelik 03.02.2014
  • Yaş/Cinsiyet 40 / E
  • Meslek xxxxxxxxxxx
  • Konum Kırklareli
  • Ad Soyad A** K**
  • Mesajlar 152
  • Beğeniler 6 / 11
  • Ticaret 0, (%0)
Ö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
%>

 

 

wmaraci
wmaraci
wmaraci
wmaraci
Konuyu toplam 1 kişi okuyor. (0 kullanıcı ve 1 misafir)
Site Ayarları
  • Tema Seçeneği
  • Site Sesleri
  • Bildirimler
  • Özel Mesaj Al