📄 form_user.frm
字号:
VERSION 5.00
Begin VB.Form Form_user
BorderStyle = 1 'Fixed Single
Caption = "宇迪/ERP1.0.0-系统管理"
ClientHeight = 4050
ClientLeft = 3525
ClientTop = 2925
ClientWidth = 4230
ControlBox = 0 'False
HelpContextID = 1011
Icon = "Form_User.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4050
ScaleWidth = 4230
StartUpPosition = 2 '屏幕中心
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":038A
Left = 1245
List = "Form_User.frx":0391
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 = 1170
Width = 1035
End
Begin VB.CommandButton Command1
Caption = "取消"
Height = 315
Index = 1
Left = 1560
TabIndex = 5
Top = 1170
Width = 1035
End
Begin VB.CommandButton Command1
Caption = "确定"
Height = 315
Index = 0
Left = 270
TabIndex = 4
Top = 1170
Width = 1035
End
Begin VB.TextBox Text1
CausesValidation= 0 'False
Height = 315
IMEMode = 3 'DISABLE
Index = 1
Left = 1290
PasswordChar = "*"
TabIndex = 0
Top = 630
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":03A6
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":08E1
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 = 720
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
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()
Combo1.ListIndex = 0
TextFile
Text2(0).Enabled = True
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
Sub Save_user()
On Error Resume Next
Set Fsote = CreateObject("Scripting.FileSystemObject")
Set Tste = Fsote.CreateTextFile(App.Path + "\System_Erp.txt", True)
Tste.WriteLine "Sqlserver=" + Trim(Text2(2).Text)
Tste.WriteLine "Datatype=" + Trim(Combo1.Text)
Tste.WriteLine "UserId=" + Trim(Text2(0).Text)
Tste.WriteLine "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 + -