Module Module1
'Tipe Output
Public bBiner As Boolean
'Var X1 - X4 setiap ronde
Public X1(10) As String
Public X2(10) As String
Public X3(10) As String
Public X4(10) As String
'Variabel Array Kunci Enkripsi
Public KEnkripsi() As String
'Variabel Array Kunci Dekripsi
Public KDekripsi() As String
'Var Proses
Public cProses As String
Public strKunci As String
Public strPlain As String
Public strCipher As String
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'Proses pembentukan kunci
Public Sub GetIDEAKey(ByVal pstrKey As String, ByVal pArrKeyEncrypt() As String, ByVal pArrKeyDecrypt() As String)
Dim strKunci As String
Dim K(9, 6) As String
Dim KD(9, 6) As String
Dim nRound As Integer
Dim nKey As Integer
Dim i As Integer
Dim j As Integer
'Panjang kunci harus 16 karakter
If Len(pstrKey) <> 16 Then
MsgBox("Panjang kunci harus 16 karakter !", vbCritical)
Exit Sub
End If
'Biner kunci - 128 bit
strKunci = ""
For i = 1 To Len(pstrKey)
strKunci = strKunci & FDec2Biner(Asc(Mid(pstrKey, i, 1)), 8)
Next i
'---- Pembentukan Key Enkripsi ----
nRound = 1 : nKey = 0
For i = 1 To 7
'Kelompokkan ke 8 buah subkey (pjg 16 bit)
For j = 1 To 128 Step 16
'Tambah nKey
nKey = nKey + 1
If nKey = 7 Then
'Tambah Round
nRound = nRound + 1
'Reset nilai nKey
nKey = 1
End If
If Val(Format(nRound) & Format(nKey)) < 95 Then
'Kunci per round
K(nRound, nKey) = Mid(strKunci, j, 16)
End If
Next j
'Untuk putaran terakhir tidak usah rotasi kiri
If i <> 7 Then
strKunci = FRotateLeftShift(strKunci, 25)
End If
Next i
'---- Pembentukan Key Dekripsi ----
For i = 1 To 9
For j = 1 To 6
If (i = 1) Or (i = 9) Then
'Putaran awal & terakhir
If (j = 1) Or (j = 4) Then
KD(i, j) = FDec2Biner(Inverse(FBiner2Dec(K(10 - i, j))), 16)
ElseIf (j = 2) Or (j = 3) Then
KD(i, j) = FMinus(K(10 - i, j))
Else
'Putaran terakhir -> tidak ada key 5 & 6
If i < 9 Then
KD(i, j) = K(10 - i - 1, j)
End If
End If
Else
'Putaran selanjutnya
If (j = 1) Or (j = 4) Then
KD(i, j) = FDec2Biner(Inverse(FBiner2Dec(K(10 - i, j))), 16)
ElseIf (j = 2) Or (j = 3) Then
KD(i, j) = FMinus(K(10 - i, IIf(j = 2, 3, 2)))
Else
KD(i, j) = K(10 - i - 1, j)
End If
End If
Next j
Next i
'Array kunci berdimensi 9, 6
ReDim pArrKeyEncrypt(9, 6) <<Error 'ReDim' cannot change the number of dimensions of an array.
ReDim pArrKeyDecrypt(9, 6) <<Error 'ReDim' cannot change the number of dimensions of an array.
'Hasil pembentukan kunci
pArrKeyEncrypt = K
pArrKeyDecrypt = KD
End Sub
'Proses enkripsi - IDEA
Public Function IDEAEncryption(ByVal pstrEncryptText As String, ByVal K() As String) As String
Dim strBinerText As String
Dim X(4) As String
Dim Hasil(14) As String
Dim nTmp1 As Double
Dim cTmp1 As String
Dim strHasil As String
Dim i As Integer
Dim j As Integer
'Panjang text harus 8 karakter
If Len(pstrEncryptText) <> 8 Then
MsgBox("Panjang text harus 8 karakter !", vbCritical)
Exit Function
End If
'Biner text - 64 bit
strBinerText = ""
For i = 1 To Len(pstrEncryptText)
strBinerText = strBinerText & FDec2Biner(Asc(Mid(pstrEncryptText, i, 1)), 8)
Next i
'Kelompokkan ke 4 sub blok X
j = 0
For i = 1 To 64 Step 16
j = j + 1
X(j) = Mid(strBinerText, i, 16)
Next i
'Lakukan sebanyak 8 putaran
For i = 1 To 8
'Simpan hasil X
X1(i) = X(1)
X2(i) = X(2)
X3(i) = X(3)
X4(i) = X(4)
'Algo-1 -> Hasil = (X1 * K1) mod ((2^16) + 1)
nTmp1 = FBiner2Dec(X(1)) * FBiner2Dec(K(i, 1))
Hasil(1) = FDec2Biner(FMod(nTmp1, (2 ^ 16) + 1), 16)
'Algo-2 -> Hasil = (X2 + K2) mod 2^16
nTmp1 = FBiner2Dec(X(2)) + FBiner2Dec(K(i, 2))
Hasil(2) = FDec2Biner(FMod(nTmp1, 2 ^ 16), 16)
'Algo-3 -> Hasil = (X3 + K3) mod 2^16
nTmp1 = FBiner2Dec(X(3)) + FBiner2Dec(K(i, 3))
Hasil(3) = FDec2Biner(FMod(nTmp1, 2 ^ 16), 16)
'Algo-4 -> Hasil = (X4 * K4) mod ((2^16) + 1)
nTmp1 = FBiner2Dec(X(4)) * FBiner2Dec(K(i, 4))
Hasil(4) = FDec2Biner(FMod(nTmp1, (2 ^ 16) + 1), 16)
'Algo-5 -> Hasil = Hasil(1) XOR Hasil(3)
Hasil(5) = FXORBiner(Hasil(1), Hasil(3), 16)
'Algo-6 -> Hasil = Hasil(2) XOR Hasil(4)
Hasil(6) = FXORBiner(Hasil(2), Hasil(4), 16)
'Algo-7 -> Hasil = (Hasil(5) * K5) mod ((2^16) + 1)
nTmp1 = FBiner2Dec(Hasil(5)) * FBiner2Dec(K(i, 5))
Hasil(7) = FDec2Biner(FMod(nTmp1, (2 ^ 16) + 1), 16)
'Algo-8 -> Hasil = (Hasil(6) + Hasil(7)) mod 2^16
nTmp1 = FBiner2Dec(Hasil(6)) + FBiner2Dec(Hasil(7))
Hasil(8) = FDec2Biner(FMod(nTmp1, 2 ^ 16), 16)
'Algo-9 -> Hasil = (Hasil(8) * K6) mod ((2^16) + 1)
nTmp1 = FBiner2Dec(Hasil(8)) * FBiner2Dec(K(i, 6))
Hasil(9) = FDec2Biner(FMod(nTmp1, (2 ^ 16) + 1), 16)
'Algo-10 -> Hasil = (Hasil(7) * Hasil(9)) mod (2^16)
nTmp1 = FBiner2Dec(Hasil(7)) + FBiner2Dec(Hasil(9))
Hasil(10) = FDec2Biner(FMod(nTmp1, 2 ^ 16), 16)
'Algo-11 -> Hasil = Hasil(1) XOR Hasil(9)
Hasil(11) = FXORBiner(Hasil(1), Hasil(9), 16)
'Algo-12 -> Hasil = Hasil(3) XOR Hasil(9)
Hasil(12) = FXORBiner(Hasil(3), Hasil(9), 16)
'Algo-13 -> Hasil = Hasil(2) XOR Hasil(10)
Hasil(13) = FXORBiner(Hasil(2), Hasil(10), 16)
'Algo-14 -> Hasil = Hasil(4) XOR Hasil(10)
Hasil(14) = FXORBiner(Hasil(4), Hasil(10), 16)
'Hasil
X(1) = Hasil(11)
If i < 8 Then
'Swap
X(2) = Hasil(12)
X(3) = Hasil(13)
Else
'No Swap
X(2) = Hasil(13)
X(3) = Hasil(12)
End If
X(4) = Hasil(14)
Next i
'Simpan hasil X
X1(9) = Hasil(11)
X2(9) = Hasil(13)
X3(9) = Hasil(12)
X4(9) = Hasil(14)
'---- TRANSFORMASI OUTPUT ----
'Algo-1 -> Hasil = (X1 * K1) mod ((2^16) + 1)
nTmp1 = FBiner2Dec(X(1)) * FBiner2Dec(K(9, 1))
Hasil(1) = FDec2Biner(FMod(nTmp1, (2 ^ 16) + 1), 16)
'Algo-2 -> Hasil = (X2 + K2) mod 2^16
nTmp1 = FBiner2Dec(X(2)) + FBiner2Dec(K(9, 2))
Hasil(2) = FDec2Biner(FMod(nTmp1, 2 ^ 16), 16)
'Algo-3 -> Hasil = (X3 + K3) mod 2^16
nTmp1 = FBiner2Dec(X(3)) + FBiner2Dec(K(9, 3))
Hasil(3) = FDec2Biner(FMod(nTmp1, 2 ^ 16), 16)
'Algo-4 -> Hasil = (X4 * K4) mod ((2^16) + 1)
nTmp1 = FBiner2Dec(X(4)) * FBiner2Dec(K(9, 4))
Hasil(4) = FDec2Biner(FMod(nTmp1, (2 ^ 16) + 1), 16)
'Simpan hasil X
X1(10) = Hasil(1)
X2(10) = Hasil(2)
X3(10) = Hasil(3)
X4(10) = Hasil(4)
'---- KONVERSI KE ASCII ----
strHasil = ""
cTmp1 = Hasil(1) & Hasil(2) & Hasil(3) & Hasil(4)
For i = 1 To 64 Step 8
strHasil = strHasil & Chr(FBiner2Dec(Mid(cTmp1, i, 8)))
Next i
'Hasil enkripsi
IDEAEncryption = strHasil
End Function
'Proses dekripsi - IDEA
Public Function IDEADecryption(ByVal pstrDecryptText As String, ByVal K() As String) As String
Dim strBinerText As String
Dim KD(9, 6) As String
Dim X(4) As String
Dim Hasil(14) As String
Dim nTmp1 As Double
Dim cTmp1 As String
Dim strHasil As String
Dim i As Integer
Dim j As Integer
'Panjang text harus 8 karakter
If Len(pstrDecryptText) <> 8 Then
MsgBox("Panjang text harus 8 karakter !", vbCritical)
Exit Function
End If
'Biner text - 64 bit
strBinerText = ""
For i = 1 To Len(pstrDecryptText)
strBinerText = strBinerText & FDec2Biner(Asc(Mid(pstrDecryptText, i, 1)), 8)
Next i
'Kelompokkan ke 4 sub blok X
j = 0
For i = 1 To 64 Step 16
j = j + 1
X(j) = Mid(strBinerText, i, 16)
Next i
'Lakukan sebanyak 8 putaran
For i = 1 To 8
'Simpan hasil X
X1(i) = X(1)
X2(i) = X(2)
X3(i) = X(3)
X4(i) = X(4)
'---- K1 & K4 --- dipangkat -1 (* ganti jadi /)
'Algo-1 -> Hasil = (X1 * K1) mod ((2^16) + 1)
nTmp1 = FBiner2Dec(X(1)) * FBiner2Dec(K(i, 1))
Hasil(1) = FDec2Biner(FMod(nTmp1, (2 ^ 16) + 1), 16)
'Algo-2 -> Hasil = (X2 + K2) mod 2^16
nTmp1 = FBiner2Dec(X(2)) + FBiner2Dec(K(i, 2))
Hasil(2) = FDec2Biner(FMod(nTmp1, 2 ^ 16), 16)
'Algo-3 -> Hasil = (X3 + K3) mod 2^16
nTmp1 = FBiner2Dec(X(3)) + FBiner2Dec(K(i, 3))
Hasil(3) = FDec2Biner(FMod(nTmp1, 2 ^ 16), 16)
'Algo-4 -> Hasil = (X4 * K4) mod ((2^16) + 1)
nTmp1 = FBiner2Dec(X(4)) * FBiner2Dec(K(i, 4))
Hasil(4) = FDec2Biner(FMod(nTmp1, (2 ^ 16) + 1), 16)
'Algo-5 -> Hasil = Hasil(1) XOR Hasil(3)
Hasil(5) = FXORBiner(Hasil(1), Hasil(3), 16)
'Algo-6 -> Hasil = Hasil(2) XOR Hasil(4)
Hasil(6) = FXORBiner(Hasil(2), Hasil(4), 16)
'Algo-7 -> Hasil = (Hasil(5) * K5) mod ((2^16) + 1)
nTmp1 = FBiner2Dec(Hasil(5)) * FBiner2Dec(K(i, 5))
Hasil(7) = FDec2Biner(FMod(nTmp1, (2 ^ 16) + 1), 16)
'Algo-8 -> Hasil = (Hasil(6) + Hasil(7)) mod 2^16
nTmp1 = FBiner2Dec(Hasil(6)) + FBiner2Dec(Hasil(7))
Hasil(8) = FDec2Biner(FMod(nTmp1, 2 ^ 16), 16)
'Algo-9 -> Hasil = (Hasil(8) * K6) mod ((2^16) + 1)
nTmp1 = FBiner2Dec(Hasil(8)) * FBiner2Dec(K(i, 6))
Hasil(9) = FDec2Biner(FMod(nTmp1, (2 ^ 16) + 1), 16)
'Algo-10 -> Hasil = (Hasil(7) * Hasil(9)) mod (2^16)
nTmp1 = FBiner2Dec(Hasil(7)) + FBiner2Dec(Hasil(9))
Hasil(10) = FDec2Biner(FMod(nTmp1, 2 ^ 16), 16)
'Algo-11 -> Hasil = Hasil(1) XOR Hasil(9)
Hasil(11) = FXORBiner(Hasil(1), Hasil(9), 16)
'Algo-12 -> Hasil = Hasil(3) XOR Hasil(9)
Hasil(12) = FXORBiner(Hasil(3), Hasil(9), 16)
'Algo-13 -> Hasil = Hasil(2) XOR Hasil(10)
Hasil(13) = FXORBiner(Hasil(2), Hasil(10), 16)
'Algo-14 -> Hasil = Hasil(4) XOR Hasil(10)
Hasil(14) = FXORBiner(Hasil(4), Hasil(10), 16)
'Hasil
X(1) = Hasil(11)
If i < 8 Then
'Swap
X(2) = Hasil(12)
X(3) = Hasil(13)
Else
'No Swap
X(2) = Hasil(13)
X(3) = Hasil(12)
End If
X(4) = Hasil(14)
Next i
'Simpan hasil X
X1(9) = Hasil(11)
X2(9) = Hasil(13)
X3(9) = Hasil(12)
X4(9) = Hasil(14)
'---- TRANSFORMASI OUTPUT ----
'Algo-1 -> Hasil = (X1 * K1) mod ((2^16) + 1)
nTmp1 = FBiner2Dec(X(1)) * FBiner2Dec(K(9, 1))
Hasil(1) = FDec2Biner(FMod(nTmp1, (2 ^ 16) + 1), 16)
'Algo-2 -> Hasil = (X2 + K2) mod 2^16
nTmp1 = FBiner2Dec(X(2)) + FBiner2Dec(K(9, 2))
Hasil(2) = FDec2Biner(FMod(nTmp1, 2 ^ 16), 16)
'Algo-3 -> Hasil = (X3 + K3) mod 2^16
nTmp1 = FBiner2Dec(X(3)) + FBiner2Dec(K(9, 3))
Hasil(3) = FDec2Biner(FMod(nTmp1, 2 ^ 16), 16)
'Algo-4 -> Hasil = (X4 * K4) mod ((2^16) + 1)
nTmp1 = FBiner2Dec(X(4)) * FBiner2Dec(K(9, 4))
Hasil(4) = FDec2Biner(FMod(nTmp1, (2 ^ 16) + 1), 16)
'Simpan hasil X
X1(10) = Hasil(1)
X2(10) = Hasil(2)
X3(10) = Hasil(3)
X4(10) = Hasil(4)
'---- KONVERSI KE ASCII ----
strHasil = ""
cTmp1 = Hasil(1) & Hasil(2) & Hasil(3) & Hasil(4)
For i = 1 To 64 Step 8
strHasil = strHasil & Chr(FBiner2Dec(Mid(cTmp1, i, 8)))
Next i
'Hasil dekripsi
IDEADecryption = strHasil
End Function
'Pengubahan desimal menjadi biner
Public Function FDec2Biner(ByVal pnAngka As Double, Optional ByVal pnLength As Double = -1) As String
Dim nLoop As Double
Dim nHasilBagi As Double
Dim nSisaBagi As Double
Dim cBiner1 As String
Dim cBiner2 As String
nHasilBagi = pnAngka
While nHasilBagi <> 0
nSisaBagi = FMod(nHasilBagi, 2)
cBiner1 = cBiner1 & Format(nSisaBagi)
nHasilBagi = FDiv(nHasilBagi, 2)
End While
If cBiner1 = "" Then cBiner1 = "0"
'Ambil Terbalik
For nLoop = Len(cBiner1) To 1 Step -1
cBiner2 = cBiner2 & Mid(cBiner1, nLoop, 1)
Next nLoop
If pnLength = -1 Then
'Angka Biner
FDec2Biner = cBiner2
Else
If Len(cBiner2) <= pnLength Then
'Angka Biner Kurang dari pnLength
FDec2Biner = String(pnLength - Len(cBiner2), "0") & cBiner2
Else
'Angka Biner Melebihi pnLength
FDec2Biner = Left(cBiner2, pnLength)
End If
End If
End Function
'Pengubahan biner menjadi desimal
Public Function FBiner2Dec(ByVal pcText As String) As Double
Dim nLoop As Double
Dim nHasil As Double
nHasil = 0
'Konversi dari belakang
For nLoop = Len(pcText) To 1 Step -1
If Mid(pcText, nLoop, 1) = "1" Then
nHasil = nHasil + (2 ^ (Len(pcText) - nLoop))
End If
Next nLoop
'Angka Desimal
FBiner2Dec = nHasil
End Function
Public Function FMod(ByVal pnA1 As Double, ByVal pnA2 As Double) As Double
Dim nMod As Double
nMod = pnA1 / pnA2
FMod = pnA1 - (pnA2 * Int(nMod))
End Function
Public Function FDiv(ByVal pnA1 As Double, ByVal pnA2 As Double) As Double
Dim nDiv As Double
nDiv = pnA1 / pnA2
FDiv = Int(nDiv)
End Function
Public Function FXORBiner(ByVal pcText1 As String, ByVal pcText2 As String, Optional ByVal pnByte As Long = 0) As String
Dim nF As Long
Dim cXOR As String
Dim nByte1 As Long
Dim cText1 As String
Dim cText2 As String
Dim cHasilXOR As String
'Banyak byte
nByte1 = pnByte
If nByte1 = 0 Then
'Ambil yang terpanjang
If Len(pcText1) > Len(pcText2) Then
nByte1 = Len(pcText1)
Else
nByte1 = Len(pcText2)
End If
End If
cText1 = FormatStr(pcText1, "0", nByte1) 'Text-1
cText2 = FormatStr(pcText2, "0", nByte1) 'Text-2
For nF = 1 To nByte1
cXOR = cXOR & IIf(Mid(cText1, nF, 1) = Mid(cText2, nF, 1), "0", "1")
Next nF
'Hasil XOR
cHasilXOR = FormatStr(cXOR, "0", pnByte)
FXORBiner = cHasilXOR
End Function
Public Function FRotateLeftShift(ByVal pcText As String, ByVal pnRotate As Long) As String
Dim nLoop As Integer
Dim cHasil As String
cHasil = pcText
For nLoop = 1 To pnRotate
cHasil = Right(cHasil, Len(cHasil) - 1) & Left(cHasil, 1)
Next nLoop
FRotateLeftShift = cHasil
End Function
Public Function FormatStr(ByVal pcText As String, ByVal pcZeroText As String, ByVal pnLength As Long) As String
If Len(pcText) > pnLength Then
'Jika lebih besar, maka cut
pcText = Left(pcText, pnLength)
ElseIf Len(pcText) < pnLength Then
'Jika lebih kecil, maka tambah
FormatStr = String(pnLength - Len(pcText), pcZeroText) & pcText
Else
FormatStr = pcText
End If
End Function
'Inverse functions
Public Function Inverse(ByVal A As Double) As Double
Dim G0 As Double, G1 As Double, G2 As Double, V0 As Double, V1 As Double, V2 As Double, Y As Double, n As Double
n = 65537
G0 = n
G1 = A
V0 = 0
V1 = 1
While (G1 <> 0)
Y = Int(G0 / G1)
G2 = G0 - Y * G1
G0 = G1
G1 = G2
V2 = V0 - Y * V1
V0 = V1
V1 = V2
End While
If (V0 >= 0) Then
Inverse = V0
Else
Inverse = V0 + n
End If
End Function
'FMinus
Public Function FMinus(ByVal pcBiner As String) As String
FMinus = FDec2Biner(65536 - FBiner2Dec(pcBiner), 16)
End Function
'Delay
Public Sub PDelay(ByVal pnMilliSeconds As Long)
Application.DoEvents()
Sleep(pnMilliSeconds)
End Sub
'Tipe Output
Public Function FOutput(ByVal pcBinerText As String, ByVal pbBiner As Boolean) As String
If pbBiner Then
FOutput = pcBinerText
Else
If Len(pcBinerText) < 64 Then
FOutput = FormatStr(Hex(FBiner2Dec(pcBinerText)), "0", 4)
Else
FOutput = FormatStr(FBiner2Hex(pcBinerText), "0", 32)
End If
End If
End Function
'Biner ke heksa
Public Function FBiner2Hex(ByVal pcText As String) As String
Dim i As Integer
For i = 1 To Len(pcText) Step 4
FBiner2Hex = FBiner2Hex & Hex(FBiner2Dec(Mid(pcText, i, 4)))
Next i
End Function
'Heksa ke desimal
Public Function FHex2Dec(ByVal pcText As String) As Double
Dim i As Integer
For i = 1 To Len(pcText)
Select Case Mid(pcText, i, 1)
Case "1" To "9" : FHex2Dec = FHex2Dec + CDec(Mid(pcText, i, 1)) * 16 ^ (Len(pcText) - i)
Case "A", "a" : FHex2Dec = FHex2Dec + 10 * 16 ^ (Len(pcText) - i)
Case "B", "b" : FHex2Dec = FHex2Dec + 11 * 16 ^ (Len(pcText) - i)
Case "C", "c" : FHex2Dec = FHex2Dec + 12 * 16 ^ (Len(pcText) - i)
Case "D", "d" : FHex2Dec = FHex2Dec + 13 * 16 ^ (Len(pcText) - i)
Case "E", "e" : FHex2Dec = FHex2Dec + 14 * 16 ^ (Len(pcText) - i)
Case "F", "f" : FHex2Dec = FHex2Dec + 15 * 16 ^ (Len(pcText) - i)
End Select
Next i
End Function
End Module
No comments:
Post a Comment