用户登录.frm

财务管理系统！ 经过本人操作可以使用！

VERSION 5.00
Begin VB.Form 用户登录 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "用户登录"
   ClientHeight    =   2370
   ClientLeft      =   3930
   ClientTop       =   2925
   ClientWidth     =   4830
   ControlBox      =   0   'False
   Icon            =   "用户登录.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2370
   ScaleWidth      =   4830
   Begin VB.TextBox Text2 
      Alignment       =   1  'Right Justify
      Height          =   300
      IMEMode         =   3  'DISABLE
      Left            =   1680
      PasswordChar    =   "*"
      TabIndex        =   3
      Top             =   1560
      Width           =   2175
   End
   Begin VB.TextBox Text1 
      Alignment       =   1  'Right Justify
      Height          =   300
      IMEMode         =   3  'DISABLE
      Left            =   1680
      PasswordChar    =   "*"
      TabIndex        =   2
      Top             =   1080
      Width           =   2175
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000005&
      BorderWidth     =   2
      X1              =   0
      X2              =   4800
      Y1              =   810
      Y2              =   810
   End
   Begin VB.Image Image1 
      Height          =   480
      Left            =   90
      Picture         =   "用户登录.frx":0442
      Top             =   180
      Width           =   480
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "用 户 登 录"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   26.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   525
      Left            =   960
      TabIndex        =   4
      Top             =   90
      Width           =   2970
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "密  码："
      Height          =   180
      Left            =   600
      TabIndex        =   1
      Top             =   1590
      Width           =   720
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "用户名："
      Height          =   255
      Left            =   600
      TabIndex        =   0
      Top             =   1140
      Width           =   1695
   End
End
Attribute VB_Name = "用户登录"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'API函数声明
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 RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) 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 RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) 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
Const REG_SZ = 1
Const HKEY_CURRENT_USER = &H80000001
Dim Total As Integer, Uname As String, Pass As String
Private Sub Form_Load()
Dim strString As String
Dim RetVal As Long
On Error GoTo A1
Me.Left = (主程序.Width - Me.Width) / 2
Me.Top = (主程序.Height - Me.Height) / 3
  Uname = GetString(HKEY_CURRENT_USER, "RegData\UserName", "")
  Pass = GetString(HKEY_CURRENT_USER, "RegData\PassWord", "")
  Exit Sub
A1:
    strString = " "
    SaveString HKEY_CURRENT_USER, "RegData", "UserName", strString
    SaveString HKEY_CURRENT_USER, "RegData", "PassWord", strString
End Sub
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
    Dim strString As String
On Error GoTo A1
    Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
    RegQueryValueEx hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize
    strBuf = String(lDataBufSize, Chr$(0))
    RegQueryValueEx hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize
    RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
    Exit Function
A1:
    strString = " "
    SaveString HKEY_CURRENT_USER, "RegData", "AA", strString
    Text1.Text = ""
    Text1.SetFocus
End Function
Function GetString(hKey As Long, strPath As String, strValue As String)
    Dim Ret
    RegOpenKey hKey, strPath, Ret
    GetString = RegQueryStringValue(Ret, strValue)
    RegCloseKey Ret
End Function
Sub SaveString(hKey As Long, strPath As String, strValue As String, strData As String)
    Dim Ret
    RegCreateKey hKey, strPath, Ret
    RegSetValue Ret, strValue, REG_SZ, strData, Len(strData)
    RegCloseKey Ret
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
  If Text1 <> Uname Then
   Total = Total + 1
     If Total > 2 Then
        MsgBox "用户名错，对不起，您无权使用本系统 ！        ", vbExclamation, "提示信息"
        End
     End If
   MsgBox "您的用户名不正确，请重新输入用户名 ！", vbExclamation, "提示信息"
   Text1 = ""
 Else
 Text2 = ""
 Text2.SetFocus
 Total = 0
End If
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
  If Text2 <> Pass Then
   Total = Total + 1
     If Total > 2 Then
        MsgBox "密码错，对不起，您无权使用本系统 ！        ", vbExclamation, "提示信息"
        End
     End If
   MsgBox "您的用密码不正确，请重新输入密码 ！", vbExclamation, "提示信息"
   Text2 = ""
   Text2.SetFocus
 Else
主程序.Show
Unload Me
Unload 启动
End If
End If
End Sub