📄 frm_option.frm
字号:
VERSION 5.00
Object = "{C932BA88-4374-101B-A56C-00AA003668DC}#1.1#0"; "MSMASK32.OCX"
Begin VB.Form Frm_Option
BorderStyle = 1 'Fixed Single
Caption = "初始配置"
ClientHeight = 4185
ClientLeft = 45
ClientTop = 330
ClientWidth = 5520
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4185
ScaleWidth = 5520
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame2
Caption = "管理员密码设置(不可以用汉字做密码）"
Height = 1455
Left = 120
TabIndex = 9
Top = 1800
Width = 5295
Begin VB.TextBox TxtRePwd
Appearance = 0 'Flat
BeginProperty Font
Name = "黑体"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2640
MaxLength = 15
TabIndex = 3
Top = 840
Width = 2535
End
Begin VB.TextBox TxtPwd
Appearance = 0 'Flat
BeginProperty Font
Name = "黑体"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2640
MaxLength = 15
TabIndex = 2
Top = 240
Width = 2535
End
Begin VB.Label Label2
Caption = "确认新密码："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 480
TabIndex = 11
Top = 960
Width = 1455
End
Begin VB.Label Label1
Caption = "管理员密码："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 480
TabIndex = 10
Top = 360
Width = 1455
End
End
Begin MSMask.MaskEdBox MaskEdBoxIP
Height = 495
Left = 2760
TabIndex = 0
Top = 360
Width = 2535
_ExtentX = 4471
_ExtentY = 873
_Version = 393216
Appearance = 0
MaxLength = 15
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "黑体"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mask = "###.###.###.###"
PromptChar = " "
End
Begin VB.CommandButton Command2
Cancel = -1 'True
Caption = "取消"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3480
TabIndex = 5
Top = 3480
Width = 1335
End
Begin VB.CommandButton Command1
Caption = "确定"
Default = -1 'True
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 360
TabIndex = 4
Top = 3480
Width = 1335
End
Begin VB.Frame Frame1
Caption = "网络配置"
Height = 1575
Left = 120
TabIndex = 6
Top = 120
Width = 5295
Begin MSMask.MaskEdBox MaskEdBoxPort
Height = 495
Left = 2640
TabIndex = 1
Top = 960
Width = 2535
_ExtentX = 4471
_ExtentY = 873
_Version = 393216
Appearance = 0
MaxLength = 5
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "黑体"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mask = "#####"
PromptChar = " "
End
Begin VB.Label Label4
Caption = "连接端口："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 600
TabIndex = 8
Top = 1080
Width = 1215
End
Begin VB.Label Label3
Caption = "服务器IP地址："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 360
TabIndex = 7
Top = 360
Width = 1695
End
End
End
Attribute VB_Name = "Frm_Option"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'定义变量
Dim Filenum As Integer
Dim LoadFiles As String
Private Sub Command1_Click()
Dim ip1 As Integer, ip2 As Integer, ip3 As Integer, ip4 As Integer
If MaskEdBoxIP.Text = Empty Then
MsgBox "请输入主机的IP地址！", vbExclamation, Me.Caption
Exit Sub
End If
If (Mid(MaskEdBoxIP.Text, 1, 3) = " ") Or (Mid(MaskEdBoxIP.Text, 5, 3) = " ") Or (Mid(MaskEdBoxIP.Text, 9, 3) = " ") Or (Mid(MaskEdBoxIP.Text, 13, 3) = " ") Then
MsgBox "IP地址不能有空域值！", vbExclamation, Me.Caption
MaskEdBoxIP.SetFocus
End If
If MaskEdBoxPort.Text = Empty Then
MsgBox "请输入端口值！", vbExclamation, Me.Caption
Exit Sub
End If
If (Mid(MaskEdBoxIP.Text, 1, 3) <> " ") And (Mid(MaskEdBoxIP.Text, 5, 3) <> " ") And (Mid(MaskEdBoxIP.Text, 9, 3) <> " ") And (Mid(MaskEdBoxIP.Text, 13, 3) <> " ") Then
ip1 = Int(Trim(Mid(MaskEdBoxIP.Text, 1, 3)))
ip2 = Int(Trim(Mid(MaskEdBoxIP.Text, 5, 3)))
ip3 = Int(Trim(Mid(MaskEdBoxIP.Text, 9, 3)))
ip4 = Int(Trim(Mid(MaskEdBoxIP.Text, 13, 3)))
End If
'当密码输入为空时，则提示信息。
If TxtPwd.Text = Empty Then
MsgBox "请输入管理员密码！", vbExclamation, Me.Caption
Exit Sub
End If
If (ip1 < 0) Or (ip1 > 254) Or (ip2 < 0) Or (ip2 > 254) Or (ip3 < 0) Or (ip3 > 254) Or (ip4 < 0) Or (ip4 > 254) Then
MsgBox "您的输入不正确,请重新输入！", vbExclamation, Me.Caption
MaskEdBoxIP.SetFocus
End If
If CLng(MaskEdBoxPort.Text) <= 0 Or CLng(MaskEdBoxPort.Text) > 65535 Then
MsgBox "端口设置错误！", vbExclamation, Me.Caption
End If
Dim A As Long
Dim B As Long
Dim i As String
Dim P As String
Dim ip As String
Dim port As String
Dim Str1 As String
i = MaskEdBoxIP.Text
P = MaskEdBoxPort.Text
Str1 = " "
ip = StringCleaner(i, Str1)
port = StringCleaner(P, Str1)
'写信息
'修改gonfig.ini文件中CONFIG字段中SERVERIP的值为服务器IP
'修改gonfig.ini文件中CONFIG字段中PORT的值为连接端口
'如果该文件不存在会自动建立,当函数返回值为0时说明修改不成功
A = WritePrivateProfileString("CONFIG", "SEVERIP", ip, App.Path & "\config.ini")
If A = 0 Then MsgBox ("写文件时出错")
B = WritePrivateProfileString("CONFIG", "PORT", port, App.Path & "\config.ini")
If B = 0 Then MsgBox ("写文件时出错")
If TxtPwd.Text = TxtRePwd.Text Then
'密码信息文件的路径
LoadFiles = App.Path & IIf(Len(App.Path) > 3, "\setting.ini", "setting.ini")
'将你输入的密码加密到 Cipher_Text 的变量里
Dim Cipher_Text As String
SubCipher TxtPwd.Text, TxtPwd.Text, Cipher_Text
'保存到文件并加密
Filenum = FreeFile
Open LoadFiles For Random As Filenum
'把 Cipher_Text 的变量写入文件里
Put #Filenum, 1, Cipher_Text
Close Filenum
'将文件的属性设置为隐藏
SetAttr App.Path & "\config.ini", "2"
SetAttr App.Path & "\setting.ini", "2"
Unload Me
Else
MsgBox "两次输入的密码不相同！", vbExclamation, Me.Caption
End If
End Sub
Private Sub Form_Load()
On Error Resume Next
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Function StringCleaner(s As String, Search As String) As String '去除字符串中的空格
Dim i As Integer, res As String
res = s
Do While InStr(res, Search)
i = InStr(res, Search)
res = left(res, i - 1) & Mid(res, i + 1)
Loop
StringCleaner = res
End Function
'加密子程序
Private Sub SubCipher(ByVal Password As String, ByVal From_Text As String, To_Text As String)
Const MIN_ASC = 32 ' Space.
Const MAX_ASC = 126 ' ~.
Const NUM_ASC = MAX_ASC - MIN_ASC + 1
Dim offset As Long
Dim Str_len As Integer
Dim i As Integer
Dim ch As Integer
'得到了加密的数字
offset = NumericPassword(Password)
Rnd -1
'对随机数生成器做初始化的动作
Randomize offset
Str_len = Len(From_Text)
For i = 1 To Str_len
ch = Asc(Mid$(From_Text, i, 1))
If ch >= MIN_ASC And ch <= MAX_ASC Then
ch = ch - MIN_ASC
offset = Int((NUM_ASC + 1) * Rnd)
ch = ((ch + offset) Mod NUM_ASC)
ch = ch + MIN_ASC
To_Text = To_Text & Chr$(ch)
End If
Next i
End Sub
'解密子程序
Private Sub SubDecipher(ByVal Password As String, ByVal From_Text As String, To_Text As String)
Const MIN_ASC = 32 ' Space.
Const MAX_ASC = 126 ' ~.
Const NUM_ASC = MAX_ASC - MIN_ASC + 1
Dim offset As Long
Dim Str_len As Integer
Dim i As Integer
Dim ch As Integer
offset = NumericPassword(Password)
Rnd -1
Randomize offset
Str_len = Len(From_Text)
For i = 1 To Str_len
ch = Asc(Mid$(From_Text, i, 1))
If ch >= MIN_ASC And ch <= MAX_ASC Then
ch = ch - MIN_ASC
offset = Int((NUM_ASC + 1) * Rnd)
ch = ((ch - offset) Mod NUM_ASC)
If ch < 0 Then ch = ch + NUM_ASC
ch = ch + MIN_ASC
To_Text = To_Text & Chr$(ch)
End If
Next i
End Sub
'将你输入的每个字符转换成密码数字
Private Function NumericPassword(ByVal Password As String) As Long
Dim Value As Long
Dim ch As Long
Dim Shift1 As Long
Dim Shift2 As Long
Dim i As Integer
Dim Str_len As Integer
'得到字符串内字符的数目
Str_len = Len(Password)
'给每个字符转换成密码数字
For i = 1 To Str_len
ch = Asc(Mid$(Password, i, 1))
Value = Value Xor (ch * 2 ^ Shift1)
Value = Value Xor (ch * 2 ^ Shift2)
Shift1 = (Shift1 + 7) Mod 19
Shift2 = (Shift2 + 13) Mod 23
Next i
NumericPassword = Value
End Function
Private Sub TxtPwd_KeyPress(KeyAscii As Integer)
If KeyAscii <> 8 And KeyAscii < 32 Or KeyAscii > 126 Then
Beep
KeyAscii = 0
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -