훅이 잘걸리는 소스를 가지고 기존에 있던 웹브라우저 소스에 추가를시켰습니다.
실행이 되며 잔오류는 없는데 키보드 훅이 걸리지를 않습니다. 이유를 알수있을까요 ?
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.