0
Kayıt Ol

Kullanıcı Kaydı , Kullanıcı Girişi

5

●

3.465

  • 17-03-2008, 16:30:29
    #1
    Tuncsoft
    Tuncsoft
    Üyeliği durduruldu
    Yeni bir makale ile karşınızdayım ;
    Bugün kulllanıcı girişi yapmayı , oturum açmayı , md5 şifrelemeyi öğreneceğiz.

    Oturum nedir ; Windows sunucularda siteye bağlanan her istemci için benzersiz bir oturum numarası açılır Bunu Session.SessionID komutu ile öğreniriz, ama konumuz gereği buna pek değinmeyeceğim.

    Ekteki Dosyayı PC nize indirip Localhost unuzda yada Sunucunuzda çalıştırınız [Yazma izni vermeyi unutmayını tabi]

    Default.asp
    <%@LANGUAGE="VBSCRIPT"%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-9" />
<title>Default</title>
</head>

<body>
<center>
<p><a href="Login.asp">Üye Girişi</a></p>
<p>&nbsp;</p>
<p><a href="Kayit.asp">Üye Kaydı</a></p>
</center>
</body>
</html>

    Login.asp
    <%@LANGUAGE="VBSCRIPT"%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-9" />
<title>Giriş Kontrol</title>
</head>

<body>
<form action="" method="post">
  <label>Kullanıcı Adı
  <input name="user" type="text" id="user" />
  </label>
  <label>Parola :
  <input name="pass" type="password" id="pass" />
  </label>
  <input type="submit" name="Submit" value="Giriş" />
</form>
<%
'include yöntemi ile lazım olan dosyaları sayfada çalıştıralım
'include etmek sayfalarda tekrar tekrar aynı şeyleri yazacağımıza bir defa yazıp gerekli yerlerde kullanmamız için iyi olur
%>
<!--#include file="Baglanti.asp" -->
<!--#include file="Koruma.asp" -->
<!--#include file="Md5.asp" -->
<%

IF REQUEST.ServerVariables("REQUEST_METHOD")="POST" THEN
'Giriş Butonuna basılıp Post edlince Çalışacaktır

Dim KullaniciADI
Dim Parolasi

KullaniciADI=Trim(Temizlik(Request.Form("user")))
Parolasi=Trim(HashEncode(Request.Form("pass")))
'Kullanıcı adını ve parolasını tanımladık inputların name lerinden alır değerleri
'Sql injection lara karşı önlemimizide aldık
'Parola için MD5 şifremele yöntemini kullandık

	Set Login = adoCon.Execute ("SELECT idno,Username,Password,Uyebanli FROM tbl_users WHERE Username='"&KullaniciADI&"' AND Password='"&Parolasi&"' AND Uyebanli=0;")
		
		If Login.EOF Then
			
			Response.Write("Hatalı bilgi!")
				
				Else
				
				Session("Uyegirisi")="Tamamdir" 'İstemciye oturum açtık Uyegirisi=Tamamdir dedik
				Session("Uyenumarasi")=Login("idno") 'Üyeyi tanımak için idnumarasını alacağız
				Response.Redirect("Panel.asp") 'Panel.asp ye yönlendirdik
				
				End If
'Veritabanına bağlanıp tbl_users tablosuna girdik ve KullaniciADI&Parolasi sını sorgulattık eğer böyle bir bilgi varsa
'İstemciye oturum açtık ve Panel.asp ye yönlendirdik


END IF
%>
</body>
</html>
    Kayit.asp
    <%@LANGUAGE="VBSCRIPT"%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-9" />
<title>Kayıt</title>
</head>

