Solved

Application Process Path

Posted on 2010-08-18
35
790 Views
Last Modified: 2013-11-23
Detecting the Application before launch
Is there a way (I suspect a particular windows message) to find out when people launch programs/applications?

The application is running fine, IF you test it in notepad alone.  BUT with all the other files? it's not working.
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

0
Comment
Question by:systan
  • 19
  • 5
  • 5
  • +2
35 Comments
 
LVL 14

Author Comment

by:systan
ID: 33471126
.
unit FPipes;

interface

uses
  Classes, Windows;

const
  cShutDownMsg = 'shutdown';
  cPipeFormat = '\\%s\pipe\%s';

type
  RPIPEMessage = record
    Size: DWORD;
    Kind: Byte;
    Count: DWORD;
    Data: array[0..8095] of Char;
  end;

  TOnDataEvent = procedure(Sender: TObject; aData: String; var aRespond: String) of Object;

  TPipeServer = class(TThread)
  private
    FHandle: THandle;
    FPipeName: string;
    FOnData: TOnDataEvent;
  protected
  public
    constructor CreatePipeServer(aServer, aPipe: string; StartServer: Boolean);
    destructor Destroy; override;
    procedure StartUpServer;
    procedure ShutDownServer;
    procedure Execute; override;
    property OnData: TOnDataEvent read FOnData write FOnData;
  end;

  TPipeClient = class
  private
    FPipeName: string;
    function ProcessMsg(aMsg: RPIPEMessage): RPIPEMessage;
  protected
  public
    constructor Create(aServer, aPipe: string);
    function SendString(aStr: string): string;
  end;

implementation

uses
  SysUtils;

procedure CalcMsgSize(var Msg: RPIPEMessage);
begin
 Msg.Size := SizeOf(Msg.Size) +
             SizeOf(Msg.Kind) +
             SizeOf(Msg.Count) +
             Msg.Count + 3;
end;

{ TPipeServer }

constructor TPipeServer.CreatePipeServer(aServer, aPipe: string; StartServer: Boolean);
begin
 if aServer = '' then
  FPipeName := Format(cPipeFormat, ['.', aPipe])
 else
  FPipeName := Format(cPipeFormat, [aServer, aPipe]);
 FHandle := INVALID_HANDLE_VALUE;
 if StartServer then
  StartUpServer;
 Create(not StartServer);
end;

destructor TPipeServer.Destroy;
begin
 if FHandle <> INVALID_HANDLE_VALUE then
  ShutDownServer;
 inherited Destroy;
end;

procedure TPipeServer.Execute;
var
 i, w: Cardinal;
 InMsg,
 OutMsg: RPIPEMessage;
 s, r: String;
begin
 while not Terminated do
  begin
   if (FHandle = INVALID_HANDLE_VALUE) then
    Sleep(250)
   else
    if ConnectNamedPipe(FHandle, nil) then
     try
      InMsg.Size := SizeOf(InMsg);
      ReadFile(FHandle, InMsg, InMsg.Size, InMsg.Size, nil);
      if not Terminated and Assigned(FOnData) then
       begin
        s := '';
        for i := 0 to Pred(InMsg.Count) do
         s := s + InMsg.Data[i];
        FOnData(Self, s, r);
        OutMsg.Kind := 0;
        OutMsg.Count := Length(r);
        StrPCopy(OutMsg.Data, r);
        CalcMsgSize(OutMsg);
        WriteFile(FHandle, OutMsg, OutMsg.Size, w, nil);
       end;
     finally
      DisconnectNamedPipe(FHandle);
     end;
  end;
end;

procedure TPipeServer.ShutDownServer;
var
 InMsg,
 OutMsg: RPIPEMessage;
 BytesRead: Cardinal;
begin
 if FHandle <> INVALID_HANDLE_VALUE then
  begin
   Terminate;
   OutMsg.Size := SizeOf(OutMsg);
   with InMsg do
    begin
     Kind := 0;
     Count := Length(cShutDownMsg);
     StrPCopy(Data, cShutDownMsg);
    end;
   CalcMsgSize(InMsg);
   CallNamedPipe(PChar(FPipeName), @InMsg, InMsg.Size, @OutMsg, OutMsg.Size, BytesRead, 100);
   CloseHandle(FHandle);
   FHandle := INVALID_HANDLE_VALUE;
  end;
end;

procedure TPipeServer.StartUpServer;
begin
 if WaitNamedPipe(PChar(FPipeName), 100 {ms}) then
  raise Exception.Create('Requested PIPE exists already.');

 FHandle := CreateNamedPipe(PChar(FPipeName), PIPE_ACCESS_DUPLEX,
                            PIPE_TYPE_MESSAGE or PIPE_READMODE_MESSAGE or PIPE_WAIT,
                            PIPE_UNLIMITED_INSTANCES, SizeOf(RPIPEMessage), SizeOf(RPIPEMessage),
                            NMPWAIT_USE_DEFAULT_WAIT, nil);

 if FHandle = INVALID_HANDLE_VALUE then
  raise Exception.Create('Could not create PIPE.');
end;

{ TPipeClient }

constructor TPipeClient.Create(aServer, aPipe: string);
begin
 inherited Create;
 if aServer = '' then
  FPipeName := Format(cPipeFormat, ['.', aPipe])
 else
  FPipeName := Format(cPipeFormat, [aServer, aPipe]);
end;

function TPipeClient.ProcessMsg(aMsg: RPIPEMessage): RPIPEMessage;
begin
 CalcMsgSize(aMsg);
 Result.Size := SizeOf(Result);
 if WaitNamedPipe(PChar(FPipeName), 10) then
  if not CallNamedPipe(PChar(FPipeName), @aMsg, aMsg.Size, @Result, Result.Size, Result.Size, 500) then
   raise Exception.Create('PIPE did not respond.')
  else
 else
  raise Exception.Create('PIPE does not exist.');
end;

function TPipeClient.SendString(aStr: string): string;
var
 Msg: RPIPEMessage;
begin
 Msg.Kind := 1;
 Msg.Count := Length(aStr);
 StrPCopy(Msg.Data, aStr);
 Msg := ProcessMsg(Msg);
 Result := Copy(Msg.Data, 1, Msg.Count);
end;

end.

Open in new window

0
 
LVL 14

Author Comment

by:systan
ID: 33471147
.
unit Unit1;
interface

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

type
  TForm1 = class(TForm)
    Button2: TButton;
    Button1: TButton;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
     FServer: TPipeServer;
     procedure OnPipeData(Sender: TObject; aData: String; var aRespond: String);

  public
    { Public declarations }

  end;

var
  Form1: TForm1;
//HookMsg: cardinal;

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

implementation

{$R *.dfm}

procedure TForm1.OnPipeData(Sender: TObject; aData: String; var aRespond: String);
begin
Form1.Text := aData;
aRespond := '1';
end;

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

procedure TForm1.Button1Click(Sender: TObject);
begin
if (not SetHook) then ShowMessage('Couldn''t start Hook');
FServer := TPipeServer.CreatePipeServer('', 'TwinSoft', True);
FServer.OnData := OnPipeData;
end;


//Im not sure of this if it is going to fix this
//initialization
//HookMsg := RegisterWindowMessage('myhookdll_hookmsg');


end.

Open in new window

0
 
LVL 14

Author Comment

by:systan
ID: 33471204
redifined
unit Unit1;
interface

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

type
  TForm1 = class(TForm)
    Button2: TButton;
    Button1: TButton;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
     FServer: TPipeServer;
     procedure OnPipeData(Sender: TObject; aData: String; var aRespond: String);

  public
    { Public declarations }

  end;

var
  Form1: TForm1;
//HookMsg: cardinal;

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

implementation

{$R *.dfm}

procedure TForm1.OnPipeData(Sender: TObject; aData: String; var aRespond: String);
var
  buttonSelected : Integer;
begin
Form1.Text := aData;
if aData<>'' then
begin
buttonSelected := MessageDlg('Do you want to continue launching ' + aData + '?', mtConfirmation, [mbYes,mbNO], 0);
if buttonSelected = mrYes then aRespond := '1' else aRespond := '0';
end;
end;

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

procedure TForm1.Button1Click(Sender: TObject);
begin
if (not SetHook) then ShowMessage('Couldn''t start Hook');
FServer := TPipeServer.CreatePipeServer('', 'TwinSoft', True);
FServer.OnData := OnPipeData;
end;


//Im not sure of this if it is going to fix this
//initialization
//HookMsg := RegisterWindowMessage('myhookdll_hookmsg');


end.

Open in new 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.

 
LVL 14

Author Comment

by:systan
ID: 33471257
redefined library
library MatHook;

uses
  Fpipes,
  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;
var aResult:string;
begin
  try
    case Msg of
      WM_CREATE:
      begin
      //MessageBox(0, GetCommandLine, 'Command Line parameter(s)', MB_OK);

      with TPipeClient.Create('', 'TwinSoft') do
        try
          aResult := SendString(GetCommandLine);
          finally
          Free;
        end;

      if aResult = '1' then
      begin
      //MessageBox(0, GetCommandLine, 'THIS WILL CONTINUE LAUNCHING', MB_OK);
      SetWindowLong(buf^.hMatWnd, GWL_WNDPROC, buf^.oldProc);
      Result := CallWindowProc(Pointer(buf^.oldProc), Handle, Msg, wp, lp);
      end
      else
      begin
      //MessageBox(0, GetCommandLine, 'THIS WILL NOT CONTINUE TO OPEN', MB_OK);
      SetWindowLong(buf^.hMatWnd, GWL_WNDPROC, buf^.oldProc);
      result := 0;
      end;

      end;//wm_create

      // user definied message to stop subclassing
      // ( REGISTERWINDOWSMESSAGE would be a better choice instead of WM_USER message!)
     WM_USER + 1:
     begin
         //MessageBox(0, 'GetCommandLine', 'USER', MB_OK);
        // 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);
    //Result := DefWindowProc(hWnd,Msg,wParam,lParam);
  except
    Result := 0;
  end;//end main try

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
          { NOT just notepad, but to all
          hTemp := HWND(wp);
          FillChar(szClass, 256, 0);
          GetClassName(hTemp, szClass, 256);
          if (szClass = 'Notepad') then
          }
          if EnumThreadWindows(GetCurrentThreadId, @hTemp, 0) then
          begin
          hTemp := HWND(wp);
          FillChar(szClass, SizeOf(szClass), 0);
          ZeroMemory(@szClass, SizeOf(szClass));
          GetWindowText(hTemp, szClass, SizeOf(szClass));
          GetClassName(hTemp, szClass, SizeOf(szClass));


          buf^.hMatWnd := htemp;
          buf^.oldProc := GetWindowLong(buf^.hMatWnd, GWL_WNDPROC);
          SetWindowLong(buf^.hMatWnd, GWL_WNDPROC, Integer(@MatWndProc));
          end;
        end;

        HCBT_DESTROYWND:
        begin
          { NOT just notepad, but to all
          hTemp := HWND(wp);
          FillChar(szClass, 256, 0);
          GetClassName(hTemp, szClass, 256);
          if (szClass = 'Notepad') then
          }
          SetWindowLong(buf^.hMatWnd, GWL_WNDPROC, buf^.OldProc);
        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

0
 
LVL 14

Author Comment

by:systan
ID: 33471296
0
 
LVL 3

Expert Comment

by:NevTon
ID: 33471369
Hi,

I've readed Your previous post in this subject:
http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_26266299.html

I think You do something wrong, I see this in that way:
1. detect application create
2. pause application thread
3. ask a question about launching this application
4. if answer was "ok" - unpause the application thread
5. if answer was "cancel" - terminate application thread

When I do a few tests, then throw the code to illustrate what I meant.
0
 
LVL 14

Author Comment

by:systan
ID: 33471723
NevTon;
What a surprise comment!
I've been asking this many times, but no one cooperate to test the code,  even the full code was completly attached and need only to debug some lines.

Thanks


1. detect application create
Yes, the program code is detecting

2. pause application thread
No, not pause, but it will be read when an analysis occurs.

3. ask a question about launching this application
4. if answer was "ok" - unpause the application thread
5. if answer was "cancel" - terminate application thread

Actually there is no asking (messagebox)
After recieving the [aData=GetCommandLine=ApplicationPath from .DLL message]
//.dll code
aResult := SendString(GetCommandLine);

//unit.pas
//analyzed function is to be coded, if this is solved.
procedure TForm1.OnPipeData(Sender: TObject; aData: String; var aRespond: String);
begin
IF (analyzed(aData)='BAD') then aRespond := '0' else aRespond := '1';
end;

I will generate a readstream analyses of the application that is currently created,  
IF  the application is good (upon diagnose),  then continue launching the application.
IF  the application is bad (upon diagnose),  then it will terminate the application.
0
 
LVL 3

Expert Comment

