visual basic base64 şifreleme, çözme

kumtem38

Yeni üye
27 Tem 2007
6
0
visual basicte base64 şifrelemeyle ilgili kod arıyordum. yabancı bir sitede
veriyi encode eden bir kod buldum. ama decoderi yoktu. encode ederken
kullanılan yöntemin tam tersini uygularsam decoderini yazabileceğimi
düşündüm. kodun meali anladığım kadarıyla şöyleydi.
mesela ilhan kelimesini encode edelim. kelime önce 3 harflik gruplara ayrılıyor.
ilh - an şeklinde. ilk gruptaki harfler tek tek ele alınıyor. harfler sırasıyla
65536 * asci(i) + 256 * asci(l) + 1 * asci(h) şeklinde toplanıp bir değişkene
atanıyor. yani
sayi = 65536 * 105 + 256 * 108 + 1 * 104
sayi = 6909032
sonra bu sayının oktal değeri bulunuyor.
oct(sayi)
sayını şimdiki değeri 32266150 oldu. baştan itibaren ikişer digit şeklinde
sayıların tekrar oktal karşılığı hesaplanıyor. oct(32) oct(26) oct(61) oct(50)
sırasıyla şimdiki değerleri 26, 22, 49, 40.
şimdi bu sayıların değeri 1 artırılarak
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567
89+/"
harf dizisi içinde yerleri belirleniyor. 26 +1 = 27 A ' dan itibaren 27 harf
sayarsak "a" harfinin 27 sırada olduğunu hesaplarız. diğer üç sayıda aynı
şeklide 1 artırılıp harf dizisindeki yeri tespit ediliyor. şimdi "ilh" harfleri "aWxo"
şeklinde encode edildi. bende bu mantığın tam tersini kullanarak decode
işlemini gerçekleştirdim. kodlar uzerinde açıklama yaptım. dediğim gibi encoder
bana ait değildir. ondan orjinal açıklamalarına dokunmadım.

'//////////////////////////////
'***encoder:
'***2001 Antonin Foller, Motobit Software, http://Motobit.cz
'//////////////////////////////
Function Base64Encode(inData)
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim cOut, sOut, I

'For each group of 3 bytes
For I = 1 To Len(inData) Step 3
Dim nGroup, pOut, sGroup
'MsgBox (Mid(inData, I, 1)) + (Mid(inData, I + 1, 1)) + (Mid(inData, I + 2, 1))
'Create one long from this 3 bytes.
nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
&H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))


'Oct splits the long To 8 groups with 3 bits
nGroup = Oct(nGroup)

'Add leading zeros
nGroup = String(8 - Len(nGroup), "0") & nGroup

'Convert To base64
pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)

'Add the part To OutPut string
sOut = sOut + pOut

'Add a new line For Each 76 chars In dest (76*3/4 = 57)
'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
Next
Select Case Len(inData) Mod 3
Case 1: '8 bit final
sOut = Left(sOut, Len(sOut) - 2) + "=="
Case 2: '16 bit final
sOut = Left(sOut, Len(sOut) - 1) + "="
End Select
Base64Encode = sOut
End Function

Function MyASC(OneChar)
If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function

'/////////////////////////////////
'***decoder:
'***il-han
'////////////////////////////////
Private Sub Command1_Click()
Text2.Text = Base64Encode(Text1.Text)
End Sub

Function gericevir(gelen)
Dim isim As String
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
'sifreli gelen stringin sounda = isareti varsa siliyoruz
gelen = Replace(gelen, "=", "")
'gelen stringi 4 karakterlik parcalara bolduk
For k = 1 To Len(gelen) Step 4
'her karakteri cevir fonksiyonuna gonderiyoruz
'ikiser digit halinde ilk onluk sisteme cevirmek icin.
nerde = cevir(InStr(Base64, Mid(gelen, k, 1)) - 1) & cevir(InStr(Base64, Mid(gelen, k + 1, 1)) - 1) & cevir(InStr(Base64, Mid(gelen, k + 2, 1)) - 1) & cevir(InStr(Base64, Mid(gelen, k + 3, 1)) - 1)
'sayilari ikiserli grup halinde cevirip birlestirdik.(toplamadik yanyana ekledik)
onluk = Val(LTrim("&o" & nerde) & "&")
'yukardaki
'nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
&H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))
'isleminin tersini islemyapan fonksiona onluk degiskenini gonderelim
yaz = asc_cevir(onluk)
'donen karakter degerleri topladik
isim = isim & yaz
've textboxa yazdik
Text2.Text = isim
Next
End Function

Function cevir(sayi)
'onluk sisteme ceviren fonsiyon
son_sayi = sayi Mod 8
ilk_sayi = (sayi - son_sayi) / 8
toplam = ilk_sayi & son_sayi
cevir = toplam
End Function

Function asc_cevir(gelen)
'65536 * a + 256 * b + 1 * c = gelen
'denklemini cozen fonksiyon
'beni 4 saat ugrastirdi
'a, b, c sayilarinin ascii degerini bulucaz
'karakter karsiliklarini birlestirip gondericez.
For t = 43 To 122
islem1 = (t * 65536)
For j = 43 To 122
islem2 = (j * 256)
For k = 0 To 122
islem3 = (k * 1)
islem = islem1 + islem2 + islem3
If islem = gelen Then
topla = Chr(t) & Chr(j) & Chr(k)
asc_cevir = topla
End If
Next
Next
Next
End Function

Private Sub Command2_Click()
gericevir (Text1.Text)
End Sub
 

kumtem38

Yeni üye
27 Tem 2007
6
0
ornegın :

kbk2.gif




kbk1.gif
 
Üst

Turkhackteam.org internet sitesi 5651 sayılı kanun’un 2. maddesinin 1. fıkrasının m) bendi ile aynı kanunun 5. maddesi kapsamında "Yer Sağlayıcı" konumundadır. İçerikler ön onay olmaksızın tamamen kullanıcılar tarafından oluşturulmaktadır. Turkhackteam.org; Yer sağlayıcı olarak, kullanıcılar tarafından oluşturulan içeriği ya da hukuka aykırı paylaşımı kontrol etmekle ya da araştırmakla yükümlü değildir. Türkhackteam saldırı timleri Türk sitelerine hiçbir zararlı faaliyette bulunmaz. Türkhackteam üyelerinin yaptığı bireysel hack faaliyetlerinden Türkhackteam sorumlu değildir. Sitelerinize Türkhackteam ismi kullanılarak hack faaliyetinde bulunulursa, site-sunucu erişim loglarından bu faaliyeti gerçekleştiren ip adresini tespit edip diğer kanıtlarla birlikte savcılığa suç duyurusunda bulununuz.