VİSUAL BASİCTE RESİM İÇİNE METİN ŞİFRELEME DEŞİFRELEME

'METiN SIFRELEME ve DESIFRELEMEDE
 'ikincil byte
 'imza icin 2 px, 4 px uzunluk
 'sifre icin 5 px, 1 px = 1-0

'RESMi SiFRELEME ve DESiFRELEME
 'birincil byte
 'RK + 0-1 + XXXX
 'bu islem resmin renk sayisini 4096'ya dusurur

'RESMi RESME SiFRELEME VE DESiFRELEME
 'birincil byte
 'RK + 0-1 + XXXX + GGG + YYY
 'bu islem resmin renk sayisini 4096'ya dusurur

'METNi RESME DONUSTUR ve RESMi METNE DONUSTUR
 'tum bytelar; tek pikselde uc karakter
 'RK + 0-1 + XXXX


Dim g1, y1 As Single
Dim re, re1 As String
Dim rr, rg, rb As Byte
Dim ara As String
Dim sonuc As Byte
Dim met As String
Dim toplam As Single
Dim dur As Boolean
Dim sure As Single
Public dil As Byte
Public rrs As Boolean 'resmiresmesifrele resmi ac icin

Dim rkgen, rkyuk As Single

Sub imzala( )
 Dim imze As String

End Sub

Sub belirle( )
 For m = 0 To 15
 For n = 0 To 15
 If ara = Hex(m ) & Hex(n ) Then
 sonuc = m * 16 + n
 Exit Sub
 End If
 Next
 Next
End Sub

Private Sub cmd_kay_Click( )
On Error GoTo hkay
If Trim(tkodad.Text ) = "" Then
 tkodad.Text = ""
 If dil = 0 Then
 MsgBox ("Bir kayit ismi verilmedi." ), vbExclamation, ("Resim Kodlayici" )
 Else
 MsgBox ("Please type a saving name." ), vbExclamation, ("Picture Coder" )
 End If
 tkodad.SetFocus
 Exit Sub
End If
SavePicture p.Image, tkodad.Text & ".bmp"
If dil = 0 Then
 MsgBox ("Kodlanan resim '" & tkodad.Text & "' ismi ile" & Chr(10 ) & & CurDir$ & Chr(10 ) & & "dizininde kaydedildi." ), vbInformation, ("Resim Kodlayici" )
Else
 MsgBox ("Coded picture saved with name '" & tkodad.Text & "' to directory" & Chr(10 ) & & CurDir$ ), vbInformation, ("Picture Coder" )
End If
Exit Sub
hkay:
If dil = 0 Then
MsgBox ("Hata olustu! Kaydetmek icin bir resim secilmemis olabilir." ), vbExclamation, ("Resim Kodlayici" )
Else
MsgBox ("Error! Maybe there is no coded picture to save." ), vbExclamation, ("Picture Coder" )
End If
End Sub

Sub metnidesifrele( )
 On Error GoTo hdesif

 yap.Enabled = False

 g1 = -1
 y1 = 0

 'imza kontrol
 met = ""
 For i = 1 To 2
 g1 = g1 + 1
 If g1 > p.ScaleWidth - 1 Then
 g1 = 0
 y1 = y1 + 1
 End If

 re = Hex(p.Point(g1, y1 ) )
 re = re & String(6 - Len(re ), "0" )

 ara = Mid(re, 4, 1 ) & Mid(re, 2, 1 )
 belirle

 met = met & Chr(sonuc )
 Next

 If met <> "RK" Then
 durdur_Click
 If dil = 0 Then
 MsgBox ("Bu resme bir metin kodlanmamis." ), vbExclamation, ("Resim Kodlayici" )
 Else
 MsgBox ("No text coded this picture." ), vbExclamation, ("Picture Coder" )
 End If
 Exit Sub
 End If

 'sifre kontrol
 met = ""
 For i = 1 To 5
 g1 = g1 + 1
 If g1 > p.ScaleWidth - 1 Then
 g1 = 0
 y1 = y1 + 1
 End If

 re = Hex(p.Point(g1, y1 ) )
 re = re & String(6 - Len(re ), "0" )

 ara = Mid(re, 4, 1 ) & Mid(re, 2, 1 )
 belirle

 met = met & Chr(sonuc )
 Next

 If Left(met, 1 ) = "1" Then
 Dim sif As String
 sif = InputBox("Desifreleme icin giris sifresini giriniz.", "Resim Kodlayici - Metin Desifreleme Sifresi" )
 If Len(sif ) = 0 Then
 durdur_Click
 Exit Sub
 End If
 If sif <> Right(met, 4 ) Then
 MsgBox ("Sifre yanlis." ), vbOKOnly, ("Resim Kodlayici" )
 durdur_Click
 Exit Sub
 End If
 End If

 sure = Timer

 'islem uzunlugu 4 px
 met = ""
 For i = 1 To 4
 g1 = g1 + 1
 If g1 > p.ScaleWidth - 1 Then
 g1 = 0
 y1 = y1 + 1
 End If

 re = Hex(p.Point(g1, y1 ) )
 re = re & String(6 - Len(re ), "0" )

 ara = Mid(re, 4, 1 ) & Mid(re, 2, 1 )
 belirle

 met = met & Chr(sonuc )
 Next

 toplam = 0
 For k = 1 To 4
 For r = 1 To 15
 If Mid(met, k, 1 ) = Hex(r ) Then
 toplam = toplam + (16 ^ (4 - k ) ) * r
 End If
 Next
 Next

 'metni bul
 met = ""
 For i = 1 To toplam
 g1 = g1 + 1
 If g1 > p.ScaleWidth - 1 Then
 g1 = 0
 y1 = y1 + 1
 End If

 re = Hex(p.Point(g1, y1 ) )
 re = re & String(6 - Len(re ), "0" )

 ara = Mid(re, 4, 1 ) & Mid(re, 2, 1 )
 belirle

 met = met & Chr(sonuc )

 DoEvents
 If dur = True Then
 durdur_Click
 Exit Sub
 End If

 ld.Caption = Str(toplam - i )
 Next

 'If Len(met ) > 1 Then met = Left(met, Len(met ) - 2 )
 td.Text = met

 sure = Int(Abs(Timer - sure ) * 100 ) / 100
 If dil = 0 Then
 ld.Caption = "Islem tamamlandi. Islem suresi: " & Trim(Str(sure ) ) & " saniye. Desifrelenen metnin karakter sayisi: " & Trim(Str(Len(td.Text ) ) )
 Else
 ld.Caption = "Process completed. Process time: " & Trim(Str(sure ) ) & " second. Character number of decoded text: " & Trim(Str(Len(td.Text ) ) )
 End If

 durdur_Click

 Exit Sub
hdesif:
 If dil = 0 Then
 MsgBox ("Hata !" ), vbCritical, ("Resim Kodlayici" )
 Else
 MsgBox ("Error !" ), vbCritical, ("Picture Coder" )
 End If
End Sub

Private Sub cmd_tst_Click( )
ts.Text = ""
ts.SetFocus
End Sub

Private Sub cmdf2g_Click( )
gos.Show
End Sub

Private Sub cmdf3g_Click( )
gos.Show
End Sub

Private Sub cmdf4_Click( )
gos.Show
End Sub

Private Sub cmdf4r_Click( )
rrs = True
ac.Show
End Sub

Private Sub cmdf5_Click( )
gos.Show
End Sub

Private Sub cmdf6t_Click( )
tf6.Text = ""
tf6.SetFocus
End Sub

Private Sub durdur_Click( )
dur = True
durdur.Visible = False
yap.Visible = True
r_ekle.Enabled = True
mnuIY.Enabled = True
mnuIsRA.Enabled = True
Beep
End Sub

Private Sub Form_Load( )
rkgen = Width
rkyuk = Height

Dim at As String
at = Chr(10 ) & & Chr(10 ) & 
fbasl.Caption = "Ali Eskici" & at & "2003" & at & "masterturk.org Linklerin Görülmesine İzin Vermiyor
Linki Görebilmek İçin Üye Ol veya Giriş Yap"
dilsec

pf2.BackColor = RGB(1, 1, 1 )
End Sub

Private Sub dilsec( )
 Dim at As String
 at = Chr(10 ) & & Chr(10 ) & 
 If dil = 0 Then
 Caption = "Resim Kodlayici"
 mnuI.Caption = "&Islem"
 mnuIY.Caption = "&Yeni"
 mnuIsRA.Caption = "&Resim ac"
 mnuIYap.Caption = "Y&ap"
 mnuIs(0 ).Caption = "Metni sifrele"
 mnuIs(1 ).Caption = "Metni desifrele"
 mnuIs(2 ).Caption = "Resmi sifrele"
 mnuIs(3 ).Caption = "Resmi desifrele"
 mnuIs(4 ).Caption = "Resmi resme sifrele"
 mnuIs(5 ).Caption = "Resimdeki resmi desifrele"
 mnuIs(6 ).Caption = "Metni resme donustur"
 mnuIs(7 ).Caption = "Resmi metne donustur"
 mnuRK.Caption = "R&esim Kodlayici"
 mnuRKY.Caption = "&Yardim"
 mnuRKH.Caption = "&Hakkinda"
 mnuRKK.Caption = "&Kapat"
 r_ekle.Caption = "&Resim sec"
 cmd_kay.Caption = "&Kodlanan resmi kaydet"
 cmd_tst.Caption = "&Temizle"
 yap.Caption = "I&sle"
 durdur.Caption = "&Durdur"
 tkodad.ToolTipText = "Kodlanan resmin kayit ismi"
 fdr.Caption = "Kodlanan resim"
 f(0 ).Caption = "Sifrelenen metin"
 lmsk0.Caption = "Kalan karakter sayisi:"
 f(1 ).Caption = "Desifrelenen metin"
 f(2 ).Caption = "Resim Sifreleme"
 f(3 ).Caption = "Resim Desifreleme"
 lisim.Caption = "Resim Kodlayici"
 chkp.Caption = "Si&fre kullan"
 rsl.Caption = "Sifrelenecek resme maskeyi secin."
 of21.Caption = "Tek renk"
 lf2k.Caption = "Kirmizi"
 lf2y.Caption = "Yesil"
 lf2m.Caption = "Mavi"
 of22.Caption = "Karisik renkli"
 cmdf2g.Caption = "Sifrelenen resmi goster"
 cmdf3g.Caption = "Desifrelenen resmi goster"
 f(5 ).Caption = "Resimdeki resmi desifrele"
 cmdf5.Caption = "Desifrelenen resmi goster"
 f(4 ).Caption = "Resmi resme sifrele"
 l1f4.Caption = "Bu islem sifrelenen resmi ve sifrelenen resmin bulundugu resmin renk sayisini 4096'ya dusurecektir."
 cmdf4r.Caption = "Resme sifrelenecek resmi ac"
 cmdf4.Caption = "Sonuc resmi goster"
 l2f4.Caption = "Sonuc resim kodlanan resimdir."
 f(6 ).Caption = "Metni resme donustur"
 cmdf6t.Caption = "Temizle"
 f(7 ).Caption = "Resmi metne donustur"

 gos.Caption = "Resim - Resim Kodlayici"
 gos.cmdt.Caption = "&Tamam"

 ac.Caption = "Resim Ac - Resim Kodlayici"
 ac.cmd_ac.Caption = "&Ac"
 ac.cmd_v.Caption = "&Vazgec"

 Else

 Caption = "Picture Coder"
 mnuI.Caption = "P&rocess type"
 mnuIY.Caption = "&New"
 mnuIsRA.Caption = "&Open picture"
 mnuIYap.Caption = "&Process"
 mnuIs(0 ).Caption = "&Encode text"
 mnuIs(1 ).Caption = "&Decode text"
 mnuIs(2 ).Caption = "Encode picture"
 mnuIs(3 ).Caption = "Decode picture"
 mnuIs(4 ).Caption = "Encode picture to picture"
 mnuIs(5 ).Caption = "Decode picture in picture"
 mnuIs(6 ).Caption = "Convert text to picture"
 mnuIs(7 ).Caption = "Convert picture to text"
 mnuRK.Caption = "P&icture Coder"
 mnuRKY.Caption = "&Help"
 mnuRKH.Caption = "&About"
 mnuRKK.Caption = "E&xit"
 r_ekle.Caption = "&Choose picture"
 cmd_kay.Caption = "&Save coded picture"
 cmd_tst.Caption = "C&lear"
 yap.Caption = "&Process"
 durdur.Caption = "S&top"
 tkodad.ToolTipText = "Saving name of coded picture"
 fdr.Caption = "Coding picture"
 f(0 ).Caption = "Ciphering text"
 lmsk0.Caption = "Left number of character:"
 f(1 ).Caption = "Deciphering text"
 f(2 ).Caption = "Picture Ciphering"
 f(3 ).Caption = "Picture Deciphering"
 lisim.Caption = "Picture Coder"
 chkp.Caption = "&Use password"
 rsl.Caption = "Choose the mask to ciphering picture."
 of21.Caption = "Monocolor"
 lf2k.Caption = "Red"
 lf2y.Caption = "Green"
 lf2m.Caption = "Blue"
 of22.Caption = "Mixed color"
 cmdf2g.Caption = "Show encoded pictur"
 cmdf3g.Caption = "Show decoded picture"
 f(5 ).Caption = "Decode picture in picture"
 cmdf5.Caption = "Show decoded picture"
 f(4 ).Caption = "Encode picture to picture"
 l1f4.Caption = "This process will decrease color of encoding picture and picture that a picture inside, to 4096."
 cmdf4r.Caption = "Open picture that will encode"
 cmdf4.Caption = "Show result picture"
 l2f4.Caption = "Result picture is coded picture."
 f(6 ).Caption = "Convert text to picture"
 cmdf6t.Caption = "Clear"
 f(7 ).Caption = "Convert picture to text"

 ac.Caption = "Open picture - Picture Coder"
 ac.cmd_ac.Caption = "&Open"
 ac.cmd_v.Caption = "&Cancel"

 gos.Caption = "Picture - Picture Coder"
 gos.cmdt.Caption = "&Ok"
 End If
