Jumat, 20 Januari 2012

Listing Progaram Login



' password version 1.0
' created by: Mr. Jake Rodriguez Pomperada, MAED-IT
' date : March 30, 2009 Monday
' tool : Visual Basic 6.0
' email : jakerpomperada@yahoo.com
' location : purok pag-asa, barangay alijis 6100 bacolod city, negros
'            occidental philippines

Option Explicit
Dim WrongLogin As Integer
Dim rs As ADODB.Recordset

Private Sub Command1_Click()
On Error GoTo errhandler
   
    If WrongLogin = 2 Then
        Call MsgBox("kamu sudah 3 kali gagal. silahkan keluar!!!", vbOKOnly, "Sorry")
        End
    End If
   
    WrongLogin = WrongLogin + 1
    Form1.txt_try.Text = Str(WrongLogin)
   
    If UCase(txtUserName.Text) = "" Or IsNull(txtUserName.Text) = True Then
        Call MsgBox("Nama Harus di isi.", vbOKOnly, "Nama")
        txtUserName.SetFocus
        Exit Sub
    End If
    If UCase(txtPassword.Text) = "" Or IsNull(txtPassword.Text) = True Then
        Call MsgBox("Password Harus di isi.", vbOKOnly, "Password")
        txtPassword.SetFocus
        Exit Sub
    End If
   
    Open_cn
   
    Set rs = New ADODB.Recordset
    rs.Open ("Select * from Login Where UserName= '" & UCase(txtUserName.Text) & "'"), cn, adOpenStatic, adLockOptimistic, _
        adCmdText
   
  
        If UCase(txtPassword.Text) <> rs.Fields("password") Then
            Call MsgBox("Incorrect Password", vbOKOnly, "Login Error")
            txtPassword.Text = ""
            txtPassword.SetFocus
            Exit Sub
        Else
            'Correct!
            UserName = UCase(txtUserName.Text) 'May need in the future project
            MsgBox ("Correct Login.  This is where you open another form and close this one.")
            'This is where you open a new form and close frmLogin
            'Example:
           
            'frmMain.show
            'unload me
        End If
    Close_cn
    Exit Sub
errhandler:

    Call MsgBox("Incorrect Username", vbOKOnly, "Login Error")
    txtUserName.Text = ""
    txtPassword.Text = ""
    txtUserName.SetFocus
    Exit Sub
   
   
End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Form_Load()
Form1.Show
Form1.txtUserName.SetFocus
WrongLogin = 0
End Sub



Private Sub Txtusername_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then
   Form1.txtPassword.SetFocus
   End If
End Sub



Private Sub Txtpassword_KeyPress(KeyAscii As Integer)
 If KeyAscii = 13 Then
   Form1.Command1.SetFocus
   End If
End Sub
 
Option Explicit

Public UserName As String
Public DatabasePath As String
Public cn As ADODB.Connection

 Module Login

Public Sub Open_cn()

        Set cn = New ADODB.Connection
        cn.CursorLocation = adUseClient
        cn.Provider = "Microsoft.Jet.OLEDB.4.0"
        cn.Properties("Data Source") = App.Path & "\login.mdb"
        cn.Open

End Sub
Public Sub Close_cn()
   
     cn.Close
     Set cn = Nothing
   
End Sub




Module Client

Public SQL As String

Sub ClearFORM(f As Form)
    Dim ctl As Control
    For Each ctl In f
        If TypeOf ctl Is TextBox Then ctl.Text = ""
        If TypeOf ctl Is ComboBox Then ctl.Text = ""
    Next
End Sub

Sub center(f As Form)
    f.Move (Screen.Width - f.Width) / 2, (Screen.Height - f.Height) / 4
End Sub

Sub RubahCMD(f As Form, L0 As Boolean, L1 As Boolean, L2 As Boolean, L3 As Boolean)
    f.CmdProses(0).Enabled = L0
    f.CmdProses(1).Enabled = L1
    f.CmdProses(2).Enabled = L2
    f.CmdProses(3).Enabled = L3
End Sub





Listing Program Client



Dim IPServer As String

Sub hapus()
NIDN.Enabled = True
ClearFORM Me
Call RubahCMD(Me, True, False, False, False)
CmdProses(1).Caption = "&Simpan"
End Sub
Sub ProsesDB(Log As Byte)
    Select Case Log
    Case 0
        SQL = "INSERT INTO Dosen(NIDN, Nama, Tempat,Tanggal,Pendidikan,Bagian,Status)" & _
                    "values('" & NIDN.Text & _
                    "','" & NAMA.Text & _
                    "','" & TEMPAT.Text & _
                    "','" & TANGGAL.Text & _
                    "','" & PENDIDIKAN.Text & _
                    "','" & BAGIAN.Text & _
                    "','" & STATUS.Text & "')"
    Case 1
    SQL = "UPDATE Dosen SET Nama='" & NAMA.Text & "'," & _
        " Tempat = '" & TEMPAT.Text & "' " & _
        " Tanggal = '" & TANGGAL.Text & "' " & _
        " Pendidikan = '" & PENDIDIKAN.Text & "' " & _
        " Bagian = '" & BAGIAN.Text & "' " & _
        " Status = '" & STATUS.Text & "' " & _
        "where NIDN ='" & NIDN.Text & "'"
Case 2
        x = MsgBox("Yakin RECORD Barang Akan Dihapus...!", vbQuestion + vbYesNo, "Barang")
        If x = vbYes Then
        WS.SendData "DELETE-" & Kode.Text
       
        End If
        Call hapus
        Kode.SetFocus
    Case 3
        Call hapus
        Kode.SetFocus
    Case 4
        Unload Me
    End Select
End Sub
Sub tampilDosen()
On Error Resume Next
NIDN.Text = Rs!NIDN
NAMA.Text = Rs!NAMA
TEMPAT.Text = Rs!TEMPAT
TANGGAL.Text = Rs!TANGGAL
PENDIDIKAN.Text = Rs!PENDIDIKAN
BAGIAN.Text = Rs!BAGIAN
STATUS.Text = Rs!STATUS
End Sub

Private Sub CMDproses_click(index As Integer)
Select Case index
    Case 0
    Call hapus
    NIDN.SetFocus
    Case 1
    If CmdProses(1).Caption = "&Simpan" Then
    Call ProsesDB(0)
        Else
        Call ProsesDB(1)
        End If
    Case 2
    x = MsgBox("Yakin RECORD Dosen Akan Dihapus...!", vbQuestion + vbYesNo, "Dosen")
    If x = vbYes Then ProsesDB 2
    Call hapus
    NIDN.SetFocus
    Case 3
    Call hapus
    NIDN.SetFocus
    Case 5
    Adodc1.Refresh
    Case 4
    Unload Me
End Select
End Sub

Private Sub form_load()
Call hapus
MulaiKoneksi
    BAGIAN.AddItem "HRD"
    BAGIAN.AddItem "Humas"
    BAGIAN.AddItem "Keuangan"
   
    PENDIDIKAN.AddItem "Diploma III"
    PENDIDIKAN.AddItem "Strata I"
    PENDIDIKAN.AddItem "Strata II"
   
    STATUS.AddItem "Menikah"
    STATUS.AddItem "Belum MENIKAH"
End Sub
Private Sub NIDN_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If NIDN.Text = "" Then Exit Sub
WS.SendData "SEARCH-" & NIDN.Text
End If
End Sub
Sub MulaiKoneksi()
IPServer = "192.168.10.1"
IPClient = WS.LocalIP
WS.Connect IPServer, 1000
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
DoEvents
End
End Sub
Private Sub WS_Dataarrival(ByVal bytesTotal As Long)
Dim xkrim As String
Dim xData1() As String
Dim xData2() As String

WS.GetData xKirim, vbString, bytesTotal
xData1 = Split(xKirim, "-")
Select Case xData1(0)
Case "NOTHING"
x = NIDN.Text
Call hapus
NIDN.Text = x
Call RubahCMD(Me, False, True, False, True)
CmdProses(1).Caption = "&Simpan"
NAMA.SetFocus
Case "RECORD"
xData2 = Split(xData1(1), "/")
NAMA.Text = xData2(0)
TEMPAT.Text = xData2(1)
TANGGAL.Text = xData2(2)
PENDIDIKAN.Text = xData2(3)
BAGIAN.Text = xData2(4)
STATUS.Text = xData2(5)
Call RubahCMD(Me, False, True, True, True)
CmdProses(1).Caption = "&Edit"
NIDN.Enabled = False
NAMA.SetFocus
Case "DEL"
MsgBox "penghapusan data berhasil !"
Call hapus
Case "EDIT"
MsgBox "pengeditan record berhasil !"
Call hapus
End Select
End Sub