[reqyz]

Сообщение от NumLock

1. callback-функции
2. AllocateHWnd

что то не получилось... сделал так

Код:

type
  TMes = class
  private
    FHWnd: HWND;
  protected
    procedure WMCopyData(var Msg:TMessage); message WM_COPYDATA;
  public
    constructor Create();
    destructor Destroy; override;
  end;

var
  Handl:HWND=0;

constructor TMes.Create();
begin
  inherited Create();
  FHWnd := AllocateHWnd(WMCopyData);
end;

destructor TMes.Destroy;
begin
  DeallocateHWnd(FHWnd);
  inherited Destroy;
end;


  Mess:string;



function SetHook(Wnd: HWND;dwThreadId:LongWord): BOOL; stdcall; external 'hooklib.dll';
function RemoveHook: BOOL; stdcall; external 'hooklib.dll';


procedure TMes.WMCopyData(var Msg: TMessage);
begin
  inherited;
  Mess:=pchar(Msg.WParam);
  Msg.Result:=1;
end;

...

    messa:=TMes.Create;
    if(SetHook(messa.FHWnd,ProcInfo.dwThreadId))then

но сообщения не приходят(

ДЛЛ

Код:

library hooklib;

uses
  Windows,
  Messages;

const
  HookMap = '{F3E25943-FCC7-43E5-BE22-7CF35EA5FCC6}';

type
  PHookData = ^THookData;
  THookData = packed record
    AppWnd  : HWND;
    OldHook : HHOOK;
  end;

var
  hMap     : THandle = 0;
  HookData : PHookData = nil;

procedure DLLEntryPoint(dwReason: DWORD);
begin
  case dwReason of
    DLL_PROCESS_ATTACH:
    begin
      hMap     := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, SizeOf(THookData), HookMap);
      HookData := MapViewOfFile(hMap, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(THookData));
    end;
    DLL_PROCESS_DETACH:
    begin
      UnMapViewOfFile(HookData);
      CloseHandle(hMap);
    end
  end
end;

procedure SaveLog(s:string);
var
 cds:TCopyDataStruct;
begin
 cds.cbData:=length(s)+1;
 cds.lpData:=pchar(s);
 SendMessage(HookData^.AppWnd,WM_COPYDATA,0,Cardinal(@cds));
end;

function HookProc(Code: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT;stdcall;
var
 WndHeader:array[0..MAX_PATH-1] of char;
begin
  if Code>=0 then
  begin
   case Code of
     HCBT_CREATEWND:
       if (IsWindow(wParam) and (PCBTCreateWnd(lParam)^.lpcs^.hwndParent=0) and
       (lstrlen(PCBTCreateWnd(lParam)^.lpcs^.lpszName)>0)) then
        SaveLog('[Open] '+PCBTCreateWnd(lParam)^.lpcs^.lpszName);

     HCBT_DESTROYWND:
      if (IsWindow(wParam) and IsWindowVisible(wParam) and (GetParent(wParam)=0))  then
      begin
       GetWindowText(wParam,WndHeader,MAX_PATH);
       if (WndHeader<>'')then
       SaveLog('[Close] '+WndHeader);
      end
   end;
   Result := 0;
 end else
 Result := CallNextHookEx(HookData^.OldHook, Code, WParam, LParam);
end;

function SetHook(Wnd: HWND;dwThreadId: DWORD): BOOL; stdcall;
begin
  if HookData <> nil then
  begin
    HookData^.AppWnd := Wnd;
    HookData^.OldHook := SetWindowsHookEx(WH_CBT, HookProc, HInstance,dwThreadId);
    Result:=HookData^.OldHook <> 0;
  end else
   Result:=False;
end;

function RemoveHook: BOOL; stdcall;
begin
  Result := UnhookWindowsHookEx(HookData^.OldHook);
end;

exports
  SetHook, RemoveHook;

begin
  if @DLLProc = nil then DLLProc := @DLLEntryPoint;
  DLLEntryPoint(DLL_PROCESS_ATTACH);
end.

а если без dll

Код:

    messa:=TMes.Create;
    CreateProcessA(nil,'process.exe',nil,nil,false,0,Pointer(messa.FHWnd),nil,StartInfo,ProcInfo);

так сообщения находит, но матюгается( и процесс не создаётся