Delphi Trace all Windows create and destroyed

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
wackyteseoAsked:
Who is Participating?

Improve company productivity with a Business Account.Sign Up

x
 
systanConnect With a Mentor Commented:
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
 
systanCommented:
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
 
wackyteseoAuthor Commented:
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
Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
Geert GOracle dbaCommented:
systan ...
this looks awfully much like mathias's dll
> a reference to his site would be in place:
www.madshi.net
0
 
jimyXCommented:
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
 
systanCommented:
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
 
systanCommented:
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
 
wackyteseoAuthor Commented:
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
 
systanCommented:
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
 
jimyXCommented:
>   "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
 
jimyXCommented:
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
 
wackyteseoAuthor Commented:
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
 
systanCommented:
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
 
systanCommented:
0
 
wackyteseoAuthor Commented:
Ho systan , i have tried but i don't know where i wrong , the hook don't work
i attach file of example
0
 
wackyteseoAuthor Commented:
0
 
wackyteseoAuthor Commented:
Wowwww , good solution for me , if i want also the number of handle ?



p.s. Thank you also for jimyx
0
 
wackyteseoAuthor Commented:
if is possible have also the handle of window
0
 
systanCommented:
SendMessage(FindWindowEx(FindWindow('TForm1', nil), 0, 'TListBox', nil), LB_INSERTSTRING, 0, Integer(PChar(getcommandline + ' CREATED with HANDLE ' + IntToStr(wp) )));

0
 
wackyteseoAuthor Commented:
thank you so much
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.