Kaskus

Tech

tamihAvatar border
TS
tamih
belajar enkripsi dan deskripsi
GAN mav ane mau nanya nih, ane baru belajar enkripsi menyembunyikan file kedalam file lain dan dipasword untuk file hasilnya. tpi ketika di deskripsi kenapa klo masukan pasword yang tidak sesuai dengan pasword yang dimasukan sebelumnya file itu tetap dideskripsi ya? kaya pasword itu tidak kesimpan didalam file itu sendiri.
mohon pencerahannya.
ini ane tampilkan codingan file enkripsinya dan codingan deskripsinya.dan modul fungsi enkripsinya.

Private Sub cmd_enkripsi_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

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


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


mohon bantuannya para master.
0
1.1K
8
GuestAvatar border
Komentar yang asik ya
Urutan
Terbaru
Terlama
GuestAvatar border
Komentar yang asik ya
Komunitas Pilihan