Source Code Program Enkripsi Dekripsi Data Dengan Menggunakan Algoritma Monoalpabetik VB 6.0

Ehm langsung aja ya. ni gua punya punya program untuk enkripsi dan dekripsi data dengan VB 6.0 dengan menggunakan algoritma Monoalpabetik.

Untuk Source nya nich aja ya...!!!

Keterangan metode monoalpabetik > Untuk pemetaan, digunakan string atau kalimat tertentu sebagai kunci.
Misalnya menggunakan nama seseorang.
String yang digunakan sebagai kunci tersebut, diekstrak, sehingga menjadi string dengan semua karakternya berbeda, tetapi urutan dalam string tetap sama.
Hasil ekstrak digunakan untuk menyusun nilai pemetaan dengan menambahkan karakter yang belum ada.

Contoh 4.1:

String kunci: RETANTYO WARDOYO
Diekstrak menjadi: RETANYOWD

String kunci: HARI INI TIDAK ADA KULIAH
Diekstrak menjadi: HARINTDKUL

Source Code
Private Sub cmd_dekrip_Click()
If keyword.Caption = "" Then
MsgBox "Isi Kunci dan Tekan Tombol Generate"
ElseIf txtchiper.Text = "" Then
MsgBox "Isi Chiper Text Terlebih Dahulu"
Else
Dim e, eo, o, oo, inp, inpo As String
Dim p, po As Integer
inp = txtchiper.Text
p = Len(txtchiper.Text)
inpo = keyword.Caption
po = Len(keyword.Caption)
For i = 1 To p
e = Mid(inp, i, 1)
For x = 1 To po
eo = Mid(inpo, x, 1)
If eo <> e Then
GoTo 1
Else
GoTo 2
End If
1 Next x
2 txtplain.Text = txtplain.Text + Mid(Label5.Caption, x, 1)
Next i
End If
End Sub

Private Sub cmd_Generate_Click()
keyword.Caption = ""
Dim Enkrip, Output, Inputan As String
Dim Panjang_Input As Integer
Inputan = key.Text + "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Panjang_Input = Len(key.Text + "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
For i = 1 To Panjang_Input
Enkrip = Mid(Inputan, i, 1)
key2.Caption = Enkrip
Next i
End Sub

Private Sub Enkrip_Click()
If keyword.Caption = "" Then
MsgBox "Isi Kunci dan Tekan Tombol Generate"
ElseIf txtplain.Text = "" Then
MsgBox "Isi Plain Text Terlebih Dahulu"
Else
Dim e, o, inp As String
Dim p As Integer
inp = txtplain.Text
p = Len(txtplain.Text)
For i = 1 To p
e = Mid(inp, i, 1)
e = Asc(e) - 64
txtchiper.Text = txtchiper.Text + Mid(keyword.Caption, e, 1)
Next i
End If
End Sub

Private Sub Form_Load()
MsgBox "Program ini hanya menerima karakter A-Z Tanpa Tanda Baca"
End Sub

Private Sub key2_Change()
Dim enk, out, masuk As String
Dim panjang As Integer
masuk = keyword.Caption
panjang = Len(keyword.Caption)
For i = 1 To panjang
enk = Mid(masuk, i, 1)
If key2.Caption <> enk Then
GoTo 2
Else
GoTo 1
End If
2 Next i
keyword.Caption = keyword.Caption + key2.Caption
1 End Sub

NB. Klo ada yang perlu programmnya ntar gua apload di 4shared dech. sama yang cesar n affine
peace