用户登录.frm

一个客车售票系统

VERSION 5.00
Begin VB.Form 用户登录 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "用户登录"
   ClientHeight    =   2535
   ClientLeft      =   2745
   ClientTop       =   2835
   ClientWidth     =   6150
   ControlBox      =   0   'False
   DrawStyle       =   1  'Dash
   FillStyle       =   0  'Solid
   Icon            =   "用户登录.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Moveable        =   0   'False
   ScaleHeight     =   2535
   ScaleWidth      =   6150
   Begin VB.TextBox Text1 
      Alignment       =   1  'Right Justify
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   345
      IMEMode         =   3  'DISABLE
      Left            =   2670
      PasswordChar    =   "*"
      TabIndex        =   0
      Top             =   930
      Width           =   2235
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "请输入密码："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   375
      Left            =   720
      TabIndex        =   1
      Top             =   930
      Width           =   1995
   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 RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult 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
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 FindWindow Lib "User32" Alias "FindWindowA" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "User32" (ByVal hwnd As Long, ByVal X As Long, _
 ByVal hWndInsterAfter As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private m_MidiFile1 As String
Private m_Media As String
Dim hWndl As Long
Const REG_SZ = 1
Const HKEY_CURRENT_USER = &H80000001
Const SWP_HIDEWINDOW = &H80
Const SWP_SHOWWINDOW = &H40
Dim Total As Integer, M As String
Private Sub Form_Load()
Dim strString As String
Dim RetVal As Long
On Error GoTo A1
  hWndl = FindWindow("Shell_traywnd", "")
  M = GetString(HKEY_CURRENT_USER, "RegData\AA", "")
  Exit Sub
A1:
    strString = " "
    SaveString HKEY_CURRENT_USER, "RegData", "AA", strString
End Sub
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
    Dim strString As String
    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)
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
Private 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)
Dim X As Integer
If KeyAscii = 13 Then
  If Text1 <> M Then
   Total = Total + 1
     If Total > 2 Then
        MsgBox "对不起，您无权使用本系统 ！        ", vbExclamation, "提示信息"
        Open App.Path + "\" + "Screen.txt" For Input As #1
        Input #1, apiRECT.Right
        Close #1
        Call SetWindowPos(hWndl, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
        Select Case apiRECT.Right
          Case 1024
            SetDisplayMode 1024, 768, 16
          Case 800
            SetDisplayMode 800, 600, 16
          Case 640
            SetDisplayMode 640, 480, 16
        End Select
'          If apiRECT.Right = 1024 Then
'        End If
'        If apiRECT.Right = 800 Then
'        End If
'        If apiRECT.Right = 640 Then
'        End If
        Unload Me
        End
     End If
   MsgBox "您的密码不正确，请重新输入密码 ！", vbExclamation, "提示信息"
   Text1 = ""
 Else
DoEvents
工作选项.Show
Unload Me
Unload 启动
End If
End If
End Sub