'Deskripsi: Mengencrypt/decrypt suatu file teks menjadi file teks yang
'           lainnya dengan menggunakan password.
'Pembuat  : Masino Sinaga (admin@masinosinaga.com)
'Diupload : Rabu, 22 Mei 2002
'Persiapan: 1. Buat 1 Project baru dengan 1 Form dan 1 RichTextBox.
'           2. Beri nama RichTextBox dengan "rtfEncDec".
'           3. Copy-kan coding berikut ke dalam editor form ybt.
'---------------------------------------------------------------------

'Pada contoh ini, nama file default telah tersedia ketika
'kotak dialog InputBox ditampilkan. Klik saja OK tanpa
'mengganti nama file yang telah terisi di InputBox tersebut.
'Untuk mencoba ulang, hapus file Masino.txt, Masino1.txt,
'dan file Sinaga.txt yang terbentuk di direktori program ini...

Sub FileEncodeAndDecode(InputFile As String, _
                       OutputFile As String, _
                       PasswordKey As String)
   Dim temp As Single
   Dim Char As String * 1
   Dim XORMask As Single
   Dim temp1 As Integer
   Open InputFile For Binary As #1
   Open OutputFile For Binary As #2
   For x = 1 To Len(PasswordKey)
       temp = Asc(Mid$(PasswordKey, x, 1))
       For y = 1 To temp
           temp1 = Rnd
       Next y
       Randomize temp1
   Next x
   Counter = 0
   For z = 1 To FileLen(InputFile)
       XORMask = Int(Rnd * 256)
       Get 1, , Char
       Char = Chr$((Asc(Char) Xor XORMask))
       Put 2, , Char
       Counter = Counter + 1
       If Counter > Len(PasswordKey) Then Counter = 1
       For x = 1 To (Asc(Mid$(PasswordKey, Counter, 1)) * 2)
           temp = Rnd
       Next x
   Next z
   Close #1
   Close #2
   'Tampilkan hasilnya ke rtfEncDec...
   Open OutputFile For Binary As #3
      rtfEncDec.Text = Input(LOF(3), 3)
   Close #3
End Sub

Private Sub Command1_Click()
Dim InputFile As String
   Dim OutputFile As String
   Dim PasswordKey As String
   On Error GoTo Pesan
   'Jika file Masino.txt sudah ada dan file Sinaga.txt belum
   If Dir(App.Path & "\Masino.txt") <> "" And _
      Dir(App.Path & "\Sinaga.txt") = "" Then
      InputFile = InputBox("Masukkan nama file yang akan " & _
                        "di-encrypt/decrypt:", _
                        "File Sumber", "Masino.txt")
      If StrPtr(InputFile) = 0 Or InputFile = "" Then Exit Sub
   'Jika file Masino.txt dan Sinaga.txt sudah ada
   ElseIf Dir(App.Path & "\Masino.txt") <> "" And _
      Dir(App.Path & "\Sinaga.txt") <> "" Then
      InputFile = InputBox("Masukkan nama file yang akan " & _
                        "di-encrypt/decrypt:", _
                        "File Sumber", "Sinaga.txt")
      If StrPtr(InputFile) = 0 Or InputFile = "" Then Exit Sub
   End If
   Open App.Path & "\" & InputFile For Binary As #1
      rtfEncDec.Text = Input(LOF(1), 1)
   Close #1
  
   'Jika file Masino.txt sudah ada dan file Sinaga.txt belum
   If Dir(App.Path & "\Masino.txt") <> "" And _
      Dir(App.Path & "\Sinaga.txt") = "" Then
      OutputFile = InputBox("Masukkan nama file hasil " & _
                         "encrypt/decrypt: ", _
                         "File Tujuan", "Sinaga.txt")
      If StrPtr(OutputFile) = 0 Or OutputFile = "" Then Exit Sub
   'Jika file Masino.txt dan Sinaga.txt sudah ada
   ElseIf Dir(App.Path & "\Masino.txt") <> "" And _
      Dir(App.Path & "\Sinaga.txt") <> "" Then
      OutputFile = InputBox("Masukkan nama file hasil " & _
                         "encrypt/decrypt: ", _
                         "File Tujuan", "Masino1.txt")
      If StrPtr(OutputFile) = 0 Or OutputFile = "" Then Exit Sub
   End If
  
   PasswordKey = InputBox("Masukkan password:", _
                          "Password", "masinosinaga")
  
   Call FileEncodeAndDecode(App.Path & "\" & InputFile, _
                            App.Path & "\" & OutputFile, _
                            PasswordKey)
  
   MsgBox "Berhasil di-encrypt/decrypt ke " & OutputFile, _
          vbInformation, "Encrypt/Decrypt OK"
  
   End
   Exit Sub
Pesan:
   MsgBox Err.Number & " - " & Err.Description


End Sub

Private Sub Form_Load()
 BuatFileTeks  'Buat file teks pada permulaan aplikasi ini
 rtfEncDec.RightMargin = rtfEncDec.Width + 500
End Sub

Sub BuatFileTeks()
 Open App.Path & "\Masino.txt" For Output As #1
      Print #1, "Testing membuat file teks..."
      Print #1, "Isinya akan digunakan untuk encode/decode"
      Print #1, "-----------------------------------------"
      Print #1, "Masino Sinaga"
      Print #1, "Asrama Melati 219 Puslatpos"
      Print #1, "Jalan Terusan Sari Asih 54 Bandung 40151"
 Close #1
End Sub