Senin, 23 Januari 2012

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 ProjectComponen 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

2 komentar: