Digital Encrypt v1.0
Awal Ide pembuatannya sebenernya dari
gblackDi forum sebelah ->
Forum Malware pada Topik :
Masalah Pembuatan Virus / Trojan / etc..(All Programming)Forum MalwareDigital Encrypt dibuat dengan menggunakan
Algoritma RC4Algoritma RC4- Code: Select all
Public Function RC4(ByVal Lambang As String, ByVal Password As String) As String
On Error Resume Next
Dim RB(0 To 255) As Integer, X As Long, Y As Long, Z As Long, Karakter() As Byte, SusunanByte() As Byte, Penyimpanan As Byte
If Len(Password) = 0 Then
Exit Function
End If
If Len(Lambang) = 0 Then
Exit Function
End If
If Len(Password) > 256 Then
Karakter() = StrConv(Left$(Password, 256), vbFromUnicode)
Else
Karakter() = StrConv(Password, vbFromUnicode)
End If
For X = 0 To 255
RB(X) = X
Next X
X = 0
Y = 0
Z = 0
For X = 0 To 255
Y = (Y + RB(X) + Karakter(X Mod Len(Password))) Mod 256
Penyimpanan = RB(X)
RB(X) = RB(Y)
RB(Y) = Penyimpanan
Next X
X = 0
Y = 0
Z = 0
SusunanByte() = StrConv(Lambang, vbFromUnicode)
For X = 0 To Len(Lambang)
Y = (Y + 1) Mod 256
Z = (Z + RB(Y)) Mod 256
Penyimpanan = RB(Y)
RB(Y) = RB(Z)
RB(Z) = Penyimpanan
SusunanByte(X) = SusunanByte(X) Xor (RB((RB(Y) + RB(Z)) Mod 256))
Next X
RC4 = StrConv(SusunanByte, vbUnicode)
End Function
Download RC4Klik - Untuk Mendownload Kode
Cara Menggunakannya :1.)Klik tombol
Cari File jika ingin mengencrypt sebuah program
2.)Klik tombol
Lindungi Sekarang untuk menjalankan / mengencrypt program.
Uji coba saya lakukan pada
Windows Media Player 9Bisa kamu lihat pada gambar dibawah ini :


Jika tidak menyukai
Metode Encrypt RC4Kamu bisa menggantinya dengan
Metode Encrypt RSA 512 bit (64 byte)Pada source code / project ->
Digital Encrypt v1.0Awal – akhir kalimat kode encrypt
- Code: Select all
Public Function RC4(ByVal Lambang As String, ByVal Password As String) As String
…………
…………….
………………
End Function

