module1.bas

教你如何实现键盘开机

Attribute VB_Name = "Module1"
Option Explicit
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const WM_SETHOTKEY = &H32
Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Public Declare Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long
Public Const EWX_FORCE = 4
Public Const EWX_LOGOFF = 0
Public Const EWX_REBOOT = 2
Public Const EWX_SHUTDOWN = 1
Public Const SW_HIDE = 0
Public Const SW_NORMAL = 1
Public Const SW_MAX = 10
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWDEFAULT = 10
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public 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
Public Const HWND_BOTTOM = 1
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Declare Function PaintDesktop Lib "user32" (ByVal hdc As Long) As Long
Public Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, ByVal lpSecurityAttributes As Long) As Long
Public Declare Function SHFileOperation Lib "shell32.dll" (lpFileOp As SHFILEOPSTRUCT) As Long
Public Type SHFILEOPSTRUCT
        hwnd As Long
        wFunc As Long
        pFrom As String
        pTo As String
        fFlags As Integer
        fAnyOperationsAborted As Long
        hNameMappings As Long
        lpszProgressTitle As String '  only used if FOF_SIMPLEPROGRESS
End Type
Public Const FO_COPY = &H2
Public Const FO_DELETE = &H3
Public Const FO_MOVE = &H1
Public Const FO_RENAME = &H4
Public Const FOF_ALLOWUNDO = &H40
Public Const FOF_CONFIRMMOUSE = &H2
Public Const FOF_FILESONLY = &H80
Public Const FOF_MULTIDESTFILES = &H1
Public Const FOF_NOCONFIRMATION = &H10
Public Const FOF_NOCONFIRMMKDIR = &H200
Public Const FOF_RENAMEONCOLLISION = &H8
Public Const FOF_SILENT = &H4
Public Const FOF_SIMPLEPROGRESS = &H100
Public Const FOF_WANTMAPPINGHANDLE = &H20
Public Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
Public Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Public Const MOD_ALT = &H1
Public Const MOD_CONTROL = &H2
Public Const MOD_SHIFT = &H4
Public Const MOD_WIN = &H8
Public Const GWL_WNDPROC = (-4)
Public Const WM_HOTKEY = &H312
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Type OPENFILENAME
        lStructSize As Long
        hwndOwner As Long
        hInstance As Long
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
End Type
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_LONGNAMES = &H200000
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
Public Const REG_SZ = 1
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public 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
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const NIM_MODIFY = &H1
Public Const WM_RBUTTONDOWN = &H204
Public Type NOTIFYICONDATA
        cbSize As Long
        hwnd As Long
        uID As Long
        uFlags As Long
        uCallbackMessage As Long
        hIcon As Long
        szTip As String * 64
End Type
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_SYSCOMMAND = &H112
Public Const SC_MINIMIZE = &HF020&
Public Const WM_SHOWWINDOW = &H18

Public Windir$
Public SysDir$, DeskhWnd&, MainHwnd&
Public Ch(19) As Boolean, PreF&, CxkjjF As Boolean
Public ChHs(2) As Boolean
Public Sub Main()
Dim Windir_ As String * 256
Dim SysDir_ As String * 256
Dim nWindir_&, nSysdir_&, nCh&
nWindir_ = GetWindowsDirectory(Windir_, 255)
If nWindir_ Then
    Windir = Mid(Windir_, 1, nWindir_)
Else
    MsgBox "程序启动出错，请重新启动计算机，或查毒", , ""
End If
nSysdir_ = GetSystemDirectory(SysDir_, 255)
If nSysdir_ Then
    SysDir = Mid(SysDir_, 1, nSysdir_)
Else
    MsgBox "程序启动出错，请重新启动计算机，或查毒", , ""
End If
DeskhWnd = GetDesktopWindow
For nCh = 0 To 19
    Ch(nCh) = GetSetting("BigChina", "Explorer", nCh, 0)
Next
For nCh = 0 To 2
    ChHs(nCh) = GetSetting("BigChina", "Explorer", nCh + 5000, 0)
Next
Load FormMain
End Sub
Public Function GetKjj(ByVal id As Long) As String
    GetKjj = GetSetting("BigChina", "Explorer", id + 100)
End Function
Public Function MainProc&(ByVal hwnd&, ByVal msg&, ByVal Wp&, ByVal Lp&)
On Error GoTo ErrRe
Dim Zhixing As Boolean, Minling As String, ChecNum&, ErrNum&, MdCs$, Xw&, ZhixingHs As Boolean
Zhixing = False: ZhixingHs = False
If msg = WM_HOTKEY Then
    Select Case Wp
        Case &HB000
            Zhixing = Ch(0): ChecNum = 0
        Case &HB001
            Zhixing = Ch(1): ChecNum = 1
        Case &HB002
            Zhixing = Ch(2): ChecNum = 2
        Case &HB003
            Zhixing = Ch(3): ChecNum = 3
        Case &HB004
            Zhixing = Ch(4): ChecNum = 4
        Case &HB005
            Zhixing = Ch(5): ChecNum = 5
        Case &HB006
            Zhixing = Ch(6): ChecNum = 6
        Case &HB007
            Zhixing = Ch(7): ChecNum = 7
        Case &HB008
            Zhixing = Ch(8): ChecNum = 8
        Case &HB009
            Zhixing = Ch(9): ChecNum = 9
        Case &HB010
            Zhixing = Ch(10): ChecNum = 10
        Case &HB011
            Zhixing = Ch(11): ChecNum = 11
        Case &HB012
            Zhixing = Ch(12): ChecNum = 12
        Case &HB013
            Zhixing = Ch(13): ChecNum = 13
        Case &HB014
            Zhixing = Ch(14): ChecNum = 14
        Case &HB015
            Zhixing = Ch(15): ChecNum = 15
        Case &HB016
            Zhixing = Ch(16): ChecNum = 16
        Case &HB017
            Zhixing = Ch(17): ChecNum = 17
        Case &HB018
            Zhixing = Ch(18): ChecNum = 18
        Case &HB019
            Zhixing = Ch(19): ChecNum = 19
        Case &HB020
            ZhixingHs = ChHs(0): ChecNum = 0
        Case &HB021
            ZhixingHs = ChHs(1): ChecNum = 1
        Case &HB022
            ZhixingHs = ChHs(2): ChecNum = 2
    End Select
    If Zhixing Then
        Minling = GetKjj(ChecNum)
        Dim SwMd&, Tmpswmd&
        Tmpswmd = GetSetting("BigChina", "Explorer", "ShowMode", "1")
        If Tmpswmd = 0 Then
            SwMd = SW_SHOWMAXIMIZED: MdCs = "最大化"
        ElseIf Tmpswmd = 1 Then
            SwMd = SW_SHOWDEFAULT: MdCs = "缺省"
        ElseIf Tmpswmd = 2 Then
            SwMd = SW_SHOWMINIMIZED: MdCs = "最小化"
        End If
        If GetSetting("BigChina", "Explorer", "Kjxw", "0") = "1" Then
            SetForegroundWindow MainHwnd
            If MsgBox("真的要以" & MdCs & "方式启动" & vbCrLf & Minling & "吗？", vbYesNo, "快捷键启动") = vbNo Then GoTo XwExit
        End If
        ErrNum = ShellExecute(MainHwnd, "open", Minling, vbNullString, vbNullString, SwMd)
XwExit:
    ElseIf ZhixingHs Then
        Select Case ChecNum
            Case 0
            If MsgBox("真的要关机吗？请确保你已经保存了所有应保存的数据！", vbYesNo, "快捷键关机") = vbYes Then ExitWindowsEx EWX_FORCE Or EWX_SHUTDOWN, 0
            Case 1
            If MsgBox("真的要重启吗？请确保你已经保存了所有应保存的数据！", vbYesNo, "快捷键关机") = vbYes Then ExitWindowsEx EWX_FORCE Or EWX_REBOOT, 0
            Case 2
            ErrNum = ShellExecute(MainHwnd, "open", GetSetting("BigChina", "Explorer", "TxtIetNr", "Http://www.cufe.edu.cn"), vbNullString, vbNullString, SW_SHOWMAXIMIZED)
        End Select
    End If
ElseIf msg = &H600 Then
    If Lp = WM_RBUTTONDOWN Then
    FormMain.PopupMenu FormMain.TaskBMn
    ElseIf Lp = WM_LBUTTONDBLCLK Then
    FormMain.Show
    SetForegroundWindow MainHwnd
    End If
End If
ErrRe:
MainProc = CallWindowProc(PreF, hwnd, msg, Wp, Lp)
End Function