desklock.frm

机房管理

VERSION 5.00
Begin VB.Form frmLock 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "是否锁定系统"
   ClientHeight    =   2895
   ClientLeft      =   3795
   ClientTop       =   4350
   ClientWidth     =   5340
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   Icon            =   "desklock.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   NegotiateMenus  =   0   'False
   ScaleHeight     =   2895
   ScaleWidth      =   5340
   Begin VB.PictureBox Picture1 
      Height          =   1155
      Left            =   1095
      ScaleHeight     =   1095
      ScaleWidth      =   2205
      TabIndex        =   5
      Top             =   345
      Width           =   2265
      Begin VB.CommandButton OneKey 
         Caption         =   "1"
         Height          =   540
         Left            =   435
         TabIndex        =   15
         Top             =   0
         Width           =   435
      End
      Begin VB.CommandButton TwoKey 
         Caption         =   "2"
         Height          =   540
         Left            =   885
         TabIndex        =   14
         Top             =   0
         Width           =   435
      End
      Begin VB.CommandButton ThreeKey 
         Caption         =   "3"
         Height          =   540
         Left            =   1320
         TabIndex        =   13
         Top             =   0
         Width           =   435
      End
      Begin VB.CommandButton FourKey 
         Caption         =   "4"
         Height          =   540
         Left            =   1770
         TabIndex        =   12
         Top             =   0
         Width           =   435
      End
      Begin VB.CommandButton FiveKey 
         Caption         =   "5"
         Height          =   540
         Left            =   0
         TabIndex        =   11
         Top             =   555
         Width           =   435
      End
      Begin VB.CommandButton SixKey 
         Caption         =   "6"
         Height          =   540
         Left            =   435
         TabIndex        =   10
         Top             =   555
         Width           =   435
      End
      Begin VB.CommandButton SevenKey 
         Caption         =   "7"
         Height          =   540
         Left            =   870
         TabIndex        =   9
         Top             =   555
         Width           =   435
      End
      Begin VB.CommandButton EightKey 
         Caption         =   "8"
         Height          =   540
         Left            =   1320
         TabIndex        =   8
         Top             =   555
         Width           =   435
      End
      Begin VB.CommandButton NineKey 
         Caption         =   "9"
         Height          =   540
         Left            =   1770
         TabIndex        =   7
         Top             =   555
         Width           =   435
      End
      Begin VB.CommandButton ZeroKey 
         Caption         =   "0"
         Height          =   540
         Left            =   0
         TabIndex        =   6
         Top             =   0
         Width           =   435
      End
   End
   Begin VB.TextBox hinthintS 
      Height          =   270
      Left            =   1950
      TabIndex        =   0
      Top             =   2970
      Width           =   345
   End
   Begin VB.CommandButton Lock_switch 
      BackColor       =   &H000000FF&
      Caption         =   "锁定(&L)"
      Height          =   450
      Left            =   3765
      TabIndex        =   3
      ToolTipText     =   "锁定与解锁"
      Top             =   390
      Width           =   1290
   End
   Begin VB.CommandButton CloseButton 
      BackColor       =   &H00C0C0C0&
      Cancel          =   -1  'True
      Height          =   435
      Left            =   3765
      Picture         =   "desklock.frx":08CA
      Style           =   1  'Graphical
      TabIndex        =   1
      ToolTipText     =   "关闭"
      Top             =   915
      Width           =   1290
   End
   Begin VB.Line Line2 
      BorderColor     =   &H00FFFFFF&
      X1              =   255
      X2              =   5115
      Y1              =   1620
      Y2              =   1620
   End
   Begin VB.Line Line1 
      X1              =   255
      X2              =   5115
      Y1              =   1605
      Y2              =   1605
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   $"desklock.frx":2036
      ForeColor       =   &H00E0E0E0&
      Height          =   630
      Left            =   270
      TabIndex        =   4
      Top             =   1785
      Width           =   4890
   End
   Begin VB.Image Image2 
      BorderStyle     =   1  'Fixed Single
      Height          =   1215
      Left            =   240
      OLEDropMode     =   1  'Manual
      Picture         =   "desklock.frx":20E0
      Top             =   330
      Width           =   720
   End
   Begin VB.Image Image1 
      Height          =   1350
      Left            =   15
      Picture         =   "desklock.frx":48D6
      Top             =   15
      Visible         =   0   'False
      Width           =   1350
   End
   Begin VB.Label hinthint 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "技术支持：VB中国 [温州东化计算机科技有限公司]"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00E0E0E0&
      Height          =   180
      Left            =   300
      MouseIcon       =   "desklock.frx":A8B8
      MousePointer    =   99  'Custom
      TabIndex        =   2
      Top             =   2460
      Width           =   4050
   End
End
Attribute VB_Name = "frmLock"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const WM_CLOSE = &H10&
Dim opt1 As String
Dim opt2 As String
Dim opt3 As String
Dim opt4 As String

Dim locked As Integer
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Const SPI_SCREENSAVERRUNNING = 97
Public privatecode As String
Dim hintlabel As String
Dim code As String

Function CloseApplication(ByVal sAppCaption As String) As Boolean

Dim lHwnd As Long
Dim lRetVal As Long
lHwnd = FindWindow(vbNullString, sAppCaption)
If lHwnd <> 0 Then
  lRetVal = PostMessage(lHwnd, WM_CLOSE, 0&, 0&)
End If

End Function

Private Sub Form_Unload(Cancel As Integer)
  
  FL = False
  SaveSetting App.EXEName, "Option", "Lock_L", Me.left
  SaveSetting App.EXEName, "Option", "Lock_T", Me.tOp
  
End Sub

Private Sub hinthint_Click()

  ShellEx "http://www.vb-code.net"
  
End Sub

Private Sub Lock_switch_Click()

' 锁定按钮按时
   If code = privatecode Then
   locked = 0
   Lock_switch.Caption = "锁定(&L)"
   Call unloc
   Else
      Call Clear
      locked = 1
      Call Lockit
      Lock_switch.Caption = "解锁(&U)"
   End If
   
End Sub

Private Sub NineKey_Click()

   code = code + "9"
   If Len(code) > 10 Then
   code = ""
   End If
hinthintS.SetFocus

End Sub

Private Sub ZeroKey_Click()
   
   code = code + "0"
   If Len(code) > 10 Then
   code = ""
   End If
hinthintS.SetFocus

End Sub

Private Sub CloseButton_Click()

On Error GoTo Err_unload
' 关闭程序
Call cClipCursor
Dim ret As Integer
Dim pOld As Boolean
ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)

'Call CloseApplication("desklock") '关闭应用程序
 Unload frmLock
  Exit Sub
Err_unload:
 MsgBox "表单御载错误!    " & vbCrLf & vbCrLf & Err.Description, vbCritical
 
End Sub

Private Sub SevenKey_Click()

code = code + "7"
   If Len(code) > 10 Then
   code = ""
   End If
hinthintS.SetFocus

End Sub

Private Sub EightKey_Click()

code = code + "8"
   If Len(code) > 10 Then
   code = ""
   End If
hinthintS.SetFocus

End Sub

Private Sub Form_Load()
  
  FL = True
  On Error GoTo Err_Load
  Dim L As Long, T As Long
  L = Val(GetSetting(App.EXEName, "Option", "Lock_L", 2000))
  T = Val(GetSetting(App.EXEName, "Option", "Lock_T", 2000))
  Me.left = L
  Me.tOp = T

' 设定系统路径
  Dim sFileBuffer As String * 250, retVal As Long, sSystemInI As String
     
     retVal = GetSystemDirectory(sFileBuffer, 251)
  If retVal = 0 Then
     sSystemInI = "C:\Windows\System\SysLock.InI"
   Else
     sSystemInI = left(sFileBuffer, InStr(1, sFileBuffer, Chr(0), vbBinaryCompare) - 1)
     sSystemInI = sSystemInI & "\SysLock.InI"
  End If
   
frmLock.KeyPreview = True
On Error GoTo 1000            '第一次运行，文件不存在时
Open sSystemInI For Input As 1
Input #1, privatecode
Close 1
GoTo 1010
1000 '
Close 1
Open sSystemInI For Output As 1
Print #1, "88888888"
Close 1
privatecode = "88888888"
hintlabel = "  必须输入密码： 初始为 88888888"
1010 '
On Error GoTo 0

  Exit Sub