by:NevTon
ID: 33473310
I have  the impression, that You previously have asked questions for EE users  incorrectly, which entail inappropriate responses.
But if  you wait for my analysis of this topic, it brightens a little.
0
 
LVL 14

Author Comment

by:systan
ID: 33474564
Wow!,  
I could wait until the admin close this post if no one can solved it.
But I hope you can test it  and analyze what to do with the code to make it perfect.   Here's the complete code link;
http://filedb.experts-exchange.com/incoming/2010/08_w34/338614/projectx.zip

Yes, I've ask questions incorrectly, I noticed it also.
Actually if your the one who can solved this?,  I will be surprise, very surprise.

There's Aflarin, Geert, Epasquier, ThievingSix as active delphi experts, But I don't know why they have not tested the code and see the bug since they are very fast delphi coders, smart programmers.

I'm hoping you can,  if they don't wanna participate the test.
0
 
LVL 3

Expert Comment

by:NevTon
ID: 33478578
I start tests from  the beginning to see what the problem is.
It  just so happens that I have little time to study this topic and I  must add that I also need a solution.
So, please wait. I make a progress.
0
 
LVL 3

Expert Comment

by:NevTon
ID: 33478642
I'm working on WinXP SP3, BDS 2006.

Right now the problem is:
1. detect application create
because WH_CBT hook is getting data only from test application.

So, I think I'm in the same point as You...
0
 
LVL 3

Assisted Solution

by:NevTon
NevTon earned 20 total points
ID: 33479838
Ok, I think I've understand the idea of global hooks and  interprocess communications (IPC) useing pipes.
More, I see whats wrong with Your implementation.
So, be patience, solution is near.
0
 
LVL 14

Author Comment

by:systan
ID: 33480999
Ok;
Do you think the problem is in the pipes unit?
Well when we filter it with notepad? it performs fine,   but with no filtering it does not cooperate.
i'LL wait for your solution, I know some experts here are listening, but I wonder why they have no comment, probably they think it's hard to troubleshoot the code.
0
 
LVL 14

Author Comment

by:systan
ID: 33488370
Oh, yes probably with pipes, nice move,  I'll wait for your comment before I test it my self.
0
 
LVL 14

Author Comment

by:systan
ID: 33491107
NevTon;
Are you there? How is it?

Aflarin; Geert;
I know both of you are listening,  any simple pointly comment?
0
 
LVL 14

Author Comment

by:systan
ID: 33493521
NO! it's not because of Pipes that doesn't perform well, it is because of the code of Mathook.
I test it many times before and now.
Any updates NevTon?
0
 
LVL 14

Author Comment

by:systan
ID: 33494692
Nevton?
>>More, I see whats wrong with Your implementation.

So, what's going on, how is it?
0
 
LVL 37

Assisted Solution

by:Geert Gruwez
Geert Gruwez earned 20 total points
ID: 33495159
i think windows doesn't send a message when a app starts
you look to be in the right direction for using a hook

it's not that i don't want to answer
i just have no experience in this area

i'll have a look, because you ask so nicely :)
0
 
LVL 14

Assisted Solution

by:DragonSlayer
DragonSlayer earned 20 total points
ID: 33495509
Hi Systan, have you looked at a similar question I have recently answered? http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Components/Q_26367130.html
0
 
LVL 13

Expert Comment

by:aflarin
ID: 33496630
here is my 5 cents:

there is no easy way (like window message) to get process start notification

but as far as I know there are the following ways to do what you want:

1a. SetWindowHooks (CBT , WinProc or WinProcRet) to intercept the window creation notification, then you can get the window process and check if it's a new process
If you want to forbid launching some application, you can try to terminate it after get notification, but it may fail if the app was launched with non default rights or if you app was launched with limited rights

Pros: it's rather simple way
Cons: it won't work with no-window applications and with console applications (I'm not sure about console application, but as far as I remember you don't receive the window creation notification for console windows). Also ProcessTerminate may fail

1b. SetWinEventHook

Pros: the same as 1a, but you can intercept the window creation notification in the exe file and get rif of the dll
Cons: the same as 1a

2. the kernel mode driver and PsSetCreateProcessNotifyRoutine

Pros: it works with no-window apps and console apps
Cons: it's more complex way (you have to develop windows driver); your app mush have the rights to install driver; you still have to use ProcessTerminate

you can use the ready driver from http://www.codeproject.com/kb/threads/procmon.aspx (it uses the system event object to notify about process creation) and translate to delphi the code of installing/deinstalling driver and monitoring processes

