模拟系统按键

(* //
  标题:模拟系统按键
  说明:支持组合键;不支持部分系统热键(如:Ctrl+Shift+Del...)
  设计:Zswang
  日期:2002-01-24
  支持:wjhu111@21cn.com
  // *)
/// ////Begin Source
procedure SendKey(const mKey: Word; mShiftState: TShiftState; mCount: Integer = 1); { 模拟系统按键;mCount指定按键次数 }
const
    cExtended: set of Byte = [VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT, VK_HOME, VK_END, VK_PRIOR, VK_NEXT, VK_INSERT,
        VK_DELETE];
    procedure pKeyboardEvent(mKey, mScanCode: Byte; mFlags: Longint);
    var
        vKeyboardMsg: TMsg;
    begin
        keybd_event(mKey, mScanCode, mFlags, 0);
        while PeekMessage(vKeyboardMsg, 0, WM_KEYFIRST, WM_KEYLAST, PM_REMOVE) do
        begin
            TranslateMessage(vKeyboardMsg);
            DispatchMessage(vKeyboardMsg);
        end;
    end; { pKeyboardEvent }
    procedure pSendKeyDown(mKey: Word; mGenUpMsg: Boolean);
    var
        vScanCode: Byte;
        vNumState: Boolean;
        vKeyBoardState: TKeyboardState;
    begin
        if (mKey = VK_NUMLOCK) then
        begin
            vNumState := ByteBool(GetKeyState(VK_NUMLOCK) and 1);
            GetKeyBoardState(vKeyBoardState);
            if vNumState then
                vKeyBoardState[VK_NUMLOCK] := (vKeyBoardState[VK_NUMLOCK] and not 1)
            else
                vKeyBoardState[VK_NUMLOCK] := (vKeyBoardState[VK_NUMLOCK] or 1);
            SetKeyBoardState(vKeyBoardState);
            Exit;
        end;
        vScanCode := Lo(MapVirtualKey(mKey, 0));
        if (mKey in cExtended) then
        begin
            pKeyboardEvent(mKey, vScanCode, KEYEVENTF_EXTENDEDKEY);
            if mGenUpMsg then
                pKeyboardEvent(mKey, vScanCode, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP)
        end
        else
        begin
            pKeyboardEvent(mKey, vScanCode, 0);
            if mGenUpMsg then
                pKeyboardEvent(mKey, vScanCode, KEYEVENTF_KEYUP);
        end;
    end; { pSendKeyDown }
    procedure pSendKeyUp(mKey: Word);
    var
        vScanCode: Byte;
    begin
        vScanCode := Lo(MapVirtualKey(mKey, 0));
        if mKey in cExtended then
            pKeyboardEvent(mKey, vScanCode, KEYEVENTF_EXTENDEDKEY and KEYEVENTF_KEYUP)
        else
            pKeyboardEvent(mKey, vScanCode, KEYEVENTF_KEYUP);
    end; { pSendKeyUp }

var
    I: Integer;
begin
    for I := 1 to mCount do
    begin
        if ssShift in mShiftState then
            pSendKeyDown(VK_SHIFT, False);
        if ssCtrl in mShiftState then
            pSendKeyDown(VK_CONTROL, False);
        if ssAlt in mShiftState then
            pSendKeyDown(VK_MENU, False);
        pSendKeyDown(mKey, True);
        if ssShift in mShiftState then
            pSendKeyUp(VK_SHIFT);
        if ssCtrl in mShiftState then
            pSendKeyUp(VK_CONTROL);
        if ssAlt in mShiftState then
            pSendKeyUp(VK_MENU);
    end;
end; { SendKey }

/// ////End Source
/// ////Begin Demo
procedure TForm1.Button1Click(Sender: TObject);
begin
    SendKey(VK_F4, [ssAlt]);
end;
/// ////End Demo