不从TComponent继承 ,请问怎么捕获系统消息,比如TIME消息或者自定义消息?(100分)

Z

zbdbx

Unregistered / Unconfirmed
GUEST, unregistred user!
想写一个封装winsock的单元,但是我不想从TComponent继承
请问怎么捕获系统消息,比如TIME消息或者自定义消息?
 
W

wr960204

Unregistered / Unconfirmed
GUEST, unregistred user!
Type
TObj = class
private
FHWnd : HWND;
protected
Procedure WndProc(var Msg : TMessage);
procedure WMTimer(var Message: TWMTimer);
message WM_TIMER;
public
constructor Create;
destructor Destroy;
override;
property HWnd : HWND read FHWnd;
end;
{ TObj }
constructor TObj.Create;
begin
FHWnd := AllocateHWnd(WndProc);
end;

destructor TObj.Destroy;
begin
DeallocateHWnd(FHWnd);
FHWnd := 0;
inherited Destroy;
end;

procedure TObj.WMTimer(var Message: TWMTimer);
begin
ShowMessage('aaaa');
end;

procedure TObj.WndProc(var Msg: TMessage);
begin
Dispatch(Msg);//分派消息
end;
使用的时候如下:
var
Obj : TObj;
begin
Obj := TObj.Create;
SetTimer(Obj.HWnd, 0, 1000, nil);//让操作系统每隔一秒钟向Obj发WM_TIMER消息
end;
 
H

hxy2002

Unregistered / Unconfirmed
GUEST, unregistred user!
可参考TTimer控件写法
 
Z

zbdbx

Unregistered / Unconfirmed
GUEST, unregistred user!
问题是解决了,不过对于我还不太完美,就是AllocateHWnd和DeallocateHWnd这两个函数要使用classes单元,我要减小程序体积,不想使用classes单元,请问如何替代这两个函数?
program Project1;
{$APPTYPE CONSOLE}
uses
windows,
Unit1 in 'Unit1.pas';
var
Obj : TObj;
Msg: TMsg;
begin
Obj := TObj.Create;
SetTimer(Obj.HWnd, 0, 1000, nil);//让操作系统每隔一秒钟向Obj发WM_TIMER消息
while GetMessage(Msg, 0, 0, 0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end.
//--------------------------------
unit Unit1;
interface
uses windows, messages, classes;
//不想要classes单元
Type
TObj = class
private
FHWnd : HWND;
protected
Procedure WndProc(var Msg : TMessage);
procedure WMTimer(var Message: TWMTimer);
message WM_TIMER;
public
constructor Create;
destructor Destroy;
override;
property HWnd : HWND read FHWnd;
end;

implementation

constructor TObj.Create;
begin
FHWnd := AllocateHWnd(WndProc);
end;

destructor TObj.Destroy;
begin
DeallocateHWnd(FHWnd);
FHWnd := 0;
inherited Destroy;
end;

procedure TObj.WMTimer(var Message: TWMTimer);
begin
Windows.MessageBox(FHWnd,'a','b',2);
end;

procedure TObj.WndProc(var Msg: TMessage);
begin
Dispatch(Msg);//分派消息
end;

end.
 

张辉明

Unregistered / Unconfirmed
GUEST, unregistred user!
直接从classes抄过来。
var
UtilWindowClass: TWndClass = (
style: 0;
lpfnWndProc: @DefWindowProc;
cbClsExtra: 0;
cbWndExtra: 0;
hInstance: 0;
hIcon: 0;
hCursor: 0;
hbrBackground: 0;
lpszMenuName: nil;
lpszClassName: 'TPUtilWindow');
function AllocateHWnd(Method: TWndMethod): HWND;
var
TempClass: TWndClass;
ClassRegistered: Boolean;
begin
UtilWindowClass.hInstance := HInstance;
{$IFDEF PIC}
UtilWindowClass.lpfnWndProc := @DefWindowProc;
{$ENDIF}
ClassRegistered := GetClassInfo(HInstance, UtilWindowClass.lpszClassName,
TempClass);
if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then
begin
if ClassRegistered then
Windows.UnregisterClass(UtilWindowClass.lpszClassName, HInstance);
Windows.RegisterClass(UtilWindowClass);
end;
Result := CreateWindowEx(WS_EX_TOOLWINDOW, UtilWindowClass.lpszClassName,
'', WS_POPUP {!0}, 0, 0, 0, 0, 0, 0, HInstance, nil);
if Assigned(Method) then
SetWindowLong(Result, GWL_WNDPROC, Longint(MakeObjectInstance(Method)));
end;

procedure DeallocateHWnd(Wnd: HWND);
var
Instance: Pointer;
begin
Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC));
DestroyWindow(Wnd);
if Instance <> @DefWindowProc then
FreeObjectInstance(Instance);
end;
 

张辉明

Unregistered / Unconfirmed
GUEST, unregistred user!
注意,可能还会涉及到CLASSES中一个些函数,如MakeObjectInstance,你也需要搬过来。
这个函数可有学文哦 :)很有意思的。
 
W

wr960204

Unregistered / Unconfirmed
GUEST, unregistred user!
没办法给你写一个例子吧.具体Thunk技术的讲解可以去我的博客看
http://blog.csdn.net/wr960204/archive/2008/01/29/2071480.aspx
unit Unit2;
interface
uses
Windows, Messages;
Type
TObj = class
private
FThunk : Pointer;
FHWnd : HWND;
protected
Function WndProc(hWnd: HWND;
Msg: UINT;
wParam: WPARAM;
lParam: LPARAM): Integer;
stdcall;
procedure WMTimer(var Message: TWMTimer);
message WM_TIMER;
public
constructor Create;
destructor Destroy;
override;
property HWnd : HWND read FHWnd;
end;

implementation
//构造出一段Thunk代码
Function CreateThunk(Obj : TObject;
CallBackProc: Pointer):pointer;
const
PageSize = 4096;
SizeOfJmpCode = 5;
type
TCode = packed record
Int3: Byte;
//想调试的的时候填Int 3($CC),不想调试的时候填nop($90)
PopEAX : Byte;
//把返回地址从栈中弹出
Push: Byte;
//压栈指令
AddrOfSelf: TObject;
//压入Self地址,把Self作为第一个参数
PushEAX : Byte;
//重新压入返回地址
Jmp: Byte;
//相对跳转指令
AddrOfJmp: Cardinal;
//要跳转到的地址,
end;
var
LCode : ^TCode;
begin
//分配一段可以执行,可读写的内存
Result := VirtualAlloc(nil, PageSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
LCode := Result;
LCode^.Int3 := $90;
//nop
//LCode^.Int3 := $CC;
//Int 3
LCode^.PopEAX := $58;
LCode^.Push := $68;
LCode^.AddrOfSelf := Obj;
LCode^.PushEAX := $50;
LCode^.Jmp := $E9;
LCode^.AddrOfJmp := DWORD(CallBackProc) - (DWORD(@LCode^.Jmp) + SizeOfJmpCode);//计算相对地址
end;

//销毁thunk代码
procedure ReleaseThunk(Thunk: Pointer);
begin
VirtualFree(Thunk, 0, MEM_RELEASE);
end;

var
ObjWindowClass: TWndClass = (
style: 0;
lpfnWndProc: @DefWindowProc;
cbClsExtra: 0;
cbWndExtra: 0;
hInstance: 0;
hIcon: 0;
hCursor: 0;
hbrBackground: 0;
lpszMenuName: nil;
lpszClassName: 'TObjWindow');
constructor TObj.Create;
var
TempClass: TWndClass;
ClassRegistered: Boolean;
begin
FThunk := CreateThunk(Self, @TObj.WndProc);
ObjWindowClass.hInstance := HInstance;
ClassRegistered := GetClassInfo(HInstance, ObjWindowClass.lpszClassName,
TempClass);
if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then
begin
if ClassRegistered then
Windows.UnregisterClass(ObjWindowClass.lpszClassName, HInstance);
Windows.RegisterClass(ObjWindowClass);
end;
FHWnd := CreateWindowEx(WS_EX_TOOLWINDOW, ObjWindowClass.lpszClassName,
'', WS_POPUP {+ 0}, 0, 0, 0, 0, 0, 0, HInstance, nil);
SetWindowLong(FHWnd, GWL_WNDPROC, Longint(FThunk));
end;

destructor TObj.Destroy;
begin
DestroyWindow(FHWnd);
FHWnd := 0;
ReleaseThunk(FThunk);
inherited Destroy;
end;

procedure TObj.WMTimer(var Message: TWMTimer);
begin
Windows.MessageBox(FHWnd,'a','b',2);
end;

Function TObj.WndProc(hWnd: HWND;
Msg: UINT;
wParam: WPARAM;
lParam: LPARAM): Integer;
stdcall;
var
_Msg : TMessage;
begin
_Msg.Msg := Msg;
_Msg.LParam := lParam;
_Msg.WParam := WParam;
_Msg.Result := 0;
Dispatch(_Msg);//分派消息
Result := _Msg.Result;
end;

end.
 
Z

zbdbx

Unregistered / Unconfirmed
GUEST, unregistred user!
非常感谢各位,划分
 

Similar threads

I
回复
0
查看
554
import
I
I
回复
0
查看
509
import
I
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
1K
DelphiTeacher的专栏
D
顶部