📄 splash.frm
字号:
VERSION 5.00
Object = "{E95A2510-F3D1-416D-823B-4F840FE98091}#3.0#0"; "Command.ocx"
Begin VB.Form splash
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 0 'None
Caption = "内蒙古自治区呼和浩特市服务业、娱乐业、文化体育业专用发票管理软件"
ClientHeight = 6360
ClientLeft = 0
ClientTop = 0
ClientWidth = 10620
ControlBox = 0 'False
FontTransparent = 0 'False
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
Picture = "splash.frx":0000
ScaleHeight = 6360
ScaleWidth = 10620
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin CSCommand.Command Command2
Height = 375
Left = 7560
TabIndex = 7
Top = 4200
Width = 1215
_ExtentX = 2143
_ExtentY = 661
IconAlign = 0
Icon = "splash.frx":E44F
Caption = "关 闭"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin CSCommand.Command Command1
Height = 375
Left = 7560
TabIndex = 6
Top = 3480
Width = 1215
_ExtentX = 2143
_ExtentY = 661
IconAlign = 0
Icon = "splash.frx":E46B
Caption = "登 录"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Timer Timer2
Enabled = 0 'False
Interval = 100
Left = 7800
Top = 2160
End
Begin VB.TextBox txtInputPW
Appearance = 0 'Flat
BackColor = &H00FFFFFF&
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
IMEMode = 3 'DISABLE
Left = 2400
PasswordChar = "*"
TabIndex = 4
Top = 4200
Width = 4215
End
Begin VB.TextBox txtInputUser
Appearance = 0 'Flat
BackColor = &H00FFFFFF&
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 2400
TabIndex = 1
Top = 3480
Width = 4215
End
Begin VB.Label Label2
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 375
Left = 3240
TabIndex = 5
Top = 1920
Width = 6375
End
Begin VB.Label lblInputPW
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "密 码："
BeginProperty Font
Name = "黑体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 375
Left = 240
TabIndex = 3
Top = 4200
Width = 2055
End
Begin VB.Label lblInputUser
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "用 户 名："
BeginProperty Font
Name = "黑体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 375
Left = 240
TabIndex = 2
Top = 3480
Width = 2055
End
Begin VB.Label lblWaiting
Alignment = 2 'Center
BackStyle = 0 'Transparent
BeginProperty Font
Name = "黑体"
Size = 18
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 495
Left = 1200
TabIndex = 0
Top = 5400
Width = 5895
End
End
Attribute VB_Name = "splash"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function GetPrivateProfileString Lib "Kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, lpKeyName As String, ByVal lpDefault As String, ByVal lpRetunedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function SaveINI Lib "Kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lplFileName As String) As Long
Public comm As Integer
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim SQL, connstr As String
Public filename As String
Private Sub Command1_Click()
On Error Resume Next
If comm = 0 Then
Dim anIntVariable As Integer
If txtInputUser.Text = "" Or txtInputPW.Text = "" Then
anIntVariable = MsgBox("请输入用户名和密码！", vbCritical + vbOKOnly, "系统提示")
Exit Sub
End If
SQL = "select * from admins where users='" & txtInputUser.Text & "'"
rs.Open SQL, conn, 1, 1
If rs.EOF Then
lblWaiting.Caption = "无此用户！"
Else
If rs("pass") = txtInputPW.Text Then
users = txtInputUser.Text
pass = txtInputPW.Text
AdminArea = rs("area") '权限
AdminXm = rs("name") '用户姓名
czy = AdminXm
rs("addtimes") = Now()
rs.Update
Timer2.Enabled = True
lblInputUser.Visible = False
lblInputPW.Visible = False
txtInputUser.Visible = False
txtInputPW.Visible = False
Command1.Enabled = False
Command2.Enabled = False
lblWaiting.Caption = "系统载入中请等待......"
Else
lblWaiting.Caption = "密码错误！"
End If
End If
rs.Close
Else
SaveINI "main", "company", txtInputUser.Text, filename
SaveINI "main", "keys", txtInputPW.Text, filename
MsgBox "注册完成，请退出程序，再次进入，如果出现登录窗口，恭喜您，您注册成功。"
End
End If
End Sub
Private Sub Command2_Click()
On Error Resume Next
End
End Sub
Private Sub Form_Load()
On Error Resume Next
Dim i As Integer
connstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\GLNHHY.DLL;Persist Security Info=False"
Set conn = New ADODB.Connection
conn.Open connstr
Set rs = New ADODB.Recordset
Me.Top = (Screen.Height - Me.Height) / 2
Me.Left = (Screen.Width - Me.Width) / 2
Me.Show
Me.Refresh
filename = App.Path & "\system.ini"
companys = Trim(CStr(GetINI("main", "company", filename)))
comp = Trim(CStr(GetINI("main", "comp", filename)))
keys = Trim(CStr(GetINI("main", "keys", filename)))
nowtimes = Trim(CStr(GetINI("main", "SYSVALUE", filename)))
exptimes = Trim(CStr(GetINI("main", "exptimes", filename)))
Pub_path = Trim(CStr(GetINI("system", "path", filename)))
Version = CSng(formnum(Trim(CStr(GetINI("main", "version", filename)))))
nowtimes = CDate(StringEnDeCodecn(CStr(nowtimes), 75))
'Debug.Print StringEnDeCodecn(CStr(Date), 75)
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.FolderExists(Pub_path) Then
fs.CreateFolder (Pub_path)
End If
Set fs = Nothing
If DateDiff("d", Now(), nowtimes) > 0 Then
MsgBox ("请正确调整当前系统时间")
End
End If
SaveINI "main", "SYSVALUE", CDate(StringEnDeCodecn(CStr(Date), 75)), filename
dexp = DateDiff("d", Now(), exptimes)
If dexp < 10 Then
If dexp < 0 Then
MsgBox ("系统已经过期，请速与博易公司联系")
End
Else
MsgBox ("系统还有" & dexp & "天过期，请及时与博易公司联系")
End If
End If
If verkeys(companys & exptimes, keys) Then
lblInputUser.Caption = "用 户 名："
lblInputPW.Caption = "密 码："
txtInputPW.PasswordChar = "*"
Label2.Caption = "授权给：" & companys
Command1.Caption = "登 录"
comm = 0
Else
lblInputUser.Caption = "单位名称："
lblInputPW.Caption = "序 列 号："
txtInputPW.PasswordChar = ""
Label2.Caption = Label2.Caption & "[未注册]"
Command1.Caption = "注 册"
comm = 1
End If
End Sub
Public Function GetINI(Appname As String, KeyName As String, filename As String) As String
On Error Resume Next
Dim RetStr As String
RetStr = String(10000, Chr(0))
GetINI = Left(RetStr, GetPrivateProfileString(ByVal Appname, ByVal KeyName, "", RetStr, Len(RetStr), filename))
End Function
Function verkeys(str1, str2) As Boolean
On Error Resume Next
Dim ci, Ni As String
Dim i, ai As Integer
Dim n1, n2, n3, n4 As Double
Dim c1, c2, c3, c4 As String
If str1 = "" Or str2 = "" Then verkeys = False: Exit Function
For i = 1 To Len(str1)
ai = Asc(Mid(str1, i, 1))
If ai <> 0 Then ci = CStr(Asc(Mid(str1, i, 1))) & ci
Next
For i = 1 To Len(ci)
ai = Asc(Mid(ci, i, 1))
If ai <> 0 Then Ni = CStr(Asc(Mid(ci, i, 1))) & Ni
Next
For i = 1 To Len(Ni)
ai = Asc(Mid(Ni, i, 1))
n1 = n1 + 2.5 * ai
n2 = n2 + 3 * ai
n3 = n3 + 4.5 * ai
n4 = n4 + 7 * ai
Next
c1 = "0207" & Fix(CDbl(n1))
c2 = "0030" & Fix(CDbl(n2))
c3 = "0304" & Fix(CDbl(n3))
c4 = "1040" & Fix(CDbl(n4))
c1 = Right(c1, 4)
c2 = Right(c2, 4)
c3 = Right(c3, 4)
c4 = Right(c4, 4)
Ni = c1 & "-" & c2 & "-" & c3 & "-" & c4
If Ni = str2 Then
verkeys = True
Else
verkeys = False
End If
End Function
Private Sub Timer2_Timer()
On Error Resume Next
Load MDIForm1
MDIForm1.Visible = True
Me.Hide
Unload splash
End Sub
Private Function StringEnDeCodecn(strSource As String, MA) As String
On Error GoTo ErrEnDeCode
Dim X As Single
Dim CHARNUM As Long, RANDOMINTEGER As Integer
Dim SINGLECHAR As String * 1
Dim strTmp As String
If MA < 0 Then
MA = MA * (-1)
End If
X = Rnd(-MA)
For i = 1 To Len(strSource) Step 1 '取单字节内容
SINGLECHAR = Mid(strSource, i, 1)
CHARNUM = Asc(SINGLECHAR)
g: RANDOMINTEGER = Int(127 * Rnd)
If RANDOMINTEGER < 30 Or RANDOMINTEGER > 100 Then GoTo g
CHARNUM = CHARNUM Xor RANDOMINTEGER
strTmp = strTmp & Chr(CHARNUM)
Next i
StringEnDeCodecn = strTmp
Exit Function
ErrEnDeCode:
StringEnDeCodecn = ""
MsgBox Err.Number & "\" & Err.Description
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -