模拟键盘按键的问题！

Question

添加到收藏夹和整理收藏夹　　　　 const
　　　　　CLSID_ShellUIHelper: TGUID = '{64AB4BB7-111E-11D1-8F79-00C04FC2FBE1}';　　　　var
　　　　　p:procedure(Handle: THandle; Path: PChar); stdcall;　　　　procedure TForm1.OrganizeFavorite(Sender: Tobject);
　　　　var
　　　　　H: HWnd;
　　　　begin
　　　　　H := LoadLibrary(PChar('shdocvw.dll'));
　　　　　if H <> 0 then
　　　　　begin
　　　　p := GetProcAddress(H, PChar('DoOrganizeFavDlg'));
　　　　　　if Assigned(p) then p(Application.Handle, PChar(FavFolder));
　　　　　end;
　　　　　FreeLibrary(h);
　　　　end;
　　　　
　　　　procedure TForm1.AddFavorite(Sender: TObject);
　　　　var
　　　　　ShellUIHelper: ISHellUIHelper;
　　　　　url, title: Olevariant;
　　　　begin
　　　　　Title := Webbrowser1.LocationName;
　　　　　Url := Webbrowser1.LocationUrl;
　　　　　if Url <> '' then
　　　　　begin
　　　　　　ShellUIHelper := CreateComObject(CLSID_SHELLUIHELPER) as IShellUIHelper;
　　　　　　ShellUIHelper.AddFavorite(url, title);
　　　　　end;
　　　　end; 　　用上面的通过ISHellUIHelper接口来打开“添加到收藏夹”对话框的方法比较简单，但是有个缺陷，就是打开的窗口不是模式窗口，而是独立于应用程序的。可以想象，如果使用与OrganizeFavorite过程同样的方法来打开对话框，由于可以指定父窗口的句柄，自然可以实现模式窗口（效果与在资源管理器和IE中打开“添加到收藏夹”对话框相同）。问题显然是这样的，上面两个过程的作者当时只知道shdocvw.dll中DoOrganizeFavDlg的原型而不知道DoAddToFavDlg的原型，所以只好用ISHellUIHelper接口来实现（或许是他不够严谨，认为是否是模式窗口无所谓？）。
　　下面的过程就告诉你DoAddToFavDlg的函数原型。需要注意的是，这样打开的对话框并不执行“添加到收藏夹”的操作，它只是告诉应用程序用户是否选择了“确定”，同时在DoAddToFavDlg的第二个参数中返回用户希望放置Internet快捷方式的路径，建立.Url文件的工作由应用程序自己来完成。　　　　procedure TForm1.AddFavorite(IE: TEmbeddedWB);
　　　　　procedure CreateUrl(AUrlPath, AUrl: PChar);
　　　　　var
　　　　　　URLfile: TIniFile;
　　　　　begin
　　　　　　URLfile := TIniFile.Create(String(AUrlPath));
　　　　　RLfile.WriteString('InternetShortcut', 'URL', String(AUrl));
　　　　　RLfile.Free;
　　　　　end; 
　　　　var
　　　　　AddFav: function(Handle: THandle;
　　　　　　UrlPath: PChar; UrlPathSize: Cardinal;
　　　　　　Title: PChar; TitleSize: Cardinal;
　　　　　　FavIDLIST: pItemIDList): Bool; stdcall;
　　　　　FDoc: IHTMLDocument2;
　　　　　UrlPath, url, title: array[0..MAX_PATH] of char;
　　　　　H: HWnd;
　　　　　pidl: pItemIDList;
　　　　　FRetOK: Bool;
　　　　begin
　　　　　FDoc := IHTMLDocument2(IE.Document);
　　　　　if FDoc = nil then exit;
　　　　　StrPCopy(Title, FDoc.Get_title);
　　　　　StrPCopy(url, FDoc.Get_url);
　　　　　if Url <> '' then
　　　　　begin
　　　　　　H := LoadLibrary(PChar('shdocvw.dll'));
　　　　　　if H <> 0 then
　　　　　　begin
　　　　　　　SHGetSpecialFolderLocation(0, CSIDL_FAVORITES, pidl);
　　　　　　　AddFav := GetProcAddress(H, PChar('DoAddToFavDlg'));
　　　　　　　if Assigned(AddFav) then
　　　　　　　　FRetOK :=AddFav(Handle, UrlPath, Sizeof(UrlPath), Title, Sizeof(Title), pidl)
　　　　　　end;
　　　　　　FreeLibrary(h);
　　　　　　if FRetOK then
　　　　　　　CreateUrl(UrlPath, Url);
　　　　　end
　　　　end;

Answer 1

模拟键盘按键：unit SendKey; interface uses 
 SysUtils, Windows, Messages, Classes, KeyDefs; type 
  { Error codes } 
  TSendKeyError = (sk_None, sk_FailSetHook, sk_InvalidToken, 
    sk_UnknownError, sk_AlreadyPlaying); 
  { first vk code to last vk code } 
  TvkKeySet = set of vk_LButton..vk_Scroll;   { exceptions } 
  ESendKeyError = class(Exception); 
  ESKSetHookError = class(ESendKeyError); 
  ESKInvalidToken = class(ESendKeyError); 
  ESKAlreadyPlaying = class(ESendKeyError); function SendKeys(S: String): TSendKeyError; 
procedure WaitForHook; 
procedure StopPlayback; var 
  Playing: Boolean; implementation uses Forms; type 
  { a TList descendant that know how to dispose of its contents } 
  TMessageList = class(TList) 
  public 
    destructor Destroy; override; 
  end; const 
  { valid "sys" keys } 
  vkKeySet: TvkKeySet = [Ord('A')..Ord('Z'), vk_Menu, vk_F1..vk_F12]; 
destructor TMessageList.Destroy; 
var 
  i: longint; 
begin 
  { deallocate all the message records before discarding the list } 
  for i := 0 to Count - 1 do 
    Dispose(PEventMsg(Items[i])); 
  inherited Destroy; 
end; var 
  { variables global to the DLL } 
  MsgCount: word = 0; 
  MessageBuffer: TEventMsg; 
  HookHandle: hHook = 0; 
  MessageList: TMessageList = Nil; 
  AltPressed, ControlPressed, ShiftPressed: Boolean; procedure StopPlayback; 
{ Unhook the hook, and clean up } 
begin 
  { if Hook is currently active, then unplug it } 
  if Playing then 
    UnhookWindowsHookEx(HookHandle); 
  MessageList.Free; 
  Playing := False; 
end; function Play(Code: integer; wParam, lParam: Longint): Longint; stdcal 
l; 
{ This is the JournalPlayback callback function.  It is called by } 
{ Windows when Windows polls for hardware events.  The code parameter  
} 
{ indicates what to do. } 
begin 
  case Code of 
    HC_SKIP: 
      { HC_SKIP means to pull the next message out of our list. If we  
} 
      { are at the end of the list, it's okay to unhook the } 
      { JournalPlayback hook from here. } 
      begin 
        { increment message counter } 
        inc(MsgCount); 
        { check to see if all messages have been played } 
        if MsgCount >= MessageList.Count then StopPlayback 
        { otherwise copy next message from list into buffer } 
        else MessageBuffer := TEventMsg(MessageList.Items[MsgCount]^);         Result := 0; 
      end; 
    HC_GETNEXT: 
      { HC_GETNEXT means to fill the wParam and lParam with the proper 
 } 
      { values so that the message can be played back.  DO NOT unhook  
} 
      { hook from within here.  Return value indicates how much time }       { until Windows should playback message.  We'll return 0 so that 
 } 
      { it is processed right away. } 
      begin 
        { move message in buffer to message queue } 
        PEventMsg(lParam)^ := MessageBuffer; 
        Result := 0  { process immediately } 
      end 
    else 
      { if Code isn't HC_SKIP or HC_GETNEXT, call next hook in chain }       Result := CallNextHookEx(HookHandle, Code, wParam, lParam); 
  end; 
end; procedure StartPlayback; 
{ Initializes globals and sets the hook } 
begin 
  { grab first message from list and place in buffer in case we } 
  { get a hc_GetNext before and hc_Skip } 
  MessageBuffer := TEventMsg(MessageList.Items[0]^); 
  { initialize message count and play indicator } 
  MsgCount := 0; 
  { initialize Alt, Control, and Shift key flags } 
  AltPressed := False; 
  ControlPressed := False; 
  ShiftPressed := False; 
  { set the hook! } 
  HookHandle := SetWindowsHookEx(wh_JournalPlayback, Play, hInstance,  
0); 
  if HookHandle = 0 then 
    raise ESKSetHookError.Create('Failed to set hook'); 
  Playing := True; 
end; procedure MakeMessage(vKey: byte; M: Cardinal); 
{ procedure builds a TEventMsg record that emulates a keystroke and } { adds it to message list } 
var 
  E: PEventMsg; 
begin 
  New(E);                                 // allocate a message record   with E^ do 
  begin 
    message := M;                         // set message field 
    paramL := vKey;                       // vk code in ParamL 
    paramH := MapVirtualKey(vKey, 0);     // scan code in ParamH 
    time := GetTickCount;                 // set time 
    hwnd := 0;                            // ignored 
  end; 
  MessageList.Add(E); 
end; procedure KeyDown(vKey: byte); 
{ Generates KeyDownMessage } 
begin 
  { don't generate a "sys" key if the control key is pressed } 
  { (This is a Windows quirk) } 
  if AltPressed and (not ControlPressed) and  (vKey in vkKeySet) then     MakeMessage(vKey, wm_SysKeyDown) 
  else 
    MakeMessage(vKey, wm_KeyDown); 
end; procedure KeyUp(vKey: byte); 
{ Generates KeyUp message } 
begin 
  { don't generate a "sys" key if the control key is pressed } 
  { (This is a Windows quirk) } 
  if AltPressed and (not ControlPressed) and (vKey in vkKeySet) then 
    MakeMessage(vKey, wm_SysKeyUp) 
  else 
    MakeMessage(vKey, wm_KeyUp); 
end; 

Answer 2

procedure SimKeyPresses(VKeyCode: Word); 
{ This function simulates keypresses for the given key, taking into } { account the current state of Alt, Control, and Shift keys } 
begin 
  { press Alt key if flag has been set } 
  if AltPressed then 
    KeyDown(vk_Menu); 
  { press Control key if flag has been set } 
  if ControlPressed then 
    KeyDown(vk_Control); 
  { if shift is pressed, or shifted key and control is not pressed...  
} 
  if (((Hi(VKeyCode) and 1) <> 0) and (not ControlPressed)) or 
    ShiftPressed then 
    KeyDown(vk_Shift);    { ...press shift } 
  KeyDown(Lo(VKeyCode));  { press key down } 
  KeyUp(Lo(VKeyCode));    { release key } 
  { if shift is pressed, or shifted key and control is not pressed...  
} 
  if (((Hi(VKeyCode) and 1) <> 0) and (not ControlPressed)) or 
    ShiftPressed then 
    KeyUp(vk_Shift);      { ...release shift } 
  { if shift flag is set, reset flag } 
  if ShiftPressed then begin 
    ShiftPressed := False; 
  end; 
  { Release Control key if flag has been set, reset flag } 
  if ControlPressed then begin 
    KeyUp(vk_Control); 
    ControlPressed := False; 
  end; 
  { Release Alt key if flag has been set, reset flag } 
  if AltPressed then begin 
    KeyUp(vk_Menu); 
    AltPressed := False; 
  end; 
end; procedure ProcessKey(S: String); 
{ This function parses each character in the string to create the } 
{ message list } 
var 
  KeyCode: word; 
  Key: byte; 
  index: integer; 
  Token: TKeyString; 
begin 
  index := 1; 
  repeat 
    case S[index] of 
      KeyGroupOpen: 
        { It's the beginning of a special token! } 
        begin 
          Token := ''; 
          inc(index); 
          while S[index] <> KeyGroupClose do begin 
            { add to Token until the end token symbol is encountered }             Token := Token + S[index]; 
            inc(index); 
            { check to make sure the token's not too long } 
            if (Length(Token) = 7) and (S[index] <> KeyGroupClose) the 
n 
              raise ESKInvalidToken.Create('No closing brace'); 
          end; 
          { look for token in array, Key parameter will } 
          { contain vk code if successful } 
          if not FindKeyInArray(Token, Key) then 
            raise ESKInvalidToken.Create('Invalid token'); 
          { simulate keypress sequence } 
          SimKeyPresses(MakeWord(Key, 0)); 
        end; 
      AltKey: AltPressed := True;           // set Alt flag 
      ControlKey: ControlPressed := True;   // set Control flag 
      ShiftKey: ShiftPressed := True;       // set Shift flag 
      else begin 
      { A normal character was pressed } 
        { convert character into a word where the high byte contains }         { the shift state and the low byte contains the vk code } 
        KeyCode := vkKeyScan(S[index]); 
        { simulate keypress sequence } 
        SimKeyPresses(KeyCode); 
      end; 
    end; 
    Inc(index); 
  until index > Length(S); 
end; procedure WaitForHook; 
begin 
  repeat Application.ProcessMessages until not Playing; 
end; function SendKeys(S: String): TSendKeyError; 
{ This is the one entry point.  Based on the string passed in the S  } { parameter, this function creates a list of keyup/keydown messages, } { sets a JournalPlayback hook, and replays the keystroke messages.   } begin 
  Result := sk_None;                     // assume success 
  try 
    if Playing then raise ESKAlreadyPlaying.Create(''); 
    MessageList := TMessageList.Create;  // create list of messages 
    ProcessKey(S);                       // create messages from strin 
g 
    StartPlayback;                     // set hook and play back messa 
ges 
  except 
    { if an exception occurs, return an error code, and clean up } 
    on E:ESendKeyError do 
    begin 
      MessageList.Free; 
      if E is ESKSetHookError then 
        Result := sk_FailSetHook 
      else if E is ESKInvalidToken then 
        Result := sk_InvalidToken 
      else if E is ESKAlreadyPlaying then 
        Result := sk_AlreadyPlaying; 
    end 
    else 
      Result := sk_UnknownError;  // Catch-all exception handler 
  end; 
end; end.