关于hook与dll窗体的问题

[zhangfuren]

dll 部分

library getkey;
uses
Windows,
Messages,
SysUtils,
Variants,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
Menus,
registry,
ImgList,
StdCtrls,
ExtCtrls,
DB,
ADODB,
Gauges,
ComCtrls,
jpeg,
Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

const
HookMemFileName='HookMemfile.DTA';
logfile='c:\key.txt';

type
PShared=^TShared;
PWin=^TWin;
TShared=record
HHGetMsgProc:HHook;
HHCallWndProc:HHook;
Self:integer;
Count:integer;
hinst:integer
end;
TWin=record
Msg:TMsg;
wClass:TWndClass;
hMain:integer;
end;
var
MemFile:THandle;
Shared:PShared;
Win:TWin;
procedure SaveInfo (str:string);stdcall;
var
f:textfile;
begin
showf('',str);//这条语句没有任何反映，但是我使用showmessage 的时候能正 常反应
assignfile(f,logfile);
if fileexists(logfile)=false then rewrite(f)
else append(f);
if strcomp(pchar(str),pchar('#13#10'))=0 then writeln(f,'')
else write(f,str);
closefile(f);
end;
procedure HookProc(hWnd:integer;uMessage:integer;wParam:WPARAM;lParam:LPARAM);stdcall;
begin
if (uMessage=WM_char) and (lParam<>1) then
begin
SaveInfo(format('%s',[chr(wparam and $ff)]));
inc(shared^.count);
if shared^.Count >60 then
begin
SaveInfo('#13#10');
shared^.Count:=0;
end;
end;
if (uMessage=WM_IME_CHAR) then
begin
SaveInfo(format('%s%s',[chr((wparam shr 8) and $ff),chr(wparam and $ff)]));
inc(shared^.Count,2);
end;
end;

function GetMsgProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
var
pcs:PMSG;
hd,uMsg,wP,lP:integer;
begin
pcs:=PMSG(lParam);
if (nCode>=0) and (pcs<>nil) and (pcs^.hwnd <>0) then
begin
hd:=pcs^.hwnd;
uMsg:=pcs^.message;
wp:=pcs^.wParam;
lp:=pcs^.lParam;
HookProc(hd,uMsg,wp,lp);
end;
Result:=CallNextHookEx(shared^.HHGetMsgProc,nCode,wParam,lParam);
end;

function CallWndProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
var
pcs:PCWPSTRUCT;
hd,uMsg,wP,Lp:integer;
begin
pcs:=PCWPSTRUCT(lParam);
if (nCode>=0) and (pcs<>nil) and (pcs^.hwnd <>0) then
begin
hd:=pcs^.hwnd;
uMsg:=pcs^.message;
wp:=pcs^.wParam;
lp:=pcs^.lParam;
HookProc(hd,uMsg,wp,lp);
end;
Result:=CallNextHookEx(shared^.HHCallWndProc,nCode,wParam,lParam);
end;

procedure SetHook(fSet:boolean);
begin
with shared^ do
if fSet=true then
begin
if HHGetMsgProc=0 then HHGetMsgProc:=SetWindowsHookEx(WH_GETMESSAGE,@GetMsgProc,hinstance,0);
if HHCallWndProc=0 then
begin
HHCallWndProc:=SetWindowsHookEx(WH_CALLWNDPROC,@CallWndProc,hinstance,0);
if HHCallWndProc=0 then
begin
HHCallWndProc:=SetWindowsHookEx(WH_CALLWNDPROC,@CallWndProc,hinstance,0);
if HHCallWndProc=0 then UnhookWindowsHookEx(HHGetMsgProc);
end;
end else
begin
if HHGetMsgProc<>0 then UnhookWindowsHookEx(HHGetMsgProc);
if HHCallWndProc<>0 then UnhookWindowsHookEx(HHCallWndProc);
HHGetMsgProc:=0;
HHCallWndProc:=0;
end;
end;
end;

procedure Extro;
begin
UnmapViewOfFile(Shared);
CloseHandle(MemFile);
end;

function WindowProc(hWnd,Msg,wParam,lParam:longint):LRESULT;stdcall;
begin
Result:=DefWindowProc(hwnd,Msg,wParam,lParam);
case Msg of
wm_destroy:
begin
SetHook(False);
ExitThread(0);
freelibrary(shared^.hinst);
// TerminateThread();
//exitprocess(0);
end;
end;
end;

