📄 form_user.frm
字号:
VERSION 5.00
Begin VB.Form Form_user
BorderStyle = 1 'Fixed Single
Caption = "百利/ERP5.0-系统管理"
ClientHeight = 1470
ClientLeft = 795
ClientTop = 1725
ClientWidth = 4140
ControlBox = 0 'False
HelpContextID = 1011
Icon = "Form_User.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1470
ScaleWidth = 4140
Begin VB.Frame Frame1
Caption = "数据库信息"
Height = 2115
Left = 60
TabIndex = 7
Top = 1710
Width = 4095
Begin VB.ComboBox Combo1
Height = 300
ItemData = "Form_User.frx":0442
Left = 1245
List = "Form_User.frx":0449
Style = 2 'Dropdown List
TabIndex = 15
Top = 1620
Width = 1965
End
Begin VB.TextBox Text2
Height = 315
Index = 2
Left = 1245
TabIndex = 14
Top = 1155
Width = 1905
End
Begin VB.TextBox Text2
Height = 315
IMEMode = 3 'DISABLE
Index = 1
Left = 1245
PasswordChar = "*"
TabIndex = 13
Top = 705
Width = 1905
End
Begin VB.TextBox Text2
Enabled = 0 'False
Height = 315
Index = 0
Left = 1245
TabIndex = 12
Top = 255
Width = 1905
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "数据库类型:"
Height = 180
Index = 3
Left = 270
TabIndex = 11
Top = 1680
Width = 990
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "数据服务器:"
Height = 180
Index = 2
Left = 270
TabIndex = 10
Top = 1170
Width = 990
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "口令:"
Height = 180
Index = 1
Left = 270
TabIndex = 9
Top = 720
Width = 450
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "帐户名:"
Height = 180
Index = 0
Left = 270
TabIndex = 8
Top = 360
Width = 630
End
End
Begin VB.CommandButton Command1
Caption = "高级 >>"
Height = 315
Index = 2
Left = 2880
TabIndex = 6
Top = 1050
Width = 1035
End
Begin VB.CommandButton Command1
Caption = "取消"
Height = 315
Index = 1
Left = 1560
TabIndex = 5
Top = 1050
Width = 1035
End
Begin VB.CommandButton Command1
Caption = "确定"
Height = 315
Index = 0
Left = 270
TabIndex = 4
Top = 1050
Width = 1035
End
Begin VB.TextBox Text1
CausesValidation= 0 'False
Height = 315
IMEMode = 3 'DISABLE
Index = 1
Left = 1290
PasswordChar = "*"
TabIndex = 0
Top = 600
Width = 1965
End
Begin VB.TextBox Text2
Enabled = 0 'False
Height = 240
Index = 3
Left = 1650
MultiLine = -1 'True
TabIndex = 16
Text = "Form_User.frx":045E
Top = 660
Visible = 0 'False
Width = 1140
End
Begin VB.TextBox Text1
Height = 315
Index = 0
Left = 1290
Locked = -1 'True
TabIndex = 3
Text = "Administrator"
Top = 180
Width = 1965
End
Begin VB.TextBox Text1
Enabled = 0 'False
Height = 270
Index = 2
Left = 1800
MultiLine = -1 'True
TabIndex = 17
Text = "Form_User.frx":0999
Top = 180
Visible = 0 'False
Width = 615
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "口令:"
Height = 180
Index = 1
Left = 510
TabIndex = 2
Top = 675
Width = 450
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "用户名:"
Height = 180
Index = 0
Left = 510
TabIndex = 1
Top = 240
Width = 630
End
End
Attribute VB_Name = "Form_user"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
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 sysobjects WHERE name = 'HDSystem_BakDataBases'")
If aDo_Password.EOF Then
Class.System_Sql
End If
aDo_Password.Close
Set aDo_Password = Conn_System2.Execute("select * from HDSystem_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
Else
If Trim(Text1(1)) <> "" Then MsgBox "用户口令错误！ ", 16: aDo_Password.Close: Set aDo_Password = Nothing: Text1(1).SetFocus: Exit Sub
End If
Conn_System.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)
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 <= 2025 Then
Me.Height = 4335
Command1(2).Caption = "恢复"
Else
Me.Height = 2025
Command1(2).Caption = "高级"
End If
End Select
End Sub
Private Sub Command2_Click()
Class.System_Sql
End Sub
Private Sub Form_Load()
Move (Screen.Width - Me.Width) / 2.1, (Screen.Height - Me.Height) / 2.2
Combo1.ListIndex = 0
Call TextFile
End Sub
Private Sub TextFile()
On Error GoTo ERR_EXIT
Text2(2).Text = ReadOneString("Option", "SqlServer", "localhost")
Text2(0).Text = ReadOneString("Option", "UserID", "sa")
Text2(1).Text = Mmjm2(ReadOneString("Option", "Password", ""))
Exit Sub
ERR_EXIT:
Text2(0).Enabled = True
End Sub
Sub Save_user()
On Error Resume Next
Call WriteOneString("Option", "SqlServer", Trim(Text2(2).Text))
Call WriteOneString("Option", "UserID", Trim(Text2(0).Text))
Call WriteOneString("Option", "Password", Mmjm1(Trim(Text2(1).Text)))
Call WriteOneString("Option", "Datatype", Trim(Combo1.Text))
End Sub
Private Function Mmjm1(Srmm As String) As String '密码加密模块
Dim Zfcte As Integer, I As Integer
Mmjm1 = ""
For I = 1 To Len(Srmm)
Zfcte = Asc(Mid(Srmm, I, 1)) + Len(Srmm) + I
Mmjm1 = Mmjm1 + Mid(Trim(str(1000 + Zfcte)), 2, 3)
Next I
End Function
Private Function Mmjm2(Srmm As String) As String '密码解密模块
Dim Zfcte As Integer, I As Integer
Mmjm2 = ""
For I = 1 To Int(Len(Srmm) / 3)
Zfcte = Val(Mid(Srmm, (I - 1) * 3 + 1, 3)) - Int(Len(Srmm) / 3) - I
Mmjm2 = Mmjm2 + Chr(Zfcte)
Next I
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 + -