Solved

Delphi Trace all Windows create and destroyed

Posted on 2011-03-25
20
446 Views
Last Modified: 2012-05-11
Hi ,
I have to do a software that store in a database all activity of pc , when the user open a application and when close the application .
Somethings like winsight but only for event Create and Destroyed
Thank you so much
0
Comment
Question by:wackyteseo
  • 8
  • 8
  • 3
  • +1
20 Comments
 
LVL 14

Expert Comment

by:systan
ID: 35215203
app:

function SetHook(): Boolean; stdcall; external 'MatHook.dll';
function RemoveHook(): Boolean; stdcall; external 'MatHook.dll';

// ...

procedure TForm1.Button1Click(Sender: TObject);
begin
  if (not SetHook) then ShowMessage('Couldn''t start Hook');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if (not RemoveHook) then ShowMessage('Couldn''t stop Hook');
end;

---

DLL:

library MatHook;

uses
  Windows,
  Messages;

type
  THookRec = record
    hMatHook: HHOOK;
    hMatWnd: HWND;
    oldProc: Integer;
  end;

var
  map: DWord;
  buf: ^THookRec;

// new window proc - runs in context of target process
function MatWndProc(Handle: hWnd; Msg: uInt; wp: wParam; lp: lParam): LongInt; stdcall;
begin
  try
    case Msg of
      WM_CREATE:
      begin
        MessageBox(0, GetCommandLine, 'Command Line parameter(s)', MB_OK);
      end;

      // user definied message to stop subclassing
      // (RegisterWindowMessage would be a better choice instead of WM_USER message!)
      WM_USER + 1:
      begin
        // delete custom menu entries (quick'n'dirty)
        SetWindowLong(buf^.hMatWnd, GWL_WNDPROC, buf^.oldProc);
      end;

    end;
    Result := CallWindowProc(Pointer(buf^.oldProc), Handle, Msg, wp, lp);
  except
    Result := 0;
  end;
end;

// hook proc - waits for target window to be created
function MatHookProc(nCode: Integer; wp: wParam; lp: lParam): LongInt; stdcall;
var
  hTemp: hWnd;
  szClass: array[0..255] of Char;
begin
  try
    if (nCode >= HC_ACTION) then
    begin
      Case nCode of
        HCBT_CREATEWND:
        begin
          hTemp := HWND(wp);
          FillChar(szClass, 256, 0);
          GetClassName(hTemp, szClass, 256);
          if (szClass = 'Notepad') then
          begin
            buf^.hMatWnd := htemp;
            buf^.oldProc := GetWindowLong(buf^.hMatWnd, GWL_WNDPROC);
            SetWindowLong(buf^.hMatWnd, GWL_WNDPROC, Integer(@MatWndProc));
          end;
        end;
        HCBT_DESTROYWND:
        begin
          hTemp := HWND(wp);
          FillChar(szClass, 256, 0);
          GetClassName(hTemp, szClass, 256);
          if (szClass = 'Notepad') then
          begin
            SetWindowLong(buf^.hMatWnd, GWL_WNDPROC, buf^.OldProc);
          end;

        end;
      end;
    end;
    Result := CallNextHookEx(buf^.hMatHook, nCode, wp, lp);
  except
    Result := 0;
  end;
end;

// sets up hook
function SetHook: Boolean; stdcall; export;
begin
  try
    Result := false;
    if (not assigned(buf)) then
    begin
      map := CreateFileMapping(DWord(-1), nil, PAGE_READWRITE, 0, SizeOf(THookRec), 'HookRecMemBlock');
      buf := MapViewOfFile(map, FILE_MAP_ALL_ACCESS, 0, 0, 0);
      buf^.hMatHook := SetWindowsHookEx(WH_CBT, @MatHookProc, hInstance, 0);
      Result := true;
    end;
  except
    Result := false;
  end;
end;

// removes hook
function RemoveHook: Boolean; stdcall; export;
begin
  Result := false;
  if (assigned(buf)) then
  begin
    // tell our new wnd proc to stop subclassing
    // (has to be done in context of target process)
    SendMessage(buf^.hMatWnd, wm_User + 1, 1, 0);
    if (buf^.hMatHook <> 0) then UnhookWindowsHookEx(buf^.hMatHook);
    buf^.hMatHook := 0;
    UnmapViewOfFile(buf);
    buf := nil;
    Result := true;
  end;
end;

// DLL entry point
procedure DllEntry(dwReason: DWord);
begin
  Case dwReason of
    DLL_PROCESS_ATTACH:
    begin
      if (not assigned(buf)) then
      begin
        map := OpenFileMapping(FILE_MAP_ALL_ACCESS, false, 'HookRecMemBlock');
        buf := MapViewOfFile(map, FILE_MAP_ALL_ACCESS, 0, 0, 0);
        CloseHandle(map);
        map := 0;
      end;
    end;
    DLL_PROCESS_DETACH:
    begin
      UnmapViewOfFile(buf);
      buf := nil;
    end;
  end;
end;

exports
  SetHook,
  RemoveHook;

// main
begin
  DisableThreadLibraryCalls(hInstance);
  DllProc := @DLLEntry;
  DllEntry(DLL_PROCESS_ATTACH);
end.

Open in new window

by_Markus_alias_DaFox_in_Ex-Ex
0
 

Author Comment

by:wackyteseo
ID: 35215517
ok , thank for this
step one i create a dll

I don't understand how i have information in the main app when is created or closed window ?
0
 
LVL 36

Expert Comment

by:Geert Gruwez
ID: 35215522
systan ...
this looks awfully much like mathias's dll
> a reference to his site would be in place:
www.madshi.net
0
 
LVL 24

Expert Comment

by:jimyX
ID: 35215545
Simply you can read all the running processes from the Task Manager - Applications Tab and match and store based on the status.

Check this out:
http://vcldeveloper.com/downloads/ProcessInfo.zip
0
 
LVL 14

Expert Comment

by:systan
ID: 35220686
Geert?
>>this looks awfully much like mathias's dll
yes, depends on the user, alright well try to make another way.

wackyteseo?
Ok;
Are you getting it in the process info?
or what?
0
 
LVL 14

Expert Comment

by:systan
ID: 35220712
wackyteseo?
Ok;
Are you getting it in the process info?
or what?

Trace/List what?
Get the application executable name?, like c:\windows\system32\calc.exe
Get the opened application windows title?, like?
What?
0
 

Author Comment

by:wackyteseo
ID: 35221432
for systan :

if you look Winsight or Winspector , you can see that when open any window , i have a message like
"Window 00d000 , clas blablabla , created "
i have do a little procedure to do this , when open any windows or destroyed i have a called procedure , may be your example do this , but i didn't build a dll.

for jimyX :your solution is good but not is instant , for have a check istant i have set the time short and i have a little freeze of the system, i need the instant message
0
 
LVL 14

Expert Comment

by:systan
ID: 35221609
So do you want to get the application executable name?, like c:\windows\system32\calc.exe
or get the opened application windows caption title?

example output like; ?
CREATED c:\windows\system32\calc.exe
...
DESTROYED c:\windows\system32\calc.exe
0
 
LVL 24

Expert Comment

by:jimyX
ID: 35221747
>   "i need the instant message"

You need to explain a bit more here, because the demo works fine here.

Anyway, I created a sample project that reads all the running (or open) applications and show their details in a Listview and once any application is terminated then the details will be moved to another Listview (or they can be stored in a database instead).

Because EE restricts uploading certain extensions, you need to add the following file to the attached sample directory before you compile it:
ProcessInfo.inc

The file "ProcessInfo.inc" can be found in the source link:
http://vcldeveloper.com/downloads/ProcessInfo.zip
Sample-Project.zip
0
 
LVL 24

Expert Comment

by:jimyX
ID: 35221809
Updated sample project.

Do not forget to add "ProcessInfo.inc".

Just to let you know, this is just a sample and it can be changed, updated and improved to match your requirements.
Sample-Project-2.zip
0
Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

 

Author Comment

by:wackyteseo
ID: 35222001
for systan :

yes i want output like as you write , and if it is possible also the handle of process , but for the last not is a problem
0
 
LVL 14

Expert Comment

by:systan
ID: 35222693
Here's the mathook code updated;
library mathook;

uses
  Windows, SysUtils,
  Messages;

type
  THookRec = record
    hMatHook: HHOOK;
    hMatWnd: HWND;
    oldProc: Integer;
  end;

var
  map: DWord;
  buf: ^THookRec;

// hook proc - waits for target window to be created
function MatHookProc(nCode: Integer; wp: wParam; lp: lParam): LongInt; stdcall;
begin
  try
    if (nCode > 0) then
    begin
      Case nCode of
      HSHELL_WINDOWCREATED:
      begin
      //sends message to the form that high level window is created
      //sends the getwindowtext
      //sends the getcommandline
      //sends the gethandle
      end;
      HSHELL_WINDOWDESTROYED:
      begin
      //sends message to the form that high level window has been destroyed
      end;
      end;
    end;
    Result := CallNextHookEx(buf^.hMatHook, nCode, wp, lp);
  except
    Result := 0;
  end;
end;

// sets up hook
function SetHook: Boolean; stdcall; export;
begin
  try
    Result := false;
    if (not assigned(buf)) then
    begin
      map := CreateFileMapping(DWord(-1), nil, PAGE_READWRITE, 0, SizeOf(THookRec), 'HookRecMemBlock');
      buf := MapViewOfFile(map, FILE_MAP_ALL_ACCESS, 0, 0, 0);
      buf^.hMatHook := SetWindowsHookEx(WH_SHELL, @MatHookProc, hInstance, 0);
      Result := true;
    end;
  except
    Result := false;
  end;
end;

// removes hook
function RemoveHook: Boolean; stdcall; export;
begin
  Result := false;
  if (assigned(buf)) then
  begin
    // tell our new wnd proc to stop subclassing
    // (has to be done in context of target process)
    SendMessage(buf^.hMatWnd, wm_User + 1, 1, 0);
    if (buf^.hMatHook <> 0) then UnhookWindowsHookEx(buf^.hMatHook);
    buf^.hMatHook := 0;
    UnmapViewOfFile(buf);
    buf := nil;
    Result := true;
  end;
end;

// DLL entry point
procedure DllEntry(dwReason: DWord);
begin
  Case dwReason of
    DLL_PROCESS_ATTACH:
    begin
      if (not assigned(buf)) then
      begin
        map := OpenFileMapping(FILE_MAP_ALL_ACCESS, false, 'HookRecMemBlock');
        buf := MapViewOfFile(map, FILE_MAP_ALL_ACCESS, 0, 0, 0);
        CloseHandle(map);
        map := 0;
      end;
    end;
    DLL_PROCESS_DETACH:
    begin
      UnmapViewOfFile(buf);
      buf := nil;
    end;
  end;
end;

exports
  SetHook,
  RemoveHook;

// main
begin
  DisableThreadLibraryCalls(hInstance);
  DllProc := @DLLEntry;
  DllEntry(DLL_PROCESS_ATTACH);
end.

Open in new window

That's the nearest possible automate solution that you want;
You just need to send information back to the form.


Good Luck
0
 
LVL 14

Expert Comment

by:systan
ID: 35223125
0
 

Author Comment

by:wackyteseo
ID: 35223955
Ho systan , i have tried but i don't know where i wrong , the hook don't work
i attach file of example
0
 

Author Comment

by:wackyteseo
ID: 35224017
0
 
LVL 14

Accepted Solution

by:
systan earned 125 total points
ID: 35226401
Please see the last update code I send;
http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_26910900.html#35222693
Change <MatHookProc> function with this one;
function MatHookProc(nCode: Integer; wp: wParam; lp: lParam): LongInt; stdcall;
begin
Result := CallNextHookEx(buf^.hMatHook, nCode, wp, lp);
if nCode < 0 then Exit;
Case nCode of
      HSHELL_WINDOWCREATED:
      begin
      SendMessage(FindWindowEx(FindWindow('TForm1', nil), 0, 'TListBox', nil), LB_INSERTSTRING, 0, Integer(PChar(getcommandline + ' CREATED')));
      end;
      HSHELL_WINDOWDESTROYED:
      begin
      SendMessage(FindWindowEx(FindWindow('TForm1', nil), 0, 'TListBox', nil), LB_INSERTSTRING, 0, Integer(PChar(getcommandline + ' DESTROYED')));
      end;
      end;
end;

Open in new window

About the links?, there not very specific.
About the new added lines in the function?, it's the basic idea to send message to the form and i don't know what's the disadvantages using that way.
0
 

Author Comment

by:wackyteseo
ID: 35227679
Wowwww , good solution for me , if i want also the number of handle ?



p.s. Thank you also for jimyx
0
 

Author Closing Comment

by:wackyteseo
ID: 35227685
if is possible have also the handle of window
0
 
LVL 14

Expert Comment

by:systan
ID: 35229109
SendMessage(FindWindowEx(FindWindow('TForm1', nil), 0, 'TListBox', nil), LB_INSERTSTRING, 0, Integer(PChar(getcommandline + ' CREATED with HANDLE ' + IntToStr(wp) )));

0
 

Author Comment

by:wackyteseo
ID: 35232529
thank you so much
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Suggested Solutions

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now