📄 frmlogin.frm
字号:
VERSION 5.00
Begin VB.Form FrmLogin
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
Caption = "Login to Billing"
ClientHeight = 2775
ClientLeft = 45
ClientTop = 405
ClientWidth = 3990
Icon = "FrmLogin.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2775
ScaleWidth = 3990
StartUpPosition = 2 'CenterScreen
Begin VB.TextBox TxtUser
BackColor = &H00FFFFFF&
Height = 375
Left = 1560
MaxLength = 15
TabIndex = 0
Top = 840
Width = 2055
End
Begin VB.TextBox TxtPassword
Height = 375
IMEMode = 3 'DISABLE
Left = 1560
MaxLength = 15
PasswordChar = "*"
TabIndex = 1
Top = 1320
Width = 2055
End
Begin VB.CommandButton CmdLogin
Appearance = 0 'Flat
Caption = "Login"
Height = 375
Left = 1560
TabIndex = 2
Top = 2040
Width = 975
End
Begin VB.CommandButton CmdBatal
Appearance = 0 'Flat
Caption = "Batal"
Height = 375
Left = 2640
TabIndex = 3
Top = 2040
Width = 975
End
Begin VB.Label Label4
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "CopyLeft BLacK PeaRL Cyber Community 2008-2009"
BeginProperty Font
Name = "Agency FB"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 255
Left = 1080
TabIndex = 7
Top = 2520
Width = 2775
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "Password"
Height = 255
Left = 240
TabIndex = 6
Top = 1320
Width = 1215
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Nama User"
Height = 255
Left = 240
TabIndex = 5
Top = 840
Width = 1215
End
Begin VB.Line Line1
X1 = 240
X2 = 3600
Y1 = 1920
Y2 = 1920
End
Begin VB.Shape Shape1
BackColor = &H00FFFFC0&
BorderColor = &H00E0E0E0&
BorderWidth = 2
FillColor = &H00FFFFC0&
FillStyle = 0 'Solid
Height = 1815
Left = 120
Top = 720
Width = 3735
End
Begin VB.Label Label3
Alignment = 2 'Center
BackColor = &H00008080&
BackStyle = 0 'Transparent
Caption = "Login to Billing"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0080FFFF&
Height = 375
Left = 1440
TabIndex = 4
Top = 120
Width = 1935
End
Begin VB.Image Image1
Height = 690
Left = 120
Picture = "FrmLogin.frx":B532
Top = 0
Width = 3750
End
End
Attribute VB_Name = "FrmLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public nama_user As String
Public jenis_login As String
Public path As String
Public username As String
Private Sub CmdBatal_Click()
End
End Sub
Private Sub CmdLogin_Click()
Call login
End Sub
Private Sub TxtPassword_GotFocus()
TxtPassword.Backcolor = &HFFFF00
End Sub
Private Sub TxtPassword_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call login
End If
End Sub
Private Sub TxtPassword_LostFocus()
TxtPassword.Backcolor = &HFFFFFF
End Sub
Private Sub TxtUser_GotFocus()
TxtUser.Backcolor = &HFFFF00
End Sub
Private Sub TxtUser_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call CekUser
End If
End Sub
Private Sub CekUser()
On Error Resume Next
cn.Open
cmd.ActiveConnection = cn
cmd.CommandType = adCmdText
cmd.CommandText = "SELECT account.* FROM account WHERE account.user = '" & TxtUser.Text & "'"
cmd.Execute
rs.ActiveConnection = cn
rs.Open "SELECT account.* FROM account WHERE account.user = '" & TxtUser.Text & "'", cn, adOpenStatic, adLockOptimistic
If rs.RecordCount = 0 Then
MsgBox "Nama user '" & TxtUser.Text & "' tidak diketahui.", vbInformation, "User Information"
TxtUser.Text = ""
TxtUser.SetFocus
Else
TxtPassword.SetFocus
End If
cn.Close
End Sub
Private Sub login()
On Error GoTo error
cn.Open
cmd.ActiveConnection = cn
cmd.CommandType = adCmdText
cmd.CommandText = "SELECT account.* FROM account WHERE account.user = '" & TxtUser.Text & "'"
cmd.Execute
rs.ActiveConnection = cn
rs.Open "SELECT account.* FROM account WHERE account.user = '" & TxtUser.Text & "'", cn, adOpenStatic, adLockOptimistic
If rs.RecordCount = 0 Then
MsgBox "Nama user '" & TxtUser.Text & "' tidak diketahui.", vbInformation, "Gagal Login"
TxtUser.Text = ""
TxtPassword.Text = ""
TxtUser.SetFocus
Else
If TxtPassword.Text = DecryptText(rs(5), "password") Then
username = rs(0)
nama_user = rs(1)
jenis_login = rs(2)
path = "server"
cn.Close
TulisCache
Load FrmMain
FrmMain.Show
Unload Me
Else
MsgBox "Maaf Password anda salah!", vbInformation, "Log In Failed"
TxtPassword.Text = ""
TxtPassword.SetFocus
cn.Close
End If
End If
error:
Select Case err.Number
Case 3750
MsgBox "Aduh, Maaf Ada Kesalahan Teknis", vbOKOnly, "System Lost"
End Select
End Sub
Private Sub TxtUser_LostFocus()
TxtUser.Backcolor = &HFFFFFF
End Sub
Private Sub TulisCache()
On Error GoTo error
cn.Open
cmd.ActiveConnection = cn
cmd.CommandType = adCmdText
cmd.CommandText = "SELECT cache.* FROM cache WHERE cache.path = '" & path & "'"
cmd.Execute
rs.ActiveConnection = cn
rs.Open "SELECT cache.* FROM cache WHERE cache.path = '" & path & "'", cn, adOpenStatic, adLockOptimistic
If Not rs.RecordCount = 0 Then
rs(1) = path
rs(2) = username
rs(3) = nama_user
rs(4) = jenis_login
rs.Update
Else
rs.AddNew
rs(1) = path
rs(2) = username
rs(3) = nama_user
rs(4) = jenis_login
rs.Update
End If
cn.Close
error:
Select Case err.Number
Case 53
MsgBox "error euy"
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -