關於 SENDKEYS 的 代碼[3]

KeyControl Case "%" KeyUp vbKeyMenu End Select colBrace.Remove colBrace.Count iPos = iPos + 1 Else ' Invalid sendkeys command: sMsg = "Invalid sendkeys command: unmatched ) at position " & iPos GoTo errorHandler End If Case "{" ' special key If (iPos + 2 > iLen) Then sMsg = "Invalid sendkeys command; opening { without content or closing } at position " & iPos GoTo errorHandler Else iNextPos = InStr(iPos + 2, sKeys, "}") If (iNextPos = 0) Then sMsg = "Invalid sendkeys command; opening { without closing } at position " & iPos GoTo errorHandler Else sContent = Mid$(sKeys, iPos + 1, iNextPos - iPos - 1) iPos = iNextPos + 1 ' is this a key/presses pair? iNextPos = InStr(sContent, " ") If (iNextPos > 0) Then sKey = Left$(sContent, iNextPos - 1) sCount = Mid$(sContent, iNextPos + 1) If Not (IsNumeric(sCount)) Then sMsg = "Invalid sendkeys command; key repetitions '" & sCount & "' is invalid near position " & iPos lCount = CLng(sCount) End If Else sKey = sContent lCount = 1 End If KeyPress sKey, lCount End If End If Case Else ' send the key as is KeyPress sChar, 1 iPos = iPos + 1 End Select Loop If (colBrace.Count > 0) Then sMsg = "Invalid sendkeys command: more open brackets than close brackets." GoTo errorHandler End If Exit Sub errorHandler: If Len(sMsg) = 0 Then sMsg = Err.Description lErr = Err.Number End If ' If we don't clear up the shift/control/alt keys, ' then you might find other apps on the system are hard to ' use. ' Make sure you have Break on Unhandled Errors switched ' on. Do While colBrace.Count > 0 sChar = colBrace(colBrace.Count) ' send key up Select Case sChar Case "+" KeyUp vbKeyShift Case "~" KeyUp vbKeyControl Case "%" KeyUp vbKeyMenu End Select colBrace.Remove colBrace.Count Loop On Error GoTo 0 Err.Raise lErr, App.EXEName & ".cSendKeys", sMsg Exit Sub End Sub Public Sub KeyPress(ByVal sKey As String, Optional ByVal lCount = 1) Dim vKey As KeyCodeConstants Dim l As Long On Error Resume Next vKey = m_colKeyMap(sKey) On Error GoTo 0 If (vKey = 0) Then ' translate string into v key code vKey = KeyCode(sKey) End If If (vKey <> 0) Then For l = 1 To lCount KeyDown vKey KeyUp vKey Next l Else Err.Raise 9, , "Key " & sKey & " could not be interpreted." End If End Sub Public Sub KeyDown(ByVal vKey As KeyCodeConstants) keybd_event vKey, 0, KEYEVENTF_EXTENDEDKEY, 0 End Sub Public Sub KeyUp(ByVal vKey As KeyCodeConstants) keybd_event vKey, 0, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0 End Sub Public Function KeyCode(ByVal sChar As String) As KeyCodeConstants Dim bNt As Boolean Dim iKeyCode As Integer Dim b() As Byte Dim iKey As Integer Dim vKey As KeyCodeConstants Dim iShift As ShiftConstants ' Determine if we have Unicode support or not: bNt = ((GetVersion() And &H80000000) = 0) ' Get the keyboard scan code for the character: If (bNt) Then b = sChar CopyMemory iKey, b(0), 2 iKeyCode = VkKeyScanW(iKey) Else b = StrConv(sChar, vbFromUnicode) iKeyCode = VkKeyScan(b(0)) End If KeyCode = (iKeyCode And &HFF&) End Function Private Sub Class_Initialize() m_colKeyMap.Add vbKeyBack, "BACKSPACE" m_colKeyMap.Add vbKeyBack, "BS" m_colKeyMap.Add vbKeyBack, "BKSP" m_colKeyMap.Add vbKeyPause, "BREAK" m_colKeyMap.Add vbKeyCapital, "CAPSLOCK" m_colKeyMap.Add vbKeyDelete, "DELETE" m_colKeyMap.Add vbKeyDelete, "DEL" m_colKeyMap.Add vbKeyDown, "DOWN" m_colKeyMap.Add vbKeyEnd, "END" m_colKeyMap.Add vbKeyReturn, "ENTER" m_colKeyMap.Add vbKeyReturn, "~" m_colKeyMap.Add vbKeyEscape, "ESC" m_colKeyMap.Add vbKeyHelp, "HELP" m_colKeyMap.Add vbKeyHome, "HOME" m_colKeyMap.Add vbKeyInsert, "INS" m_colKeyMap.Add vbKeyInsert, "INSERT" m_colKeyMap.Add vbKeyLeft, "LEFT" m_colKeyMap.Add vbKeyNumlock, "NUMLOCK" m_colKeyMap.Add vbKeyPageDown, "PGDN" m_colKeyMap.Add vbKeyPageUp, "PGUP" m_colKeyMap.Add vbKeyPrint, "PRTSC" m_