[PsyChaos]

bu arada yazılan son iki kod bana ait değildir. maxiasp'den tanıdığım @aliayen arkadaşıma aittir. kendisine teşekkür ederim..

[absconder]

bende katılayım bari

bu şekilde class yazıp onlardan kütüphane oluşturmak ve bu kütüphaneyi kullanmak daha koılayıma gidiyor benim, o yüzden bu formatta yazıyorum.

class içerisinde iki fonksiyon mevcut, yazılan class'ın asıl amacı parametre ile gönderilen texti katıştırmak (mix etmek) ama rastgele say üreticisi olarakta kullanılabilir.

<%
Dim word
word = "ABCDEFGHIJKLMNOPQRSTUVXYZabcdefghijklmnopqrstuvxyz1234567890"

set m = new mixer

' parametre olarak gönderilen kelimeyi katıştırır. kullanım: m.strMix(kelime)
response.write m.strMix(word) 

response.write "<br>"

' rastgele sayı üretir. kullanım : m.rndInt(ustSınır)
response.write m.rndInt(100)
%>

<%
Class mixer
	Public Property Get strMix(arg)
		dim myStr, char, retVal
		retVal = ""
		myStr = arg
		while (myStr <>"")
			char = mid(myStr,rndInt(len(myStr)),1)
			myStr = replace(myStr,char,"")
			retVal = retVal + char
		wend
		strMix = retVal
	End Property
	
	Public Function rndInt(diameter)
		randomize timer
		rndInt= int(rnd * diameter) + 1
	End Function
End Class
%>

[soul]

İnternette buldum çaldım Adresi kaybettiğimden veremiyorum.

URLDecode işlemi;

