Q&A

  • 간단한웹브라우저에 키보드훅 걸기

훅이 잘걸리는 소스를 가지고 기존에 있던 웹브라우저 소스에 추가를시켰습니다.

실행이 되며 잔오류는 없는데 키보드 훅이 걸리지를 않습니다. 이유를 알수있을까요 ?



unit WebBrowser_Form;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.OleCtrls, SHDocVw, Vcl.ComCtrls,
  Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.ToolWin, Vcl.ActnMan, Vcl.ActnCtrls,
   Vcl.ActnList, Vcl.PlatformDefaultStyleActnCtrls, System.Actions;

type
  TTwebBrowser_Form = class(TForm)
    ActionToolBar1: TActionToolBar;
    Panel1: TPanel;
    Label1: TLabel;
    Eurl: TEdit;
    StatusBar1: TStatusBar;
    WebBrowser1: TWebBrowser;
    ActionManager1: TActionManager;
    Back_Action: TAction;
    Forward_Action: TAction;
    Stop_Action: TAction;
    procedure FormCreate(Sender: TObject);
    procedure Back_ActionExecute(Sender: TObject);
    procedure Forward_ActionExecute(Sender: TObject);
    procedure Stop_ActionExecute(Sender: TObject);
    procedure EurlKeyPress(Sender: TObject; var Key: Char);
    procedure EurlClick(Sender: TObject);
    procedure WebBrowser1BeforeNavigate2(ASender: TObject;
      const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
      Headers: OleVariant; var Cancel: WordBool);
    procedure WebBrowser1DownloadBegin(Sender: TObject);
    procedure WebBrowser1DownloadComplete(Sender: TObject);
    procedure WebBrowser1StatusTextChange(ASender: TObject;
      const Text: WideString);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  kd = 'http://www.naver.com';

var
  TwebBrowser_Form: TTwebBrowser_Form;
  slHistory : TStringList;
implementation

{$R *.dfm}

  function LowLevelKeyboardProc(nCode: integer; wParam: WPARAM; lParam: LPARAM):
  LRESULT; stdcall;
type
  PKBDLLHOOKSTRUCT = ^TKBDLLHOOKSTRUCT;
  TKBDLLHOOKSTRUCT = record
    vkCode: cardinal;
    scanCode: cardinal;
    flags: cardinal;
    time: cardinal;
    dwExtraInfo: Cardinal;
  end;

  PKeyboardLowLevelHookStruct = ^TKeyboardLowLevelHookStruct;
  TKeyboardLowLevelHookStruct = TKBDLLHOOKSTRUCT;
const
  LLKHF_ALTDOWN = $20;
var
  hs: PKeyboardLowLevelHookStruct;
  ctrlDown: boolean;
begin

  if nCode = HC_ACTION then
  begin

    hs := PKeyboardLowLevelHookStruct(lParam);
    ctrlDown := GetAsyncKeyState(VK_CONTROL) and $8000 <> 0;
    if (hs^.vkCode = VK_ESCAPE) and ctrlDown then
      Exit;
    if (hs^.vkCode = VK_TAB) and ((hs^.flags and LLKHF_ALTDOWN) <> 0) then
      Exit;
    if (hs^.vkCode = VK_ESCAPE) and ((hs^.flags and LLKHF_ALTDOWN) <> 0) then
      Exit;
    if (hs^.vkCode = VK_LWIN) or (hs^.vkCode = VK_RWIN) then
      Exit;

  end;

  result := CallNextHookEx(0, nCode, wParam, lParam);

end;


procedure TTwebBrowser_Form.Back_ActionExecute(Sender: TObject);
begin
  Forward_Action.Enabled := True;
eURL.Text := slHistory.Strings[slHistory.Indexof(eURL.Text)-1];
WebBrowser1.Goback;
if slHistory.Indexof(eURL.Text) = 0 then
Back_Action.Enabled := False;
end;

procedure TTwebBrowser_Form.EurlClick(Sender: TObject);
begin
 eURL.SelectAll;
end;

procedure TTwebBrowser_Form.EurlKeyPress(Sender: TObject; var Key: Char);
begin
     if key = #13  then
  begin
    key := #0;
    if eURL.Text <> '' then  begin
      WebBrowser1.Navigate(eURL.Text);
      if slHistory.IndexOf(eURL.Text) = -1 then
          begin
            slHistory.Add(eURL.Text);
            if slHistory.Count > 1 then
              Back_Action.Enabled := True
            else
              Back_Action.Enabled := False;
          end;
      end;
   end;
end;

procedure TTwebBrowser_Form.FormCreate(Sender: TObject);
begin
    slHistory := TStringList.Create
end;

procedure TTwebBrowser_Form.FormShow(Sender: TObject);
begin
//시작하면 강동 페이지로 고
WebBrowser1.Navigate(kd);
ShowWindow(Handle, SW_MAXIMIZE);  // 최대화

end;

procedure TTwebBrowser_Form.Forward_ActionExecute(Sender: TObject);
begin
  if slHistory.Indexof(eURL.TExt) = slHistory.Count - 2 then
  Forward_Action.Enabled :=False;
  eURL.Text := slHistory.Strings[slHistory.Indexof(eURL.Text)+1];
  WebBrowser1.GoForward;
  Back_Action.Enabled := True;
end;

procedure TTwebBrowser_Form.Stop_ActionExecute(Sender: TObject);
begin
WebBrowser1.Stop;
StatusBar1.SimpleText := '';
end;

procedure TTwebBrowser_Form.WebBrowser1BeforeNavigate2(ASender: TObject;
  const pDisp: IDispatch; const URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
begin
 StatusBar1.SimpleText := URL;
end;

procedure TTwebBrowser_Form.WebBrowser1DownloadBegin(Sender: TObject);
begin
 Stop_Action.Enabled := True;
end;

procedure TTwebBrowser_Form.WebBrowser1DownloadComplete(Sender: TObject);
begin
Stop_Action.Enabled := False;
StatusBar1.SimpleText := '';
end;

procedure TTwebBrowser_Form.WebBrowser1StatusTextChange(ASender: TObject;
  const Text: WideString);
begin
StatusBar1.SimpleText := Text
end;

end.

0  COMMENTS