End Sub

Private Sub Form_Resize( )
If WindowState = 1 Then Exit Sub
Width = rkgen
Height = rkyuk
End Sub

Private Sub hf2_Change(Index As Integer )
lf2r(Index ).Caption = Trim(Str(hf2(Index ).Value ) )
pf2.BackColor = RGB(hf2(0 ).Value * 16 + 15, hf2(1 ).Value * 16 + 15, hf2(2 ).Value * 16 + 15 )
End Sub

Private Sub mnuIs_Click(Index As Integer )
 For i = 0 To 7
 mnuIs(i ).Checked = False
 f(i ).Visible = False
 Next

 mnuIs(Index ).Checked = True
 f(Index ).Visible = True
 fbas.Visible = False
 rrs = False
 If mnuIs(6 ).Checked = True Or mnuIs(7 ).Checked = True Then yap.Enabled = True
End Sub

Private Sub mnuIsRA_Click( )
r_ekle_Click
End Sub

Private Sub mnuIY_Click( )
 p.Picture = LoadPicture( )
 ts.Text = ""
 td.Text = ""
 img.Picture = LoadPicture( )
 imgf4.Picture = LoadPicture( )
 ps.Picture = LoadPicture( )
 lad.Caption = ""
 yap.Enabled = False
 mnuIYap.Enabled = False
 tf6.Text = ""
 tf7.Text = ""
 If dil = 0 Then
 ld.Caption = "Sistem yeni isleme hazir."
 Else
 ld.Caption = "System is ready to new process."
 End If
End Sub

Private Sub mnuIYap_Click( )
yap_Click
End Sub

Private Sub mnuRKdil_Click(Index As Integer )
 mnuRKdil(0 ).Checked = False
 mnuRKdil(1 ).Checked = False
 mnuRKdil(Index ).Checked = True
 If mnuRKdil(0 ).Checked = True Then dil = 0 Else dil = 1
 dilsec
End Sub

Private Sub mnuRKH_Click( )
hak.Show
End Sub

Private Sub mnuRKK_Click( )
End
End Sub

Private Sub mnuRKY_Click( )
 Dim ac As String
 at = Chr(10 ) & & Chr(10 ) & 
 If dil = 0 Then
 MsgBox ("Program acildiginda yapilacak islem 'Islem' menusunden secilmeli." & at & "Kaydedilen resimler BMP formatindadir. Kayit isminde uzanti belirtilmemeli." & at & "BMP formatinda buyuk resimler diskte cok yer kaplayacagindan gerekenden buyuk resimlerin kodlanmamasi tavsiye edilir." & at & "Programin kodladigi resimler yine Resim Kodlayici tarafindan desifre edilebilir." & at & "Resim Kodlayici ile kaydedilen bir resim bir resim duzenleme araci ile kaydedilirse resmin icindeki sifreli bilgi kaybolur." ), vbInformation, ("Resim Kodlayici - Yardim" )
 Else
 MsgBox ("When programme is open process type must choose from 'Process type' menu." & at & "Saved pictures are in BMP format. Mustn't write format type to saving name." & at & "Advising don't choose big dimension picture because of in BMP formatted pictures are covering lot of places on disc." & at & "Coded pictures, can decode with this programme later." & at & "If a saved coded picture, after save with other picture programme, information in coded picture will lost." ), vbInformation, ("Picture Coder - Help" )
 End If
End Sub

Private Sub r_ekle_Click( )
ac.Show
ac.f.Refresh
End Sub

Sub metnisifrele( )
 Dim cev
 Dim pass, passk As String

 yap.Enabled = False

 'daha once kodlanmis mi
 g1 = -1
 y1 = 0
 met = ""

 For i = 1 To 2
 g1 = g1 + 1
 If g1 > p.ScaleWidth - 1 Then
 g1 = 0
 y1 = y1 + 1
 End If

 re = Hex(p.Point(0, 0 ) )
 re = re & String(6 - Len(re ), "0" )

 ara = Mid(re, 4, 1 ) & Mid(re, 2, 1 )
 belirle

 met = met & Chr(sonuc )
 Next

 If met = "RK" Then
 If dil = 0 Then
 cev = MsgBox("Bu resim daha once kodlanmis. Devam edilirse uzerine yazilacak. Devam etmek istiyor musunuz?", vbYesNo, "Resim Kodlayici" )
 Else
 cev = MsgBox("Before this picture has coded. If continue overwrite to it. Do you want to continue?", vbYesNo, "Picture Coder" )
 End If
 If cev = vbNo Then
 durdur_Click
 Exit Sub
 End If
 End If

 If chkp.Value = 1 Then
ms1:
 pass = InputBox("Metnin desifrelenmesinde sorulacak giris sifresini giriniz. Sifre 4 karakterli olmalidir. Semboller dahil tum karakterler gecerlidir.", "Giris Sifresi" )
 If pass = "" Then
 chkp.Value = 0
 MsgBox ("Giris sifresini kullanmamayi sectiniz. Resimden metin, sifre sorulmadan desifrelenecek." ), vbOKOnly, ("Resim Kodlayici" )
 pass = "00000"
 GoTo ms2
 End If
 If Len(pass ) <> 4 Then
 MsgBox ("Giris sifresi bosluk dahil 4 karakterli olmalidir." ), vbExclamation, ("Resim Kodlayici" )
 GoTo ms1
 End If
 passk = InputBox("Sifreyi tekrar girin.", "Resim Kodlayici - Giris Sifresi Onayi" )
 If pass <> passk Then
 MsgBox ("Giris sifresi onaylanamadi. Sifreyi tekrar girin." ), vbExclamation, ("Resim Kodlayici" )
 GoTo ms1
 End If
 pass = "1" & pass
 Else
 pass = "00000"
 End If

ms2:
 sure = Timer

 met = ts.Text

 'met = 2 + 5 + 4 + met
 met = "RK" & pass & String(4 - Len(Hex(Len(met ) ) ), "0" ) & Hex(Len(met ) ) & met

 'metin uzunlugunu kontrol et
 If Len(met ) > p.ScaleWidth * p.ScaleHeight Then
 If dil = 0 Then
 cev = MsgBox("Resim, metnin kodlanmasi icin kucuk. Tum metin kodlanamayacak. Devam edilsin mi?", vbYesNo, "Resim Kodlayici" )
 Else
 cev = MsgBox("Picture is little to coding to text. Can't code all the text. Will it continue?", vbYesNo, "Picture Coder" )
 End If
 If cev = vbYes Then
 met = Mid(met, 12, p.ScaleWidth * p.ScaleHeight - 11 )
 met = "RK" & pass & String(4 - Len(Hex(Len(met ) ) ), "0" ) & Hex(Len(met ) ) & met
 Else
 Exit Sub
 End If
 End If

 'metni sifrele
 g1 = -1
 y1 = 0

 For i = 1 To Len(met )
 g1 = g1 + 1
 If g1 > p.ScaleWidth - 1 Then
 g1 = 0
 y1 = y1 + 1
 End If

 re = Hex(p.Point(g1, y1 ) )
 re = re & String(6 - Len(re ), "0" )

 re1 = Hex(Asc(Mid(met, i, 1 ) ) )
 re1 = String(2 - Len(re1 ), "0" ) & re1

 ara = Left(re, 1 ) & Right(re1, 1 )
 belirle
 rb = sonuc

 ara = Mid(re, 3, 1 ) & Left(re1, 1 )
 belirle
 rg = sonuc

 ara = Mid(re, 5, 2 )
 belirle
 rr = sonuc

 p.PSet (g1, y1 ), RGB(rr, rg, rb )

 DoEvents
 If dur = True Then
 durdur_Click
 cmd_kay.Enabled = False
 Exit Sub
 End If

 ld.Caption = Str(Len(met ) - i )
 Next

 sure = Int(Abs(Timer - sure ) * 100 ) / 100
 'a l i e s k i c i . c o m
 If dil = 0 Then
 ld.Caption = "Islem tamamlandi. Islem suresi: " & Trim(Str(sure ) ) & " saniye. Sifrelenen metnin karakter sayisi: " & Trim(Str(Len(ts.Text ) ) )
 Else
 ld.Caption = "Process completed. Process time: " & Trim(Str(sure ) ) & " second. Character number of coded text: " & Trim(Str(Len(ts.Text ) ) )
 End If

 cmd_kay.Enabled = True
 durdur_Click
End Sub

Private Sub ts_Change( )
If dil = 0 Then
 lsmk.Caption = Trim(Str((p.ScaleWidth * p.ScaleHeight - Len(ts.Text ) - 11 ) ) )
Else
 lsmk.Caption = Trim(Str((p.ScaleWidth * p.ScaleHeight - Len(ts.Text ) - 11 ) ) )
End If
End Sub

Private Sub resmisifrele( )
 On Error GoTo rsh

 Dim cev
 Dim pass, passk As String

 'daha once kodlanmis mi

 g1 = -1
 y1 = 0
 met = ""

 For i = 1 To 2
 g1 = g1 + 1
 If g1 > p.ScaleWidth - 1 Then
 g1 = 0
 y1 = y1 + 1
 End If

 re = Hex(p.Point(0, 0 ) )
 'a l i e s k i c i . c o m
 re = re & String(6 - Len(re ), "0" )

 ara = Mid(re, 3, 1 ) & Mid(re, 1, 1 )
 belirle

 met = met & Chr(sonuc )
 Next

 If met = "RK" Then
 If dil = 0 Then
 cev = MsgBox("Bu resim daha once kodlanmis. Devam edilirse uzerine yazilacak. Devam etmek istiyor musunuz?", vbYesNo, "Resim Kodlayici" )
 Else
 cev = MsgBox("Before this picture has coded. If continue overwrite to it. Do you want to continue?", vbYesNo, "Picture Coder" )
 End If
 If cev = vbNo Then
 durdur_Click
 Exit Sub
 End If
 End If

 'imza ve sifre ekle

 met = ""
 If chkp.Value = 1 Then
rss1:
 If dil = 0 Then
 pass = InputBox("Sifreyi 4 karakterli olarak giriniz.", "Sifre Girisi - Resim Kodlayici" )
 Else
 pass = InputBox("Enter the password as 4 characters", "Password Entering - Picture Coder" )
 End If

 If Len(pass ) = 0 Then GoTo rss2
 If Len(pass ) <> 4 And Len(pass ) <> 0 Then GoTo rss1

 If dil = 0 Then
 passk = InputBox("Sifreyi onaylayin.", "Sifre Onayi - Resim Kodlayici" )
 Else
 passk = InputBox("Approval to the password.", "Password Approval" )
 End If

 If Len(pass ) = 0 Then GoTo rss2
 'a li e s k i c i .c o m
 If Len(pass ) <> 4 And Len(pass ) <> 0 Then GoTo rss1

 If pass <> passk Then GoTo rss1

 met = "RK" & "1" & pass
 Else
rss2:
 met = "RK" & "0" & "0000"
 End If

 gos.Hide

 If of21.Value = True Then
 For i = p.ScaleLeft To p.ScaleWidth - 1
 For j = p.ScaleTop To p.ScaleHeight - 1
 re = Hex(p.Point(i, j ) )
 'a li e s k i ci . c o m
 re = re & String(6 - Len(re ), "0" )

 ara = Hex(Val(lf2r(2 ).Caption ) ) & Mid(re, 1, 1 )
 belirle
 rb = sonuc

 ara = Hex(Val(lf2r(1 ).Caption ) ) & Mid(re, 3, 1 )
 belirle
 rg = sonuc

 ara = Hex(Val(lf2r(0 ).Caption ) ) & Mid(re, 5, 1 )
 belirle
 rr = sonuc

 p.PSet (i, j ), RGB(rr, rg, rb )
 Next
 DoEvents

 If dur = True Then
 durdur_Click
 cmd_kay.Enabled = False
 Exit Sub
 End If

 ld.Caption = Str(p.ScaleWidth - 1 - i )
 Next
 End If

 If of22.Value = True Then
 Randomize Timer

 For i = p.ScaleLeft To p.ScaleWidth - 1
 'a l i e s k i c i . c om
 For j = p.ScaleTop To p.ScaleHeight - 1
 re = Hex(p.Point(i, j ) )
 re = re & String(6 - Len(re ), "0" )

 ara = Hex(Fix(Rnd * 15 ) + 1 ) & Mid(re, 1, 1 )
 belirle
 rb = sonuc

 ara = Hex(Fix(Rnd * 15 ) + 1 ) & Mid(re, 3, 1 )
 belirle
 rg = sonuc

 ara = Hex(Fix(Rnd * 15 ) + 1 ) & Mid(re, 5, 1 )
 belirle
 rr = sonuc
 'a l i e sk i ci . c o m
 p.PSet (i, j ), RGB(rr, rg, rb )
 Next

DoEvents

If dur = True Then
durdur_Click
cmd_kay.Enabled = False
Exit Sub
End If

ld.Caption = Str(p.ScaleWidth - 1 - i )
Next
End If

'imzayi kodla

g1 = -1
y1 = 0

For i = 1 To Len(met )
g1 = g1 + 1
If g1 > p.ScaleWidth - 1 Then
g1 = 0
y1 = y1 + 1
End If

re = Hex(p.Point(g1, y1 ) )
re = re & String(6 - Len(re ), "0" )

re1 = Hex(Asc(Mid(met, i, 1 ) ) )
re1 = String(2 - Len(re1 ), "0" ) & re1

ara = Right(re1, 1 ) & Mid(re, 2, 1 )
belirle
rb = sonuc

ara = Left(re1, 1 ) & Mid(re, 4, 1 )
belirle
rg = sonuc

ara = Mid(re, 5, 2 )
belirle
rr = sonuc

p.PSet (g1, y1 ), RGB(rr, rg, rb )
Next

