FORM LOGIN DENGAN PASSWORD BERENSKRIP (Encryption)

Besic kode adalah

Sub enskrp() 'MENGACAK DATA

Dim kalimat As String

Dim pos As Integer

  kalimat = Text1 ‘input data

  For pos = 1 To Len(kalimat)

    Mid(kalimat, pos, 1) = Chr(((Asc(Mid(kalimat, pos, 1)) * 2) \ 1) + 2)

  Next pos

  Text2 = kalimat ‘output data

End Sub

---

Sub Decrypting() 'MENGEMBALIKAN DATA DI ACAK

  Dim kalimat As String

  Dim pos As Integer

  kalimat = Text1  ‘Input data

  For pos = 1 To Len(kalimat)

    Mid(kalimat, pos, 1) = Chr((Asc(Mid(kalimat, pos, 1)) - 2) \ 2)

  Next pos

  Text2 = kalimat ‘ Output data

End Sub

Langkan pembuatan:

Seperti biasa buat project baru :

Tool yang kita gunakan adalah

-          Form

-          MDIform

-          Textbox

-          ListView1

-          ImageList1

-          Adodc1

-          DataGrid

-          StatusBar

Untuk mendapatkan tool diatas seperti basa pilih menu Project – Componen beri conteng pada

-          Microsoft Ado Data Control 6.0 (OLDB)

-          Microsoft DataGrid Contol 6.0 (OLDB)

-          Microsoft Window Common Control 6.0 (SP6)

 Buat Rancangan form Sebagai berikut

 

Properti : Form

TOOL	PRPERTIS	NAME
Form	BorderStyle : FixedSingle StartUpPosition : ScreenSenter MDChil = False	Form1
Form	BorderStyle : FixedSingle MDChil = True	Form2
Form	BorderStyle : FixedSingle MDChil = True	Form3
MDIForm	Windowsate : Maxsimized	MDIForm1

Code Form Login :

Option Explicit

Public conn As New ADODB.Connection

---

Public Function OpenConnection() As Boolean

On Error GoTo ErrHandler

    Dim strCon As String

    strCon = "PROVIDER=MSDataShape;Data PROVIDER= microsoft.jet.oledb.4.0;Data Source=" _

& App.Path & "\Database.mdb;Jet OLEDB:Database Password=rahman; "

    Set conn = New ADODB.Connection

    conn.ConnectionString = strCon

    conn.Open

    OpenConnection = True

    Exit Function

ErrHandler:

    OpenConnection = False

End Function

---

Sub enskrp() 'MENGACAK PASWORD

Dim kalimat As String

Dim pos As Integer

  kalimat = Text2

  For pos = 1 To Len(kalimat)

    Mid(kalimat, pos, 1) = Chr(((Asc(Mid(kalimat, pos, 1)) * 2) \ 1) + 2)

  Next pos

  Text3 = kalimat

End Sub

---

Private Sub Command1_Click()

enskrp

Adodc1.Recordset.Find "USER_NAME='" + Text1.Text + "'", , adSearchForward, 1

If Not Adodc1.Recordset.EOF Then

If (Text1.Text = Adodc1.Recordset!USER_NAME) And (Text3.Text = Adodc1.Recordset!PWD) Then

MDIForm1.Show

Unload Me

Else

    MsgBox ("Nama User dan Password yang anda masukin salah"), vbInformation, "Wrong...."

End If

End If

End Sub

---

Private Sub Form_Load()

OpenConnection

Adodc1.ConnectionString = conn.ConnectionString

Adodc1.RecordSource = "LOGIN"

Set DataGrid1.DataSource = Adodc1

End Sub

 

Cara Seting ListView1 Click kana pada ListView1 akam Muncul Properti Pages

Click Tab Clom Heder

Click – Inser Colom

Colon Name	Size
USER NAME	3440.12
CREATED	1940.03
MODIFIY	1940.03

Pada Tab Emage lists

Pada Normal dan Small ganti dari <none> menjadi ImageList1
catan : ImageList sudah anda sispkan ke Form

Code Programnya:

Option Explicit

Dim Db As Connection

Dim Database As Connection

Dim WithEvents rs As Recordset

---

Sub konek()

Set Database = Nothing

Set Database = New Connection

Database.CursorLocation = adUseClient

Database.Open "PROVIDER=MSDataShape;Data PROVIDER= microsoft.jet.oledb.4.0;Data Source=" _

& App.Path & "\Database.mdb;Jet OLEDB:Database Password=rahman; "

End Sub

---

Private Sub IsiList_From_Tabel()

Dim itmnew As ListItem

ListView1.ListItems.Clear

