[soul]

Exchange()
İki değişkenin değerlerini değiştirir;
b' yi a, a'yı b yapacaktır.

<%
 '// Exchange() v0.1 by Ferruh Mavituna
 Function Exchange(byRef n, byRef m)
  Dim t
  t=m:m=n:n=t
 End Function
%>

isPositive()
Verdiğiniz rakamın pozitif değer olup olmadığına bakar Boolean (true/false) döndürür.

'// isPositive() v0.1 by Ferruh Mavituna
 Function isPositive(byVal Num)
  isPositive = False
  If NOT isNumeric(Num) Then 
   isPositive = False
  Else
   If Num>0 Then isPositive = True
  End If
 End Function

En Büyük Ortak Bölen (EBOB - Greatest Common Divisior)

 '// Find Greatest Common Divisior v0.3 by Ferruh Mavituna
 '// Sample : Response.Write fm_gcd(111,333)
 Function fm_gcd(byVal m, byVal n)
  Dim r, i
  r=666
  '// m>0 && n>0
  If NOT isPositive(m) OR NOT isPositive(n) Then 
   Response.Write "Input Wrong !"
   Response.End
  End If
  '// If m<n Then m<>n
  If m < n Then Exchange m,n
  While r<>0
   '// m/n
   r = m mod n
   If r = 0 Then 
	fm_gcd = n
   Else
	m=n:n=r
   End If
  Wend
 End Function

[HypNotic]

Abi supersin ama şunları uzun uzun yazacağına zipleyip de yollasaydın ya Neyse sağol...

[Re Entry]

Klavyene sağlık.

[soul]

Rå® tarafından gönderilen mesaj:

Abi supersin ama şunları uzun uzun yazacağına zipleyip de yollasaydın ya Neyse sağol...

Hocam hepsini bir toplayalım ondan sonra bir de paketler paket halinde göndeririz. Ancak sanırım ki bu şekilde işinize yarayacak fonksiyonu bulmak daha kolay.

[BLueSNaKe]

Şimdiye kadar hep uzun uzun kod yazarak yaptığım şeyleri bu fonksiyonlar sayesinde yaptım ve işim daha da kolaylaştı. Teşekkürler soul. Devamını bekliyorum.

[HypNotic]

soul tarafından gönderilen mesaj:

Hocam hepsini bir toplayalım ondan sonra bir de paketler paket halinde göndeririz. Ancak sanırım ki bu şekilde işinize yarayacak fonksiyonu bulmak daha kolay.

Aman hocam ben daha hocalığa başlamadım.Yani daha o kadar kendimi grlişmiş sanmıyorum.BiLdikLerim kısıtLı ve sizinki kadar değiLdir.Neyse eğer paketLeyip yoLLarsanız sevinirim

[Joy]

Umarım bu kodları Personel web server yardımı ile çalıştırmayı denemişsindir. Bende çalışıyorlarda.

[soul]

Bir kısmını daha gönderlim;

Record Tree List
Belli bir kayıt dizisinden recursive tree menu veya benzeri şeyler oluşturmaya yarıyor, genelde kullanıma göre özelleştirilmesi gerekebilir.

'// Record Tree List
Function RecTree(byVal SQL, byVal idCol, byVal valCol, byVal parentCol, byVal parentVal, byVal targetHref, byVal subLevel, byVal x,byVal subChar, byRef catCounter)

	Dim Obj, subObj, tmpName, tmpStr, tmpSQL

	tmpSQL = SQL & " WHERE " & parentCol & " = " & parentVal
'	Response.Write SQL : response.end

	getRs Obj, tmpSQL

		'// Loop Records
		While NOT Obj.EOF
			tmpName = "<a href=""" & targetHref & Obj(idCol) & """ title=""" & Obj(valCol) & """>" & Obj(valCol) & "</a>"

			'// Levels
			tmpstr=""
			For i=1 To sublevel
				tmpstr = tmpstr & subChar
			Next
			
			'// Print
			
			'// First Main Cat.
			If catCounter>0 AND sublevel=0 Then Response.Write "<br />"

			'// Main Cats
			If sublevel=0 Then 
				If x Then tmpName = "</td><td valign=""top"">" & tmpName
				tmpName = "<strong>" & tmpName & "</strong>"
			End If

			Response.Write tmpstr & tmpName & "<br />" & vbNewline

			parentVal = Obj(idCol)
			tmpSQL = SQL & " WHERE " & parentCol & " = " & parentVal
			getRs subObj, tmpSQL

			'Response.Write tmpSQL

			'// Call this func.  
			catCounter=catCounter+1
			If RsEmpty(subObj) Then 
				RecTree SQL, idCol, valCol, parentCol, parentVal, targetHref, subLevel+1,x,subChar, catCounter
				'Response.Write "<br>"
			End If
			
			Obj.MoveNext
		Wend
	
	'// Kill
	fmKill Obj

End Function

fmKill
Basit şelkilde bir RS i kapama amacı ile kullanlır

'// fmKill RS
Function fmKill(Obj) '// Close RS
	If isObject(Obj) Then
		Obj.Close
		Set Obj=Nothing
	End If
End Function

fm_NewFile
Text dosyası yoksa oluştur varsa dosyaya ekleme yap

'// New File
Function fm_NewFile(byVal File,byVal Text) 'New File
	Dim FSObj, NewFileObj, GetFObj
	If NOT Instr(File,":") Then File = server.Mappath(File)

	Set FSObj = CreateObject("Scripting.FileSystemObject")
	
	If NOT fm_FileExist(File) Then '// If we don't have
		Set NewFileObj = FSObj.CreateTextFile(File,false,false)
			If Text<>"" Then NewFileObj.Write Text
	Else
		Set GetFObj = FSObj.GetFile(File)
		Set NewFileObj = GetFObj.OpenAsTextStream(8,0)
			If Text<>"" Then NewFileObj.Write Text
		
		Set GetFObj = Nothing
	End If
	
	NewFileObj.Close : Set FSObj=Nothing : Set NewFileObj=Nothing
End Function

fm_GetPath
Dosya Yolunu Al, Verilen stringe göre otomatik olarak server.Mappath ile relative yada absolute path döndürür.

Function fm_getPath(byVal File)
	If NOT Instr(File,":") Then File = server.Mappath(File)
	fm_getPath=File
End Function

fm_hilite
Aranılan kelimeyi renklendir. Google gibi her kelime için farklı renk.
// Comment lı kısım açılırsa farklı renkleri kendi üretir.

'// Hilite Search Texts v1.0
Function fm_hilite(byval alltext,byval word)
	Dim Arrword, i, ArrColorList(15), Color, xx
	Arrword = Split(word,",") '// Make an array from wordlist
	
	'// Generate Color List
'	For xx = 0 to 15 Step 3
'		Color =  "DDFF" & String(2,hex(xx))
'		ArrColorList(Int(xx/3)) = color
'	Next
	
	Dim ArrNewCList, ArrListi
	ArrNewCList = Array ("DF0","DFC","9F0","FCF","9FF","FF0","FF9")

	For i = 0 to Ubound(Arrword)
		word = Trim(Arrword(i))	
		If Instr(alltext,word) > 0 Then
			alltext = Replace(alltext,word,"<span style=""background-color:#" & ArrNewClist(ArrListi mod Ubound(ArrNewCList)) & "; font-weight:bold"">" & word & "</span>")
			ArrListi = ArrListi + 1
		End If
	Next

	fm_hilite = alltext
End Function

[Kuen]

hakkını nasıl ödeyeceğiz bilmiyorum tebrikler..

Bu arada türkinternetteki yazıyı okudum kutlarım ne diyelim yolundan ilerliyoruz.

[PsyChaos]

bende çok kullandığım fonsiyonları burda toplamak istiyorum. @soul bir mahsuru yoksa ilk msj'dan sonra devam edeceğim zaman zaman..

Bu fonsiyon ile SQL Injection Saldırılarını Daha Aza İndirgiyoruz.

<%
Public Function SQLInjectionKillers(byVal strWords)

strBadWords = Array("SELECT", "DROP", ";", "--", "INSERT", "DELETE", "xp_", "UNION","'")
strBadWordsReplace = Array("&#83elect", "&#68rop", "&#59", "&#45-", "&#73nsert", "&#68elete", "&#120p&#95", "&#85nion","&#39")
				
	For iSQL = 0 to uBound(strBadWords)
	strWords = Replace(strWords, strBadWords(iSQL), strBadWordsReplace(iSQL),1,-1,1)
	Next
				
SQLInjectionKillers = strWords
			
End Function
%>

'---------------------------------
Bu Sub yordamıda, A-Z & a-z Şeklinde sıralama yapıyor

<%
	Sub AZ()
		For b = 65 To 90 Step 1
			Response.Write "<a href='?Harf="& chr(b) &"'>"& chr(b) &"</a> "
		Next
			
		Response.Write "<br>"
			
		For s = 97 To 122 Step 1
			Response.Write "<a href='?Harf="& chr(s) &"'>"& chr(s) &"</a> "
		Next
	End Sub
%>

'----------------------
Bu fonsiyon ile Localde ya da web üzerinde Access Veritabanı oluşturabilirsiniz.

<% 
Function CreateDatabase(ByVal DBPath) 
   On Error Resume Next 
   Set oCatalog = server.CreateObject("ADOX.Catalog" ) 
   oCatalog.Create _ 
       "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBPath 
   CreateDatabase = Err.Number = 0 
End Function 

If CreateDatabase(server.MapPath("deneme.mdb" )) Then 
   Response.Write("Veritabanı oluşturuldu..." ) 
End If 
%>

'-----------------------
Bu sub yordamı ile bilgisayarınızın yada server'ın fiziksel belleğini öğrenebilirsiniz.

<%
Sub Bellek(strComputer)

Dim wbemServ  
Set wbemServ = GetObject("winmgmts:\\" & strComputer) 

Dim wbemLMC 
Set wbemLMC = wbemServ.InstancesOf("Win32_LogicalMemoryConfiguration" ) 

Dim wbemObject 
For Each wbemObject In wbemLMC 
     Response.Write "Toplam fiziksel bellek (kb): " &  wbemObject.TotalPhysicalMemory 
Next
End Sub

Bellek(bilgisayar Adı)
%>