📄 login.frm
字号:
VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "comctl32.ocx"
Begin VB.Form login
BackColor = &H00E0E0E0&
BorderStyle = 1 'Fixed Single
Caption = "授权检查"
ClientHeight = 2310
ClientLeft = 45
ClientTop = 330
ClientWidth = 5970
Icon = "login.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2310
ScaleWidth = 5970
StartUpPosition = 2 '屏幕中心
Begin MSAdodcLib.Adodc Adodc2
Height = 330
Left = 2475
Top = 1980
Visible = 0 'False
Width = 1605
_ExtentX = 2831
_ExtentY = 582
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 2
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = $"login.frx":030A
OLEDBString = $"login.frx":03A1
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = "catvuser"
Caption = "Adodc2"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin VB.Frame Frame1
BackColor = &H00E0E0E0&
Height = 2160
Left = 75
TabIndex = 0
Top = 30
Width = 5790
Begin VB.CheckBox Check1
BackColor = &H00C0C0C0&
Height = 210
Left = 5310
TabIndex = 11
Top = 360
Width = 285
End
Begin ComctlLib.ProgressBar ProgressBar1
Height = 180
Left = 165
TabIndex = 10
Top = 765
Visible = 0 'False
Width = 5490
_ExtentX = 9684
_ExtentY = 318
_Version = 327682
Appearance = 1
End
Begin VB.CommandButton Command3
BackColor = &H80000003&
Caption = "连 接"
Height = 315
Left = 4095
Picture = "login.frx":0438
Style = 1 'Graphical
TabIndex = 1
Top = 285
Width = 1065
End
Begin VB.Frame Frame2
Height = 30
Left = 135
TabIndex = 9
Top = 765
Width = 5520
End
Begin VB.ComboBox Combo1
Height = 300
Left = 2340
TabIndex = 14
Text = "本地服务器"
Top = 315
Width = 1440
End
Begin VB.TextBox Text1
Height = 315
Left = 2355
TabIndex = 2
Top = 1155
Width = 1215
End
Begin VB.TextBox Text2
Height = 315
IMEMode = 3 'DISABLE
Left = 2355
PasswordChar = "*"
TabIndex = 3
Top = 1590
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "确认"
Enabled = 0 'False
Height = 300
Left = 4095
TabIndex = 4
Top = 1155
Width = 1050
End
Begin VB.CommandButton Command2
Caption = "退出"
Height = 300
Left = 4095
TabIndex = 5
Top = 1590
Width = 1050
End
Begin VB.Label Label5
BackStyle = 0 'Transparent
Height = 300
Left = 4860
TabIndex = 13
Top = 930
Width = 885
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Height = 255
Left = 150
TabIndex = 12
Top = 975
Width = 1050
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "请选择登录服务器："
Height = 300
Left = 435
TabIndex = 8
Top = 345
Width = 1725
End
Begin VB.Image Image1
Height = 480
Left = 555
Picture = "login.frx":0D02
Top = 1320
Width = 480
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "姓名："
ForeColor = &H00800000&
Height = 255
Left = 1545
TabIndex = 7
Top = 1230
Width = 735
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "口令："
ForeColor = &H00800000&
Height = 375
Left = 1545
TabIndex = 6
Top = 1590
Width = 735
End
End
Begin MSAdodcLib.Adodc Adodc1
Height = 825
Left = 75
Top = 1530
Visible = 0 'False
Width = 2265
_ExtentX = 3995
_ExtentY = 1455
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = ""
OLEDBString = ""
OLEDBFile = ""
DataSourceName = "catv"
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
Caption = "Adodc1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
End
Attribute VB_Name = "login"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Combo1_KeyPress(KeyAscii As Integer)
Combo1.Text = "全局服务器"
Command3.SetFocus
End Sub
Private Sub Command1_Click()
Dim MeVer As String
Dim Czy_Type As String
Dim strPass As String
Dim bz0 As Integer
Dim i As Integer
MeVer = "2005.07.02"
Registration_Type = ""
Account_ID = ""
QAccount_ID = ""
On Error GoTo ERR_13
If Len(Text1) > 0 Then
Adodc1.ConnectionString = My_PROVIDER
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "select * from 用户 where username like '" & Me.Text1.Text & "' and userno like '" & Me.Text2.Text & "'"
Adodc1.Refresh
CzyPassWord = Me.Text2.Text
If Adodc1.Recordset.RecordCount > 0 Then
PASSed1 = True
CzyName = Text1
CzyType = Adodc1.Recordset.Fields("usertype")
Czy_Type = Adodc1.Recordset.Fields("user_type")
Adodc1.Recordset.Close
Adodc1.ConnectionString = My_PROVIDER
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "select * from 参数"
Adodc1.Refresh
Account_ID = Format(Adodc1.Recordset.Fields("帐号"), "000000")
System_Date = Adodc1.Recordset.Fields("系统日期")
Half_times = Adodc1.Recordset.Fields("退房半价始时间")
Half_time = Adodc1.Recordset.Fields("退房半价终时间")
System_Statu = Adodc1.Recordset.Fields("系统状态")
TongZhi = IIf(IsNull(Adodc1.Recordset.Fields("通知")), "", Adodc1.Recordset.Fields("通知"))
SoftVerSion = Adodc1.Recordset.Fields("版本号")
Adodc1.Recordset.Close
If MeVer <> SoftVerSion Then
MsgBox "重要提示：" & Chr(13) & Chr(13) & " 当前软件已升级到" & SoftVerSion & "版，请到服务器下载新软件后，" & Chr(13) & Chr(13) & "再运行升级软件！", 64, "升级提示"
PASSed1 = False
Unload Me
End If
If TongZhi <> "" Then
MsgBox "通知：" & Chr(13) & Chr(13) & TongZhi, 64, "通知"
End If
If System_Statu = "正常" Then
Unload Me
Else
MsgBox "请稍候：系统现在正处于 [" & System_Statu & "] 状态！", 64, "提示"
PASSed1 = False
Unload Me
End If
Else
MsgBox "请注意：用户名或口令错误！", 48, "错误信息"
End If
Else
MsgBox "请输入您的姓名", 48, "提示信息"
End If
Exit Sub
ERR_13:
MsgBox Err.Description & " 或服务器登录失败，请检查或与系统管理员联系！", 48, "提示"
Exit Sub
End Sub
Private Sub Command2_Click()
PASSed1 = False
Unload Me
End Sub
Private Sub Command3_Click()
Dim i, j, Field_COUNT As Integer
Dim strCMD As Command
If Combo1.Text = "全局服务器" Then
Open App.Path & "\server.dat" For Input As #1
Input #1, FP_ZDLX
Input #1, My_USERID
Input #1, My_PASSWORD
Input #1, My_DATASOURCE
Input #1, My_INITIALCATALOG
Input #1, My_PROVIDER
Input #1, BK_PROVIDER
Close #1
DATA_SERVER = "全局服务器"
Else
If Combo1.Text = "本地服务器" Then
Open App.Path & "\locat.dat" For Input As #1
Input #1, FP_ZDLX
Input #1, My_USERID
Input #1, My_PASSWORD
Input #1, My_DATASOURCE
Input #1, My_INITIALCATALOG
Input #1, My_PROVIDER
Input #1, BK_PROVIDER
Close #1
DATA_SERVER = "本地服务器"
Me.Check1.Value = 0
Else
MsgBox "请注意：服务器选择错误！", 48, "提示"
Combo1.Text = "全局服务器"
Combo1.SetFocus
Exit Sub
End If
End If
Me.Command1.Enabled = True
Me.Text1.SetFocus
Exit Sub
Err_Process:
MsgBox "信息：操作错误！", 16, "警告"
Exit Sub
End Sub
Private Sub Form_Load()
On Error GoTo Err_Process1
封面.Show 1
RoomNO = ""
Room_Rate = 0
TableName(0) = "CATVUSER"
TableName(1) = "SF"
TableName(2) = "USER_AZ"
TableName(3) = "USER_BQ"
TableName(4) = "USER_BT"
TableName(5) = "USER_FT"
TableName(6) = "USER_GH"
TableName(7) = "USER_HF"
TableName(8) = "USER_XH"
TableName(9) = "USER_ZD"
TableName(10) = "菜单"
TableName(11) = "参数"
TableName(12) = "发票栏目原始数据"
TableName(13) = "发票自定义"
TableName(14) = "各类业务收费标准"
TableName(15) = "扩展参数"
TableName(16) = "片区"
TableName(17) = "安装工"
TableName(18) = "收费标准"
TableName(19) = "收费类型"
TableName(20) = "用户"
TableName(21) = "终端类型"
Me.Combo1.AddItem "本地服务器"
Me.Combo1.AddItem "全局服务器"
Open App.Path & "\BKPIC.dat" For Input As #1
Input #1, BKPicPath
Input #1, PianQu
Input #1, DWMC
Close #1
Open App.Path & "\server.dat" For Input As #1
Input #1, My_USERID
Input #1, My_PASSWORD
Input #1, My_DATASOURCE
Input #1, My_INITIALCATALOG
Input #1, My_PROVIDER
Close #1
PASSed1 = False
Exit Sub
Err_Process1:
MsgBox "错误信息：读取系统参数错误！", 64, "警告"
Exit Sub
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unload Me
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = Asc(Chr(13)) Then
Text2.SetFocus
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = Asc(Chr(13)) Then
If Command1.Enabled Then
Command1_Click
Else
MsgBox "请注意：您未连接到数据库服务器！", 48, "提示"
Text2.SetFocus
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -