Anasayfa
Doğum tarihi
tarafından Merhaba arkadaşlar Çorbada bizimde tuzumuz olsun 
Kolay bi şifreleme kodu...
Normalde ACSII kodlarını artırıp yapılan şifreleme pek güvenilir değil. Mesela baba kelimesinden şifre çok kolay bir şekilde çözülür baba => cbcb(1 artırdığımızda) olacak çünkü. Diyelimki 500 artırdınız(zor olsun açması diye) birdaha o metni çözemezsiniz metini birdaha çözmeye çalıştığınızda saçma şeyler çıkar ortaya. O zaman aşağıdaki kodu bi inceleyin.
Private Sub Command1_Click()
kod = InputBox("Şifreyi girin", , 1)
If kod = "" Then Exit Sub 'Cancel seçilirse, yordamdan çık
charsInFile% = Len(Text1.Text) 'dize uzunluğunu bul
Open "c:\sifre.txt" For Output As #1 'dosyayı aç
For i% = 1 To charsInFile% 'dosyadaki her karakter için
letter$ = Mid(Text1.Text, i%, 1) 'sonraki karakteri oku
'w/ Asc sayısına dönüştür, sonra şifrelemek için Xor'u kullan
Print #1, Asc(letter$) Xor kod; 've dosyayı kaydet
Next i%
Close #1 'bittiğinde dosyayı kapat
End If
End Sub
Bunu deneyin şifre içinde 1000 deyin mesela ve kaydedilen dosyayı notepad ile açın, gerçekten anlaşılmaz.
Şimdi bunu çözelim;
Private Sub Command2_Click()
Wrap$ = Chr$(13) + Chr$(10) 'kayan karakter yarat
'şifreyi alip şifreli metni dönüştür
kod = InputBox("Şifreyi girin", , 1)
If kod = "" Then Exit Sub 'Cancel seçilirse, yordamdan çık
Open "c:\sifre.txt" For Input As #1 'dosyayı aç
On Error GoTo Problem: 'hata işleyici ayarla
decrypt$ = "" 'dizeyi deşifre için sıfırla
Do Until EOF(1) 'dosyanın sonuna kadar
Input #1, Number& 'şifreli sayıları oku
e$ = Chr$(Number& Xor kod) 'Xor ile dönüştür
decrypt$ = decrypt$ & e$ 've dize oluştur
Loop
Text1.Text = decrypt$ 'dönüştürülen dizeyi görüntüle
Text1.Enabled = True 'kaydırma çubuklarını etkinleştir
CleanUp: 'bittiğinde...
Close #1 'dosyayı kapat
End If
Exit Sub
Problem: 'sorun olduğunda, uygun iletiyi görüntüle
If Err.Number = 5 Then 'Chr$ sorunu yanlış tuştur
MsgBox ("Yanlış şifre")
Else 'diğer sorunlar için (büyük dosya gibi) şu hatayı ver
MsgBox "Dosya Açılamıyor", , Err.Description
End If
Resume CleanUp: 'CleanUp ile bitir
End Sub
Biraz inceleyin gerçekten kolay. En azından işe yarıyor...
Kolay bi şifreleme kodu...Normalde ACSII kodlarını artırıp yapılan şifreleme pek güvenilir değil. Mesela baba kelimesinden şifre çok kolay bir şekilde çözülür baba => cbcb(1 artırdığımızda) olacak çünkü. Diyelimki 500 artırdınız(zor olsun açması diye) birdaha o metni çözemezsiniz metini birdaha çözmeye çalıştığınızda saçma şeyler çıkar ortaya. O zaman aşağıdaki kodu bi inceleyin.
Private Sub Command1_Click()
kod = InputBox("Şifreyi girin", , 1)
If kod = "" Then Exit Sub 'Cancel seçilirse, yordamdan çık
charsInFile% = Len(Text1.Text) 'dize uzunluğunu bul
Open "c:\sifre.txt" For Output As #1 'dosyayı aç
For i% = 1 To charsInFile% 'dosyadaki her karakter için
letter$ = Mid(Text1.Text, i%, 1) 'sonraki karakteri oku
'w/ Asc sayısına dönüştür, sonra şifrelemek için Xor'u kullan
Print #1, Asc(letter$) Xor kod; 've dosyayı kaydet
Next i%
Close #1 'bittiğinde dosyayı kapat
End If
End Sub
Bunu deneyin şifre içinde 1000 deyin mesela ve kaydedilen dosyayı notepad ile açın, gerçekten anlaşılmaz.
Şimdi bunu çözelim;
Private Sub Command2_Click()
Wrap$ = Chr$(13) + Chr$(10) 'kayan karakter yarat
'şifreyi alip şifreli metni dönüştür
kod = InputBox("Şifreyi girin", , 1)
If kod = "" Then Exit Sub 'Cancel seçilirse, yordamdan çık
Open "c:\sifre.txt" For Input As #1 'dosyayı aç
On Error GoTo Problem: 'hata işleyici ayarla
decrypt$ = "" 'dizeyi deşifre için sıfırla
Do Until EOF(1) 'dosyanın sonuna kadar
Input #1, Number& 'şifreli sayıları oku
e$ = Chr$(Number& Xor kod) 'Xor ile dönüştür
decrypt$ = decrypt$ & e$ 've dize oluştur
Loop
Text1.Text = decrypt$ 'dönüştürülen dizeyi görüntüle
Text1.Enabled = True 'kaydırma çubuklarını etkinleştir
CleanUp: 'bittiğinde...
Close #1 'dosyayı kapat
End If
Exit Sub
Problem: 'sorun olduğunda, uygun iletiyi görüntüle
If Err.Number = 5 Then 'Chr$ sorunu yanlış tuştur
MsgBox ("Yanlış şifre")
Else 'diğer sorunlar için (büyük dosya gibi) şu hatayı ver
MsgBox "Dosya Açılamıyor", , Err.Description
End If
Resume CleanUp: 'CleanUp ile bitir
End Sub
Biraz inceleyin gerçekten kolay. En azından işe yarıyor...