<body>
<form action="" method="post">
<table width="480" border="0" align="center">
  <tr>
    <td width="165">Kullanıcı Adı </td>
    <td width="10">:</td>
    <td width="291"><input name="userr" type="text" id="userr" /></td>
  </tr>
  <tr>
    <td>Parola</td>
    <td>:</td>
    <td><input name="pass" type="password" id="pass" /></td>
  </tr>
  <tr>
    <td>Mail Adres </td>
    <td>:</td>
    <td><input name="mail" type="text" id="mail" /></td>
  </tr>
  <tr>
    <td>&nbsp;</td>
    <td>&nbsp;</td>
    <td>&nbsp;</td>
  </tr>
  <tr>
    <td>Adınız Soyadınız </td>
    <td>:</td>
    <td><input name="adsoyad" type="text" id="adsoyad" /></td>
  </tr>
  <tr>
    <td>Hakkınızda</td>
    <td>:</td>
    <td><textarea name="hakkinda" cols="30" rows="5" id="hakkinda"></textarea></td>
  </tr>
  <tr>
    <td>&nbsp;</td>
    <td>&nbsp;</td>
    <td>&nbsp;</td>
  </tr>
  <tr>
    <td>&nbsp;</td>
    <td>&nbsp;</td>
    <td><input type="submit" name="Submit" value="  KAYDET  " /></td>
  </tr>
  <tr>
    <td>&nbsp;</td>
    <td>&nbsp;</td>
    <td>&nbsp;</td>
  </tr>
</table>
</form>
<!--#include file="Koruma.asp" -->
<!--#include file="Md5.asp" -->
<!--#include file="Baglanti.asp" -->
<%
IF REQUEST.ServerVariables("REQUEST_METHOD")="POST" THEN
'KAYDET Butonuna basılıp Post edlince Çalışacaktır


Dim KullaniciADI
Dim Parolasi
Dim MailAdresi
Dim AdiSoyadi
Dim Hakkinda
'Değişkenlerimizi Hafızaya aldık


KullaniciADI=Trim(Temizlik(Request.Form("userr")))
Parolasi=Trim(HashEncode(Request.Form("pass")))
KontrolParolasi=Trim(Request.Form("pass"))

MailAdresi=Trim(Temizlik(Request.Form("mail")))

AdiSoyadi=Trim(Temizlik(Request.Form("adsoyad")))
Hakkinda=Trim(Temizlik(Request.Form("hakkinda")))
'Formdan gelen verileri değişkenlere atadık
'Temizlik İşlemleri de yaptık


	If Len(KullaniciADI) <= 4 Then
		Response.Write("Kullanıcı Adı Yazınız")
	Elseif Len(KontrolParolasi) <= 5 Then
		Response.Write("Parola Yazınız")
	Elseif Len(MailAdresi) <= 8 Then
		Response.Write("Mail Adres Yazınız")
	Elseif Len(AdiSoyadi) <= 6 Then
		Response.Write("Adınızı Soyadınızı Yazınız")
	Elseif Len(Hakkinda) <= 9 Then
		Response.Write("Hakkınızda Bişeyler Yazınız")
	Else
	Call KayitIslemleri 'KayitIslemleri Bölümüne  geç
	End if
'Form kontrolleri tamam boş bilgi istemiyoruz


Sub KayitIslemleri 'Sub istendiğinde çalıştırılan istenmediğinde pas geçilen bir bölümdür

Dim Kontrol
Dim Kaydet

Set Kontrol = adoCon.Execute ("SELECT * FROM tbl_users WHERE Username='"&KullaniciADI&"' OR MailAdres='"&MailAdresi&"';")
'Daha önce kişi kaydolmuşmu kontrol edeceğiz

	If Kontrol.EOF Then 'Eğer Kullanıcı adı veya mail daha önce kayıt olunmamışsa kayıt işlemini yapalım
	
Set Kaydet = Server.CreateObject("Adodb.Recordset")
Kaydet.Open "tbl_users" , adoCon,1,3	'Okuma yazma yetkisi ile tabloyu açtık
	
	Kaydet.Addnew 'Yeni Kayıt Girmek için komut yazdık
	Kaydet("Username")=KullaniciADI
	Kaydet("Password")=Parolasi
	Kaydet("AdSoyad")=AdiSoyadi
	Kaydet("MailAdres")=MailAdresi
	Kaydet("KayitTarihi")=Now()
	Kaydet("Hakkinda")=Hakkinda
	Kaydet.Update 'Kayıt işlemini Update ettik
	Kaydet.Close 'Kayıt işlemini kapattık
	
	'Yazdıralım sonucu
	Response.Write("Üye Kaydınız Tamamlandı<br>")
	Response.Write("Üye Girişi Yapabilirsiniz <a href=""Login.asp"">Tıklayın<a>")
	
	Else 'Değilse Uyaralım
		Response.Write("Bu bilgilerle daha önce kayıt olunmuş")
	End If


End Sub



END IF
%>
</body>
</html>
    Panel.asp
    <%@LANGUAGE="VBSCRIPT"%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-9" />
<title>Panel</title>
</head>
<%
'Bu sayfa üyelere açık bir sayfadır
'Eğer Kullanıcı Girişi Yapılmamışsa Login.asp ye yönlendireceğiz
%>
<!--#include file="OturumKontrol.asp" -->
<!--#include file="Baglanti.asp" -->

<%
UyeNUMARASI=Session("Uyenumarasi")
'Giriş yaparken üyenin numarasını oturum bilgisine atamıştık

Set Uyebilgi = adoCon.Execute ("SELECT * FROM tbl_users WHERE idno="&UyeNUMARASI&" AND Uyebanli=0;")
	If Uyebilgi.EOF Then Response.Redirect("Login.asp")
		'Oturumu açtıktan sonra kullanıcı oturumu kapatana kadar üyelere açık bölümlere girebilecektir
		'Fakat diyelim Biz kullanıcıyı üye oturum açtığı sırada sildik yada banladık hala üyelere açık yerlere girebilir
		'Onun için hersayfada veritanından kontrol edelimki banlamamiz yada silmemiz işe yarasın

KullanicinADISOYADI=Uyebilgi("AdSoyad")

Uyebilgi.Close
Set Uyebilgi = NOTHING
%>
<body>
<p>Merhaba Sayın [<strong><%=(KullanicinADISOYADI)%></strong>] 
Başarılı Bir şekilde giriş yaptınız </p>
<p><a href="Logout.asp">Çıkış</a></p>
</body>
</html>
    Logout.asp
    <%
'İstemci için açılmış olan tüm oturum bilgilerini sıfırlıyoruz
'Tekrar Login.asp ye gönderiyoruz
'Başka bir yere de gönderebiliriz o bizim isteğimize kalmış
Session.Abandon()
Response.Redirect("Default.asp")
%>

    Yardımcı Dosyalar
    Baglanti.asp
    <%
'--------------------------------------
VeritabaniYolu="VeriTabani.mdb"
'---------------------------------------

Set adoCon=Server.CreateObject("AdoDb.Connection")
adoCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(VeritabaniYolu)
%>
    Koruma.asp
    <%
Function Temizlik(Temizle)
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)
Temizlik=Temizle
End Function
%>
    Md5.asp
    <%

' Written By: Mark G. Jager
' Written Date: 8/10/2000

Function getSalt(intLen)



	Dim strSalt
	Dim intIndex, intRand

	If Not IsNumeric(intLen) Then
		getSalt = "00000000"
		exit function
	ElseIf CInt(intLen) <> CDbl(intLen) Or CInt(intLen) < 1 Then
		getSalt = "00000000"
		exit function
	End If

	Randomize

	For intIndex = 1 to CInt(intLen)
		intRand = CInt(Rnd * 1000) Mod 16
		strSalt = strSalt & getDecHex(intRand)
	Next
	
	getSalt = strSalt

End Function


Function HashEncode(strSecret)

    Dim strEncode, strH(4)
    Dim intPos
    
    
    If len(strSecret) = 0 or len(strSecret) >= 2^61 then
		HashEncode = "0000000000000000000000000000000000000000"
		exit function
    end if
    
    
    'Initial Hex words are used for encoding Digest.  
    'These can be any valid 8-digit hex value (0 to F)
    strH(0) = "FB0C14C2"
    strH(1) = "9F00AB2E"
    strH(2) = "991FFA67"
    strH(3) = "76FA2C3F"
    strH(4) = "ADE426FA"
    
    For intPos = 1 to len(strSecret) step 56
		
		strEncode = Mid(strSecret, intPos, 56) 'get 56 character chunks
		strEncode = WordToBinary(strEncode) 'convert to binary
		strEncode = PadBinary(strEncode) 'make it 512 bites
		strEncode = BlockToHex(strEncode) 'convert to hex value
		strEncode = DigestHex(strEncode, strH(0), strH(1), strH(2), strH(3), strH(4))
		strH(0) = HexAdd(left(strEncode, 8), strH(0))
		strH(1) = HexAdd(mid(strEncode, 9, 8), strH(1))
		strH(2) = HexAdd(mid(strEncode, 17, 8), strH(2))
		strH(3) = HexAdd(mid(strEncode, 25, 8), strH(3))
		strH(4) = HexAdd(right(strEncode, 8), strH(4))
		
    Next
    
    HashEncode = strH(0) & strH(1) & strH(2) & strH(3) & strH(4)
    
