Solved

Application Process Path

Posted on 2010-08-18
35
786 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
Comment Utility
.
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
Comment Utility
.
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
Comment Utility
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
 
LVL 14

Author Comment

by:systan
Comment Utility
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
Comment Utility
0
 
LVL 3

Expert Comment

by:NevTon
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
Nevton?
>>More, I see whats wrong with Your implementation.

So, what's going on, how is it?
0
Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

 
LVL 36

Assisted Solution

by:Geert Gruwez
Geert Gruwez earned 20 total points
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
I've made some changes in your project. Try it
Aflarin.zip
0
 
LVL 13

Expert Comment

by:aflarin
Comment Utility
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
Comment Utility
>>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
Comment Utility
>> 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 36

Expert Comment

by:Geert Gruwez
Comment Utility
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
Comment Utility
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
Comment Utility
>> 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 36

Expert Comment

by:Geert Gruwez
Comment Utility
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
Comment Utility
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
Comment Utility
>>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 36

Expert Comment

by:Geert Gruwez
Comment Utility
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 36

Expert Comment

by:Geert Gruwez
Comment Utility
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
Comment Utility
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

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
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 use NetBeans IDE 8.0 for Windows to perform CRUD operations on a MySql database.

728 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

13 Experts available now in Live!

Get 1:1 Help Now