alexa-tracking
Selamat Guest, Agan dapat mencoba tampilan baru KASKUS Masih Kangen Tampilan Sebelumnya
Kategori
Kategori
Home / FORUM / All / Tech / ... / Programmer Forum /
belajar stegographer
1024
1024
KASKUS
51
244
https://www.kaskus.co.id/thread/53bd84fabfcb17356a8b46ac/belajar-stegographer

belajar stegographer

gan ane lagi belajar stegographer mohon bantuannya donk.
ini tampilan stegonya
belajar stegographer

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
belajar stegographer

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

Beri apresiasi terhadap thread ini Gan!


×
GDP Network
© 2018 KASKUS, PT Darta Media Indonesia. All rights reserved
Ikuti KASKUS di