End Function



Function HexToBinary(btHex)

    Select Case btHex
    Case "0"
        HexToBinary = "0000"
    Case "1"
        HexToBinary = "0001"
    Case "2"
        HexToBinary = "0010"
    Case "3"
        HexToBinary = "0011"
    Case "4"
        HexToBinary = "0100"
    Case "5"
        HexToBinary = "0101"
    Case "6"
        HexToBinary = "0110"
    Case "7"
        HexToBinary = "0111"
    Case "8"
        HexToBinary = "1000"
    Case "9"
        HexToBinary = "1001"
    Case "A"
        HexToBinary = "1010"
    Case "B"
        HexToBinary = "1011"
    Case "C"
        HexToBinary = "1100"
    Case "D"
        HexToBinary = "1101"
    Case "E"
        HexToBinary = "1110"
    Case "F"
        HexToBinary = "1111"
    Case Else
        HexToBinary = "2222"
    End Select
End Function

Function BinaryToHex(strBinary)

    Select Case strBinary
    Case "0000"
        BinaryToHex = "0"
    Case "0001"
        BinaryToHex = "1"
    Case "0010"
        BinaryToHex = "2"
    Case "0011"
        BinaryToHex = "3"
    Case "0100"
        BinaryToHex = "4"
    Case "0101"
        BinaryToHex = "5"
    Case "0110"
        BinaryToHex = "6"
    Case "0111"
        BinaryToHex = "7"
    Case "1000"
        BinaryToHex = "8"
    Case "1001"
        BinaryToHex = "9"
    Case "1010"
        BinaryToHex = "A"
    Case "1011"
        BinaryToHex = "B"
    Case "1100"
        BinaryToHex = "C"
    Case "1101"
        BinaryToHex = "D"
    Case "1110"
        BinaryToHex = "E"
    Case "1111"
        BinaryToHex = "F"
    Case Else
        BinaryToHex = "Z"
    End Select
End Function

Function WordToBinary(strWord)

	Dim strTemp, strBinary 
	Dim intPos

	For intPos = 1 To Len(strWord)
	    strTemp = Mid(strWord, cint(intPos), 1)
	    strBinary = strBinary & IntToBinary(Asc(strTemp))
	Next

	WordToBinary = strBinary

End Function

Function HexToInt(strHex)

	Dim intNew, intPos, intLen

	intNew = 0
	intLen = CDbl(len(strHex)) - 1
	
	For intPos = CDbl(intLen) to 0 step -1
	    Select Case Mid(strHex, CDbl(intPos) + 1, 1)       
	    Case "0"
			intNew = CDbl(intNew) + (0 * 16^CDbl(intLen - intPos))
	    Case "1"
	        intNew = CDbl(intNew) + (1 * 16^CDbl(intLen - intPos))
	    Case "2"
	        intNew = CDbl(intNew) + (2 * 16^CDbl(intLen - intPos))
	    Case "3"
	        intNew = CDbl(intNew) + (3 * 16^CDbl(intLen - intPos))
	    Case "4"
	        intNew = CDbl(intNew) + (4 * 16^CDbl(intLen - intPos))
	    Case "5"
	        intNew = CDbl(intNew) + (5 * 16^CDbl(intLen - intPos))
	    Case "6"
	        intNew = CDbl(intNew) + (6 * 16^CDbl(intLen - intPos))
	    Case "7"
	        intNew = CDbl(intNew) + (7 * 16^CDbl(intLen - intPos))
	    Case "8"
	        intNew = CDbl(intNew) + (8 * 16^CDbl(intLen - intPos))
	    Case "9"
	        intNew = CDbl(intNew) + (9 * 16^CDbl(intLen - intPos))
	    Case "A"
	        intNew = CDbl(intNew) + (10 * 16^CDbl(intLen - intPos))
	    Case "B"
	        intNew = CDbl(intNew) + (11 * 16^CDbl(intLen - intPos))
	    Case "C"
	        intNew = CDbl(intNew) + (12 * 16^CDbl(intLen - intPos))
	    Case "D"
	        intNew = CDbl(intNew) + (13 * 16^CDbl(intLen - intPos))
	    Case "E"
	        intNew = CDbl(intNew) + (14 * 16^CDbl(intLen - intPos))
	    Case "F"
	        intNew = CDbl(intNew) + (15 * 16^CDbl(intLen - intPos))
		End Select

	Next

	HexToInt = CDbl(intNew)
	
