ini tampilan stegonya
ini codingan cmd_stegonya.
Private Sub cmd_stego_Click()
Dim data As String
Dim x As Long
Dim y As Long
Dim z As Long
Dim pjg As Long
Dim ext As String
Dim encpjg As String
encpjg = FileLen(txt_target.Text)
ext = Mid(StrReverse(txt_target.Text), 1, 4)
ext = StrReverse(ext)
pjg = FileLen(txt_asli.Text)
FileCopy txt_target.Text, txt_target.Text & "_STEGO" & ext
x = FileLen(txt_asli.Text) Mod 10000
y = FileLen(txt_asli.Text) - x
Open txt_asli.Text For Binary Access Read As #1
Open txt_target.Text & "_STEGO" & ext For Binary Access Write As #2
Put #2, FileLen(txt_target.Text) + 1, ""
If pjg >= 10000 Then
For z = 1 To y Step 10000
data = Space$(10000)
Get #1, z, data
Put #2, , encrypt(data, txt_kunci.Text)
Next
y = x
data = Space$(y)
Get #1, , data
Put #2, , encrypt(data, txt_kunci.Text)
Put #2, , "|" & encrypt(encpjg, txt_kunci.Text)
Else
data = Space$(pjg)
Get #1, 1, data
Put #2, , encrypt(data, txt_kunci.Text)
Put #2, , "|" & encrypt(encpjg, txt_kunci.Text)
End If
Close #2
Close #1
MsgBox "selesai!!" & vbCrLf & "file ter-stego di " & txt_target.Text & "_STEGO" & ext, vbOKOnly, "stego"
txt_asli.Text = ""
txt_target.Text = ""
txt_kunci.Text = ""
End If
End Sub
dan ini tampilan unstegonya
ni codingan unstegonya.
Private Sub cmd_unstego_Click()
On Error Resume Next
Dim unstego As String
Dim uncek As String
Dim pmbts As String
Dim pjg2 As Long
Dim z As Long
Dim a As Long
Dim b As Long
Dim c As Long
Dim d As Long
Dim e As Long
z = 0
uncek = Space$(1)
Open txt_file_stego.Text For Binary Access Read As #1
Open txt_file_stego.Text & "_UNSTEGO." & txt_extensi_file.Text For Binary Access Write As #2
Put #2, 1, ""
While uncek <> "|"
Get #1, FileLen(txt_file_stego.Text) - z, uncek
pmbts = uncek & pmbts
z = z + 1
Wend
b = Len(pmbts)
pmbts = Mid(pmbts, 2, Len(pmbts) - 1)
pmbts = encrypt(pmbts, txt_kunci.Text)
z = pmbts
a = FileLen(txt_file_stego.Text) - (b + z)
If a >= 10000 Then
c = a Mod 10000
d = (a - c) + z
For e = (z + 1) To d Step 10000
unstego = Space$(10000)
Get #1, e, unstego
Put #2, , encrypt(unstego, txt_kunci.Text)
Next
unstego = Space$(c)
Get #1, , unstego
Put #2, , encrypt(unstego, txt_kunci.Text)
Else
unstego = Space$(a)
Get #1, (z + 1), unstego
Put #2, , encrypt(unstego, txt_kunci.Text)
End If
Close #2
Close #1
MsgBox "selesai!!" & vbCrLf & "file ter-unstego", vbOKOnly, "unstego"
txt_file_stego.Text = ""
txt_extensi_file.Text = ""
txt_kunci.Text = ""
End Sub
ini codingan fungsinya
Function encrypt(data As String, kunci As String) As String
Dim i As Double
Dim x As Double
Dim gimmehash As Long
gimmehash = hash(kunci)
Dim enkripsi As String
For i = 1 To Len(data)
x = i Mod Len(kunci)
If x = 0 Then
x = 1
End If
enkripsi = enkripsi & Chr(((Asc(Mid(data, i, 1)) Xor Asc(Mid(kunci, x, 1)) Xor i) Xor gimmehash) Mod 256)
Next
encrypt = enkripsi
End Function
Function hash(keys As String) As Long
If keys = "" Then
MsgBox "Silahkan isi password nya dulu", vbCritical, "ERROORRR"
End
Else
Dim r As Long
Dim nilai As Long
For r = 1 To Len(keys)
nilai = nilai + Asc(Mid(keys, r, 1))
nilai = nilai Mod Len(keys)
hash = nilai
Next
End If
End Function
yang saya mau tanyakan kenapa kunci di file stego tidak tersimpan difile yang telah terstego, ketika di unstego masukan kunci asal"n tidak sesuai yang kita masukan file itu tetap terunstego. gmn ya biar file itu bisa menyimpan kunci agar ketika hasil file stegonya di unstego kita memasukan kunci yang sama dengan hasil file yang terstego. please help master" vb 6
