📄 form_user.frm
字号:
VERSION 5.00
Begin VB.Form Form_user
BorderStyle = 1 'Fixed Single
Caption = "宇迪光学/ERP2.00-系统管理"
ClientHeight = 2610
ClientLeft = 3525
ClientTop = 2925
ClientWidth = 4665
ControlBox = 0 'False
HelpContextID = 1011
Icon = "Form_User.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2610
ScaleWidth = 4665
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame2
Height = 1635
Left = 60
TabIndex = 14
Top = 900
Width = 4545
Begin VB.CommandButton Command1
Caption = "高级(&A)"
Height = 315
Index = 2
Left = 3210
TabIndex = 4
Top = 1200
Width = 1035
End
Begin VB.CommandButton Command1
Cancel = -1 'True
Caption = "取消(&C)"
Height = 315
Index = 1
Left = 1890
TabIndex = 3
Top = 1200
Width = 1035
End
Begin VB.CommandButton Command1
Caption = "确定(&O)"
Default = -1 'True
Height = 315
Index = 0
Left = 600
TabIndex = 2
Top = 1200
Width = 1035
End
Begin VB.TextBox Text1
Height = 315
Index = 0
Left = 1230
Locked = -1 'True
TabIndex = 0
Text = "Administrator"
Top = 270
Width = 3015
End
Begin VB.TextBox Text1
CausesValidation= 0 'False
Height = 315
IMEMode = 3 'DISABLE
Index = 1
Left = 1230
PasswordChar = "*"
TabIndex = 1
Top = 720
Width = 3015
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "口 令:"
Height = 180
Index = 1
Left = 270
TabIndex = 16
Top = 810
Width = 810
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "用 户 名:"
Height = 180
Index = 0
Left = 270
TabIndex = 15
Top = 330
Width = 810
End
End
Begin VB.Frame Frame1
Caption = "数据库信息"
Height = 2145
Left = 60
TabIndex = 9
Top = 2760
Width = 4545
Begin VB.ComboBox Combo1
Height = 300
ItemData = "Form_User.frx":0ECA
Left = 1245
List = "Form_User.frx":0ED1
Style = 2 'Dropdown List
TabIndex = 8
Top = 1620
Width = 3015
End
Begin VB.TextBox Text2
Height = 315
Index = 2
Left = 1245
TabIndex = 7
Top = 1155
Width = 3015
End
Begin VB.TextBox Text2
Height = 315
IMEMode = 3 'DISABLE
Index = 1
Left = 1245
PasswordChar = "*"
TabIndex = 6
Top = 705
Width = 3015
End
Begin VB.TextBox Text2
Height = 315
Index = 0
Left = 1245
TabIndex = 5
Top = 255
Width = 3015
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "数据库类型:"
Height = 180
Index = 3
Left = 150
TabIndex = 13
Top = 1640
Width = 990
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "数据服务器:"
Height = 180
Index = 2
Left = 150
TabIndex = 12
Top = 1200
Width = 990
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "口 令:"
Height = 180
Index = 1
Left = 150
TabIndex = 11
Top = 770
Width = 990
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "帐 户 名:"
Height = 180
Index = 0
Left = 150
TabIndex = 10
Top = 360
Width = 990
End
End
Begin VB.TextBox Text
Enabled = 0 'False
Height = 270
Index = 0
Left = 360
MultiLine = -1 'True
TabIndex = 17
Text = "Form_User.frx":0EE6
Top = 1200
Visible = 0 'False
Width = 735
End
Begin VB.TextBox Text
Enabled = 0 'False
Height = 240
Index = 1
Left = 360
MultiLine = -1 'True
TabIndex = 18
Text = "Form_User.frx":1BB7
Top = 1800
Visible = 0 'False
Width = 660
End
Begin VB.Image Image1
Height = 900
Left = 0
Picture = "Form_User.frx":20DF
Top = 0
Width = 4800
End
End
Attribute VB_Name = "Form_user"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click(Index As Integer)
Dim aDo_Password As New Recordset
Select Case Index
Case 0
On Error GoTo err_exit
If Trim(Text2(2).Text) = "" Then MsgBox "数据服务器名不能为空! ", 16: Exit Sub
If Conn_System2.state = 1 Then Conn_System2.Close: Set Conn_System2 = Nothing
Conn_System2.Open "Provider=SQLOLEDB.1;Persist Security Info=False;Data Source=" & Trim(Text2(2).Text) & "; Initial Catalog=Master;", Trim(Text2(0).Text), Trim(Text2(1).Text)
Set aDo_Password = Conn_System2.Execute("SELECT * FROM SysDatabases WHERE name = 'EboSys'")
If aDo_Password.EOF Then
Call sub_DBInit
End If
aDo_Password.Close
Set aDo_Password = Conn_System2.Execute("select * from EboSys..Ebo_Password")
If Not aDo_Password.EOF Then
If Mmjm1(Trim(Text1(1))) <> aDo_Password!Password Then
MsgBox "用户口令错误！ ", 16
aDo_Password.Close
Set aDo_Password = Nothing
Text1(1).SetFocus
Exit Sub
End If
Else
If Trim(Text1(1)) <> "" Then
MsgBox "用户口令错误！ ", 16
aDo_Password.Close
Set aDo_Password = Nothing
Text1(1).SetFocus
Exit Sub
End If
End If
Conn_System.Open "Provider=SQLOLEDB.1;Persist Security Info=False;Data Source=" & Trim(Text2(2).Text) & "; Initial Catalog=EboSys;", Trim(Text2(0).Text), Trim(Text2(1).Text)
ServerName_Str = Trim(Text2(2).Text)
aDo_Password.Close
Set aDo_Password = Nothing
Conn_System2.Close
Set Conn_System2 = Nothing
Form_main.Show
Save_user
Unload Me
Exit Sub
err_exit:
Select Case Err.Number
Case -2147467259
MsgBox "数据服务器错误！", 16
Case -2147217843
MsgBox "数据库用户名或口令错误！", 16
Case Else
MsgBox Err.Description & "(" & Err.Number & ")", 16
End Select
Case 1
Unload Me
Case 2
If Me.Height < 4000 Then
Me.Height = 5455
Command1(2).Caption = "恢复"
Else
Me.Height = 3090
Command1(2).Caption = "高级"
End If
End Select
End Sub
Private Sub Form_Load()
Combo1.ListIndex = 0
Call sub_iniLogInfo
End Sub
Private Sub TextFile()
'初始化登陆信息
On Error GoTo err_exit
Dim Fsote As Variant
Dim Tste As Variant
Dim Dqhs As Integer, Dqnr As String
Dim i As Integer
Set Fsote = CreateObject("Scripting.FileSystemObject")
Set Tste = Fsote.OpenTextFile(App.Path + "\System_Erp.txt", 1)
For i = 1 To 4
Dqnr = Trim(Tste.ReadLine)
If InStr(1, UCase(Dqnr), "SQLSERVER=") <> 0 Then
Text2(2).Text = Mid(Dqnr, InStr(1, UCase(Dqnr), "SQLSERVER=") + 10, Len(Dqnr))
End If
If InStr(1, UCase(Dqnr), "USERID=") <> 0 Then
Text2(0).Text = Mid(Dqnr, InStr(1, UCase(Dqnr), "USERID=") + 7, Len(Dqnr))
End If
If InStr(1, UCase(Dqnr), "PASSWORD=") <> 0 Then
Text2(1).Text = Mmjm2(Mid(Dqnr, InStr(1, UCase(Dqnr), "PASSWORD=") + 9, Len(Dqnr)))
End If
Next i
Exit Sub
err_exit:
Text2(0).Enabled = True
End Sub
Private Sub sub_iniLogInfo()
On Error GoTo err_exit
Text2(2).Text = Trim(GetSetting(Ebo_gsProductName, Ebo_gsPrjName, "ServerName"))
If Trim(GetSetting(Ebo_gsProductName, Ebo_gsPrjName, "UserID")) = "" Then
Text2(0).Text = "sa"
Else
Text2(0).Text = Trim(GetSetting(Ebo_gsProductName, Ebo_gsPrjName, "UserID"))
End If
If Trim(GetSetting(Ebo_gsProductName, Ebo_gsPrjName, "Password")) <> "" Then
Text2(1).Text = Mmjm2(Trim(GetSetting(Ebo_gsProductName, Ebo_gsPrjName, "Password")))
End If
Exit Sub
err_exit:
Text2(0).Enabled = True
End Sub
Sub Save_user()
SaveSetting Ebo_gsProductName, Ebo_gsPrjName, "ServerName", Trim(Text2(2).Text)
SaveSetting Ebo_gsProductName, Ebo_gsPrjName, "UserId", Trim(Text2(0).Text)
' SaveSetting Ebo_gsProductName, Ebo_gsPrjName, "Password", Mmjm1(Trim(Text2(1).Text))
End Sub
Private Function Mmjm1(Srmm As String) As String '密码加密模块
Dim Zfcte As Integer
Mmjm1 = ""
For Jsqte = 1 To Len(Srmm)
Zfcte = Asc(Mid(Srmm, Jsqte, 1)) + Len(Srmm) + Jsqte
Mmjm1 = Mmjm1 + Mid(Trim(Str(1000 + Zfcte)), 2, 3)
Next Jsqte
End Function
Private Function Mmjm2(Srmm As String) As String '密码解密模块
Dim Zfcte As Integer
Mmjm2 = ""
For Jsqte = 1 To Int(Len(Srmm) / 3)
Zfcte = Val(Mid(Srmm, (Jsqte - 1) * 3 + 1, 3)) - Int(Len(Srmm) / 3) - Jsqte
Mmjm2 = Mmjm2 + Chr(Zfcte)
Next Jsqte
End Function
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
If Conn_System2.state = 1 Then Conn_System2.Close: Set Conn_System2 = Nothing
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -