📄 系统_登录窗体.frm
字号:
PasswordChar = "*"
TabIndex = 12
Top = 810
Width = 3210
End
Begin VB.TextBox LrText
Height = 300
IMEMode = 3 'DISABLE
Index = 2
Left = 1110
MaxLength = 20
PasswordChar = "*"
TabIndex = 11
Top = 1200
Width = 3210
End
Begin VB.Line Line1
Index = 2
X1 = 240
X2 = 4290
Y1 = 1770
Y2 = 1770
End
Begin VB.Label TsLabel
AutoSize = -1 'True
Caption = "旧密码:"
Height = 180
Index = 14
Left = 240
TabIndex = 18
Top = 480
Width = 630
End
Begin VB.Label TsLabel
AutoSize = -1 'True
Caption = "新密码:"
Height = 180
Index = 15
Left = 240
TabIndex = 17
Top = 870
Width = 630
End
Begin VB.Label TsLabel
AutoSize = -1 'True
Caption = "确认密码:"
Height = 180
Index = 16
Left = 240
TabIndex = 16
Top = 1260
Width = 810
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
Index = 3
X1 = 240
X2 = 4260
Y1 = 1800
Y2 = 1800
End
End
End
End
Attribute VB_Name = "XT_login"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Xtsjljc As String '系统数据服务器连接串
Dim ErpPassWord As String '系统连接密码
Dim DBUser As String '数据库用户
Dim Cslj As New ADODB.Connection '测试连接(为屏蔽提示信息)
Dim Tsxx As String '系统提示信息
Dim Czyrec As New ADODB.Recordset '操作员动态集
Dim Xtrlrec As New ADODB.Recordset '系统日历动态集
Dim Ztdqsjk As String '所选帐套当前数据库
Private Function Ljyxxpd() As Boolean '数据服务器(系统基本信息库)连接有效性测试
Ljyxxpd = False
If Len(Trim(ServerText.Text)) = 0 Then
Tsxx = "数据服务器名不能为空!"
Call Xtxxts(Tsxx, 0, 1)
ServerText.SetFocus
Exit Function
End If
Xtsjljc = "Provider=SQLOLEDB.1;"
Xtsjljc = Xtsjljc + "Persist Security Info=False;"
Xtsjljc = Xtsjljc + "Data Source=" + Trim(ServerText.Text) + ";"
Xtsjljc = Xtsjljc + " Initial Catalog=" + "EboSys" + ";"
If Cslj.State = 1 Then Cslj.Close
DdtsLabel = "系统正在连接数据服务器,请稍等..."
DdtsLabel.Refresh
With Me.Animation1
.Visible = True
.Open App.Path + "\Ljcs.avi"
.Play
End With
On Error GoTo Cwcl
If Cslj.State = 1 Then Cslj.Close
Cslj.Open Xtsjljc, DBUser, ErpPassWord
Animation1.Stop
Animation1.Visible = False
DdtsLabel = ""
DdtsLabel.Refresh
Ljyxxpd = True
Exit Function
Cwcl:
Animation1.Visible = False
Animation1.Stop
DdtsLabel = ""
Tsxx = "数据服务器连接测试失败!"
Call Xtxxts(Tsxx, 0, 1)
Exit Function
End Function
Private Sub CzrqText_KeyPress(KeyAscii As Integer) '录入日期限制
Call Lrrqxz(KeyAscii)
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer) '控 制 焦 点 转 移
Dim jdzygs As Integer
jdzygs = 5
Select Case KeyAscii
Case vbKeyReturn
If Kjjdzy(jdzygs) Then
KeyAscii = 0
End If
Case 39 '屏蔽"'"
KeyAscii = 0
End Select
End Sub
Private Sub Form_Load()
ErpPassWord = "Gen13301481112"
DBUser = "Ebodiy2008"
Call Qcljnr '读入连接内容
With StTab
.TabEnabled(0) = False
Frame1(0).Enabled = False
.TabEnabled(1) = True
Frame1(1).Enabled = True
.TabEnabled(2) = False
Frame1(2).Enabled = False
StTab.Tab = 1
End With
Me.HelpContextID = 2418007
End Sub
Private Sub GgszCommand_Click()
With Me.StTab
.TabEnabled(0) = False
Frame1(0).Enabled = False
.TabEnabled(1) = True
Frame1(1).Enabled = True
.Tab = 1
End With
' 让数据服务器设置文本框得到焦点
ServerText.SetFocus
ServerText.SelStart = 0
ServerText.SelLength = Len(ServerText.Text)
End Sub
Private Sub LjqdCommand_Click() '保 存 设 置
If Ljyxxpd Then
If Cw_DataEnvi.BaseInfoConnect.State = 1 Then Cw_DataEnvi.BaseInfoConnect.Close
Cw_DataEnvi.BaseInfoConnect.Open Xtsjljc, DBUser, ErpPassWord
Tsxx = "连接测试成功!"
Call Xtxxts(Tsxx, 0, 4)
StTab.TabEnabled(1) = False
Frame1(1).Enabled = False
StTab.TabEnabled(0) = True
Frame1(0).Enabled = True
StTab.Tab = 0
Call Tcztxx
If ZtCombo.ListCount > 0 Then
ZtCombo.ListIndex = 0
End If
End If
End Sub
Private Sub Qcljnr() '取 出 数 据
Dim Dqnr As String
Xtsjljc = GetSetting(Ebo_gsProductName, Ebo_gsPrjName, "Xtsjljc")
Xtczy = GetSetting(Ebo_gsProductName, Ebo_gsPrjName, "Xtczy")
Xtczybm = GetSetting(Ebo_gsProductName, Ebo_gsPrjName, "Xtczybm")
Xtztbm = GetSetting(Ebo_gsProductName, Ebo_gsPrjName, "Xtztbm", "001")
Xtdwm = GetSetting(Ebo_gsProductName, Ebo_gsPrjName, "Xtdwm")
If Trim(GetSetting(Ebo_gsProductName, Ebo_gsPrjName, "Xtrq")) <> "" Then
Xtrq = GetSetting(Ebo_gsProductName, Ebo_gsPrjName, "Xtrq")
End If
Xtyear = Val(GetSetting(Ebo_gsProductName, Ebo_gsPrjName, "XtYear"))
ServerName = Trim(GetSetting(Ebo_gsProductName, Ebo_gsPrjName, "ServerName"))
On Error GoTo Cwcl:
ServerText.Text = ServerName
If Len(Trim(Xtztbm)) <> 0 Then
Dim int_Count As Integer
For int_Count = 0 To ZtCombo.ListCount - 1
If UCase(Mid(ZtCombo.List(int_Count), 1, InStr(ZtCombo.List(int_Count), "-") - 1)) = UCase(Xtztbm) Then
ZtCombo.ListIndex = int_Count
End If
Next int_Count
End If
Exit Sub
Cwcl:
Exit Sub
End Sub
Private Sub MmText_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call QdCommand_Click
End If
End Sub
Private Sub QdCommand_Click() '确定进入系统
If CzrqText.Text = "" Then Exit Sub
If BoolDate(CzrqText.Text) = False Then
Tsxx = "所选操作日期与会计期间不一致!"
Call Xtxxts(Tsxx, 0, 1)
CzrqText.SetFocus
Exit Sub
End If
Dim login_mode As String '注册模式
If Trim(CzyCombo.Text) = "" Then Exit Sub
Set Czyrec = Cw_DataEnvi.DataConnect.Execute("Select * From gy_czygl where (czybm='" + Trim(CzyCombo.Text) + "' or czymc='" & Trim(CzyCombo.Text) & "' or rtrim(czybm)+'-'+rtrim(czymc)='" & Trim(CzyCombo.Text) & "')")
With Czyrec
If Not .EOF Then
CzyCombo.Tag = Trim(.Fields("czymc"))
CzyCombo.Text = Trim(.Fields("czybm")) + "-" + Trim(.Fields("czymc"))
Else
Tsxx = "无此用户名!"
Call Xtxxts(Tsxx, 0, 1)
Exit Sub
End If
End With
Czyrec.Close
Set Czyrec = Nothing
If Xtyxxpd Then
If Ljyxxpd1 Then
If Cw_DataEnvi.DataConnect.State = 1 Then Cw_DataEnvi.DataConnect.Close
Cw_DataEnvi.DataConnect.Open Xtsjljc, DBUser, ErpPassWord
End If
Me.Hide
ServerName = Trim(ServerText.Text)
CtdrCheck.Value = 1
GgszCommand.Enabled = False
Xtczy = CzyCombo.Tag
Xtczybm = Trim(Mid(CzyCombo.Text, 1, InStr(1, CzyCombo.Text, "-") - 1))
Xtztbm = Trim(Mid(ZtCombo.Text, 1, InStr(1, ZtCombo.Text, "-") - 1))
Xtdwm = Trim(Mid(ZtCombo.Text, InStr(1, ZtCombo.Text, "-") + 1, Len(ZtCombo.Text)))
Xtkjqjgs = 12
'业务操作日期
Xtrq = CDate(CzrqText.Text)
'用户选择系统年度 控制可以修改之会计期间
Xtyear = Val(KjyearCombo.Text)
login_mode = GetSetting(Ebo_gsProductName, Ebo_gsPrjName, "login_mode", login_mode)
'写入注册表
SaveSetting Ebo_gsProductName, Ebo_gsPrjName, "Xtsjljc", Xtsjljc
SaveSetting Ebo_gsProductName, Ebo_gsPrjName, "Xtczy", Xtczy
SaveSetting Ebo_gsProductName, Ebo_gsPrjName, "Xtczybm", Xtczybm
SaveSetting Ebo_gsProductName, Ebo_gsPrjName, "Xtztbm", Xtztbm
SaveSetting Ebo_gsProductName, Ebo_gsPrjName, "Xtdwm", Xtdwm
SaveSetting Ebo_gsProductName, Ebo_gsPrjName, "Xtrq", Xtrq
SaveSetting Ebo_gsProductName, Ebo_gsPrjName, "XtYear", Xtyear
SaveSetting Ebo_gsProductName, Ebo_gsPrjName, "ServerName", ServerName
If Trim(login_mode) = "" Or Trim(login_mode) = "0" Then
SaveSetting Ebo_gsProductName, Ebo_gsPrjName, "login_mode", "0" '注册确定
Else
SaveSetting Ebo_gsProductName, Ebo_gsPrjName, "login_mode", "10" '重新注册确定
End If
'注册在线用户
Call Register_OnlineUser(LOG_IN)
If Not App.PrevInstance Then
MainFrm.Show
End If
Unload Me
End If
End Sub
Private Sub QxCommand_Click() '取消进入系统
Dim login_mode As String '注册模式
login_mode = GetSetting(Ebo_gsProductName, Ebo_gsPrjName, "login_mode", login_mode)
If Trim(login_mode) = "" Or Trim(login_mode) = "0" Then
SaveSetting Ebo_gsProductName, Ebo_gsPrjName, "login_mode", "0" '注册取消
Else
SaveSetting Ebo_gsProductName, Ebo_gsPrjName, "login_mode", "20" '重新注册取消
End If
If CtdrCheck.Value <> 1 Then
Unload Me
Else
Me.Hide
End If
End Sub
Private Sub Rlcommand_Click() '操作日期帮助
Call Czrqbz
End Sub
Private Sub ServerText_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If LjqdCommand.Enabled Then LjqdCommand.SetFocus
End If
End Sub
Private Sub Timer1_Timer() '激活连接测试
Timer1.Enabled = False
If Ljyxxpd Then
If Cw_DataEnvi.BaseInfoConnect.State = 1 Then Cw_DataEnvi.BaseInfoConnect.Close
Cw_DataEnvi.BaseInfoConnect.Open Xtsjljc, DBUser, ErpPassWord
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -