📄 login.frm
字号:
VERSION 5.00
Object = "{CEF42A98-96F2-4C8E-B783-B04E815A05D0}#1.0#0"; "sClientDog.ocx"
Object = "{AE2D0CA9-589B-4154-98AB-A4E03BC0ED7F}#1.0#0"; "sServerDog.ocx"
Object = "{060B05EA-F4F5-4255-9BFC-9295B6A89D11}#3.0#0"; "Sinour050715.ocx"
Object = "{8803088E-2AEB-4D2F-9AF0-D08480A9BEB9}#3.0#0"; "Sinour_ES.ocx"
Begin VB.Form Login
BorderStyle = 3 'Fixed Dialog
Caption = "系统登入"
ClientHeight = 5325
ClientLeft = 45
ClientTop = 330
ClientWidth = 8040
Icon = "Login.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
Picture = "Login.frx":000C
ScaleHeight = 5325
ScaleWidth = 8040
StartUpPosition = 2 '屏幕中心
Begin Sinour_Controls.sButton cmdServer
Height = 375
Left = 3600
TabIndex = 6
Top = 4800
Width = 1335
_ExtentX = 2355
_ExtentY = 661
BTYPE = 3
TX = "连接数据库 "
ENAB = -1 'True
BeginProperty FONT {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
COLTYPE = 1
FOCUSR = -1 'True
BCOL = 14215660
BCOLO = 14215660
FCOL = 0
FCOLO = 0
MCOL = 12632256
MPTR = 1
MICON = "Login.frx":16875
UMCOL = -1 'True
SOFT = 0 'False
PICPOS = 0
NGREY = 0 'False
FX = 0
HAND = 0 'False
CHECK = 0 'False
VALUE = 0 'False
End
Begin VB.TextBox txtFileUser
Height = 315
Left = 4440
TabIndex = 0
Text = "Text1"
Top = 3060
Width = 3390
End
Begin VB.TextBox txtFilePwd
Height = 315
Left = 4440
TabIndex = 1
Text = "Text1"
Top = 3420
Width = 3390
End
Begin VB.TextBox txtPWD
Height = 315
IMEMode = 3 'DISABLE
Left = 4440
PasswordChar = "*"
TabIndex = 3
Text = "Text1"
Top = 4140
Width = 3390
End
Begin VB.ComboBox cboName
Height = 300
Left = 4440
Style = 2 'Dropdown List
TabIndex = 2
Top = 3775
Width = 3390
End
Begin Sinour_ES.sButton cmdLogin
Height = 375
Left = 5040
TabIndex = 4
Top = 4800
Width = 1335
_ExtentX = 2355
_ExtentY = 661
BTYPE = 3
TX = "登入 "
ENAB = -1 'True
BeginProperty FONT {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
COLTYPE = 1
FOCUSR = -1 'True
BCOL = 13160660
BCOLO = 13160660
FCOL = 0
FCOLO = 0
MCOL = 12632256
MPTR = 1
MICON = "Login.frx":16891
UMCOL = -1 'True
SOFT = 0 'False
PICPOS = 0
NGREY = 0 'False
FX = 0
HAND = 0 'False
CHECK = 0 'False
VALUE = 0 'False
End
Begin Sinour_ES.sButton cmdCancel
Height = 375
Left = 6480
TabIndex = 5
Top = 4800
Width = 1335
_ExtentX = 2355
_ExtentY = 661
BTYPE = 3
TX = "取消 "
ENAB = -1 'True
BeginProperty FONT {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
COLTYPE = 1
FOCUSR = -1 'True
BCOL = 13160660
BCOLO = 13160660
FCOL = 0
FCOLO = 0
MCOL = 12632256
MPTR = 1
MICON = "Login.frx":168AD
UMCOL = -1 'True
SOFT = 0 'False
PICPOS = 0
NGREY = 0 'False
FX = 0
HAND = 0 'False
CHECK = 0 'False
VALUE = 0 'False
End
Begin SCLIENTDOGLib.SClientDog SClientDog1
Left = 765
Top = 45
_Version = 65536
_ExtentX = 960
_ExtentY = 960
_StockProps = 0
End
Begin SSERVERDOGLib.SServerDog SServerDog1
Left = 180
Top = 45
_Version = 65536
_ExtentX = 960
_ExtentY = 960
_StockProps = 0
End
End
Attribute VB_Name = "Login"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rec As New ADODB.Recordset '主记录集
Dim tmpRst As New ADODB.Recordset
Public Lrst As New ADODB.Recordset '----- 2005-10-5（多帐套添加）
Dim Lcn As New Connection '---- 2005-10-5( 多帐套添加)
Dim strLcn As String '---- 2005-10-5(多帐套添加)
Dim strCN As String '---- 2005-10-5 (多帐套添加)
Dim Ie As New SINOURATLLib.CsEncrypt
Private Sub cmdServer_Click()
On Error GoTo conErr:
Dim strSQL As String
strSQL = "Driver={Microsoft Access Driver (*.mdb)};Dbq= " _
& App.Path & "\Data.mdb;Uid=" & Trim(txtFileUser.Text) & ";Pwd= " & Trim(txtFilePwd.Text) & ";"
Debug.Print strSQL
If con.State = adStateOpen Then con.Close
Set con = Nothing
con.CursorLocation = adUseClient
con.CommandTimeout = 15
con.Open strSQL, "", "", adConnectUnspecified
rec.CursorLocation = adUseClient
rec.Open "SELECT * FROM LOGIN", con, adOpenStatic, adLockBatchOptimistic
cboName.Clear
If rec.RecordCount > 0 Then
rec.MoveFirst
Do While Not rec.EOF
cboName.AddItem rec.Fields("Name")
rec.MoveNext
Loop
End If
If cboName.ListCount > 0 Then cboName.ListIndex = 0
Exit Sub
conErr:
If InStr(Err.Description, "找不到数据库文件") <> 0 Then
Message "找不到数据文件,请检查!"
End
ElseIf InStr(Err.Description, "密码无效") <> 0 Then
Message "数据库密码不正确!"
Else
Message Err.Description
End If
End Sub
Private Sub Command1_Click()
End Sub
Private Sub Form_Load()
Ie.SetTable "121212414321324"
cboName.Clear
txtPWD.Text = ""
SServerDog1.LocalPort = 5111
SServerDog1.DogSn = "000074"
SServerDog1.Listen
SClientDog1.RemoteHost = "127.0.0.1"
SClientDog1.RemotePort = 5111
SClientDog1.DogSn = "000074"
SClientDog1.Run
txtFileUser.Text = "Admin"
txtFilePwd.Text = ""
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdLogin_Click()
On Error GoTo IsErr:
Dim sPwd As String
Dim strSQL As String
' strSQL = "Driver={SQL Server};Server=127.0.0.1;Uid=sa;Pwd=;Database=KQJ"
' strSQL = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
' strSQL = strSQL & App.Path & "\Data.mdb;Persist Security Info=False"
If cboName.ListCount = 0 Then
Message "请先连接数据库!"
Exit Sub
End If
If Len(cboName.Text) = 0 Then
Message "请选择用户名!"
Exit Sub
End If
rec.MoveFirst
rec.Find "Name='" & cboName.Text & "'"
sPwd = Ie.DoEncrypt(CStr(rec.Fields("LoginID")) & Trim(txtPWD.Text))
If sPwd = Trim(rec.Fields("Password")) & vbNullString Then
UserName = rec.Fields("Name")
UserID = rec.Fields("LoginID")
MDI.Show
FristMain
Me.Hide
Else
Message "用户密码不正确!"
End If
Exit Sub
IsErr:
Message Err.Description
End Sub
Private Sub Form_Unload(Cancel As Integer)
If rec.State = 1 Then rec.Close
Set rec = Nothing
gExit = True
' End
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -