[Delphi] Een createprocess app mag niet sluiten.

[Guillome]

Hoi,

Ik start met CreateProcess bijv. notepad op.
En ik vang met die 'system hooks' op wanneer hij wordt geminimaliseert en wordt gesloten.
Maar, ik wil dat als hij gesloten wordt, dat ie dan niet echt sluit, maar dat ie minimaliseert.
Alleen, die hook wordt 'gepakt' nadat hij al is afgesloten.

Zijn er nog andere manieren voor? Is er anders een system hook, zoals beforeclose ofzo?

Bij voorbaat dank.

[Guillome]

Hmm is er niemand die dit weet?
Ik kom er echt niet uit en ik heb het wel nodig.

[Verwijderd]

Volgens mij moet dit kunnen met SetWindowsHookEx met hook id WH_CBT. Zal er 's naar kijken.
[edit]
Werkt

[Aetje]

Je wil dus vanuit een bepaalde app, controleren of een andere app gesloten word?

[Guillome]

Ja een soort BeforeClose...
Werkt dat??
Hoe?

[Aetje]

Niet echt... Wellicht kan je met de Application.OnMessage wat, maar ik zou niet weten hoe je dit implementeert...

[Verwijderd]

Ik denk niet dat dit echt mogelijk is aangezien je volgens mij niet kan bepalen wie als eerste de message krijgt (notapd of jouw eigen app.).

Misschien kun je wel proberen om het Notepad window een childform van jouw app te maken en de close-button disablen?

[Verwijderd]

Op maandag 13 mei 2002 23:08 schreef DiFool het volgende:
Volgens mij moet dit kunnen met SetWindowsHookEx met hook id WH_CBT. Zal er 's naar kijken.
[edit]
Werkt

of WH_GETMESSAGE, en dan wm_close en wm_quit eruit filteren.

[Guillome]

Op dinsdag 14 mei 2002 10:12 schreef deur het volgende:

[..]

of WH_GETMESSAGE, en dan wm_close en wm_quit eruit filteren.

Kan je dat misschien een heel klein beetje .. voordoen?

[Verwijderd]

WH_GETMESSAGE gaat niet werken, omdat je dan alleen de berichten kunt monitoren.

Ik zal vanavond een voorbeeld posten, maar je kunt vast kijken naar [topic=462493], lijkt er veel op.

[Guillome]

Ik wacht met smart DiFool

[Guillome]

Op maandag 13 mei 2002 23:08 schreef DiFool het volgende:
Volgens mij moet dit kunnen met SetWindowsHookEx met hook id WH_CBT. Zal er 's naar kijken.
[edit]
Werkt

Deze doet hier precies het verkeerde Die doet BeforeCreate ofzo van zijn eigen


Hmm in de help staat dit

LRESULT CALLBACK CBTProc(

int nCode,// hook code
WPARAM wParam,// depends on hook code
LPARAM lParam // depends on hook code
);


Parameters

nCode

Specifies a code that the hook procedure uses to determine how to process the message. This parameter can be one of the following values:

ValueMeaning
HCBT_DESTROYWND
A window is about to be destroyed.

If nCode is less than zero, the hook procedure must pass the message to the CallNextHookEx function without further processing and should return the value returned by CallNextHookEx.

wParam

Depends on the nCode parameter. For details, see the following Remarks section.

lParam

Depends on the nCode parameter. For details, see the following Remarks section.

Die moet ik hebben, maar hoe gebruik ik die?

[edit2]
Hmmm `t begint haast avond te worden

[edit3]
Belangrijk ff
Ik moet WH_SHELL gebruiken, met HSHELL_WINDOWDESTROYED.

Maar als ik

code:

Private
  procedure WMHCBTBeforeDistroyWnd(var Msg: TMessage); message WH_SHELL;

Var Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMHCBTBeforeDistroyWnd(var Msg: TMessage);
Begin
  ShowMessage(IntToStr(HCBT_DESTROYWND));
End;

Dan doet ie nix...

[Guillome]

Euh misschien zien jullie niet dat ik gereageerd heb
Dat editen is dan ook niet alles...

[Guillome]

Ik heb nu dit, maar hij pakt die Hook niet.
Application

code:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Constants;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  private
    FMappedFileHandle: THandle;
    procedure WMBeforeDistroyWnd(var Msg: TMessage); message WE_CloseWindow;
  public
    property MappedFileHandle: THandle read FMappedFileHandle write FMappedFileHandle;
  protected
  end;

  procedure HookCBT; stdcall; external 'WindowEvents.dll' index 1;
  procedure UnHookCBT; stdcall; external 'WindowEvents.dll' index 2;

var
  Form1: TForm1;

implementation

{$R *.DFM}

Procedure TForm1.WMBeforeDistroyWnd(var Msg : TMessage);
Begin
  ShowMessage('s');
End;

procedure TForm1.FormCreate(Sender: TObject);
var
  HookData: PCBTHookData;
begin
  MappedFileHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0,
    SizeOf(TCBTHookData), HookName);
  HookData := MapViewOfFile(MappedFileHandle, FILE_MAP_ALL_ACCESS, 0, 0, 0);
  if Assigned(HookData) then
  begin
    FillChar(HookData^, SizeOf(TCBTHookData), #0);
    HookData^.AppHandle := Handle;
    HookCBT;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  UnHookCBT;
  CloseHandle(MappedFileHandle);
end;

end.

En de DLL

code:

library WindowEvents;

uses
  Messages,
  Constants,
  Windows;

{$R *.RES}

function ShellProc(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT stdcall;
var
  Msg: Integer;
  MappedMemoryHandle: THandle;
  HookData: PCBTHookData;
begin
  Result := 0;
  MappedMemoryHandle := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, HookName);
  if MappedMemoryHandle <> 0 then
  begin
    HookData := MapViewOfFile(MappedMemoryHandle, FILE_MAP_ALL_ACCESS, 0, 0, 0);
    if Assigned(HookData) then
    begin
    Msg := -1;
    if Code = HSHELL_WINDOWDESTROYED Then Msg := WE_CloseWindow;
    if Msg > -1 then PostMessage(HookData^.AppHandle, Msg, wParam, lParam);
    if HookData^.HookHandle <> 0 then
      Result := CallNextHookEx(HookData^.HookHandle, Code, wParam, lParam);
    UnMapViewOfFile(HookData);
    end;
    CloseHandle(MappedMemoryHandle);
  end
end;

procedure HookCBT; stdcall;
var
  MappedMemoryHandle: THandle;
  HookData: PCBTHookData;
begin
  MappedMemoryHandle := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, HookName);
  if MappedMemoryHandle <> 0 then
  begin
    HookData := MapViewOfFile(MappedMemoryHandle, FILE_MAP_ALL_ACCESS, 0, 0, 0);
    if Assigned(HookData) then
    begin
    { Store the returned Handle in the Memory Mapped File so all instances    }
    { of the DLL hook can retrieve it to pass it the CallNextHookEx      }
    HookData^.HookHandle := SetWindowsHookEx(WH_CBT, ShellProc, hInstance, 0);
    UnmapViewOfFile(HookData);
    end;
    CloseHandle(MappedMemoryHandle);
  end
end;

procedure UnHookCBT; stdcall;
var
  MappedMemoryHandle: THandle;
  HookData: PCBTHookData;
begin
  MappedMemoryHandle := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, HookName);
  if MappedMemoryHandle <> 0 then
  begin
    HookData := MapViewOfFile(MappedMemoryHandle, FILE_MAP_ALL_ACCESS, 0, 0, 0);
    if Assigned(HookData) then
    begin
    UnHookWindowsHookEx(HookData^.HookHandle);
    HookData^.HookHandle := 0;
    UnmapViewOfFile(HookData);
    end;
    CloseHandle(MappedMemoryHandle);
  end
end;


exports  HookCBT Index 1;
exports  UnHookCBT Index 2;

begin
end.

[Verwijderd]

Oke mijn code:

Ik moet wel zeggen dat ik gisteren iets te enthousiast was, want na wat verder testen blijkt het niet te werken bij alle programma's.

Wel doet bv:

• Notepad
• Winamp
• IrfanView
• Opera

Niet doet:

• Calculator
• Explorer [niet zo gek]
• Delphi programma's [zal wel weer door Application Window <> Main Window komen]

Applicatie:

code:

unit Capture02;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

const
  CM_DestroyWnd = WM_USER + 1;

type
  TForm2 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ListBox1: TListBox;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  protected
    procedure CMDestroyWnd(var Message: TMessage); message
    CM_DestroyWnd;
  end;

var
  Form2: TForm2;

implementation

uses
  CommCtrl;

{$R *.DFM}

var
  GWindowHandleList: TList;

procedure SetHook; external 'Capture.dll';
procedure UnSetHook; external 'Capture.dll';
procedure SetObserver(Handle: HWnd); external 'Capture.dll';
procedure SetObservableWindow(Handle: HWnd; Item: Integer); external
  'Capture.dll';

function IsMainAppWindow(Wnd: HWND): Boolean;
var
  ParentWnd: HWND;
  ExStyle: DWORD;
begin
  if IsWindowVisible(Wnd) then
  begin
    ParentWnd := GetWindowLong(Wnd, GWL_HWNDPARENT);
    ExStyle := GetWindowLong(Wnd, GWL_EXSTYLE);
    Result := ((ParentWnd = 0) or (ParentWnd = GetDesktopWindow)) and
    ((ExStyle and WS_EX_TOOLWINDOW = 0) or (ExStyle and WS_EX_APPWINDOW <>
    0));
  end
  else
    Result := False;
end;

procedure CleanUp(AList: TList);
var
  i: Integer;
begin
  for i := AList.Count - 1 downto 0 do
    if not IsMainAppWindow(HWND(AList[i])) then
    AList.Delete(i);
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
  UnSetHook;
end;

procedure TForm2.CMDestroyWnd(var Message: TMessage);
begin
  if GWindowHandleList.IndexOf(Pointer(Message.WParam)) >= 0 then
  begin
    ListBox1.Items.Add(Format('HCBT_DESTROYWND: %s',
    [IntToHex(Message.WParam, 8)]));
  end
  else
    ListBox1.Items.Add('Onbekend');
end;

function ExecuteProg(FileName: string; Visibility: Integer; var ProcessID:
  DWORD): Boolean;
var
  zAppName: array[0..512] of Char;
  zCurDir: array[0..255] of Char;
  WorkDir: string;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
begin
  StrPCopy(zAppName, FileName);
  GetDir(0, WorkDir);
  StrPCopy(zCurDir, WorkDir);
  FillChar(StartupInfo, SizeOf(StartupInfo), #0);
  StartupInfo.cb := SizeOf(StartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := Visibility;
  Result := CreateProcess(nil, zAppName, nil, nil, False, Create_NEW_CONSOLE or
    NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo);
  if Result then
  begin
    ProcessID := ProcessInfo.dwProcessId;
    WaitForInputIdle(ProcessInfo.hProcess, 5000);
  end;
end;

procedure TForm2.Button1Click(Sender: TObject);

  function EnumWindowsProc(Wnd: HWND; ProcessID: DWORD): Boolean; stdcall;
  var
    PID: DWORD;
  begin
    GetWindowThreadProcessId(Wnd, @PID);
    if (ProcessID = PID) then
    GWindowHandleList.Add(Pointer(Wnd));
    Result := True;
  end;
var
  ProcessID: DWORD;
  i: Integer;
begin
  if ExecuteProg(Edit1.Text, SW_SHOW, ProcessID) then
  begin
    GWindowHandleList.Clear;
    repeat
    EnumWindows(@EnumWindowsProc, LPARAM(ProcessID));
    Sleep(100);
    until GWindowHandleList.Count > 0;

    for i := 0 to GWindowHandleList.Count - 1 do
    ListBox1.Items.Add(Format('WindowHandle = %s',
      [IntToHex(Integer(GWindowHandleList[i]), 8)]));

    { Dit kun je eventueel weghalen }
    CleanUp(GWindowHandleList);

    for i := 0 to GWindowHandleList.Count - 1 do
    ListBox1.Items.Add(Format('Observe %s',
      [IntToHex(Integer(GWindowHandleList[i]), 8)]));

    with GWindowHandleList do
    if Count <> 0 then
    begin
      while Count < 6 do
        Add(nil);

      SetObserver(Handle);

      for i := 0 to 5 do
        SetObservableWindow(HWND(Items[i]), i);
      SetHook;
    end;
  end;
end;

initialization
  GWindowHandleList := TList.Create;
finalization
  GWindowHandleList.Free;
end.

Dll:

code:

library Capture;

uses
  Windows,
  CommCtrl,
  Messages;

{$R *.RES}

type
  PHookRec = ^THookRec;
  THookRec = record
    Observer: THandle;
    ObservableWindow0: THandle;
    ObservableWindow1: THandle;
    ObservableWindow2: THandle;
    ObservableWindow3: THandle;
    ObservableWindow4: THandle;
    ObservableWindow5: THandle;
    HookID: HHOOK;
  end;

const
  CM_DestroyWnd = WM_USER + 1;

const
  HookRecPtr: PHookRec = nil;

procedure SetObserver(Handle: HWnd);
begin
  HookRecPtr.Observer := Handle;
end;

procedure SetObservableWindow(Handle: HWnd; Item: Integer);
begin
  case Item of
    0: HookRecPtr.ObservableWindow0 := Handle;
    1: HookRecPtr.ObservableWindow1 := Handle;
    2: HookRecPtr.ObservableWindow2 := Handle;
    3: HookRecPtr.ObservableWindow3 := Handle;
    4: HookRecPtr.ObservableWindow4 := Handle;
    5: HookRecPtr.ObservableWindow5 := Handle;
  end;
end;

function HookProc(Code: Integer; WParam, LParam: Longint): Longint;
  stdcall;
begin
  if (Code = HCBT_DESTROYWND) and
    ((WParam = HookRecPtr.ObservableWindow0) or
    (WParam = HookRecPtr.ObservableWindow1) or
    (WParam = HookRecPtr.ObservableWindow2) or
    (WParam = HookRecPtr.ObservableWindow3) or
    (WParam = HookRecPtr.ObservableWindow4) or
    (WParam = HookRecPtr.ObservableWindow5)) then
  begin
    PostMessage(HookRecPtr.Observer, CM_DestroyWnd, WParam, LParam);
    //CallNextHookEx(HookRecPtr.HookID, Code, WParam, LParam);
    Result := 1;
  end
  else
    Result := CallNextHookEx(HookRecPtr.HookID, Code, WParam, LParam)
end;

procedure SetHook;
begin
  HookRecPtr.HookID := SetWindowsHookEx(WH_CBT, @HookProc, HInstance,
    0);
end;

procedure UnSetHook;
begin
  UnHookWindowsHookEx(HookRecPtr.HookID);
end;

exports
  SetHook,
  UnSetHook,
  SetObserver,
  SetObservableWindow;

procedure EntryPointProc(Reason: Integer);
const
  hMapObject: THandle = 0;
begin
  case reason of
    DLL_PROCESS_ATTACH:
    begin
      hMapObject := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0,
        SizeOf(THookRec), 'CaptureDesktopEvents');
      HookRecPtr := MapViewOfFile(hMapObject, FILE_MAP_WRITE, 0, 0, 0);
    end;
    DLL_PROCESS_DETACH:
    begin
      try
        if HookRecPtr <> nil then
        UnMapViewOfFile(HookRecPtr);
        if hMapObject <> 0 then
        CloseHandle(hMapObject);
      except
      end;
    end;
  end;
end;

begin
  DllProc := @EntryPointProc;
  EntryPointProc(DLL_PROCESS_ATTACH);
end.

[Guillome]

Zo!
WErkt lekker, alleen IExplorer.exe dus niet, en daar gaat het juist om... hoe zou dat kunnen?

Basically the notifications HCBT_CREATEWND and HCBT_DESTROYWND are called whenever a window is created or destroyed in the system. This type of behavior is exactly what I thought was required. I realized soon that WH_CBT and HCBT_CREATEWND and HCBT_DESTROYWND were too much. This hook will notify you for practically every window created in the system, with few exceptions. It meant I had to identify which windows were top level, non-child and visible. Since when an application starts several windows are created, this proved to be too much and not reliable enough.

After a more in-depth look at the documentation, I realized WH_SHELL might be just what I needed. It has several useful notifications: HSHELL_ACCESSIBILITYSTATE, HSHELL_ACTIVATESHELLWINDOW, HSHELL_GETMINRECT, HSHELL_LANGUAGE, HSHELL_REDRAW, HSHELL_TASKMAN, HSHELL_WINDOWACTIVATED, HSHELL_WINDOWCREATED, HSHELL_WINDOWDESTROYED. This hook notifies you only of actions happening to top level windows (for example, the main application window, which is what we have to deal with). WH_SHELL is easier to deal with and, unlike WH_CBT, our code doesn't require overly complex logic to get the functionality we specified. It just feels better when the code is not cluttered with special cases. WH_SHELL is a listen-only hook. We cannot modify its behavior, mainly because it notifies the filter process after the default behavior has taken place.

Is dit misschien wat kan helpen?

[edit1]
En wat is die observer eigelijks?

[edit2]
Hmmm bij calc.exe en die anderen die het niet doen gaat ie hier

code:

  for i := AList.Count - 1 downto 0 do
    if not IsMainAppWindow(HWND(AList[i])) then
    AList.Delete(i);

altijd die AList.Delete(i) doen.
En dat moet niet.
Dus die IsMainAppWindow is niet 100% ok.
FF zoeken

[edit3]
En wel, IsWindowVisible(Wnd) doet het niet goed

[edit4]
Hmm zelfs als je die if IsWindowVisible(Wnd) then weg laat, dus dat ie die IsMainAppWindow altijd true geeft, doet ie t nOg niet...

[edit5]
Notepad heeft 1, en calc heeft 2 handles......dat is het zekers?

[edit6]
En ditte
for i := 0 to 5 do
SetObservableWindow(HWND(Items[i]), i);
SetHook;
Moet ie die SetHook niet voor elke For actie doen?

[edit7]
Ik hoop dat je zo verder komt?
Ik kom er echt niet uit...

[Verwijderd]

In die quote staat:

WH_SHELL is a listen-only hook. We cannot modify its behavior, mainly because it notifies the filter process after the default behavior has taken place.

Ik dacht dat het de bedoeling was, om ervoor te zorgen dat een app niet afgesloten werd?

Als je deze functie toevoegd, kun je kijken wat de caption van de window is.

code:

function GetWindowCaption(Wnd: HWND): string;
const
  BufferAllocStep = 256;
var
  Buffer: PChar;
  Size, TextLen: Integer;
begin
  Result := '';
  Buffer := nil;
  try
    Size := GetWindowTextLength(Wnd) + 2 - BufferAllocStep;
    repeat
    Inc(Size, BufferAllocStep);
    ReallocMem(Buffer, Size);
    TextLen := GetWindowText(Wnd, Buffer, Size);
    until TextLen < Size - 1;
    if TextLen > 0 then
    Result := Buffer;
  finally
    FreeMem(Buffer);
  end;
end;

Dan zul je zien dat bij de calculator de windows 'Rekenmachine' en 'CalcMsgPumpWnd' [?] gemaakt worden. Het programma identificeert Rekenmachine als de main window [dat klopt dus] en als de calculator afgesloten wordt, wordt ook een bericht verstuurd. Meest waarschijnlijke waarom het programma toch wordt afgesloten is dat het niet op een standaard manier geprogrammeerd is.

Bij explorer wordt geen window gevonden door EnumWindowsProc, die past bij de ProcessID. Ik weet niet precies wat dit betekent, maar dit zal er mee te maken hebben dat explorer ingebed zit in Windows.

Met een ander programma dat ik heb, kun je wel zien dat er verschillende windows worden gecreeerd. Dus misschien is er wel een truk hiervoor te verzinnen.

Je zult je denk ik wel moeten afvragen, of je de goeie weg ingeslagen bent. Zijn denk is simpelere manieren om te doen wat jij wilt - zover ik kan inschatten wat jij wilt.

NB. functies GetWindowCaption & IsMainAppWindow komen uit de JCL.

[Guillome]

Zijn denk is simpelere manieren om te doen wat jij wilt - zover ik kan inschatten wat jij wilt

En weet je dan ook ongeveer welke manieren er nogmeer zijn?
Anders weet ik het ook niet meer.
In iedergeval alvast heel erg bedankt voor de moeite DiFool

`t Hoeft trouwens alleen maar te werken voor Internet Explorer

[Verwijderd]

Niet gedacht, maar het is me toch gelukt.

Dmv subclassing vd Explorer window in de dll kun je WM_SYSCOMMAND etc afvangen.

Zal vanavond weer code posten [zit nu op werk]. Kan wel laat worden, want ik was van plan veel tv te kijken vandaag.

[Guillome]

Je bent een schat
Ik wacht weer met smart

[edit]
Ik wacht nog steeds

[Verwijderd]

De hook in de dll wordt aangeroepen in de context van de window [die bv gecreerd wordt]; hierdoor kun je die window subclassen.

Probleem is: hoe weet je welke window je moet subclassen? Het is vrij moeilijk om de window te achterhalen in de aanroepende applicatie; daarom laat ik het de dll bepalen.

Ik geef aan de dll het process id door van de window. De dll ziet welke windows er gecreerd worden en bepaald dan aan de hand van het process id en de classname van de window [moet 'ieframe' zijn] wat de internet explorer is.

Applicatie:

code:

unit Capture02;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

const
  { Dit bericht kan de dll sturen.. }
  CM_NotifyObserver = WM_USER + 1;

  { ..met de volgende submessages }
  NO_BeginSubClassed = 0;
  NO_EndSubClassed = 1;
  NO_ProcessIDFound = 2;
  NO_ClosePrevented = 3;