cmd_kay.Enabled = True
'a li e s k ic i. co m
durdur_Click

gos.p.Picture = p.Image
gos.Show

Exit Sub
rsh:
End Sub

Private Sub resmidesifrele( )
On Error GoTo rdh

'imzayi dekodla

met = ""
g1 = -1
y1 = 0

For i = 1 To 7
g1 = g1 + 1
If g1 > p.ScaleWidth - 1 Then
g1 = 0
y1 = y1 + 1
End If

re = Hex(p.Point(g1, y1 ) )
re = re & String(6 - Len(re ), "0" )

ara = Mid(re, 3, 1 ) & Mid(re, 1, 1 )
belirle
met = met & Chr(sonuc )
Next

If Mid(met, 1, 2 ) <> "RK" Then
If dil = 0 Then
MsgBox ("Bu resme bir resim kodlanmamis" ), vbInformation, ("Resim Kodlayici" )
Else
MsgBox ("No picture coded to this picture." ), vbInformation, ("Picture Coder" )
End If

durdur_Click
Exit Sub
End If

If Mid(met, 3, 1 ) = "1" Then
Dim pass As String
If dil = 0 Then
pass = InputBox("Sifreyi girin", "Sifre Girisi - Resim Kodlayici" )
Else
pass = InputBox("Enter the Password", "Password Entering - Picture Coder" )
End If

If pass <> Mid(met, 4, 4 ) Then
If dil = 0 Then
MsgBox ("Sifre yanlis." ), vbCritical, ("Resim Kodlayici" )
Else
MsgBox ("Password is wrong." ), vbCritical, ("Picture Coder" )
End If

durdur_Click
Exit Sub
End If
End If

gos.Hide

For i = p.ScaleLeft To p.ScaleWidth - 1
For j = p.ScaleTop To p.ScaleHeight - 1
re = Hex(p.Point(i, j ) )
re = re & String(6 - Len(re ), "0" )

ara = Mid(re, 2, 1 ) & "1"
belirle
rb = sonuc

ara = Mid(re, 4, 1 ) & "1"
belirle
rg = sonuc

ara = Mid(re, 6, 1 ) & "1"
belirle
rr = sonuc
'al i e s k i c i . c o m
p.PSet (i, j ), RGB(rr, rg, rb )
Next
DoEvents

If dur = True Then
durdur_Click
cmd_kay.Enabled = False
Exit Sub
End If

ld.Caption = Str(p.ScaleWidth - 1 - i )
Next

cmd_kay.Enabled = True
durdur_Click

gos.p.Picture = p.Image
gos.Show

Exit Sub
rdh:
End Sub

Sub resmiresmesifrele( )
On Error GoTo rrsh

Dim pass, passk As String
Dim cev

'daha once kodlanmis mi

g1 = -1
y1 = 0
met = ""

For i = 1 To 2
g1 = g1 + 1
If g1 > p.ScaleWidth - 1 Then
g1 = 0
y1 = y1 + 1
End If

re = Hex(p.Point(g1, y1 ) )
re = re & String(6 - Len(re ), "0" )

ara = Mid(re, 3, 1 ) & Mid(re, 1, 1 )
belirle

met = met & Chr(sonuc )
Next

If met = "RK" Then
If dil = 0 Then
cev = MsgBox("Bu resim daha once kodlanmis. Devam edilirse uzerine yazilacak. Devam etmek istiyor musunuz?", vbYesNo, "Resim Kodlayici" )
Else
cev = MsgBox("Before this picture has coded. If continue overwrite to it. Do you want to continue?", vbYesNo, "Picture Coder" )
End If
If cev = vbNo Then
durdur_Click
Exit Sub
End If
End If

'imza ve uzunluk

met = ""
If chkp.Value = 1 Then
rss1:
If dil = 0 Then
pass = InputBox("Sifreyi 4 karakterli olarak giriniz.", "Sifre Girisi - Resim Kodlayici" )
Else
pass = InputBox("Enter the password as 4 characters", "Password Entering - Picture Coder" )
End If

If Len(pass ) = 0 Then GoTo rss2
If Len(pass ) <> 4 And Len(pass ) <> 0 Then GoTo rss1

If dil = 0 Then
passk = InputBox("Sifreyi onaylayin.", "Sifre Onayi - Resim Kodlayici" )
Else
passk = InputBox("Approval to the password.", "Password Approval" )
End If

If Len(pass ) = 0 Then GoTo rss2
'a l i e s ki c i . c o m
If Len(pass ) <> 4 And Len(pass ) <> 0 Then GoTo rss1

If pass <> passk Then GoTo rss1

met = "RK" & "1" & pass & String(3 - Len(Hex(ps.ScaleWidth ) ), "0" ) & Hex(ps.ScaleWidth ) & String(3 - Len(Hex(ps.ScaleHeight ) ), "0" ) & Hex(ps.ScaleHeight )
Else
rss2:
met = "RK" & "0" & "0000" & String(3 - Len(Hex(ps.ScaleWidth ) ), "0" ) & Hex(ps.ScaleWidth ) & String(3 - Len(Hex(ps.ScaleHeight ) ), "0" ) & Hex(ps.ScaleHeight )
End If

'imzayi kodla

g1 = -1
y1 = 0

For i = 1 To Len(met )
g1 = g1 + 1
If g1 > p.ScaleWidth - 1 Then
g1 = 0
y1 = y1 + 1
End If

re = Hex(p.Point(g1, y1 ) )
re = re & String(6 - Len(re ), "0" )

re1 = Hex(Asc(Mid(met, i, 1 ) ) )
re1 = String(2 - Len(re1 ), "0" ) & re1

ara = Right(re1, 1 ) & Mid(re, 2, 1 )
belirle
rb = sonuc

ara = Left(re1, 1 ) & Mid(re, 4, 1 )
belirle
rg = sonuc

ara = Mid(re, 5, 2 )
belirle
rr = sonuc

p.PSet (g1, y1 ), RGB(rr, rg, rb )
Next

gos.Hide

'resmi resme kodla

g1 = -1
y1 = 0

For j = ps.ScaleTop To ps.ScaleHeight - 1
For i = ps.ScaleLeft To ps.ScaleWidth - 1
g1 = g1 + 1
If g1 > p.ScaleWidth - 1 Then
g1 = 0
y1 = y1 + 1
End If
' a l i es k i ci . c o m
re = Hex(p.Point(g1, y1 ) )
re = re & String(6 - Len(re ), "0" )

re1 = Hex(ps.Point(i, j ) )
re1 = re1 & String(6 - Len(re1 ), "0" )

ara = Mid(re, 1, 1 ) & Mid(re1, 1, 1 )
belirle
rb = sonuc

ara = Mid(re, 3, 1 ) & Mid(re1, 3, 1 )
belirle
rg = sonuc

ara = Mid(re, 5, 1 ) & Mid(re1, 5, 1 )
belirle
rr = sonuc

p.PSet (g1, y1 ), RGB(rr, rg, rb )
Next
DoEvents

If dur = True Then
durdur_Click
cmd_kay.Enabled = False
Exit Sub
End If

ld.Caption = Str(ps.ScaleWidth - 1 - i )
Next

cmd_kay.Enabled = True
durdur_Click

gos.p.Picture = p.Image
gos.Show

Exit Sub
rrsh:
End Sub

Sub resimdekiresmidesifrele( )
On Error GoTo rrdh

'imzayi dekodla

met = ""
g1 = -1
y1 = 0

For i = 1 To 13
g1 = g1 + 1
If g1 > p.ScaleWidth - 1 Then
g1 = 0
y1 = y1 + 1
End If

re = Hex(p.Point(g1, y1 ) )
re = re & String(6 - Len(re ), "0" )
' al i e s ki c i . c o m
ara = Mid(re, 3, 1 ) & Mid(re, 1, 1 )
belirle
met = met & Chr(sonuc )
Next

If Mid(met, 1, 2 ) <> "RK" Then
If dil = 0 Then
MsgBox ("Bu resme bir resim kodlanmamis" ), vbInformation, ("Resim Kodlayici" )
Else
MsgBox ("No picture coded to this picture." ), vbInformation, ("Picture Coder" )
End If

durdur_Click
Exit Sub
End If

If Mid(met, 3, 1 ) = "1" Then
Dim pass As String
If dil = 0 Then
pass = InputBox("Sifreyi girin", "Sifre Girisi - Resim Kodlayici" )
Else
pass = InputBox("Enter the Password", "Password Entering - Picture Coder" )
End If

If pass <> Mid(met, 4, 4 ) Then
If dil = 0 Then
MsgBox ("Sifre yanlis." ), vbCritical, ("Resim Kodlayici" )
Else
MsgBox ("Password is wrong." ), vbCritical, ("Picture Coder" )
End If

durdur_Click
Exit Sub
End If
End If

gos.Hide

'desifrele

'GGG 8-9-10
'YYY 11-12-13

Dim gen, yuk As Integer

'genislik-yukseklik bul

gen = 0
yuk = 0

For i = 1 To 3
For m = 0 To 15
If Mid(met, 7 + i, 1 ) = Hex(m ) Then gen = gen + m * (16 ^ (3 - i ) )
If Mid(met, 10 + i, 1 ) = Hex(m ) Then yuk = yuk + m * (16 ^ (3 - i ) )
Next
Next

ps.Width = gen
ps.Height = yuk

g1 = -1
y1 = 0

For j = 0 To yuk - 1
For i = 0 To gen - 1
g1 = g1 + 1
If g1 > p.ScaleWidth - 1 Then
g1 = 0 'a l i e s k i c i . c o m
y1 = y1 + 1
End If

re = Hex(p.Point(g1, y1 ) )
re = re & String(6 - Len(re ), "0" )

ara = Mid(re, 2, 1 ) & "1"
belirle
rb = sonuc

ara = Mid(re, 4, 1 ) & "1"
belirle
rg = sonuc

ara = Mid(re, 6, 1 ) & "1"
belirle
rr = sonuc

ps.PSet (i, j ), RGB(rr, rg, rb )
Next
DoEvents

If dur = True Then
durdur_Click
cmd_kay.Enabled = False
Exit Sub
End If

ld.Caption = Str(gen - i )
Next

cmd_kay.Enabled = True
durdur_Click

gos.p.Picture = ps.Image
p.Picture = ps.Image

gos.Show

Exit Sub
rrdh:
End Sub

Sub metniresmedonustur( )
On Error Resume Next

yap.Enabled = False

Dim pass, passk As String
Dim cev 'a l i es k ic i . c o m

'imza ve uzunluk

met = ""
If chkp.Value = 1 Then
mrd1:
If dil = 0 Then
pass = InputBox("Sifreyi 4 karakterli olarak giriniz.", "Sifre Girisi - Resim Kodlayici" )
Else
pass = InputBox("Enter the password as 4 characters", "Password Entering - Picture Coder" )
End If

If Len(pass ) = 0 Then GoTo mrd2
If Len(pass ) <> 4 And Len(pass ) <> 0 Then GoTo mrd1

If dil = 0 Then
passk = InputBox("Sifreyi onaylayin.", "Sifre Onayi - Resim Kodlayici" )
Else
passk = InputBox("Approval to the password.", "Password Approval" )
End If

If Len(pass ) = 0 Then GoTo mrd2
If Len(pass ) <> 4 And Len(pass ) <> 0 Then GoTo mrd1

If pass <> passk Then GoTo mrd1

met = "RK" & "1" & pass & tf6.Text
Else
mrd2:
met = "RK" & "0" & "0000" & tf6.Text
End If

'imzayi ve metni donustur

g1 = -1
y1 = 0

p.Width = Sqr(Len(met ) / 3 )
p.Height = Sqr(Len(met ) / 3 ) + 1
' a li es ki c i . c o m
For i = 1 To Len(met ) Step 3
g1 = g1 + 1
If g1 > p.ScaleWidth - 1 Then
g1 = 0
y1 = y1 + 1
End If

If i > Len(met ) Then Exit For
re1 = Hex(Asc(Mid(met, i, 1 ) ) )
re1 = String(2 - Len(re1 ), "0" ) & re1

ara = re1
belirle
rb = sonuc

If i + 1 > Len(met ) Then Exit For
' al ie sk ic i. co m
' a li es ki ci .c om
re1 = Hex(Asc(Mid(met, i + 1, 1 ) ) )
re1 = String(2 - Len(re1 ), "0" ) & re1

ara = re1
belirle
rg = sonuc

If i + 2 > Len(met ) Then Exit For
re1 = Hex(Asc(Mid(met, i + 2, 1 ) ) )
re1 = String(2 - Len(re1 ), "0" ) & re1

ara = re1
belirle
rr = sonuc

p.PSet (g1, y1 ), RGB(rr, rg, rb )
Next

cmd_kay.Enabled = True
durdur_Click

gos.p.Width = p.Width
gos.p.Height = p.Height

gos.p.Picture = p.Image
gos.Show

Exit Sub
mrdhata:
End Sub

Sub resmimetnedonustur( )
On Error GoTo rmdhata

yap.Enabled = False

'imzayi dekodla

met = ""
g1 = -1
y1 = 0

For i = 1 To 3
g1 = g1 + 1
If g1 > p.ScaleWidth - 1 Then
g1 = 0
y1 = y1 + 1
End If

re = Hex(p.Point(g1, y1 ) ) ' a l i es ki ci . c om

re = re & String(6 - Len(re ), "0" )

ara = Mid(re, 1, 2 )
belirle
met = met & Chr(sonuc )

ara = Mid(re, 3, 2 )
belirle
met = met & Chr(sonuc )

ara = Mid(re, 5, 2 )
belirle
met = met & Chr(sonuc )
Next

If Mid(met, 1, 2 ) <> "RK" Then
If dil = 0 Then
MsgBox ("Bu resme bir resim kodlanmamis" ), vbInformation, ("Resim Kodlayici" )
Else
MsgBox ("No picture coded to this picture." ), vbInformation, ("Picture Coder" )
End If

durdur_Click
Exit Sub
End If

If Mid(met, 3, 1 ) = "1" Then
Dim pass, passk As String
passk = ""

If dil = 0 Then
pass = InputBox("Sifreyi girin", "Sifre Girisi - Resim Kodlayici" )
Else
pass = InputBox("Enter the Password", "Password Entering - Picture Coder" )
End If

If pass <> Mid(met, 4, 4 ) Then
If dil = 0 Then
MsgBox ("Sifre yanlis." ), vbCritical, ("Resim Kodlayici" )
Else
MsgBox ("Password is wrong." ), vbCritical, ("Picture Coder" )
End If

durdur_Click
Exit Sub
End If
End If

met = ""

For j = 0 To p.ScaleHeight - 1
For i = 0 To p.ScaleWidth - 1
re = Hex(p.Point(i, j ) )
re = re & String(6 - Len(re ), "0" )

ara = Mid(re, 1, 2 )
belirle
met = met & Chr(sonuc )

ara = Mid(re, 3, 2 )
belirle
met = met & Chr(sonuc )

ara = Mid(re, 5, 2 )
belirle
met = met & Chr(sonuc )
Next
DoEvents

If dur = True Then
durdur_Click
cmd_kay.Enabled = False
Exit Sub
End If

ld.Caption = Str(p.ScaleWidth - 1 - i )
Next

cmd_kay.Enabled = True
durdur_Click

tf7.Text = Right(met, Len(met ) - 8 )

Exit Sub
rmdhata:
End Sub

Private Sub yap_Click( )
Dim flag As Boolean
flag = False
For i = 0 To 7
If mnuIs(i ).Checked = True Then flag = True
Next
If flag = False Then
If dil = 0 Then
MsgBox ("Yapilacak islemi 'Islem' menusunden seciniz." ), vbInformation, ("Resim Kodlayici" )
Else
MsgBox ("Choose process type from 'Process type' menu." ), vbInformation, ("Picture Coder" )
End If
Exit Sub
End If

dur = False
yap.Visible = False
durdur.Visible = True
cmd_kay.Enabled = False
r_ekle.Enabled = False
'ali es ki ci .c om
mnuIY.Enabled = False
mnuIsRA.Enabled = False
If mnuIs(0 ).Checked = True Then metnisifrele
If mnuIs(1 ).Checked = True Then metnidesifrele
If mnuIs(2 ).Checked = True Then resmisifrele
If mnuIs(3 ).Checked = True Then resmidesifrele
If mnuIs(4 ).Checked = True Then resmiresmesifrele
If mnuIs(5 ).Checked = True Then resimdekiresmidesifrele
If mnuIs(6 ).Checked = True Then metniresmedonustur
If mnuIs(7 ).Checked = True Then resmimetnedonustur
End Sub