一、引言
在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