'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) & Chr(13) & CurDir$ & Chr(10) & Chr(13) & "dizininde kaydedildi."), vbInformation, ("Resim Kodlayici")
Else
MsgBox ("Coded picture saved with name '" & tkodad.Text & "' to directory" & Chr(10) & Chr(13) & 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
pf2.BackColor = RGB(1, 1, 1)
End Sub
Private Sub dilsec()
Dim at As String
at = Chr(10) & Chr(13) & Chr(10) & Chr(13)
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(13) & Chr(10) & Chr(13)
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