Err_Load:
 MsgBox "表单加载错误!    " & vbCrLf & vbCrLf & Err.Description, vbCritical
 
End Sub

Private Sub OneKey_Click()

code = code + "1"
   If Len(code) > 10 Then
   code = ""
   End If
 hinthintS.SetFocus
 
End Sub

Private Sub TwoKey_Click()

code = code + "2"
   If Len(code) > 10 Then
   code = ""
   End If
hinthintS.SetFocus

End Sub

Private Sub ThreeKey_Click()

code = code + "3"
   If Len(code) > 10 Then
   code = ""
   End If
   hinthintS.SetFocus
   
End Sub

Private Sub FourKey_Click()

code = code + "4"
   If Len(code) > 10 Then
   code = ""
   End If
   hinthintS.SetFocus
   
End Sub

Private Sub FiveKey_Click()

code = code + "5"
   If Len(code) > 10 Then
   code = ""
   End If
   hinthintS.SetFocus
   
End Sub

Private Sub SixKey_Click()

code = code + "6"
   If Len(code) > 10 Then
   code = ""
   End If
   hinthintS.SetFocus
   
End Sub

Private Sub Form_Click()

'Lock_switch.Caption = "解锁(&U)"
'locked = 1
'Call Lockit

End Sub

Public Sub cClipCursor()

On Error GoTo Err_mouse
Dim client As RECT
Dim upperleft As POINT
    If locked = 1 Then
        GetClientRect Me.hwnd, client
        upperleft.x = client.left
        upperleft.y = client.tOp
        ClientToScreen Me.hwnd, upperleft
        OffsetRect client, upperleft.x, upperleft.y
        ClipCursor client
    Else
        ClipCursor ByVal 0&
    End If
  Exit Sub
Err_mouse:
 MsgBox "控制鼠标错误!    " & vbCrLf & vbCrLf & Err.Description, vbCritical
 
End Sub

Private Sub Clear()

' 清除代码
  code = ""
  
End Sub

Private Sub unloc()

  On Error GoTo Err_Unloc
' 解锁
  locked = 0
  Call cClipCursor
  Call Clear
  CloseButton.Visible = True
  Dim ret As Integer
  Dim pOld As Boolean
  ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)

  Unload frmLock
  'Call CloseApplication("desklock") ' 关闭程序
  Exit Sub
Err_Unloc:
 MsgBox "解锁错误!    " & vbCrLf & vbCrLf & Err.Description, vbCritical
 
End Sub

Public Sub Lockit()

On Error GoTo Err_Lock
' 锁定系统
locked = 1
Call cClipCursor  '捕捉鼠标
Lock_switch.Caption = "解锁(&U)"
CloseButton.Visible = False   '不显示关闭按钮

Dim ret As Integer
Dim pOld As Boolean
ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, pOld, 0)
Call Clear
  Exit Sub
Err_Lock:
 MsgBox "锁定错误!    " & vbCrLf & vbCrLf & Err.Description, vbCritical
 
End Sub

Private Sub Form_Paint()

Dim intX As Integer
Dim intY As Integer
For intX = 0 To frmLock.Width Step Image1.Width
   For intY = 0 To frmLock.Height Step (Image1.Height - 12)
     PaintPicture Image1, intX, intY
   Next intY
Next intX

End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)

KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
Lock_switch.Value = True
End If
If KeyAscii = 48 Then
ZeroKey.Value = True
End If
If KeyAscii = 49 Then
OneKey.Value = True
End If
If KeyAscii = 50 Then
TwoKey.Value = True
End If
If KeyAscii = 51 Then
ThreeKey.Value = True
End If
If KeyAscii = 52 Then
FourKey.Value = True
End If
If KeyAscii = 53 Then
FiveKey.Value = True
End If
If KeyAscii = 54 Then
SixKey.Value = True
End If
If KeyAscii = 55 Then
SevenKey.Value = True
End If
If KeyAscii = 56 Then
EightKey.Value = True
End If
If KeyAscii = 57 Then
NineKey.Value = True
End If
If KeyAscii = 72 Then
OptionButton.Value = True
End If
If KeyAscii = 88 Then
   If locked <> 1 Then
      CloseButton.Value = True
   End If
End If

End Sub