form1.frm

教你如何实现键盘开机

VERSION 5.00
Begin VB.Form FormMain 
   BackColor       =   &H00FF8080&
   BorderStyle     =   4  'Fixed ToolWindow
   ClientHeight    =   1185
   ClientLeft      =   345
   ClientTop       =   2280
   ClientWidth     =   5745
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   12
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1185
   ScaleWidth      =   5745
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.Image Image1 
      Height          =   480
      Left            =   4680
      Picture         =   "Form1.frx":0442
      Top             =   1080
      Visible         =   0   'False
      Width           =   480
   End
   Begin VB.Menu PG 
      Caption         =   "程序(&C)"
      Begin VB.Menu EXW 
         Caption         =   "退出Windows"
      End
      Begin VB.Menu shg 
         Caption         =   "-"
      End
      Begin VB.Menu EXP 
         Caption         =   "退出程序"
      End
   End
   Begin VB.Menu sz 
      Caption         =   "设置(&S)"
      Begin VB.Menu szzqd 
         Caption         =   "设置自启动"
      End
      Begin VB.Menu cxzqd 
         Caption         =   "撤消自启动"
      End
      Begin VB.Menu spb 
         Caption         =   "-"
      End
      Begin VB.Menu QS 
         Caption         =   "清除设置"
      End
      Begin VB.Menu sbpl 
         Caption         =   "-"
      End
      Begin VB.Menu OP 
         Caption         =   "选项..."
      End
   End
   Begin VB.Menu BZ 
      Caption         =   "帮助(&B)"
      Begin VB.Menu Hp 
         Caption         =   "帮助"
      End
      Begin VB.Menu sp2 
         Caption         =   "-"
      End
      Begin VB.Menu Ab 
         Caption         =   "关于..."
      End
   End
   Begin VB.Menu TaskBMn 
      Caption         =   ""
      Visible         =   0   'False
      Begin VB.Menu TaskQxKjj 
         Caption         =   "取消快捷键"
      End
      Begin VB.Menu TaskSp1 
         Caption         =   "-"
      End
      Begin VB.Menu TaskSzzqd 
         Caption         =   "设置自启动"
      End
      Begin VB.Menu TaskCxzqd 
         Caption         =   "撤消自启动"
      End
      Begin VB.Menu tasksp2 
         Caption         =   "-"
      End
      Begin VB.Menu TaskQcsz 
         Caption         =   "清除设置"
      End
      Begin VB.Menu TaskSp3 
         Caption         =   "-"
      End
      Begin VB.Menu TaskXx 
         Caption         =   "选项..."
      End
      Begin VB.Menu TaskSp4 
         Caption         =   "-"
      End
      Begin VB.Menu TaskHelp 
         Caption         =   "帮助"
      End
      Begin VB.Menu TaskAbout 
         Caption         =   "关于..."
      End
      Begin VB.Menu TaskSp5 
         Caption         =   "-"
      End
      Begin VB.Menu TaskExw 
         Caption         =   "退出Windows"
      End
      Begin VB.Menu TaskSp6 
         Caption         =   "-"
      End
      Begin VB.Menu TaskExP 
         Caption         =   "退出程序"
      End
   End
End
Attribute VB_Name = "FormMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Ab_Click()
ShellAbout hwnd, "BigChina-大中国#大中国", "  万里长城永不倒；" & vbCrLf & "  大汉民族当自强！" & vbCrLf & vbCrLf & "全世界炎黄子孙团结起来！", Icon
End Sub

Private Sub cxzqd_Click()
If SzQd(0) Then MsgBox "成功的撤消了自启动", vbInformation, ""
End Sub

Private Sub EXP_Click()
If MsgBox("退出后将无法使用快捷键，真的要退出吗？", vbYesNo + vbQuestion, "退出程序") = vbYes Then Unload Me
End Sub

Private Sub EXW_Click()
    ExitW.Show
End Sub

Private Sub Form_Click()
Hide
End Sub

Private Sub Form_Load()
If SetTaskB Then Else MsgBox "无法向任务栏加入图标": Show
MainHwnd = hwnd
If RegHk Then Else MsgBox "无法注册快捷键"
If RegPowIe Then Else MsgBox "无法注册开关机与Internet快捷键"
PreF = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf MainProc)
CxkjjF = False
End Sub

Private Sub Form_Paint()
PaintDesktop hdc
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = 0 Then
If MsgBox("退出后将无法使用快捷键，真的要退出吗？", vbYesNo + vbQuestion, "退出程序") = vbNo Then Cancel = 1: MsgBox "你只要单击窗体的空白处即可隐藏窗体", vbInformation, ""
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
UnRegHk
UnRegPowIe
SetWindowLong hwnd, GWL_WNDPROC, PreF
DelTaskB
Dim FrmUload As Form
For Each FrmUload In Forms
Unload FrmUload
Next
End Sub
Public Function RegHk&()
On Error GoTo erh
Dim HkQz&, Qz&
For HkQz = 0 To 9
    If Ch(HkQz) Then
    Qz = GetQzNum(GetSetting("BigChina", "Explorer", HkQz + 700, "0"))
    If Qz = -1 Then GoTo erh
    RegisterHotKey MainHwnd, &HB000 + HkQz, Qz, GetSetting("BigChina", "Explorer", HkQz + 1000, 48 + HkQz)
    End If
Next
For HkQz = 10 To 19
    If Ch(HkQz) Then
    Qz = GetQzNum(GetSetting("BigChina", "Explorer", HkQz + 700, "0"))
    If Qz = -1 Then GoTo erh
    RegisterHotKey MainHwnd, &HB000 + HkQz + 6, Qz, GetSetting("BigChina", "Explorer", HkQz + 1000, 86 + HkQz)
    End If
Next
RegHk = 1
Exit Function
erh:
    RegHk = 0
End Function
Public Function UnRegHk() As Long
On Error GoTo erh
Dim HkQz&
For HkQz = 0 To 9
    UnregisterHotKey MainHwnd, &HB000 + HkQz
Next
For HkQz = 16 To 25
    UnregisterHotKey MainHwnd, &HB000 + HkQz
Next
UnRegHk = 1
Exit Function
erh:
UnRegHk = 0
End Function

Private Sub Hp_Click()
Hide
If ShellExecute(MainHwnd, "open", "ReadMe.txt", vbNullString, App.Path, SW_SHOWMAXIMIZED) = 2 Then MsgBox "找不到帮助文件，请确认ReadMe.txt是否存在或你的系统里是否有程序与文本文件关联。", vbInformation, ""
End Sub

Private Sub OP_Click()
    FormPei.Show
End Sub
Private Function SzQd(ByVal id As Long) As Long
Dim hK&, He&
Dim ApH$
On Error GoTo erh
ApH = App.Path & "\" & App.EXEName
RegCreateKeyEx &H80000002, "Software\Microsoft\Windows\CurrentVersion\Run", 0, vbNullString, 0, 0, 0, hK, He
If id Then
RegSetValueEx hK, "BigChina-Ex", 0, REG_SZ, ApH, Len(ApH) + 1
Else
RegDeleteValue hK, "BigChina-Ex"
End If
RegCloseKey hK
SzQd = 1
Exit Function
erh:
SzQd = 0
End Function

Private Sub QS_Click()
If MsgBox("这将清除所有设置，要继续吗?", vbYesNo + vbQuestion, "") = vbYes Then
 DeleteSetting "BigChina", "Explorer"
 MsgBox "已将注册表中的相关内容清除", vbInformation, ""
End If
End Sub

Private Sub szzqd_Click()
If SzQd(1) Then MsgBox "成功的设置了自启动", vbInformation, ""
End Sub
Private Function GetQzNum(ByVal Qzn As Long) As Long
Select Case Qzn
    Case 0
        GetQzNum = &H1
    Case 1
        GetQzNum = &H2
    Case 2
        GetQzNum = &H4
    Case 3
        GetQzNum = &H8
    Case 4
        GetQzNum = &H1 Or &H4
    Case 5
        GetQzNum = &H1 Or &H2
    Case 6
        GetQzNum = &H1 Or &H8
    Case 7
        GetQzNum = &H2 Or &H8
    Case 8
        GetQzNum = &H4 Or &H8
    Case 9
        GetQzNum = 0
    Case Else
        MsgBox "注册快捷键时快捷键前缀非法", vbInformation, ""
        GetQzNum = -1
End Select
End Function
Private Function SetTaskB() As Long
On Error Resume Next
Dim Stb As NOTIFYICONDATA
Dim sz As String * 64
With Stb
    .cbSize = Len(Stb)
    .hIcon = Icon
    .hwnd = hwnd
    .szTip = "键盘开""机""" & Chr(0)
    .uCallbackMessage = &H600
    .uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
    .uID = 11&
End With
SetTaskB = Shell_NotifyIcon(NIM_ADD, Stb)
End Function
Private Function DelTaskB() As Long
Dim Stb As NOTIFYICONDATA
With Stb
    .cbSize = Len(Stb)
    .hwnd = hwnd
    .uID = 11&
End With
DelTaskB = Shell_NotifyIcon(NIM_DELETE, Stb)
End Function
Private Function ModTaskB(ByVal ImgId As Long) As Long
Dim Stb As NOTIFYICONDATA
With Stb
    .cbSize = Len(Stb)
    .hIcon = IIf(ImgId, Icon, Image1)
    .hwnd = hwnd
    .szTip = "键盘开""机""" & Chr(0)
    .uCallbackMessage = &H600
    .uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
    .uID = 11&
End With
ModTaskB = Shell_NotifyIcon(NIM_MODIFY, Stb)
End Function
Private Sub TaskAbout_Click()
Ab_Click
End Sub

Private Sub TaskCxzqd_Click()
cxzqd_Click
End Sub

Private Sub TaskExP_Click()
EXP_Click
End Sub

Private Sub TaskExw_Click()
EXW_Click
End Sub

Private Sub TaskHelp_Click()
Hp_Click
End Sub

Private Sub TaskQcsz_Click()
QS_Click
End Sub

Private Sub TaskQxKjj_Click()
CxkjjF = Not CxkjjF
If CxkjjF Then
    If UnRegHk Then
    If UnRegPowIe Then TaskQxKjj.Caption = "恢复快捷键": ModTaskB 0
    End If
Else
   If RegHk Then
   If RegPowIe Then TaskQxKjj.Caption = "取消快捷键": ModTaskB 1
   End If
End If
End Sub

Private Sub TaskSzzqd_Click()
szzqd_Click
End Sub

Private Sub TaskXx_Click()
OP_Click
End Sub
Public Function UnRegPowIe&()
On Error GoTo errh
Dim Xzid&
For Xzid = 0 To 2
UnregisterHotKey MainHwnd, &HB020 + Xzid
Next
UnRegPowIe = 1
Exit Function
errh:
UnRegPowIe = 0
End Function
Public Function RegPowIe&()
On Error GoTo erh
Dim Xzid&, XzId2&
For XzId2 = 0 To 2
    If ChHs(XzId2) Then
        Xzid = GetXz(GetSetting("BigChina", "Explorer", XzId2 + 6000, 3))
        If Xzid = -1 Then MsgBox "关机热键注册错误", vbInformation, "": GoTo erh
        RegisterHotKey hwnd, &HB020 + XzId2, Xzid, GetSetting("BigChina", "Explorer", XzId2 + 7000, 121 + XzId2)
    End If
Next
RegPowIe = 1
Exit Function
erh:
RegPowIe = 0
End Function
Private Function GetXz(ByVal Idd As Long) As Long
Select Case Idd
Case 0
GetXz = &H1
Case 1
GetXz = &H4
Case 2
GetXz = &H2
Case 3
GetXz = &H8
Case 4
GetXz = &H1 Or &H2
Case 5
GetXz = &H1 Or &H4
Case 6
GetXz = &H1 Or &H8
Case 7
GetXz = &H2 Or &H8
Case 8
GetXz = &H4 Or &H8
Case 9
GetXz = 0
Case Else
GetXz = -1
End Select
End Function