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