If Adodc1.Recordset.RecordCount = 0 Then Exit Sub

Adodc1.Recordset.Requery

Adodc1.Recordset.MoveFirst

Do While Not Adodc1.Recordset.EOF

    If Adodc1.Recordset.EOF Then Exit Sub

With ListView1

   Set itmnew = .ListItems.Add(, , Adodc1.Recordset.Fields("USER_NAME"), 1, 1)

    itmnew.SubItems(1) = Adodc1.Recordset.Fields("CREATED")

    itmnew.SubItems(2) = Adodc1.Recordset.Fields("MODIFY")

End With

Adodc1.Recordset.MoveNext

Loop

End Sub

---

Sub enskrp() 'MENGACAK PASWORD

Dim kalimat As String

Dim pos As Integer

  kalimat = Text2

  For pos = 1 To Len(kalimat)

    Mid(kalimat, pos, 1) = Chr(((Asc(Mid(kalimat, pos, 1)) * 2) \ 1) + 2)

  Next pos

  Text3 = kalimat

End Sub

---

Private Sub CmdAddUser_Click()

enskrp

With Adodc1.Recordset

.AddNew

!USER_NAME = Text1.Text

!PWD = Text3.Text

!CREATED = Date

!MODIFY = Date

End With

IsiList_From_Tabel

MsgBox "Uset telah berhasil di Tambahkan !", vbInformation + vbOKOnly

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

End Sub

---

Private Sub CmdCancel_Click()

Unload Me

End Sub

---

Private Sub Form_Load()

Me.Left = (Screen.Width - Me.Width) / 2

Me.Top = 1000

konek           'memanggil prosedure coneksi string

Adodc1.ConnectionString = Database.ConnectionString

Adodc1.RecordSource = "LOGIN"

Set DataGrid1.DataSource = Adodc1

IsiList_From_Tabel

End Sub

---

 

Code Programnya

Option Explicit

Dim Database As Connection

Dim WithEvents rs As Recordset

---

Sub konek()

Set Database = Nothing

Set Database = New Connection

Database.CursorLocation = adUseClient

Database.Open "PROVIDER=MSDataShape;Data PROVIDER= microsoft.jet.oledb.4.0;Data Source=" _

& App.Path & "\Database.mdb;Jet OLEDB:Database Password=rahman; "

End Sub

---

Sub enskrp() 'MENGACAK PASWORD

Dim kalimat As String

Dim pos As Integer

  kalimat = Text4

  For pos = 1 To Len(kalimat)

    Mid(kalimat, pos, 1) = Chr(((Asc(Mid(kalimat, pos, 1)) * 2) \ 1) + 2)

  Next pos

  Text5 = kalimat

End Sub

---

Sub Decrypting() 'MENGEMBALIKAN PASWORD YANG DI ACAK

  Dim kalimat As String

  Dim pos As Integer

  kalimat = Adodc1.Recordset.Fields("PWD")

  For pos = 1 To Len(kalimat)

    Mid(kalimat, pos, 1) = Chr((Asc(Mid(kalimat, pos, 1)) - 2) \ 2)

  Next pos

  Text3 = kalimat

End Sub

---

Private Sub Command1_Click()

Adodc1.Recordset.Find "USER_NAME='" + Text1.Text + "'", , adSearchForward, 1

If Not Adodc1.Recordset.EOF Then

Decrypting

'-------------------MEMBANDINGKAN PASSWORD LAMA-----------------------

    If Text3.Text <> Text2.Text Then

        MsgBox "Error Proses, Old Password in falid!", vbCritical

    Else

        enskrp

        With Adodc1.Recordset

        !USER_NAME = Text1.Text

        !PWD = Text5.Text

        !MODIFY = Date

        .Update

        End With

        MsgBox "password success at change ! ", vbInformation + vbOKOnly

        Text1.Text = ""

        Text2.Text = ""

        Text3.Text = ""

        Text4.Text = ""

        Text5.Text = ""

    End If

Else

MsgBox "Error Proses, Data not fund!", vbCritical

End If

End Sub

---

Private Sub Command2_Click()

Unload Me

End Sub

---

Private Sub Form_Load()

Me.Left = (Screen.Width - Me.Width) / 2

Me.Top = 1000

konek           'memanggil prosedure coneksi string

Adodc1.ConnectionString = Database.ConnectionString

Adodc1.RecordSource = "LOGIN"

Set DataGrid1.DataSource = Adodc1

End Sub

---

Download Artikel Lengkanya : Cara Membuat Form Login dengan Paswword di Enskrip
Download Source Codenya :Login_Enskrip&Diskripting.rar