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?
 
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
Take Control of Web Hosting For Your Clients

As a web developer or IT admin, successfully managing multiple client accounts can be challenging. In this webinar we will look at the tools provided by Media Temple and Plesk to make managing your clients’ hosting easier.

 
Geert GruwezOracle 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
All Courses

From novice to tech pro — start learning today.