3. the kernel mode driver and interception of ZwOpenFile and NtCreateFile
the sample: http://www.codeproject.com/KB/system/soviet_protector.aspx
Or you can use madCodeHook (http://madshi.net/) to inject kernel32.dll and intercept the above functions

Pros: full control over process creation
Cons: it's more complex way (you have to develop windows driver); your app mush have the rights to install driver; viruses often uses this way, so your app may be detected as virus

0
 
LVL 14

Author Comment

by:systan
ID: 33497107
Aflarin;
I have already done the things that you've mention, here is the complete code, the application runs well if it is filtered only in notepad but for the others and for all apps when it is not filtered!?  the called application failure.

Yes it is said difficult, but some experts here consider it an apportunity.
There's no harm in trying this code, while an expert knows howto.
http://filedb.experts-exchange.com/incoming/2010/08_w34/338614/projectx.zip


Thanks
0
 
LVL 14

Author Comment

by:systan
ID: 33497195
Another way of doing this is to use "TShellExecuteInfo" but a dll registration is really needed plus a regedit to work on windows 7.    So I decided to use "wb_cbt hook" for there is no dll registration and regedit modification,  even in windows vista/7/xp it works,  but as far as I test, it's only good when filtering the notepad.
0
 
LVL 13

Expert Comment

by:aflarin
ID: 33499564
I've made some changes in your project. Try it
Aflarin.zip
0
 
LVL 13

Expert Comment

by:aflarin
ID: 33499772
BTW, I forgot the fourth way

4. WMI and subscribing to __InstanceCreationEvent

Pros: it works with no-window apps and console apps
Cons: WMI service must be running; you still have to use ProcessTerminate
0
 
LVL 14

Author Comment

by:systan
ID: 33500114
>>Pros: it works with no-window apps and console apps
>>Cons: WMI service must be running; you still have to use ProcessTerminate

Aflarin;
What's Pros?
What's Cons?
What W.M.I?
0
 
LVL 13

Expert Comment

by:aflarin
ID: 33500597
>> What's Pros? What's Cons?

pros and cons. "+" and "-". advantages and disadvantages

>> What W.M.I?

http://msdn.microsoft.com/en-us/library/aa394582(VS.85).aspx
Windows Management Instrumentation (WMI) is the infrastructure for management data and operations on Windows-based operating systems.

Did you check my project http:#33499564 ?
0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 33500755
looks like aflarin pointed out the biggest problem

you don't store the old wndproc variable
and because of that you don't call the old wndproc

nice touch to add the own pid to the testing
0
 
LVL 14

Author Comment

by:systan
ID: 33501045
Yes, Geert,
I think Aflarin solve the problem, he's got the eye of the tiger that can see broken codes.
But, I'm not sure of this
>>Pros: it works with no-window apps and console apps
I think it's Cons, not Pros.

>>Did you check my project http:#33499564  ?
Yes, I did Aflarin

It's not working on no-window and console apps.
0
 
LVL 13

Accepted Solution

by:
aflarin earned 440 total points
ID: 33501159
>> I think it's Cons, not Pros.

why?

>> It's not working on no-window and console apps.

Sure, it is 1a way and as I mentioned it in http:#33496630 it don't work with such windows, because it is based on interception the window creation notification. So it can't work with no-window apps. It also can't work with the console apps, because SetWindowsHook and SetWinEventHook don't intercept messages of console windows.
0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 33501389
one thought with all of this

you extracted code from madshi's projects
fine ... but you don't get any benefits from that ... unless the original units are very buggy

if madshi does some code changes, he'll make sure to be backward compatible
madshi spent a lot of time figuring out the in's and out's of windows hooking
off course for any future releases like windows 15 he'll be modifying his code too
you would only need to "plug in" the new unit, but with this ...

did you extract the pipes from russel libby's ?

i would recommend using the complete units, not extracts
otherwise a lot of wasted time is going into looking what "broke" the units

the other side is figuring out how to use the units
but that's a one time only effort
0
 
LVL 14

Author Closing Comment

by:systan
ID: 33501469
OK;
Aflarin well done,  yet I am not satisfied with the processes, but it's good than using TShellExecuteInfo and another advantage is not using the pipes.

Although you have contributed very much, but I have to consider the comments of other experts as an acknowledgement that they also race for the solution.


Thank you very much
0
 
LVL 14

Author Comment

by:systan
ID: 33501540
>>you extracted code from madshi's projects
Yep, probably he does, fine.

>>did you extract the pipes from russel libby's ?
Probably he extracted too


Anyway, I got to find out how to deal with no-window/console apps(PsSetCreateProcessNotifyRoutine), and post is closed,  answered very wisely.


Thanks Aflarin, Geert, DragonSlayer, Nevton.
0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 33501584
here is what i had,
i got it working a little

be aware that creating a program creates several windows ...

i haven't figured out why you needed an alternative wndproc
but you didn't need it (aflarin also deleted it)
library MatHook;

uses
  Fpipes,
  SysUtils,
  Windows,
  Messages;

type
  THookRec = record
    hMatHook: HHOOK;
    hMatWnd: HWND;
    hMatPID: Cardinal;
    oldProc: Cardinal;
  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;
var
  hTemp: hWnd;
  szClass: array[0..255] of Char;
  cpid: Cardinal;
  c: TPipeClient;
  Test: string;
begin
  try
    if (nCode >= HC_ACTION) then
    begin
      case nCode of
        HCBT_CREATEWND:
        begin
          cpid := GetCurrentProcessId;
          if buf^.hMatPID <> cpid then
          begin
            hTemp := HWND(wp);
            FillChar(szClass, SizeOf(szClass), 0);
            GetClassName(hTemp, szClass, SizeOf(szClass));
            c := TPipeClient.Create('', 'TwinSoft');
            try
              Test := c.SendString(GetCommandLine);
            finally
              FreeAndNil(c);
            end;
            if Test = '0' then
            begin
              Result := 1;
              ExitProcess(1);
            end;
          end;
        end;
      end;
    end;
    Result := CallNextHookEx(buf^.hMatHook, nCode, wp, lp);
  except
    Result := 0;
  end;
end;

// sets up hook
function SetHook(AWnd: THandle): 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^.hMatWnd := AWnd;
      buf^.hMatHook := SetWindowsHookEx(WH_CBT, @MatHookProc, hInstance, 0);
      GetWindowThreadProcessId(AWnd, buf^.hMatPID);
      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

0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 33501589
unit 1

it's easier using a memo when creating a app, instead of the caption
you can see the flow of things better ...
function SetHook(AWnd: THandle): Boolean; stdcall; external 'MatHook.dll';
function RemoveHook(): Boolean; stdcall; external 'MatHook.dll';

implementation

{$R *.dfm}

procedure TForm1.AddMsg(aMsg: string);
begin
  Memo1.Lines.Add(aMsg);
end;

procedure TForm1.OnPipeData(Sender: TObject; aData: String; var aRespond: String);
begin
  AddMsg(Format('Data received : "%s"', [aData]));
  if aData <> '' then
  begin
    case MessageDlg('Do you want to continue launching ' + aData + '?', mtConfirmation, [mbYes,mbNO], 0) of
      mrYes: aRespond := '1';
    else
      aRespond := '0';
    end;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if RemoveHook then
  begin
    AddMsg('Hook stopped');
    FreeAndNil(FServer);
  end else
    AddMsg('Couldn''t stop Hook');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if not SetHook(Handle) then
    AddMsg('Couldn''t start Hook')
  else
  begin
    AddMsg('Hook started');
    FServer := TPipeServer.CreatePipeServer('', 'TwinSoft', True);
    FServer.OnData := OnPipeData;
  end;
end;


//Im not sure of this if it is going to fix this
//initialization
//HookMsg := RegisterWindowMessage('myhookdll_hookmsg');


end.

Open in new window

0
 
LVL 14

Author Comment

by:systan
ID: 33501740
Geert;
Probably you didn't noticed, I've closed tha post,  then you've submitted your code, but its good, I'll take advantage of what you have.

Or is this intensional, even if the post is closed and you wanted to contribute of what you have?
What a nice expert, this is what I called a surprising expert, a real efforted code contributor.

Aflarin? Oh, hes a machine eating experts points.  Anyway he's fast too.


Thanks to all of you commented this post.
0

Featured Post

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.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
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…
The viewer will learn how to use NetBeans IDE 8.0 for Windows to connect to a MySQL database. Open Services Panel: Create a new connection using New Connection Wizard: Create a test database called eetutorial: Create a new test tabel called ee…
The viewer will learn how to synchronize PHP projects with a remote server in NetBeans IDE 8.0 for Windows.

828 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