End Function

Function IntToBinary(intNum)

    Dim strBinary, strTemp
    Dim intNew, intTemp
    Dim dblNew
    
    intNew = intNum
    
    Do While intNew > 1
        dblNew = CDbl(intNew) / 2
        intNew = Round(CDbl(dblNew) - 0.1, 0)
        If CDbl(dblNew) = CDbl(intNew) Then
            strBinary = "0" & strBinary
        Else
            strBinary = "1" & strBinary
        End If

    Loop
    
    strBinary = intNew & strBinary
    
    intTemp = Len(strBinary) mod 8
    
    For intNew = intTemp To 7
        strBinary = "0" & strBinary
    Next
    
    IntToBinary = strBinary
    
End Function

Function PadBinary(strBinary)

	Dim intPos, intLen
	Dim strTemp
	    
	intLen = Len(strBinary)
	    
	strBinary = strBinary & "1"
	    
	For intPos = Len(strBinary) To 447
	    strBinary = strBinary & "0"
	Next
	    
	strTemp = IntToBinary(intLen)
	    
	For intPos = Len(strTemp) To 63
	    strTemp = "0" & strTemp
	Next
	    
	strBinary = strBinary & strTemp
	    
	PadBinary = strBinary
	    
End Function

Function BlockToHex(strBinary)

	Dim intPos
	Dim strHex

	For intPos = 1 To Len(strBinary) Step 4
	    strHex = strHex & BinaryToHex(Mid(strBinary, intPos, 4))
	Next

	BlockToHex = strHex

End Function

