一、引言
在Windows桌面上創建快捷方式的應用程序，可以通過設置它的屬性來實現一鍵調用該程序的功能（即“一鍵功能”），可是，如果每個常用程序都通過創建快捷方式來實現“一鍵功能”，則桌面上將顯得雜亂無章; 怎樣才能既不為應用程序創建快捷方式，又能實現“一鍵功能”呢？下面介紹用VB編程實現“一鍵功能”的方法及其應用。

二、編程原理

在API函數中有一個GetAsyncKeyState函數，功能是判斷函數調用時指定虛擬鍵的狀態，即調用該函數時，可以檢測到用戶想檢測的鍵是否被按下該函數的聲明如下:
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
參數vKey表示想檢測鍵的掃描代碼，該掃描代碼由vbKey和鍵面字符組成，例如F1、F2、F3、A的掃描代碼分別為vbKeyF1、vbKeyF2、vbKeyF3、vbKeyA。如果用戶按下指定的鍵，函數的返回值為小于0的整數，否則返回大于或等于0的整數。因此，可以根據返回值是否小于0，檢測是否按下指定的鍵。該函數還有一個非常好的特點，那就是無論調用它的程序是在前臺還是在后臺運行，它都能夠檢測鍵盤上某一鍵是否被按下（即一旦調該函數，它在整個系統范圍內都有效）。利用這個特點，我們便可以為某一個功能鍵定義一個應用程序，然后再用計時器實時檢測該鍵狀態，當該鍵被按下時調用該應用程序，從而實現“一鍵功能”。

三、應用編程

利用上述原理進行以下兩個方面的應用：1、一鍵調用編程實現的特定功能（過程的功能）;2、一鍵調用安裝在Windows下的應用程序。
對于第一方面的應用，主要是編寫一些特定功能的過程，如關機、重新啟動、打開光驅、關閉光驅，鎖定屏幕。它的編程思路是（這些功能都是簡單地調用API函數實現的，這里不再敘述）: 程序運行時，首先檢測是否為這些功能定義了快捷鍵（保存在FunctionKey.txt文件中），如果沒有定義，則顯示如圖所示的界面，讓用戶定義快捷鍵并保存。如果已經定義，則把它們讀到與特定功能的函數相對應的數組元素中，并顯示在應用程序界面的相應位置。如果此時你按下了某個已經定義的功能鍵，當GetAsyncKeyState函數檢測到后，便立即執行相應的過程。
對于第二方面的應用，主要是讓用戶為自己常用的應用程序定義快捷鍵（可以任意定義功能鍵和應用程序），從而可以方便快捷地打開它。它的編程思路與第一種相同，所不同的是，在CustomKey.txt文件中保存的是快捷鍵和與之相對應的應用程序文件名（包括路徑），當讀文件時，是把快捷鍵和應用程序文件名分別讀到不同的數組元素中。
好啦，下面讓我們動手實踐一下。啟動VB并新建一個名為AkeyFunction工程，窗體文件名也為AkeyFunction，然后在窗體上添加以下控件: 兩個框架、六個下拉組合框、五個命令按鈕、八個標簽、一個列表框、一個計時器、一個通用對話框，界面設計如圖1所示（運行時計時器和通用對話框不可見）。修改窗體的名稱為“一鍵功能”，BorderStyle為1，ControlBox為False，Visible為False，KeyPreview為True; 兩個框架的Caption分別為“特定功能區”、“自定義功能區”; 六個下拉組合框為一個數組，名稱為cmbChooseKey，Text都為空; 五個命令按鈕的名稱依次為cmdAdd、cmdDel、cmdOk、cmdCancel、cmdApply，Caption依次為“添加…”、“刪除”、“確定”、“取消”、“應用”; 八個標簽的Caption依次為“提示: 當程序運行時，按F12顯示該界面”、“快捷鍵”、“特定功能”、“關機”、“重新啟動”、“鎖定屏幕”、“打開光驅”、“關閉光驅”; 計時器的Interval為200; 通用對話框的名稱cmnAdd; 其他屬性使用缺省值。
下面是完整的源程序代碼：
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const WM_SYSCOMMAND = &H112&
Const WM_SCREENSAVE = &HF140&

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, _
ByVal dwReserved As Long) As Long
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength _
As Long, ByVal hwndCallback As Long) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias _
"GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd _
As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim iFunctionKey(5) As Integer, a() As String, iCustomFunction() As Integer
Dim strKeyFile() As String, strKey

'檢測到定義的快捷鍵被按下時，返回True，否則為Falsh
Private Function MyHotKey(vKeyCode As Integer) As Boolean
MyHotKey = (GetAsyncKeyState(vKeyCode) < 0)
End Function

'重新啟動計算機
Private Sub RebootComputer()
Dim a As Integer
a = ExitWindowsEx(EWX_REBOOT, 0)
End Sub

'關閉計算機
Private Sub CloseComputer()
Dim a As Integer
a = ExitWindowsEx(EWX_SHUTDOWN, 0)
End Sub

'打開屏幕保護程序
Private Sub LockComputer()
Dim result As Long
result = SendMessage(Form1.hWnd, WM_SYSCOMMAND, WM_SCREENSAVE, 0&)
End Sub

'打開光驅
Private Sub OpenCDROM()
Dim Ret As Long
Dim RetStr As String
Ret = mciSendString("set CDAudio door open", RetStr, 0, 0)
End Sub

'關閉光驅
Private Sub CloseCDROM()
Dim Ret As Long
Dim RetStr As String
Ret = mciSendString("set CDAudio door closed", RetStr, 0, 0)
End Sub

'檢測是否重復定義快捷鍵
Private Sub RedefineFuncKey(strCmbtxt As String, inumber As Integer)
Dim i As Integer
'檢測當前要定義的快捷鍵是否與特定功能區中已定義的快捷鍵重復
For i = 0 To 5
If strCmbtxt = cmbChooseKey(i) And strCmbtxt <> "無" And inumber <> i Then
MsgBox strCmbtxt & "功能鍵已經定義，請選擇其他功能鍵", vbInformation, "提示"
cmbChooseKey(inumber) = "無"
Exit Sub
End If
Next
'檢測當前要定義的快捷鍵是否與自定義功能區中已定義的快捷鍵重復
For i = 0 To List1.ListCount - 1
If strCmbtxt = Trim(Mid(List1.List(i), 1, 3)) Then
MsgBox strCmbtxt & "功能鍵已經定義，請選擇其他功能鍵", vbInformation, "提示"
cmbChooseKey(inumber) = "無"
Exit Sub
End If
Next
End Sub

'以下四個過程是只允許用戶從下拉組合框中選擇快捷鍵
Private Sub Lockcombobox()
Dim i As Integer
For i = 0 To 5
'鎖住下拉組合框中的文本
cmbChooseKey(i).Locked = True
Next
End Sub

Private Sub unLockcombobox()
Dim i As Integer
For i = 0 To 5
'解開下拉組合框中的文本
cmbChooseKey(i).Locked = False
Next
End Sub

Private Sub cmbChooseKey_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
Lockcombobox
'鎖定上、下方向鍵,禁示用戶通過方向鍵來改變快捷鍵，從而避免設置相同的快捷鍵
If KeyCode = vbKeyUp Or KeyCode = vbKeyDown Then
KeyCode = 0
End If
End Sub

Private Sub cmbChooseKey_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
unLockcombobox
End Sub

'把鍵面字符轉變成相應的鍵盤掃描碼
Private Function strKeyToLong(strKey As String) As Integer
Dim i As Long
Select Case strKey
Case "F2"
i = vbKeyF2
Case "F3"
i = vbKeyF3
Case "F4"
i = vbKeyF4
Case "F5"
i = vbKeyF5
Case "F6"
i = vbKeyF6
Case "F7"
i = vbKeyF7
Case "F8"
i = vbKeyF8
Case "F9"
i = vbKeyF9
Case "F10"
i = vbKeyF10
Case "F11"
i = vbKeyF11
End Select
strKeyToLong = i
End Function

Private Sub cmbChooseKey_Click(Index As Integer)
'禁止重復定義快捷鍵
RedefineFuncKey cmbChooseKey(Index).Text, Index
End Sub

Private Sub cmdAdd_Click()
Dim strFileName As String
If cmbChooseKey(5).Text = "無" Or cmbChooseKey(5).Text = "" Then
MsgBox "請先為應用程序定義一個快捷鍵", vbInformation, "提示"
Else
cmnAdd.DialogTitle = "添加"
cmnAdd.Filter = "可執行文件(*.exe) *.exe" '在添加對話框中只顯示EXE文件
cmnAdd.ShowOpen '打開添加對話框
strFileName = cmnAdd.FileName
'把定義的快捷鍵和應用程序添加到列表框中
If strFileName <> "" Then
List1.AddItem cmbChooseKey(5).Text + " " + cmnAdd.FileName
End If
cmbChooseKey(5).Text = "無"
End If
End Sub

Private Sub cmdApply_Click()
Dim strKeyJoin As String, strKeyFile As String
strKeyJoin = ""
strKeyFile = ""
'把特定功能區定義的快捷鍵以逗號為分隔符寫入FunctionKey.txt文件
For i = 0 To 4
If i < 4 Then
strKeyJoin = strKeyJoin & Trim(cmbChooseKey(i).Text) & ","
Else
strKeyJoin = strKeyJoin & Trim(cmbChooseKey(i).Text)
End If
Next
Open App.Path + "\FunctionKey.txt" For Output As #1
Print #1, strKeyJoin
Close #1
'如果在列表框中有應用程序名和快捷鍵且檢測CustomKey.txt,則刪除該文件;
If List1.ListCount = 0 And Dir(App.Path + "\CustomKey.txt") <> "" Then
Kill App.Path + "\CustomKey.txt"
'把定義的快捷鍵及應用程序以逗號為分隔符寫入CustomKey.txt文件
ElseIf List1.ListCount <> 0 Then
For i = 0 To List1.ListCount - 1
If i < List1.ListCount - 1 Then
rKeyFile = strKeyFile + List1.List(i) + ","
Else
strKeyFile = strKeyFile + List1.List(i)
End If
Next
Open App.Path + "\CustomKey.txt" For Output As #1
Print #1, strKeyFile
Close #1
End If
List1.Clear
'重新從FunctionKey.txt和CustomKey.txt文件中取得定義的快捷鍵及相應的應用程序名供程序使用
Form_Load
End Sub

Private Sub cmdCancel_Click()
Unload Me
End Sub

'刪除列表框中選中的快捷鍵和應用程序名
Private Sub cmdDel_Click()
List1.RemoveItem List1.ListIndex
End Sub

Private Sub cmdOk_Click()
cmdApply_Click '調用"應用"按鈕下的代碼
Me.Visible = False
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'按快捷鍵A調用"應用"按鈕下的代碼
If KeyCode = vbKeyA Then
cmdApply_Click
End If
End Sub

Private Sub Form_Load()
Dim strLine As String
'把F2～F11和"無"分別添加到組合框控件數組的下拉列表框和文本框中
For i = 0 To 5
cmbChooseKey(i).Text = "無"
cmbChooseKey(i).AddItem "無"
cmbChooseKey(i).AddItem "F2"
cmbChooseKey(i).AddItem "F3"
cmbChooseKey(i).AddItem "F4"
cmbChooseKey(i).AddItem "F5"
cmbChooseKey(i).AddItem "F6"
cmbChooseKey(i).AddItem "F7"
cmbChooseKey(i).AddItem "F8"
cmbChooseKey(i).AddItem "F9"
cmbChooseKey(i).AddItem "F10"
cmbChooseKey(i).AddItem "F11"
Next
'如果在應用程序的路徑上沒有FunctionKey.txt 和CustomKey.txt文件(即沒有定義快捷鍵)，
'則顯示圖1界面
If Dir(App.Path + "\FunctionKey.txt") = "" And Dir(App.Path + "\CustomKey.txt") = "" Then
Me.Show
End If
If Dir(App.Path + "\FunctionKey.txt") <> "" Then
Open App.Path + "\FunctionKey.txt" For Input As #1
Line Input #1, strLine
Close #1
'把定義的快捷鍵讀到a數組中
a = Split(strLine, ",")
For i = 0 To UBound(a)
'把從FunctionKey.txt文件取出定義的快捷鍵并轉變成鍵盤掃描碼
iFunctionKey(i) = strKeyToLong(a(i))
'如果已經為特定功能定義了快捷鍵，則在相應的位置顯示該快捷鍵，
'否則顯示"無"
If IsNumeric(Right(a(i), 1)) Then
cmbChooseKey(i).Text = a(i)
Else
cmbChooseKey(i).Text = "無"
End If
Next
End If

Dim strKeyFileJoin As String
strLine = ""
'如果CustomKey.txt文件存在，則把所有的快捷鍵和應用程序名讀到變量strLine中
If Dir(App.Path + "\CustomKey.txt") <> "" Then
Open App.Path + "\CustomKey.txt" For Input As #1
Do While Not EOF(1)
Line Input #1, strLine
strKeyFileJoin = strKeyFileJoin + strLine
Loop
Close #1
strKey = Split(strKeyFileJoin, ",") '把快捷鍵和與之對應的應用程序名放入strKey數組中
'根據strKey數組的大小，重新定義以下數組的大小并保存重新定義前的值
ReDim Preserve iCustomFunction(UBound(strKey))
ReDim Preserve strKeyFile(UBound(strKey))
'把定義的快捷鍵和應用程序名添加到列表框中，并把快捷鍵的掃描碼放入相應的數組中
For i = 0 To UBound(strKey)
List1.AddItem strKey(i)
strKeyFile(i) = Trim(Mid(strKey(i), 1, 4))
iCustomFunction(i) = strKeyToLong(strKeyFile(i))
Next
End If
End Sub

'以下兩個過程的作用是完整地顯示被遮蔽的應用程序名
Private Sub List1_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
List1.ToolTipText = Trim(Mid(List1.Text, 5))
End Sub

Private Sub List1_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
List1.ToolTipText = Trim(Mid(List1.Text, 5))
End Sub

Private Sub Timer1_Timer()
'如果用戶按了數組iFunctionKey中相應的快捷鍵，則執行與之對應的（過程）功能
If MyHotKey(iFunctionKey(0)) Then
CloseComputer
ElseIf MyHotKey(iFunctionKey(1)) Then
RebootComputer
ElseIf MyHotKey(iFunctionKey(2)) Then
LockComputer
ElseIf MyHotKey(iFunctionKey(3)) Then
OpenCDROM
ElseIf MyHotKey(iFunctionKey(4)) Then
CloseCDROM
'按F12顯示圖1的界面
ElseIf MyHotKey(vbKeyF12) Then
Me.Visible = True
ElseIf List1.ListCount > 0 Then
ReDim Preserve iCustomFunction(List1.ListCount - 1)
'如果用戶按了數組iCustomFunction中相應的快捷鍵，則打開與之對應的應用程序
For i = 0 To List1.ListCount - 1
If MyHotKey(iCustomFunction(i)) Then
Ret = Shell(Trim(Mid(strKey(i), 5)), 1)
End If
Next
End If
End Sub
四、程序說明
程序第一次運行時將出現圖1所示界面，這時你可以只為自已喜歡的特定功能設置一個快捷鍵，也可以先選擇一個快捷鍵，再點擊“添加…”為常用軟件定義一個快捷鍵，如圖1中按F8將實現一鍵上網。設置好快捷鍵并點擊“應用”或按快捷鍵A后，就可以體驗一下你設置的“一鍵功能”了！點擊“確定”將隱藏界面。如果已經定義好快捷鍵并退出后，再次運行該程序將不再顯示圖1的界面，你仍然可以直接使用“一鍵功能”，如果想重新設置，按F12即可顯示程序界面。特別需要注意的是，要實現鎖定屏幕，必須事先設置好屏幕保護程序并設置密碼。
如果你感覺該程序比較實用，可以把它加入“啟動”組，一開機就可以隨時使用設定好的“一鍵功能”。另外，你可以充分發揮你的聰明才智，用VB編寫的特定功能的過程來進一步擴充該程序。
程序在Win98＋VB6.0下調試通過。源程序下載地址: http://www.cfan.net.cn/qikan/cxg/0203yjg.zip