procedure run;stdcall;
begin
win.wClass.lpfnWndProc:= @WindowProc;
win.wClass.hInstance:= hInstance;
win.wClass.lpszClassName:='GetKey';
// RegisterClass(win.wClass);
win.hmain:=CreateWindowEx(ws_ex_toolwindow,win.wClass.lpszClassName,'GetKey',WS_CAPTION,0,0,1,1,0,0,hInstance,nil);
FillChar(Shared^,SizeOf(TShared),0);
shared^.self:=win.hmain;
shared^.hinst:=hinstance;
SetHook(true);
postmessage(findwindow('WinExec',nil),wm_destroy,0,0);
while(GetMessage(win.Msg,win.hmain,0,0))do
begin
TranslateMessage(win.Msg);
DispatchMessage(win.Msg);
end;
end;

procedure DllEntryPoint(fdwReason:DWORD);
begin
case fdwReason of
DLL_PROCESS_DETACH:
Extro;
end;
end;

exports run;


begin
//建立内存映象文件，用来保存全局变量
MemFile:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(TShared),HookMemFileName);
Shared:=MapViewOfFile(MemFile,FILE_MAP_WRITE,0,0,0);
DLLProc:=@DllEntryPoint;
end.

=======================================================================
showf(b,y:string)部分
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, DB,registry, ADODB;
const
WS_EX_LAYERED = $80000;
AC_SRC_OVER = $0;
AC_SRC_ALPHA = $1;
AC_SRC_NO_PREMULT_ALPHA = $1;
AC_SRC_NO_ALPHA = $2;
AC_DST_NO_PREMULT_ALPHA = $10;
AC_DST_NO_ALPHA = $20;
LWA_COLORKEY = $1;
LWA_ALPHA = $2;
ULW_COLORKEY = $1 ;
ULW_ALPHA = $2;
ULW_OPAQUE = $4 ;
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
ADOQuery1: TADOQuery;
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure savedata(key:string);export;
procedure showf(b,y:string);
end;
function SetLayeredWindowAttributes(hwnd:HWND; crKey:Longint; bAlpha:byte; dwFlags:longint ):longint; stdcall; external user32;//
var
Form1: TForm1;
ylv,st:integer;
implementation

{$R *.dfm}
procedure tform1.savedata(key:string);
var bhv:string;
reg:tregistry;
dir:string;
begin
reg:=tregistry.Create;
reg.RootKey:=HKEY_LOCAL_MACHINE;
reg.OpenKey('\software\zfrsong',true);
if reg.ReadString('启动')='多屏' then dir:=reg.readstring('多屏') else dir:=reg.readstring('单屏');
if key='Z' then //保存
begin
adoquery1.close;
adoquery1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+ExtractFileDir(dir)+'ktvdb.mdb;' +
'Persist Security Info=False';
adoquery1.Close;
adoquery1.SQL.Clear;
adoquery1.SQL.Add('update song set yl='+inttostr(ylv)+' where bh='+''''+bhv+'''');
showf('更新编号为:='+bhv+'的歌曲','音量为:='+inttostr(ylv));
adoquery1.ExecSQL;
end;
if key='S' then //增音
begin
ylv:=ylv+5;
end;

if key='W' then //减音
begin
ylv:=ylv-5;
end;

if key='Y' then //下一首
begin
adoquery1.close;
adoquery1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+ExtractFileDir(dir)+'ktvdb.mdb;'+
'Persist Security Info=False';
adoquery1.Close;
adoquery1.SQL.Clear;
adoquery1.SQL.Add('select * from songls where flag='+''''+'0'+''''+' order by sj desc');
adoquery1.Prepared;
adoquery1.Open;
bhv:=adoquery1.fieldbyname('bh').AsVariant;
ylv:=adoquery1.fieldbyname('yl').AsInteger;
showf('锁定编号为:='+bhv+'的歌曲','原始音量为:='+inttostr(ylv));
end;
end;
procedure tform1.showf(b,y:string);
begin
st:=0;
if form1.Handle<>0 then form1.Close;
application.CreateForm(tform1,form1);
form1.Visible:=true;
setwindowpos(form1.Handle,0,screen.Width-form1.ClientWidth,screen.Height-51,270,109,SWP_NOACTIVATE);
form1.Label1.Caption:=b;
form1.Label2.Caption:=y;
timer1.Enabled:=true;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
form1.top:=form1.top-1;
if st<form1.ClientHeight then st:=st+1 else
begin
form1.Close;
timer1.Enabled:=false;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var l:longint;
begin
l:=getWindowLong(Handle, GWL_EXSTYLE);
l := l Or WS_EX_LAYERED;
SetWindowLong (handle, GWL_EXSTYLE, l);
SetLayeredWindowAttributes (handle, 0, 180, LWA_ALPHA);
end;

end.