Function DigestHex(strHex, strH0, strH1, strH2, strH3, strH4)

	Dim strWords(79), adoConst(4), strTemp, strTemp1, strTemp2, strTemp3, strTemp4
	Dim intPos
	Dim strH(4), strA(4), strK(3)

    strK(0) = "5A827999"
    strK(1) = "6ED9EBA1"
    strK(2) = "8F1BBCDC"
    strK(3) = "CA62C1D6"
    
    strH(0) = strH0
    strH(1) = strH1
    strH(2) = strH2
    strH(3) = strH3
    strH(4) = strH4
    
	For intPos = 0 To (len(strHex) / 8) - 1
	    strWords(cint(intPos)) = Mid(strHex, (cint(intPos)*8) + 1, 8)
	Next

	For intPos = 16 To 79
	    strTemp = strWords(cint(intPos) - 3)
	    strTemp1 = HexBlockToBinary(strTemp)
	    strTemp = strWords(cint(intPos) - 8)
	    strTemp2 = HexBlockToBinary(strTemp)
	    strTemp = strWords(cint(intPos) - 14)
	    strTemp3 = HexBlockToBinary(strTemp)
	    strTemp = strWords(cint(intPos) - 16)
	    strTemp4 = HexBlockToBinary(strTemp)
	    strTemp = BinaryXOR(strTemp1, strTemp2)
	    strTemp = BinaryXOR(strTemp, strTemp3)
	    strTemp = BinaryXOR(strTemp, strTemp4)
	    strWords(cint(intPos)) = BlockToHex(BinaryShift(strTemp, 1))
	Next

	strA(0) = strH(0)
	strA(1) = strH(1)
	strA(2) = strH(2)
	strA(3) = strH(3)
	strA(4) = strH(4)

	For intPos = 0 To 79
	    strTemp = BinaryShift(HexBlockToBinary(strA(0)), 5)
	    strTemp1 = HexBlockToBinary(strA(3))
	    strTemp2 = HexBlockToBinary(strWords(cint(intPos)))
	    
	    Select Case intPos
	    
	    Case 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19
	        strTemp3 = HexBlockToBinary(strK(0))
	        strTemp4 = BinaryOR(BinaryAND(HexBlockToBinary(strA(1)), _
				HexBlockToBinary(strA(2))), BinaryAND(BinaryNOT(HexBlockToBinary(strA(1))), _
				HexBlockToBinary(strA(3))))
	    Case 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39
	        strTemp3 = HexBlockToBinary(strK(1))
	        strTemp4 = BinaryXOR(BinaryXOR(HexBlockToBinary(strA(1)), _
				HexBlockToBinary(strA(2))), HexBlockToBinary(strA(3)))
	    Case 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59
	        strTemp3 = HexBlockToBinary(strK(2))
	        strTemp4 = BinaryOR(BinaryOR(BinaryAND(HexBlockToBinary(strA(1)), _
				HexBlockToBinary(strA(2))), BinaryAND(HexBlockToBinary(strA(1)), _
				HexBlockToBinary(strA(3)))), BinaryAND(HexBlockToBinary(strA(2)), _
				HexBlockToBinary(strA(3))))
	    Case 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79
	        strTemp3 = HexBlockToBinary(strK(3))
	        strTemp4 = BinaryXOR(BinaryXOR(HexBlockToBinary(strA(1)), _
				HexBlockToBinary(strA(2))), HexBlockToBinary(strA(3)))
	    End Select
	    
	    strTemp = BlockToHex(strTemp)
	    strTemp1 = BlockToHex(strTemp1)
	    strTemp2 = BlockToHex(strTemp2)
	    strTemp3 = BlockToHex(strTemp3)
	    strTemp4 = BlockToHex(strTemp4)
	    
	    strTemp = HexAdd(strTemp, strTemp1)
	    strTemp = HexAdd(strTemp, strTemp2)
	    strTemp = HexAdd(strTemp, strTemp3)
	    strTemp = HexAdd(strTemp, strTemp4)
	    
	    strA(4) = strA(3)
	    strA(3) = strA(2)
	    strA(2) = BlockToHex(BinaryShift(HexBlockToBinary(strA(1)), 30))
	    strA(1) = strA(0)
	    strA(0) = strTemp
	    
	Next

	DigestHex = strA(0) & strA(1) & strA(2) & strA(3) & strA(4)

End Function

Function HexAdd(strHex1, strHex2)

    Dim intCalc
    Dim strNew
    
    intCalc = 0
    intCalc = CDbl(CDbl(HexToInt(strHex1)) + CDbl(HexToInt(strHex2)))
    Do While CDbl(intCalc) > 2^32
		intCalc = CDbl(intCalc) - 2^32
    Loop
       
    strNew = IntToBinary(CDbl(intCalc))
    Do While Len(strNew) < 32
        strNew = "0" & strNew
    Loop
    strNew = BlockToHex(strNew)
    
    if InStr(strNew, "00") = 1 and len(strNew) = 10 then
		strNew = right(strNew, 8)
    end if
    
    HexAdd = strNew

End Function

Function getHexDec(strHex)

    Select Case strHex
    Case "0"
        getHexDec = 0
    Case "1"
        getHexDec = 1
    Case "2"
        getHexDec = 2
    Case "3"
        getHexDec = 3
    Case "4"
        getHexDec = 4
    Case "5"
        getHexDec = 5
    Case "6"
        getHexDec = 6
    Case "7"
        getHexDec = 7
    Case "8"
        getHexDec = 8
    Case "9"
        getHexDec = 9
    Case "A"
        getHexDec = 10
    Case "B"
        getHexDec = 11
    Case "C"
        getHexDec = 12
    Case "D"
        getHexDec = 13
    Case "E"
        getHexDec = 14
    Case "F"
        getHexDec = 15
    Case Else
        getHexDec = -1
    End Select
End Function

