form3.frm

机房计时系统

VERSION 5.00
Begin VB.Form Form3 
   BorderStyle     =   0  'None
   Caption         =   "Form3"
   ClientHeight    =   3465
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4890
   LinkTopic       =   "Form3"
   ScaleHeight     =   3465
   ScaleWidth      =   4890
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Command2 
      Caption         =   "取消"
      Height          =   375
      Left            =   3720
      TabIndex        =   9
      Top             =   2760
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确定"
      Height          =   375
      Left            =   3720
      TabIndex        =   8
      Top             =   2040
      Width           =   1095
   End
   Begin VB.TextBox Text3 
      Height          =   375
      Left            =   1560
      TabIndex        =   7
      Top             =   3000
      Width           =   1335
   End
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   1560
      TabIndex        =   6
      Top             =   2400
      Width           =   1335
   End
   Begin VB.TextBox Text1 
      Height          =   375
      IMEMode         =   3  'DISABLE
      Left            =   1560
      TabIndex        =   5
      Top             =   1800
      Width           =   1335
   End
   Begin VB.Frame Frame1 
      Caption         =   "请你做如下的选择："
      Height          =   735
      Left            =   0
      TabIndex        =   1
      Top             =   960
      Width           =   4575
      Begin VB.OptionButton Option3 
         Caption         =   "修改密码"
         Height          =   300
         Left            =   3120
         TabIndex        =   4
         Top             =   240
         Width           =   1335
      End
      Begin VB.OptionButton Option2 
         Caption         =   "注册"
         Height          =   375
         Left            =   1800
         TabIndex        =   3
         Top             =   240
         Width           =   975
      End
      Begin VB.OptionButton Option1 
         Caption         =   "登录"
         Height          =   375
         Left            =   240
         TabIndex        =   2
         Top             =   240
         Width           =   1215
      End
   End
   Begin VB.Label Label5 
      BackColor       =   &H0000FF00&
      Caption         =   "机房自动计费计时系统"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   0
      TabIndex        =   13
      Top             =   0
      Width           =   4935
   End
   Begin VB.Line Line1 
      X1              =   120
      X2              =   4920
      Y1              =   240
      Y2              =   240
   End
   Begin VB.Label Label4 
      Height          =   375
      Left            =   0
      TabIndex        =   12
      Top             =   2880
      Width           =   1335
   End
   Begin VB.Label Label3 
      Caption         =   "密码:"
      Height          =   495
      Left            =   120
      TabIndex        =   11
      Top             =   2280
      Width           =   1215
   End
   Begin VB.Label Label2 
      Caption         =   "用户名："
      Height          =   375
      Left            =   120
      TabIndex        =   10
      Top             =   1800
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "   欢迎你到本机房上机"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   15.75
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   360
      TabIndex        =   0
      Top             =   240
      Width           =   4215
   End
End
Attribute VB_Name = "Form3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
 Private username(1 To 100) As String
 Dim i As Integer
 Private passw(1 To 100) As String
 Dim ntemp As String, ptemp As String, j As Integer
Dim num As Integer, ptemp2 As String


Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const HKEY_PERFORMANCE_DATA = &H80000004

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hkey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hkey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long

Function RegQueryStringValue(ByVal hkey As Long, ByVal strValueName As String)
    
    Dim lResult As Long
    Dim lValueType As Long
    Dim strBuf As String
    Dim lDataBufSize As Long
    
    On Error GoTo 0
    lResult = RegQueryValueEx(hkey, strValueName, 0&, lValueType, ByVal 0&, lDataBufSize)
    If lResult = ERROR_SUCCESS Then
        If lValueType = REG_SZ Then
            strBuf = String(lDataBufSize, " ")
            lResult = RegQueryValueEx(hkey, strValueName, 0&, 0&, ByVal strBuf, lDataBufSize)
            If lResult = ERROR_SUCCESS Then
                RegQueryStringValue = StripTerminator(strBuf)
            End If
        End If
    End If
    
End Function

Public Function GetString(hkey As Long, strpath As String, strvalue As String)

    Dim keyhand&
    Dim datatype&
    r = RegOpenKey(hkey, strpath, keyhand&)
    GetString = RegQueryStringValue(keyhand&, strvalue)
    r = RegCloseKey(keyhand&)

End Function

Function StripTerminator(ByVal strString As String) As String
    Dim intZeroPos As Integer

    intZeroPos = InStr(strString, Chr$(0))
    If intZeroPos > 0 Then
        StripTerminator = Left$(strString, intZeroPos - 1)
    Else
        StripTerminator = strString
    End If
End Function

Public Sub SaveString(hkey As Long, strpath As String, strvalue As String, strdata As String)

    Dim keyhand&
    r = RegCreateKey(hkey, strpath, keyhand&)
    r = RegSetValueEx(keyhand&, strvalue, 0, REG_SZ, ByVal strdata, Len(strdata))
    r = RegCloseKey(keyhand&)

End Sub

Private Sub Command1_Click()

     SaveString HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run", "MyApp", "c:\cc\cc.exe"
ntemp = Text1.Text
ptemp = Text2.Text
If Option1.Value = True Then
Call log
Else
If Option2.Value = True Then
Call registr
Else
Call regcctv
End If
End If


End Sub


Private Sub Command2_Click()
Call cleartext

End Sub

Private Sub Form_Load()
firstform
guan
Text3.PasswordChar = "*"
Text2.PasswordChar = "*"
Option1.Value = True
Option2.Value = False
Option3.Value = False
i = 1
 For j = 1 To 100
username(j) = ""
passw(j) = ""
Next j
Text3.Visible = False
Label4.Visible = False
End Sub

Private Sub Option1_Click()
Label4.Visible = False
Label3.Visible = False
End Sub

Private Sub Option2_Click()
If Option2.Value = True Then
Label4.Visible = True
Label4.Caption = "重复你的口令"
Text3.Visible = True
Text3.Text = ""
End If

End Sub

Private Sub Option3_Click()
If Option3.Value = True Then
Label4.Visible = True
Label4.Caption = "新口令"
Text3.Visible = True
Text3.Text = ""
End If

End Sub
Sub log()
For j = 1 To i - 1
If ntemp = username(j) Then
If ptemp = passw(j) Then
MsgBox "通讯录成功"
Text1.Text = ""
Text2.Text = ""
Exit Sub
Else
MsgBox "错误，请重试"
Text1.Text = ""
Text2.Text = ""
Exit Sub
End If
End If
Next j
If j = i Then
MsgBox "没有注册,请你先注册"
Text1.Text = ""
Text2.Text = ""
Exit Sub
End If

End Sub
Sub registr()
For j = 1 To i - 1
If ntemp = username(j) Then
MsgBox "已经沙市同。请换一个名"
Call cleartext
Exit Sub
End If
Next j
If j = i Then
ptemp2 = Text3.Text
If ptemp2 = ptemp Then
username(i) = ntemp
passw(i) = ptemp
MsgBox "注册成功“"
Call cleartext
i = i + 1
Exit Sub
Else
MsgBox "密码不一样”"
Call cleartext
Exit Sub
End If
End If


End Sub
Sub regcctv()
For j = 1 To i - 1
If ntemp = username(j) Then
If ptemp = passw(j) Then
ptemp2 = Text3.Text
If ptemp2 = InputBox("input your password again") Then
passw(j) = ptemp2
MsgBox "password 修改ok"
Call cleartext
Exit Sub
Else
MsgBox "password is 错误，请重试"
Call cleartext
Exit Sub
End If
End If
End If
Next j
If j = i Then
MsgBox "no注册，请注册“"
Call cleartext
Exit Sub
End If
End Sub
Private Sub cleartext()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""

End Sub