硬座票价调整.frm

一个客车售票系统

VERSION 5.00
Object = "{00028C01-0000-0000-0000-000000000046}#1.0#0"; "DBGRID32.OCX"
Begin VB.Form 硬座票价调整 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "票价调整"
   ClientHeight    =   8595
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   11850
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   573
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   790
   Begin MSDBGrid.DBGrid DBGrid1 
      Bindings        =   "硬座票价调整.frx":0000
      Height          =   6915
      Left            =   150
      OleObjectBlob   =   "硬座票价调整.frx":0014
      TabIndex        =   3
      Top             =   780
      Visible         =   0   'False
      Width           =   11595
   End
   Begin VB.Data Data1 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   345
      Left            =   1890
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   "硬座票价"
      Top             =   6870
      Visible         =   0   'False
      Width           =   1725
   End
   Begin VB.CommandButton Command2 
      Caption         =   "返   回"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   10140
      TabIndex        =   2
      Top             =   7890
      Width           =   1425
   End
   Begin VB.TextBox Text1 
      Alignment       =   1  'Right Justify
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   405
      IMEMode         =   3  'DISABLE
      Left            =   6120
      PasswordChar    =   "*"
      TabIndex        =   1
      Top             =   2700
      Width           =   2535
   End
   Begin VB.Label Label2 
      Caption         =   "硬  座  票  价  调  整"
      BeginProperty Font 
         Name            =   "华文隶书"
         Size            =   24
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   4050
      TabIndex        =   4
      Top             =   120
      Width           =   4545
   End
   Begin VB.Label Label1 
      Caption         =   "请输入密码："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   345
      Left            =   4080
      TabIndex        =   0
      Top             =   2760
      Width           =   1455
   End
End
Attribute VB_Name = "硬座票价调整"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const REG_SZ = 1
'Const YaoWei = 3 ' Free form binary
Const HKEY_CURRENT_USER = &H80000001
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
Dim Total As Integer, M As String
Private Sub Form_Load()
Data1.DatabaseName = App.Path + "\" + "列车客票.mdb"
Data1.RecordSource = "硬座票价"
   M = GetString(HKEY_CURRENT_USER, "RegData\AA", "")
Dim Q As String, Path As String
Dim W As Integer
Q = Me.hwnd
W = 0
Disabled Q, W
End Sub
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) 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:
   MsgBox "  注册表中没有数据，请输入数据 ！   "
   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

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
      X = MsgBox("您不能做票价调整 ！", vbExclamation, "提示信息")
      If X = 1 Then
         工作选项.Enabled = True
         Unload Me
       Exit Sub
      End If
     End If
   MsgBox "您输入的密码不正确，请重新输入密码 ！   ", vbExclamation, "提示信息"
   Text1 = ""
 Else
Text1.Visible = False
Label1.Visible = False
DBGrid1.Visible = True
End If
End If
End Sub
Private Sub Command2_Click()
'工作选项.Show
工作选项.Enabled = True
Unload Me
End Sub