form1.frm

这个是锁屏器(鼠标锁)可以设置启动计算机时启动..达到保护计算机安全

VERSION 5.00
Object = "{E94E7F82-638E-4513-8C2F-1B51EAF59D7B}#1.1#0"; "wh_Menu.ocx"
Begin VB.Form Form1 
   BorderStyle     =   0  'None
   ClientHeight    =   4185
   ClientLeft      =   120
   ClientTop       =   120
   ClientWidth     =   5295
   ControlBox      =   0   'False
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Picture         =   "Form1.frx":08CA
   ScaleHeight     =   4185
   ScaleWidth      =   5295
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Visible         =   0   'False
   Begin VB.Timer Timer2 
      Interval        =   8000
      Left            =   2040
      Top             =   8000
   End
   Begin wh_Menu.VsNetMenu VsNetMenu1 
      Left            =   240
      Top             =   3240
      _ExtentX        =   926
      _ExtentY        =   926
      BmpCount        =   5
      Bmp:1           =   "Form1.frx":405A
      Mask:1          =   15579571
      Key:1           =   "#lock"
      Bmp:2           =   "Form1.frx":43AC
      Mask:2          =   12237498
      Key:2           =   "#change"
      Bmp:3           =   "Form1.frx":46FE
      Mask:3          =   12565701
      Key:3           =   "#exit"
      Bmp:4           =   "Form1.frx":4A50
      Mask:4          =   15497863
      Key:4           =   "#about"
      Bmp:5           =   "Form1.frx":4DA2
      Mask:5          =   9669261
      Key:5           =   "#stratlock"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   1080
      Top             =   3360
   End
   Begin MouseLock.xpcmdbutton xpcmdbutton2 
      Height          =   375
      Left            =   3840
      TabIndex        =   3
      Top             =   3240
      Width           =   1095
      _ExtentX        =   1931
      _ExtentY        =   661
      Caption         =   "取消"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin MouseLock.xpcmdbutton xpcmdbutton1 
      Default         =   -1  'True
      Height          =   375
      Left            =   2160
      TabIndex        =   2
      Top             =   3240
      Width           =   1095
      _ExtentX        =   1931
      _ExtentY        =   661
      Caption         =   "解锁"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.TextBox Text1 
      Height          =   270
      IMEMode         =   3  'DISABLE
      Left            =   1920
      PasswordChar    =   "*"
      TabIndex        =   0
      Top             =   1320
      Width           =   3015
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "请输入解锁密码:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   120
      TabIndex        =   1
      Top             =   1320
      Width           =   1695
   End
   Begin VB.Menu menu 
      Caption         =   "mene"
      Visible         =   0   'False
      Begin VB.Menu lock 
         Caption         =   "锁定电脑"
      End
      Begin VB.Menu stratlock 
         Caption         =   "开机锁定"
         Begin VB.Menu open1 
            Caption         =   "开启"
         End
         Begin VB.Menu close1 
            Caption         =   "关闭"
            Checked         =   -1  'True
         End
      End
      Begin VB.Menu change 
         Caption         =   "修改密码"
      End
      Begin VB.Menu about 
         Caption         =   "关于Lock"
      End
      Begin VB.Menu exit 
         Caption         =   "退出程序"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

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

Private Type RECT

    Left As Long
    
    Top As Long
    
    Right As Long
    
    Bottom As Long
    
End Type

Private Const GCL_HCURSOR = (-12)

Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long

Private Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Long) As Long

Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long

Private Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hWnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long

Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Dim mhBaseCursor As Long

Dim mhAniCursor As Long

Dim hhkLowLevelKybd As Long  'NT热键变量

Private Sub Form_Initialize()
  
  If App.PrevInstance Then End '避免重复运行程序
  
  Dim lnghandle1 As String

  lnghandle1 = MyGetSystemDirectory & "\wh_Menu.ocx"

  If Dir(lnghandle1) = "" Then SaveFileFromRes 101, "custom", MyGetSystemDirectory & "\wh_Menu.ocx"    '第一次运行控件不存在,释放菜单控件资源
  
  If Dir(MyGetSystemDirectory & "\PICCLP32.OCX") = "" Then SaveFileFromRes 103, "custom", MyGetSystemDirectory & "\PICCLP32.OCX"   '释放图形控件资源
   
  Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2 '窗口居中显示
      
End Sub

Private Sub Form_Load()
  
  Dim hKey As Long
  
  Dim myexe As String
  
  myexe = "lock" '建立启动注册表键名lock
  
  RegCreateKey HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run", hKey '系统程序怕更改路径所以启动时加入启动项目
     
  Dim Exename1 As String
  
  Exename1 = App.Path & "\lock.exe" '注册表键值
  
  RegSetValueEx hKey, myexe, 0, REG_SZ, ByVal Exename1, 100
     
  RegCloseKey hKey
     
  Text1 = ReadIni1(1)  '借文本框清除Ini文件读取的多余空字符,D41D8CD98F00B204E9800998ECF8427E是空密码的MD5值。
  
  If Text1 = "" Or Text1 = "D41D8CD98F00B204E9800998ECF8427E" Then Call MsgBox("锁定密码为空，请及时修改密码", vbOKOnly, "温馨提示")
  
  Text1 = ""           '完成过渡后清空文本框内容

  Call Icon_Add(Me.hWnd, Me.Caption, Me.Icon, 0)   '加载任务栏图标
  
  Dim StarTrue As String * 1
  
  StarTrue = ReadIni1(3)
      
  If StarTrue = "1" Then      '是否开机锁定
     
     open1.Checked = True
     
     close1.Checked = False
     
  Else
      
     If StarTrue = "0" Then
    
        open1.Checked = False
        
        close1.Checked = True
    
     Else
    
        open1.Checked = False '这是头次运行Ini文件中无设置
        
     End If
    
   End If
  
   Dim LockTrue As String * 1
  
   LockTrue = ReadIni1(2) '读取是否正常解锁
  
   If LockTrue = "1" Then lock_Click '如果Ini中因非法关机注销等即开机限制鼠标范围
  
End Sub

Private Sub Form_Paint()
      
  Call SetWindowPos(Me.hWnd, -1, 0, 0, 0, 0, 3)   '使窗体总在最前
  
End Sub

Private Sub lock_Click()
    
  Unload Form2
  
  Call LockWindows '限制鼠标范围
  
  WriteIni1 (2)   '写Ini中做判断是否正常解锁
  
  Me.Show
  
  Text1.SetFocus '文本框获取焦点
  
  Timer1 = True '监视用户是否按Ctrl+Alt+Del调用任务管理器
  
End Sub

Private Sub open1_Click()

  If open1.Checked = False Then
   
     open1.Checked = True
     
     close1.Checked = False
       
     WriteIni1 (4)
     
     WriteIni1 (2)

  End If
  
End Sub

Private Sub close1_Click()

  If close1.Checked = False Then
   
     open1.Checked = False
     
     close1.Checked = True
       
     WriteIni1 (5)
     
     WriteIni1 (3)
      
  End If
  
End Sub

Private Sub change_Click()
  
  Form2.Show  '修改密码
  
End Sub

Private Sub about_Click()
  
  ShellAbout Me.hWnd, "MouseLock 2.0 Build 4.23.06", "Created by Mr.David", ByVal 0&  '调用系统关于对话框
  
End Sub

Private Sub exit_Click()
   
  Unload Me '退出程序
  
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
  
  Dim l As Long
  
  l = x \ 15
  
  If l = WM_RBUTTONUP Then Me.PopupMenu menu  '判断按下右键
      
  If l = WM_LBUTTONDOWN Then Me.PopupMenu menu   '判断按下左键
 
End Sub

Private Sub Timer1_Timer()
  
  Call ProcessInfo
  
  Dim lResult As Long
  
  Dim RT_FormArea As RECT
    
  lResult = SetClassLong((Me.hWnd), GCL_HCURSOR, mhAniCursor) '限制鼠标范围
  
  lResult = GetWindowRect((Me.hWnd), RT_FormArea)
  
  lResult = ClipCursor(RT_FormArea)
  
End Sub

Private Sub Timer2_Timer()

  SetProcessWorkingSetSize GetCurrentProcess(), -1&, -1& '内存压缩
  
End Sub

Private Sub xpcmdbutton1_Click()
  
  Dim a As String
  
  Dim b As String
  
  a = Text1  'A为用户输入密码
  
  a = DigestStrToHexStr(Text1) '转换为MD5
  
  Text1 = ReadIni1(1) '读Ini
    
  b = Text1 'B为Ini中保存的密码
  
  If b = "" Then b = DigestStrToHexStr(b)
  
  If a = b Then
  
    UnlockWindows '解除锁定
    
    Text1 = ""  '清空密码
    
    WriteIni1 (3) '写正常解锁标记
  
    Me.Hide
    
    Timer1 = False '关闭实时监视器
          
  Else
  
    Text1 = ""  '清空错误密码
    
    Text1.SetFocus  '文本框获取焦点
  
  End If
    
End Sub

Private Sub xpcmdbutton2_Click()
  
  Text1 = ""       '清空密码并使文本框获取焦点
  
  Text1.SetFocus
    
End Sub

Private Sub LockWindows()
  
  Dim pOld As Boolean
               
  Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, pOld, 0)   '98系统使Ctrl+Alt+Del无效
     
  hhkLowLevelKybd = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0)  'NT系统屏蔽系统热键
       
End Sub

Private Sub UnlockWindows()

  Dim pOld As Boolean
  
  Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)   '98系统使Ctrl+Alt+Del有效
  
  UnhookWindowsHookEx hhkLowLevelKybd  'NT系统恢复热键
  
  hhkLowLevelKybd = 0
   
  Dim lResult As Long
  
  Dim RT_ScreenArea As RECT
  
  With RT_ScreenArea
  
    .Top = 0
    .Left = 0
    .Bottom = Screen.Height \ Screen.TwipsPerPixelX
    .Right = Screen.Width \ Screen.TwipsPerPixelY
  
  End With
  
  lResult = ClipCursor(RT_ScreenArea)
  
  lResult = SetClassLong((Me.hWnd), GCL_HCURSOR, mhBaseCursor)  '解除鼠标范围限制
  
  lResult = DestroyCursor(mhAniCursor)
      
End Sub

Private Sub Form_Unload(Cancel As Integer)
  
  Dim StarTrue As String * 1
  
  StarTrue = ReadIni1(3)
  
  If StarTrue = "1" Then WriteIni1 (2) '如果开机锁定则退出时候写加锁标记
  
  Unload Form2
  
  If hhkLowLevelKybd <> 0 Then UnhookWindowsHookEx hhkLowLevelKybd   'NT系统恢复热键
    
  Dim pOld As Boolean
          
  Call SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)   '退出前使ALT+CTL+DEL有效
  
  Call Icon_Del(Me.hWnd, 0)
  
  Set Form2 = Nothing
  
  Set Form1 = Nothing
  
End Sub