type
  TForm2 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    FSubClassedCount: Integer; // Aantal windows dat gesubclassed zijn
    FHooking: Boolean; // Zijn we gestart met hooken?
    FWantStopHooking: Boolean; // Willen we stoppen met hooken?
    FWantClose: Boolean; // Willen we afsluiten?
  protected
    procedure CMNotifyObserver(var Message: TMessage); message
    CM_NotifyObserver;

    procedure StartHooking;
    procedure StopSubClassing;
    procedure StopHooking;
  end;

var
  Form2: TForm2;

implementation

{$R *.DFM}

procedure SetHook; external 'Capture.dll';
procedure UnSetHook; external 'Capture.dll';
procedure SetObserver(Handle: HWnd); external 'Capture.dll';
procedure SetWantProcessID(AProcessID: HWnd); external 'Capture.dll';

function GetClassNameWnd(Wnd: HWND): string;
begin
  SetLength(Result, 80);
  SetLength(Result, GetClassName(Wnd, PChar(Result), Length(Result)));
end;

function ExecuteProg(FileName: string; Visibility: Integer; var ProcessID:
  DWORD): Boolean;
var
  zAppName: array[0..512] of Char;
  zCurDir: array[0..255] of Char;
  WorkDir: string;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
begin
  StrPCopy(zAppName, FileName);
  GetDir(0, WorkDir);
  StrPCopy(zCurDir, WorkDir);
  FillChar(StartupInfo, SizeOf(StartupInfo), #0);
  StartupInfo.cb := SizeOf(StartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := Visibility;
  Result := CreateProcess(nil, zAppName, nil, nil, False, Create_NEW_CONSOLE or
    NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo);
  if Result then
  begin
    ProcessID := ProcessInfo.dwProcessId;
    WaitForInputIdle(ProcessInfo.hProcess, 5000);
  end;
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
  StartHooking;
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
  StopHooking;
end;

procedure TForm2.CMNotifyObserver(var Message: TMessage);
begin
  { Berichten van de dll weergeven }
  with ListBox1.Items do
    case Message.WParam of
    NO_BeginSubClassed:
      begin
        Inc(FSubClassedCount);
        Add(Format('Subclassing %s started', [IntToHex(Message.LParam, 8)]));
      end;
    NO_EndSubClassed:
      begin
        Add(Format('Subclassing %s stopped', [IntToHex(Message.LParam, 8)]));
        Dec(FSubClassedCount);
        if FSubClassedCount = 0 then
        begin
        if FWantStopHooking then
          StopHooking;
        if FWantClose then
          Close;
        end;
      end;
    NO_ProcessIDFound:
      Add(Format('ProcessID found in %s', [IntToHex(Message.LParam, 8)]));
    NO_ClosePrevented:
      Add(Format('Close prevented: %s', [IntToHex(Message.LParam, 8)]));
    else
    Add('Unknown message');
    end;
end;

procedure TForm2.StartHooking;
var
  ProcessID: DWORD;
begin
  if FWantClose or FWantStopHooking or (FSubClassedCount > 0) then
    Exit;

  SetObserver(Handle);
  SetHook;
  { Start IE }
  if ExecuteProg('C:\Program Files\Internet explorer\iexplore.exe', SW_SHOW,
    ProcessID) then
  begin
    { Geef het process id door aan de dll }
    SetWantProcessID(ProcessID);
    ListBox1.Items.Add(Format('Started hooking, ProcessID = %d', [ProcessID]));
    FHooking := True;
  end
  else
    UnSetHook;
end;

procedure TForm2.StopHooking;
begin
  if FSubClassedCount > 0 then
  begin
    { Eerst stoppen met subclassing }
    StopSubClassing;
    FWantStopHooking := True;
    Exit;
  end;

  UnSetHook;
  ListBox1.Items.Add('Stopped hooking');
  FHooking := False;
  FWantStopHooking := False;
end;

procedure TForm2.StopSubClassing;

  function EnumWindowsProc(Wnd: HWND; ProcessID: DWORD): Boolean; stdcall;
  begin
    if CompareText(GetClassNameWnd(Wnd), 'ieframe') = 0 then
    { Geef aan alle IE windows een stop bericht, de gesubclasste [?]
      windows zullen hierop stoppen met subclassen. }
    PostMessage(Wnd, WM_NULL, $15, $15);
    Result := True;
  end;
begin
  EnumWindows(@EnumWindowsProc, 0);
end;

procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := not FHooking;

  if FHooking then
  begin
    FWantClose := True;
    StopHooking;
  end;
end;

end.

Dll

code:

library Capture;

uses
  Windows,
  CommCtrl,
  Messages,
  SysUtils;

{$R *.RES}

type
  PHookRec = ^THookRec;
  THookRec = record
    { De window waarnaar we notification berichten sturen: }
    Observer: THandle;                      
    OldWndProc: Pointer;
    { Handle naar de IE window die we moeten subclassen, als deze 0 is
    weten we het nog niet, maar kunnen we al windows gesubclassed hebben }
    ObservedWindow: THandle;
    HookID: HHOOK;
    { Process id van de IE window die we zouden moeten subclassen }
    WantProcessID: DWORD;
  end;

const
  CM_NotifyObserver = WM_USER + 1;

  NO_BeginSubClassed = 0;
  NO_EndSubClassed = 1;
  NO_ProcessIDFound = 2;
  NO_ClosePrevented = 3;

const
  HookRecPtr: PHookRec = nil;

{ Hulpfunctie om berichten naar de observer te sturen }
procedure NotifyObserver(Msg, SubMsg: Integer);
begin
  PostMessage(HookRecPtr.Observer, CM_NotifyObserver, Msg, SubMsg);
end;

procedure UnSubClass(Handle: HWnd);
begin
  SetWindowLong(Handle, GWL_WNDPROC, Longint(HookRecPtr.OldWndProc));
  NotifyObserver(NO_EndSubClassed, LongInt(Handle));
end;

function WndProc(Wnd: HWND; Msg, WParam, LParam: Longint): Longint; stdcall;
var
  PID: DWORD;
begin
  { Als ObservedWindow 0 is [dus we weten nog niet welke window
    we zouden moeten subclassen], en het process ID is bekend, dan.. }
  if (HookRecPtr.ObservedWindow = 0) and (HookRecPtr.ObservedWindow <> Wnd) and
    (HookRecPtr.WantProcessID > 0) then
  begin
    { ..bepaal het process id van deze window }
    GetWindowThreadProcessId(Wnd, @PID);
    if PID <> HookRecPtr.WantProcessID then
    begin
    { We willen niet deze window gesubclassed hebben.. }
    Result := CallWindowProc(HookRecPtr.OldWndProc, Wnd, Msg, WParam, LParam);
    UnSubClass(Wnd);
    Exit;
    end
    else
    begin
    { We willen wel deze window gesubclassed hebben.. }
    HookRecPtr.ObservedWindow := Wnd;
    NotifyObserver(NO_ProcessIDFound, LongInt(Wnd));
    end;
  end;

  if (Msg = WM_NULL) and (WParam = $15) and (LParam = $15) then
  begin
    { Speciaal bericht van de observer, om te stoppen met subclassen }
    UnSubClass(Wnd);
    Result := 0;
  end
  else if ((Msg = WM_SYSCOMMAND) and (WParam = SC_CLOSE)) or
    ((Msg = WM_COMMAND) and (WParam = 40993)) then
  begin
    { WM_SYSCOMMAND -> via window menu 
    WM_COMMAND -> via File|Sluiten }
    NotifyObserver(NO_ClosePrevented, LongInt(Msg));
    Result := 0
  end
  else
    Result := CallWindowProc(HookRecPtr.OldWndProc, Wnd, Msg, WParam,
    LParam);
end;

procedure SubClass(Handle: Hwnd);
begin
  HookRecPtr.OldWndProc := Pointer(GetWindowLong(Handle, GWL_WNDPROC));
  SetWindowLong(Handle, GWL_WNDPROC, Longint(@WndProc));

  NotifyObserver(NO_BeginSubClassed, LongInt(Handle));
end;

procedure SetObserver(Handle: HWnd);
begin
  HookRecPtr.Observer := Handle;
end;

function GetClassNameWnd(Wnd: HWND): string;
begin
  SetLength(Result, 80);
  SetLength(Result, GetClassName(Wnd, PChar(Result), Length(Result)));
end;

function HookProc(Code: Integer; WParam, LParam: Longint): Longint;
  stdcall;
var
  ExStyle: LongInt;
begin
  { Als we nog niet weten welke window we moeten subclassen
    [ObservedWindow = 0], dan subclass deze window.. }
  if (Code = HCBT_CREATEWND) and (HookRecPtr.ObservedWindow = 0) then
  begin
    { ..tenminste als het een IE window is }
    ExStyle := GetWindowLong(WParam, GWL_EXSTYLE);
    if (ExStyle = 256) and (CompareText(GetClassNameWnd(WParam), 'ieframe') = 0)
    then
    SubClass(WParam);
  end;
  Result := CallNextHookEx(HookRecPtr.HookID, Code, WParam, LParam)
end;

procedure SetWantProcessID(AProcessID: DWORD);
begin
  HookRecPtr.WantProcessID := AProcessID;
end;

procedure SetHook;
begin
  HookRecPtr.WantProcessID := 0;
  HookRecPtr.ObservedWindow := 0;
  HookRecPtr.HookID := SetWindowsHookEx(WH_CBT, @HookProc, HInstance, 0);
end;

procedure UnSetHook;
begin
  UnHookWindowsHookEx(HookRecPtr.HookID);
end;

exports
  SetHook,
  UnSetHook,
  SetObserver,
  SetWantProcessID;

procedure EntryPointProc(Reason: Integer);
const
  hMapObject: THandle = 0;
begin
  case reason of
    DLL_PROCESS_ATTACH:
    begin
      hMapObject := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0,
        SizeOf(THookRec), 'CaptureDesktopEvents');
      HookRecPtr := MapViewOfFile(hMapObject, FILE_MAP_WRITE, 0, 0, 0);
    end;
    DLL_PROCESS_DETACH:
    begin
      try
        if HookRecPtr <> nil then
        UnMapViewOfFile(HookRecPtr);
        if hMapObject <> 0 then
        CloseHandle(hMapObject);
      except
      end;
    end;
  end;
end;

begin
  DllProc := @EntryPointProc;
  EntryPointProc(DLL_PROCESS_ATTACH);
end.

[Guillome]

wowowowowie...
Heb je dat echt allemaal zelf gemaakt??
Jemig, wat knap.
Nou ik zal vanavond testen of het werkt
Tnx man! Tnx
Wat een boel he
Van 80% snap ik nix, maarja

[Guillome]

Hmmmmm CTRL + W werkt nog wel

En dubbelklik linksbovenin...

[Verwijderd]

Dan moet je ff iets aanpassen in de dll in functie WndProc:

code:

  else if ((Msg = WM_SYSCOMMAND) and ((WParam = SC_CLOSE) or (WParam = 61539)))
    or
    ((Msg = WM_COMMAND) and ((WParam = 40993) or (WParam = 106529)))
    then
    begin
    NotifyObserver(NO_ClosePrevented, LongInt(Msg));
    Result := 0
    end

CTRL + W: Msg = WM_SYSCOMMAND; WParam = 61539
Dubbelklik: Msg = WM_COMMAND; WParam = 106529

D'r zitten nog wel fouten in het programma, zoals: Caption van IE klopt niet; dll kan maar 1 oude WndProc onthouden, gaat dus fout als 2 of meer windows gesubclassed worden; gaat iets fout bij meerdere keren hooken van windows zonder dat de IE window afgesloten wordt.

[Guillome]

Hmmm is dat van die caption nog op te lossen?
Ik hoef maar 1 IE venster te openen, dus dat andere is geen probleem meer

[Guillome]

Laatste kick, ik hoop dat je me hierbij nog kan helpen
In iedergeval hartstikke bedankt voor je hulp!

[Verwijderd]

De problemen heb ik opgelost:

Caption probleem, kwam doordat ik de ANSI api's aanriep GetWindowLong, CallWindowProc etc. terwijl IE [in XP, 2000?] unicode is. Dit los je dan op door GetWindowLongW en CallWindowProcW aan te roepen.

Ik heb het niet getest in windows 98/95, dan moet je denk ik wel GetWindowLong, CallWindowProc aanroepen. Dit kun je oplossen door de api IsWindowUnicode aan te roepen voor het subclassen, en 2 WndProc te implementeren: 1 ansi [die dus gemaakt wordt met GetWindowLong en CallWindowProc aanroept] en 1 unicode [die gemaakt wordt met GetWindowLongW en CallWindowProcW aanroept]; maar dat heb ik niet gedaan, mag jij doen

Foutmelding bij 2 of meer gesubclasste IE kwam doordat als je een gesubclasste IE afsloot, alle dll's gedetached worden. Oplossing is bij het detachen van een dll, de window te unsubclassen.

Code dll:

code:

library Capture;

uses
  Windows,
  CommCtrl,
  Messages,
  SysUtils;

{$R *.RES}

type
  PHookRec = ^THookRec;
  THookRec = record
    RObserver: THandle;
    RObservedWindow: THandle;
    RHookID: HHOOK;
    RWantProcessID: DWORD;
  end;

const
  CM_NotifyObserver = WM_USER + 1;
  CM_NotifyObserverMsg = WM_USER + 2;

  NO_BeginSubClassed = 0;
  NO_EndSubClassed = 1;
  NO_ProcessIDFound = 2;
  NO_ClosePrevented = 3;
  NO_StartProcess = 4;
  NO_EndProcess = 5;

var
  { Alle instanties van de dll die geinjecteerd worden in een window
    krijgen eigen instanties van de volgende vars: }

  { Pointer naar de data die alle dll instanties delen }
  GHookRecPtr: PHookRec = nil;
  { Handle naar de filemapping object }
  GMapObject: THandle = 0;
  { Pointer naar oude wndproc }
  GOldWndProc: Pointer = nil;
  { Handle naar Window die gesubclassed is }
  GHandle: THandle = 0;

procedure NotifyObserver(Msg, SubMsg: Integer);
begin
  PostMessage(GHookRecPtr.RObserver, CM_NotifyObserver, Msg, SubMsg);
end;

procedure UnSubClass {(Handle: HWnd)};
begin
  if (GOldWndProc <> nil) and (GHandle > 0) then
  begin
    SetWindowLongW(GHandle, GWL_WNDPROC, Longint(GOldWndProc));
    NotifyObserver(NO_EndSubClassed, LongInt(GHandle));
    GOldWndProc := nil;
    GHandle := 0;
  end;
end;

function WndProc(Wnd: HWND; Msg, WParam, LParam: Longint): Longint; stdcall;
var
  PID: DWORD;
begin
  with GHookRecPtr^ do
  begin
    if (RObservedWindow = 0) and (RWantProcessID > 0) then
    begin
    GetWindowThreadProcessId(Wnd, @PID);
    if PID <> RWantProcessID then
    begin
      Result := CallWindowProcW(GOldWndProc, Wnd, Msg, WParam, LParam);
      UnSubClass {(Wnd)};
      Exit;
    end
    else
    begin
      RObservedWindow := Wnd;
      NotifyObserver(NO_ProcessIDFound, LongInt(Wnd));
    end;
    end;

    case Msg of
    WM_NULL:
      if (WParam = $15) and (LParam = $15) then
      begin
        UnSubClass;
        Result := 0;
        Exit;
      end;
    WM_SYSCOMMAND:
      if (WParam = SC_CLOSE) or (WParam = 61539) then
      begin
        NotifyObserver(NO_ClosePrevented, LongInt(Msg));
        Result := 0;
        Exit;
      end;
    WM_COMMAND:
      if (WParam = 40993) or (WParam = 106529) then
      begin
        NotifyObserver(NO_ClosePrevented, LongInt(Msg));
        Result := 0;
        Exit;
      end;
    end;

    Result := CallWindowProcW(GOldWndProc, Wnd, Msg, WParam, LParam);
  end;
end;

procedure SubClass(Handle: Hwnd);
begin
  GHandle := Handle;
  GOldWndProc := Pointer(GetWindowLong(Handle, GWL_WNDPROC));
  SetWindowLongW(Handle, GWL_WNDPROC, Longint(@WndProc));
  NotifyObserver(NO_BeginSubClassed, LongInt(Handle));
end;

procedure SetObserver(Handle: HWnd);
begin
  GHookRecPtr.RObserver := Handle;
end;

function GetClassNameWnd(Wnd: HWND): string;
begin
  SetLength(Result, 80);
  SetLength(Result, GetClassName(Wnd, PChar(Result), Length(Result)));
end;

function HookProc(Code: Integer; WParam, LParam: Longint): Longint;
  stdcall;
var
  ExStyle: LongInt;
begin
  if (Code = HCBT_CREATEWND) and (GHookRecPtr.RObservedWindow = 0) then
  begin
    ExStyle := GetWindowLong(WParam, GWL_EXSTYLE);
    if (ExStyle = 256) and (CompareText(GetClassNameWnd(WParam), 'ieframe') = 0)
    then
    SubClass(WParam);
  end;
  Result := CallNextHookEx(GHookRecPtr.RHookID, Code, WParam, LParam)
end;

procedure SetWantProcessID(AProcessID: DWORD);
begin
  GHookRecPtr.RWantProcessID := AProcessID;
end;

procedure SetHook;
begin
  with GHookRecPtr^ do
  begin
    RWantProcessID := 0;
    RObservedWindow := 0;
    RHookID := SetWindowsHookEx(WH_CBT, @HookProc, HInstance, 0);
  end;
end;

procedure UnSetHook;
begin
  UnHookWindowsHookEx(GHookRecPtr.RHookID);
end;

exports
  SetHook,
  UnSetHook,
  SetObserver,
  SetWantProcessID;

procedure EntryPointProc(Reason: Integer);
begin
  case reason of
    DLL_PROCESS_ATTACH:
    begin
      GMapObject := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0,
        SizeOf(THookRec), 'CaptureDesktopEvents');
      GHookRecPtr := MapViewOfFile(GMapObject, FILE_MAP_WRITE, 0, 0, 0);
      NotifyObserver(NO_StartProcess, 0);
    end;
    DLL_PROCESS_DETACH:
    begin
      UnSubClass;
      NotifyObserver(NO_EndProcess, 0);
      try
        if GHookRecPtr <> nil then
        UnMapViewOfFile(GHookRecPtr);
        if GMapObject <> 0 then
        CloseHandle(GMapObject);
      except
      end;
    end;
  end;
end;

begin
  DllProc := @EntryPointProc;
  EntryPointProc(DLL_PROCESS_ATTACH);
end.

[Guillome]

Heej man
Harstikke bedankt! Hoe weet jij dat allemaal ??
Het werkt nu prima!
Nu nog implementeren.
Dat is erg lastig, aangezien ik al hooks heb voor minimalizeren, en dat combineren wil nog niet echt lukken

[edit]
Pfff volgens mij is het gelukt

[Guillome]

Ej man
Nog only 1 thing...
Kan ik ook zorgen dan dat hij niet visible is op de taskbar, maar wel gewoon zichtbaar is op je buroblad zeg maar?

[Verwijderd]

Dat doe je toch gewoon met SetWindowLong?

[edit]

Wellicht de unicode versie dus SetWindowLongW.

[Verwijderd]

aub. hier verder gaan:
http://gathering.tweakers.net/forum/list_messages/506044