<%
'// Decode URL
Function URLDecode(byVal strString)
    strString = Replace(strString, "%2F", "/")
    strString = Replace(strString, "%7C", "|")
    strString = Replace(strString, "%3F", "?")
    strString = Replace(strString, "%21", "!")
    strString = Replace(strString, "%40", "@")
    strString = Replace(strString, "%5C", "\")
    strString = Replace(strString, "%23", "#")
    strString = Replace(strString, "%24", "$")
    strString = Replace(strString, "%5E", "^")
    strString = Replace(strString, "%26", "&")
    strString = Replace(strString, "%25", "%")
    strString = Replace(strString, "%2A", "*")
    strString = Replace(strString, "%28", "(")
    strString = Replace(strString, "%29", ")")
    strString = Replace(strString, "%7D", "}")
    strString = Replace(strString, "%3A", ":")
    strString = Replace(strString, "%2C", ",")
    strString = Replace(strString, "%7B", "{")
    strString = Replace(strString, "%2B", "+")
    strString = Replace(strString, "%2E", ".")
    strString = Replace(strString, "%2D", "-")
    strString = Replace(strString, "%7E", "~")
    strString = Replace(strString, "%2D", "-")
    strString = Replace(strString, "%5B", "[")
    strString = Replace(strString, "%5F", "_")
    strString = Replace(strString, "%5D", "]")
    strString = Replace(strString, "%60", "`") 
    strString = Replace(strString, "%3D", "=")
    strString = Replace(strString, "%27", "'")
    strString = Replace(strString, "+", " ")
    strString = Replace(strString, "%22", Chr(34))
    
	URLDecode = strString
End Function    
%>

[soul]

Sayı tekil mi değil mi ?

'// Check Odd
Function IsOdd(byVal Num)
	IsOdd=False
	
	If NOT IsNumeric(Num) Then Exit Function
	If (Num mod 2)=0 Then IsOdd=True
End Function

[soul]

Timeout Kontrollü ASPTear ile veri alma;


ASPTear kullanırken en sinir olduğum şey aslında varolan siteye ulaşamadım hatası verip durması.
Aşağıdaki fonksiyon siteye ulaşana kadar ASPTear ı deniyor ve ulaşınca kodunu size geri döndürüyor. Sitenin gerçekten down olması ihitmalini gözönünde bulundurarak tearCounter = 3 kısmında maksimum deneme sayısını düzenleyebilirsiniz.

'// Get By ASPTear
Function fm_GetbyASPTear(byVal URL, byVal postData)
	'// Try !
	Dim tearCounter, XObj
	tearCounter = 3

	'On Error Resume Next
	Do 
		tearCounter = tearCounter-1
			
			'// Get Info by ASPTear
			Set Xobj = CreateObject("SOFTWING.ASPtear")
			'Xobj.FollowRedirects=True
			fm_GetbyASPTear = Xobj.Retrieve(URL, 1, postData, "", "")
			
			'// Success
			If ERR=0 Then Exit Do
			
			'// Timeout
			If tearCounter=0 Then Exit Do
			
			Err.Clear
	Loop
End Function

[soul]

Forumlardaki otomatik link oluşturma işlemini gerçekleştirir. Kodun orjinali bana ait değil Lewis Moten beye ait ben bazı hataları giderip biraz geliştirdim. Nadiren de olsa sapıtabiliyor gene de çok güzel.


Bu fonksiyon hakkında birazcık daha bilgi şurada da bulunabilir;
http://ferruh.mavituna.com/article/?432

'// 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

[soul]

Bu fonksiyonu koyduğunuz sayfalarda vereceğin parametre ile otomatik bir şifre koruması oluşur;

Sayfanın başına;

fm_protect "Pek Gizli Şifrem"

kodunu eklemeniz yeterli.

Logout işlemi için kodu koydıuğunuz sayfaya;

sayfam.ASP?logut=ok

şeklinde link vermeniz yeterli.

Aslında

sayfam.ASP?logut=cikbakiiim

gibi herhangi bir seyde diyebilrsiniz, deger vermeniz yeterli

Şfreler küçük büyük harf duyarlıdır, birebir aynı olmalıdır.

'// Make Simple Password protected pages
Function fm_protect(byVal pass)
	Dim formPs, caseSensitive
	caseSensitive = True
	formPs = Trim(Request.form("ps"))

	'// If not case sensitive
	If NOT caseSensitive Then 
		formPs=Ucase(formPs)
		pass=Ucase(pass)
	End If

	'// Check Login
	If formPs <> "" Then
		If formPs = pass Then Session("login" & pass) = "ok"
	End If

	'// Logout (?logout=x) (POST or GET)
	If Request("logout") <> "" Then Session("login" & pass) = ""

	'// Show login if not !
	If Session("login" & pass) <> "ok" Then
		Response.Write "<fieldset>" &_
			"<legend>Şifre</legend>" &_
			"<form method=""post"" action=""" & Request.ServerVariables("SCRIPT_NAME") & """>" &_
			"<input type=""password"" name=""ps"" />" &_
			"<input type=""submit"" value=""Login"" class=""but"" />" &_
			"</form>"
		
		Response.End
	End If
End Function

[soul]

Verdiğiniz stringin ilk harfini büyük yapacaktır. ( Bu kadar başka bir numara yok )

'// Fix First Letters
Function fm_fixfirst(byVal txt)
	txt = Ucase(Left(txt,1)) & Right(txt,Len(txt)-1)
	fm_fixfirst = txt
End Function

[PsyChaos]

Bu fonsiyon ile random şifreler üretebilirsiniz.

Public Function SecurityCode(Number)
	'|
	'| Security Code Product
	'| Coded By PsyChaos
	'| A.K.A Semih Turna
	'|
	
		strList = Array("1","2","3","4","5","6","7","8","9","0","Q","w","E","R","t","y","u","I","O","P","a","s","d","f","G","H","J","K","L","z","X","c","V","B","N","M")
		intList = uBound(strList)
			Randomize
				For nN = 0 To Number
					xX = Int((intList* Rnd) + 1)
					KeyValues = KeyValues & strList(xX)
				Next
				
			SecurityCode = KeyValues
			
	End Function

Kullanımı;

<% SecurityCode 4 ' 5 haneli random şifre üretir. %>

[PsyChaos]

Basit bir kod renklendirici. ASP ve PHP kodlarını renklendiriyor.

Public Function ColorCode(Code)
	'|
	'| Color Code
	'| Coded By PsyChaos
	'| A.K.A Semih Turna
	'|
	
	Code = Replace(Code,"<"+"%","&lt;"&"%")
	Code = Replace(Code,"%"+">","%"&"&gt;")
	
		Set CodeTag = server.CreateObject("Scripting.Dictionary")
			With CodeTag
				.CompareMode = 3
				.Add "&lt;"&"%" , "%"&"&gt;" 	'ASP
				.Add "&lt;"+"?" , "?"+"&gt;" 	'PHP
			End With
			
			strColor = Array("#FFFF99","#E4EEFD") 'Color Code
			
					strBeginTag = CodeTag.Keys
					strEndTag 	= CodeTag.Items
	
					intCodeCount = CodeTag.Count - 1
					
					For CT = 0 To intCodeCount
						Code = Replace(Code,strBeginTag(CT), "<span style='background-color: "& strColor(CT) &"'>"& strBeginTag(CT),1,-1,1)
						Code = Replace(Code,strEndTag(CT), strEndTag(CT) &"</span>",1,-1,1)
					Next
					
				Set CodeTag = Nothing
					
				ColorCode = Code 'Replace(Code,vbCrlf,"<br>")
	
	End Function

Kullanımı;

<% ColorCode veri %>