Function getDecHex(strHex)

    Select Case CInt(strHex)
    Case 0
       getDecHex = "0"
    Case 1
       getDecHex = "1"
    Case 2
       getDecHex = "2"
    Case 3
       getDecHex = "3"
    Case 4
       getDecHex = "4"
    Case 5
       getDecHex = "5"
    Case 6
       getDecHex = "6"
    Case 7
       getDecHex = "7"
    Case 8
       getDecHex = "8"
    Case 9
       getDecHex = "9"
    Case 10
       getDecHex = "A"
    Case 11
       getDecHex = "B"
    Case 12
       getDecHex = "C"
    Case 13
       getDecHex = "D"
    Case 14
       getDecHex = "E"
    Case 15
       getDecHex = "F"
    Case Else
       getDecHex = "Z"
    End Select
End Function

Function BinaryShift(strBinary, intPos)

    BinaryShift = Right(strBinary, Len(strBinary) - cint(intPos)) & _
		Left(strBinary, cint(intPos))

End Function

Function BinaryXOR(strBin1, strBin2)

    Dim strBinaryFinal
    Dim intPos
    
    For intPos = 1 To Len(strBin1)
        Select Case Mid(strBin1, cint(intPos), 1)
        
        Case Mid(strBin2, cint(intPos), 1)
            strBinaryFinal = strBinaryFinal & "0"
        Case Else
            strBinaryFinal = strBinaryFinal & "1"
        End Select
    Next
    
    BinaryXOR = strBinaryFinal
    
End Function

Function BinaryOR(strBin1, strBin2)

    Dim strBinaryFinal
    Dim intPos
    
    For intPos = 1 To Len(strBin1)
        If Mid(strBin1, cint(intPos), 1) = "1" Or Mid(strBin2, cint(intPos), 1) = "1" Then
            strBinaryFinal = strBinaryFinal & "1"
        Else
            strBinaryFinal = strBinaryFinal & "0"
        End If
    Next
    
    BinaryOR = strBinaryFinal
End Function

Function BinaryAND(strBin1, strBin2)

    Dim strBinaryFinal
    Dim intPos
    
    For intPos = 1 To Len(strBin1)
        If Mid(strBin1, cint(intPos), 1) = "1" And Mid(strBin2, cint(intPos), 1) = "1" Then
            strBinaryFinal = strBinaryFinal & "1"
        Else
            strBinaryFinal = strBinaryFinal & "0"
        End If
    Next
    
    BinaryAND = strBinaryFinal
End Function

Function BinaryNOT(strBinary)

    Dim strBinaryFinal
    Dim intPos
    
    For intPos = 1 To Len(strBinary)
        If Mid(strBinary, cint(intPos), 1) = "1" Then
            strBinaryFinal = strBinaryFinal & "0"
        Else
            strBinaryFinal = strBinaryFinal & "1"
        End If
    Next
    
    BinaryNOT = strBinaryFinal
    
End Function

Function HexBlockToBinary(strHex)

    Dim intPos
    Dim strTemp
    
    For intPos = 1 To Len(strHex)
        strTemp = strTemp & HexToBinary(Mid(strHex, cint(intPos), 1))
    Next
    
    HexBlockToBinary = strTemp
    
End Function
%>
    OturumKontrol.asp
    <%
'Eğer Kullanıcı Girişi Yapılmamışsa Login.asp ye yönlendireceğiz
IF NOT Session("Uyegirisi")="Tamamdir" THEN Response.Redirect("Login.asp")
%>
  • 26-01-2009, 19:49:47
    #2
    karamselli
    karamselli
    Çok işime yaradı teşekkürler
  • 26-01-2009, 20:12:33
    #3
    Peksoft
    Peksoft
    Teşekkürler Tuncsoft.
  • 28-01-2009, 10:13:03
    #4
    hmakdeniz
    hmakdeniz
    Tunçsoft yine güzel bir döküman teşekkürler
  • 28-01-2009, 10:24:03
    #5
    psycho
    psycho
    Kimlik doğrulama veya yönetimden onay bekliyor.
    Çok sağol dostum bu dosya çok gerekliydi
  • 24-09-2012, 15:34:38
    #6
    yankimetin
    yankimetin
    Üyeliği durduruldu
    güzel döküman ve bilgi paylaşım için saol