Ganti / hapus dengan kode RSA / letakkan / copy - paste, di module baru..
Terserah kamu, pengkodeannya
Key..Metode Encrypt RSA 512 bit (64 byte)- Code: Select all
Option Explicit
Public Function MetodeEncryptRSA()
Dim KalimatSederhana As String
Dim A As Long
Dim B As Long
Dim nByte As Long
Dim C As Long
Dim sPublicKey As String
Dim sPrivateKey As String
Dim JumlahPublicKey As String
Dim JumlahPrivateKey As String
Dim JumlahPassword As String
Dim D() As Byte
Dim F() As Byte
Dim i As Integer
Dim J As Integer
Dim DigitalHasil() As Byte
Dim CatHasil As String
sPublicKey = App.Path & "\" & "PenyimpananPublicKey.bin"
sPrivateKey = App.Path & "\" & "PenyimpananPrivateKey.bin"
JumlahPassword = "password"
'Awal Encrypt
JumlahPublicKey = rsaReadPublicKey(sPublicKey)
If Len(JumlahPublicKey) = 0 Then
MsgBox "public key pada file tidak bisa dibaca" & sPublicKey, vbCritical
Exit Function
End If
B = RSA_KeyBytes(JumlahPublicKey)
If B <= 0 Then
MsgBox "Kesalahan pada panjang data di public key", vbCritical
Exit Function
End If
KalimatSederhana = "Ketikkan kalimat rahasia / tidak diketahui / etc.. kamu disini...!"
F = StrConv(KalimatSederhana, vbFromUnicode)
nByte = UBound(F) - LBound(F) + 1
ReDim D(B - 1)
D(0) = 0
D(1) = 2
C = B - 3 - nByte
If C < 8 Then
MsgBox "Data \ key_nya terlalu pendek"
Exit Function
End If
Randomize
J = 2
For i = 0 To C - 1
Do
D(J + i) = Int(Rnd() * 256) And &HFF
Loop While D(J + i) = 0
Next
J = J + C
D(J) = 0
J = J + 1
For i = 0 To nByte - 1
D(J + i) = F(i)
Next
A = RSA_RawPublic(D(0), B, JumlahPublicKey, 0)
'Akhir Encrypt
'Awal decrypt -> Digunakan jika ingin melakukan decrypt juga pada program
JumlahPrivateKey = RSAPrivateKey(sPrivateKey, JumlahPassword)
If Len(JumlahPrivateKey) = 0 Then
MsgBox "private key pada file tidak bisa dibaca " & sPrivateKey, vbCritical
Exit Function
End If
B = RSA_KeyBytes(JumlahPrivateKey)
If B <= 0 Then
MsgBox "Kesalahan pada panjang data di private key", vbCritical
Exit Function
End If
A = RSA_RawPrivate(D(0), B, JumlahPrivateKey, 0)
If A <> 0 Then
Exit Function
End If
Call WIPE_String(JumlahPrivateKey, Len(JumlahPrivateKey))
Call WIPE_String(JumlahPassword, Len(JumlahPassword))
If D(0) <> 0 Then
MsgBox "Decrypt tidak bisa dilakukan"
Exit Function
End If
If D(1) <> 2 Then
MsgBox "Decrypt tidak bisa dilakukan"
Exit Function
End If
For i = 1 To B - 1
If D(i) = 0 Then
Exit For
End If
Next
nByte = B - i - 1
ReDim DigitalHasil(nByte - 1)
For i = i + 1 To B - 1
DigitalHasil(i - B + nByte) = D(i)
Next
CatHasil = StrConv(DigitalHasil, vbUnicode)
'Akhir decrypt
End Function
Public Function PembuatKey()
Dim A As Long
Dim K As Long
Dim sPublicKey As String
Dim sPrivateKey As String
Dim JumlahPublicKey As String
Dim JumlahPrivateKey As String
Dim JumlahPassword As String
sPublicKey = "PenyimpananPublicKey.bin"
sPrivateKey = "PenyimpananPrivateKey.bin"
JumlahPassword = "password"
A = RSA_MakeKeys(sPublicKey, sPrivateKey, 512, PKI_RSAEXP_EQ_3, _
50, 1000, JumlahPassword, "", 0, PKI_DEFAULT)
K = RSA_ReadPublicKey(vbNullString, 0, sPublicKey, 0)
If K > 0 Then
JumlahPublicKey = String(K, " ")
A = RSA_ReadPublicKey(JumlahPublicKey, K, sPublicKey, 0)
Else
MsgBox "Public key tidak bisa dibaca. Terjadi Kesalahan=" & K & vbCrLf & pkiErrorLookup(K)
End If
K = RSA_ReadEncPrivateKey(vbNullString, 0, sPrivateKey, JumlahPassword, 0)
If K > 0 Then
JumlahPrivateKey = String(K, " ")
A = RSA_ReadEncPrivateKey(JumlahPrivateKey, K, sPrivateKey, JumlahPassword, 0)
Else
MsgBox "Private key tidak bisa dibaca. Terjadi Kesalahan=" & K & vbCrLf & pkiErrorLookup(K)
End If
End Function
Download Kode RSAKlik - Untuk Mendownload Kodesaya tambahkan di awal kode- Code: Select all
Option Explicit
hanya berfungsi jika kode RSA diletakkan di module baru..
kenapa ?
karena itu sudah ada di kode module
Digital Encryptitu jika kamu mau merubahnya
Metode RC4 dengan
Metode RSA.DownloadEXE
Petunjuk Download :http://digitalcatusa.blogspot.com/Source Code / Project http://www.xcode.or.id/forum2/viewtopic ... 08&t=35672NB :Jika tidak mengetahui bagaimana / gimana untuk menyambungkan / menyatukan
Kode RSA dengan Kode project..
Saya persilahkan kamu untuk belajar Kode Pemrograman Visual Basic..Terima Kasih….


