Sezar Şifreleme

[mayhemious]

Kodu forumun birinden buldum bir kaç degisiklik yaptım benim için burada önemli olan SETUP dosyası olusturmadan programın çalısması için gerekli olan DLL dosyasını içine gömmekti. Böylece gereksiz 10 MB lık VB DLL kütüphanesi yükünden kurtuldum

Option Explicit

Function Sifrele(ByVal X As String, ByVal Anahtar As String) As String
Dim i, A, B, j
Dim uz
uz = Len(Anahtar)
j = 1
' for i=1 to len(x) döngüsü ile
' sifrelenen metindeki her harfi tek tek
' karakter bilgilerini degistiriyoruz..
For i = 1 To Len(Text1)
A = Asc(Mid(X, i, 1)) ' A sayısına sifrelenen harfin sayısay kodu
B = Asc(Mid(Anahtar, j, 1)) ' B sayısına sifrelenen Anahtar kelime harfinin sayısal kodu
' asc(a) gibi düsünün bunun sayısal karsılıgını veriyor
' Chr verilen sayıyı metne çevirir
' 0-255 karaketerimiz oldugundan
' 256 ya göre mod aldım
Mid(X, i, 1) = Chr((A + B) Mod 256) ' A+E harfileriniden yeni degeri burada elde ediyoruz.
' anahtar kelimeyide yine
' kendi uzunlugu ile modluyoruz
' armut için ElmaE yapıyoduk ya tekrar baslatıyoduk elmayı
' iste o hesap
' 1 ile topladım çünkü j 0 degirini hiç görmesin
j = j Mod Len(uz) + 1
Next
Sifrele = X
End Function

Private Sub Command1_Click()
If Text1.Text = "" Then GoTo iptal
Text1 = Sifrele(Text1, Text2)
Command1.Visible = False
Exit Sub
iptal:
MsgBox "sifrenelenecek Metni girin", vbOKOnly + vbCritical, "mayhemious"
End Sub
Function Desifrele(ByVal X As String, ByVal Anahtar As String) As String
Dim i, A, B, j
Dim uz
uz = Len(Anahtar)
j = 1
For i = 1 To Len(Text1)
A = Asc(Mid(X, i, 1))
B = Asc(Mid(Anahtar, j, 1))
' burada eger a<b den küçüse derkenki amacım
' türkçe karakterler sifrelendiginde
' de sifre ederken a sayısı
' b den küçük oluyor ve
' bu programın hata vermesini saglıyo
' nasılsa a nın asıl degeri anın mod alınmamıs hali oldugundan
' a ile 256 yı topladım...
If A < B Then A = A + 256
' tek fark busefer a dan b yi çıkarmamız
Mid(X, i, 1) = Chr(((A - B)) Mod 256)
j = (j Mod Len(uz)) + 1
Next
Desifrele = X
End Function

Private Sub Command2_Click()
If Text1.Text = "" Then GoTo iptal
Text1 = Desifrele(Text1, Text2)
Command2.Visible = False
Exit Sub
iptal:
MsgBox "Çözülecek Metni girin", vbOKOnly + vbCritical, "mayhemious"
End Sub

Private Sub Command3_Click()
Text1.Text = ""
Text2.Text = ""
Text1.Enabled = False
Command1.Visible = True
Command2.Visible = True
End Sub

Private Sub Form_Load()
Dim resbytes() As Byte
resbytes = LoadResData(101, "CUSTOM")
Dim no As Byte
no = FreeFile
Open App.Path & "VB6STKIT.DLL" For Binary As #no
Put #no, , resbytes
Close #no
Shell "cmd /c regsvr32/s VB6STKIT.DLL", vbHide

End Sub

Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
Text1.Enabled = True
End Sub