For Mahdi78 and Twinsoft: Changing messages from delphi DLL to delphi Form, Vice Versa

http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_10338608.html?sfQueryTermInfo=1+dig+download+extract+folder+found+help+i%27v+madshi+my+perhap+you

That solution is good, but I need to send a message to delphi Form from delphi DLL, and delphi Form reply's a message

eq1:
the (comServer) DLL sends messages to delphi Form (thepathandfilenametobeexecuted), and then delphi Form answers YES, so the DLL accepts what delphi Form instructed.

eq2:
function TShellExecuteHook.Execute(var ShellExecuteInfo: TShellExecuteInfo):HResult;
var Filename: String;
begin

Filename:=  ShellExecuteInfo.lpname;

//
//send a message to Delphi Form the >Filename (sample: c:\windows\notepad.exe)
//

//and then
//Receives the messages from delphi Form > 0 or 1
//Result := From Delphi Form
//

end;


Anyone can answer the question too.

Note: I'm not making any malicious form of program, if I am doing it, I should use the findfirst findnext and not during execution time.


The point of this question: is to get the path and filename before the application is launch for some good reasons.


So, 2 codes will be shown here, the Delphi DLL code for sending the filename, and a Delphi Form accepting the messages from the DLL, and then reply's (0 or 1)


Thank you
LVL 14
systanAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Geert GOracle dbaCommented:
at some point you will call one or other procedure in the dll from the main application
why not use a procedure variable to pass the procedure the dll has to call ?

in the dll:
type
  TReturnProc = procedure (FileName: string; var ReturnMessage: string) of object;

procedure StartingPoint(Directory: string; ReturnProc: TReturnProc); stdcall;

procedure StartingPoint(Directory: string; ReturnProc: TReturnProc);
var filename: string;
  Msg: string;
begin
  filename := Directory + '\Test.txt';
  Msg := 'Does the file exist ?';
  if Assigned(ReturnProc) then
  begin
    ReturnProc(FileName, Msg);  
    ShowMessage('Msg has changed : ' + Msg);
  end;
end;

in a form of the main application:

procedure TFormX.Button1Click(Sender: TObject);
begin
  StartingPoint('c:\', DoesFileExists);
end;

procedure TFormX.DoesFileExists(FileName: string; var ReturnMessage: string);
begin
  if FileExists(FileName) then
    ReturnMessage := 'Yes it exists !'
  else
    ReturnMessage := 'I can't find anything, so it does not exist !';
end;
0
systanAuthor Commented:
//StartingPoint('c:\', DoesFileExists); ?

We don't have to specify the [drive or filename or foldername] because the shellexecuteinfo will be the one who manage and produce the path and filename.

eq3:
function TShellExecuteHook.Execute(
  var ShellExecuteInfo: TShellExecuteInfo): HResult;
var filename:string;
begin
  filename:=shellexecuteInfo.lpFile;
  //Send the message(filename)  to Delphi Form

 //Get Delphi Form Answer
 result:=fromDelphiFormAnswer; // maybe 1 or 0 (yes or no)
end;

eqimage.JPG
0
twinsoftCommented:
Hi, i have created a solution for you. It has a form with 3 buttons.

btnStart and btnStop. Use this code in Delphi Form to start and stop the pipe server in order to wait for messages from the dll.

btnSend sends a message, using pipes, to pipe server in Delphi Form. Use this code in dll to send a message containing the file path.

Use the OnPipeData event to make all the checking according to aData (the message received) and set the aResponce accordinglly...
*************************** Main Unit ****************************

unit FMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FPipes, DateUtils;

type
  TForm1 = class(TForm)
    btnStart: TButton;
    btnStop: TButton;
    Memo: TMemo;
    btnSend: TButton;
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
  private
    FServer: TPipeServer;
    procedure OnPipeData(Sender: TObject; aData: String; var aRespond: String);
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btnStartClick(Sender: TObject);
begin
 FServer := TPipeServer.CreatePipeServer('', 'TwinSoft', True);
 FServer.OnData := OnPipeData;
end;

procedure TForm1.btnStopClick(Sender: TObject);
begin
 FServer.Free;
end;

procedure TForm1.btnSendClick(Sender: TObject);
begin
 with TPipeClient.Create('', 'TwinSoft') do
  try
   Memo.Lines.Add(SendString('C:\Demo.txt'));
  finally
   Free;
  end;
end;

procedure TForm1.OnPipeData(Sender: TObject; aData: String; var aRespond: String);
begin
 if True then  // make your check here
  aRespond := '1'
 else
  aRespond := '0';
end;

end.

*************************** FPipes Unit ****************************

unit FPipes;

interface

uses
  Classes, Windows;

const
  cShutDownMsg = 'shutdown pipe ';
  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
    begin
     Sleep(250);
    end
   else
    begin
     if ConnectNamedPipe(FHandle, nil) then
      try
       InMsg.Size := SizeOf(InMsg);
       ReadFile(FHandle, InMsg, InMsg.Size, InMsg.Size, nil);
       if 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);
        FillChar(OutMsg.Data, SizeOf(OutMsg.Count), 0);
        for i := 0 to Pred(OutMsg.Count) do
         OutMsg.Data[i] := r[i + 1];
        CalcMsgSize(OutMsg);
        WriteFile(FHandle, OutMsg, OutMsg.Size, w, nil);
        end;
      finally
       DisconnectNamedPipe(FHandle);
      end;
    end;
  end;
end;

procedure TPipeServer.ShutDownServer;
begin
 if FHandle <> INVALID_HANDLE_VALUE then
  begin
   Terminate;
   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.

*************************** Main Dfm ****************************

object Form1: TForm1
  Left = 192
  Top = 114
  Width = 250
  Height = 480
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object btnStart: TButton
    Left = 36
    Top = 36
    Width = 75
    Height = 25
    Caption = 'Start'
    TabOrder = 0
    OnClick = btnStartClick
  end
  object btnStop: TButton
    Left = 36
    Top = 68
    Width = 75
    Height = 25
    Caption = 'Stop'
    TabOrder = 1
    OnClick = btnStopClick
  end
  object Memo: TMemo
    Left = 16
    Top = 112
    Width = 185
    Height = 277
    TabOrder = 2
  end
  object btnSend: TButton
    Left = 124
    Top = 36
    Width = 75
    Height = 25
    Caption = 'Send'
    TabOrder = 3
    OnClick = btnSendClick
  end
end

Open in new window

0
Cloud Class® Course: CompTIA Cloud+

The CompTIA Cloud+ Basic training course will teach you about cloud concepts and models, data storage, networking, and network infrastructure.

twinsoftCommented:
Some corrections to FPipes.pas...
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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
systanAuthor Commented:
All I know that you are all experts, and has different ideas.
All your code's are unbelievable, I don't know what kind of brain's you have.

This program is NOT particular in the application like (notepad, calculator or msword)
Upon looking on different codes you have, I know its not the exact solution.
All that I am asking is when the application(pending) is to be launch, Delphi Form will confirm if it will continue openning or not.

Since I am not a good coder,     let me have a ZIP file with 2 delphi(DPR), a Delphi Form and a Delphi DLL,   let me test the code directly.      If is possible without a DLL, only a Delphi Form can control the application, then its's much better.

@ Mahdi, the accepted link is very good, because it does not use ishellexecehook(much better, much safe for different OS)  but it points a particular application like notepad.

@ twinsoft, I don't understand why using pipe's is implemented, I'm not sure if it will work or if it does point.

@ Geert_Gruwez, you should see the image attached to view what I am trying to implement.


The second image explanation:

eqimage2.JPG
0
systanAuthor Commented:
During my test
@ mahdi, nice link you have, it does not use ishellexecutehook, but when I removed the specific filename "notepad" it bugs my computer system(XP) during application launch, can you edit the code and send me the right implementation, and also, it lacks information to delphi form about the path and filename, it only popups a dll dialog message about the path and filename.   The point here is when the application before launch delphi form will know the path and filename.   And when delphi form know the info, delphi form will be the one who manage if the application will be launched or not.

@ twinsoft, I really didn't test the code, because I know it sounds different of what I am asking for like in the image above I shown.


Let me have the attached ZIP file, so you will know upon your testing the code is also running in your computer and in my computer also.
0
twinsoftCommented:
Hi, the code that i sent to you shows how to implement the communication mechanism between the dll and the Delphi app. It does not cover the shellexecute hook as it was covered in a previous post. I will check your code and see what can be done...
             
0
twinsoftCommented:
Hmm, you actually don't need pipes as you are using a dll and an app not two different apps. Never mind it is a nice piece of code, keep it for future use. Will check the zip...
0
Geert GOracle dbaCommented:
you have a wrong idea
you can not do anything before a program is launched.

i am assuming you want to hook before anything happens inside your application
the dll runs in the memory space of the application so it has to be started first
your flowchart should actually look like this
flowchart.png
0
Geert GOracle dbaCommented:
you would have something like this in code in your .dpr


program Project1;

uses
  Forms,
  Windows,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

function StartHookDll: boolean;
var Handle: THandle;
begin
  Result := False;
  Handle := LoadLibrary('libraryname');
  if Handle <> 0 then
  begin
    // etc
    Result := True;
  end;
end;

begin
  if StartHookDll then
  begin
    Application.Initialize;
    Application.MainFormOnTaskbar := True;
    Application.CreateForm(TForm1, Form1);
    Application.Run;
  end;
end.

Open in new window

0
systanAuthor Commented:
I'm sorry Geert_Gruwez, you have it wrong, I know my flowchart looks like not a flowchart, but the steps shown is what I want to implement, twinsoft and mahdi got it right and understood what I am asking for, if you got it wrong, please look at carefully the flow from 1 to 5.

Another meaning of the question:  Let Delphi Form decide the launching of all the applications(.exe) in windows.   Sample: When opening calculator or notepad, Delphi Form will decide with yes or no, if yes the application will continue to open, if no the application will not be launched.

In this example code:  The .Delphi DLL decides.

function TShellExecuteHook.Execute(var ShellExecuteInfo: TShellExecuteInfo): HResult;
var filename:string;
      msgbxResult:integer;
begin
  filename:=shellexecuteInfo.lpFile;
  msgbxResult:=MessageBox(0,
                  PChar('Execute this file '+filename+'?'),
                  'Confirm',
                  MB_OKCANCEL or MB_TASKMODAL);
  if msgbxResult=IDOK then
    result:=1
  else
    result:=0;
end;


But I want is the Delphi Form to decide.
So, Delphi .DLL will send message to Delphi Form(the_filename) and decides if the application will be launched or not.
And if possible without using the ishellexecutehook, other method is much better.
0
Geert GOracle dbaCommented:
aha, got it, just like the antivirus allowing internet access ... or not
0
systanAuthor Commented:
Yep,  you got it right,   but its not an antivirus allowing internet access or not,   it's just like that if you say it,    only that the applications(.exe) ask permission from Delphi Form if it will continue to launch or not.    With the path and filename info,   I can use it whatever I want to access the file it good reasons as I said on my question body posted.

Now that you knew it, I hope you have some idea's to share with it, specially "mahdi's" link code was great without using the ishellexecutehook, but it errors in my xp computer, and I hope it is applicable also with windows 7, if it will be good too.
0
twinsoftCommented:
Hi, i think that my code will actually give you a solution since the dll is not called directly from the app but by windows, so it is considered a different application.

Try the following in the dll:

uses FPipes;

function TShellExecuteHook.Execute(var ShellExecuteInfo: TShellExecuteInfo): HResult;
var filename:string;
     aResult:String;
begin
 filename:=shellexecuteInfo.lpFile;
 
 with TPipeClient.Create('', 'TwinSoft') do
  try
   aResult := SendString(filename);
  finally
   Free;
  end;

 if aResullt = '1' then
   result:=1
 else
   result:=0;
end;


then in you Delphi app add the following code:

uses FPipes;

...
private
 FServer: TPipeServer;
public
...

procedure TForm1.btnStartClick(Sender: TObject);
begin
 FServer := TPipeServer.CreatePipeServer('', 'TwinSoft', True);
 FServer.OnData := OnPipeData;
end;

procedure TForm1.btnStopClick(Sender: TObject);
begin
 FServer.Free;
end;

procedure TForm1.OnPipeData(Sender: TObject; aData: String; var aRespond: String);
begin
 if aData = 'Program.exe' then  // make your check here
  aRespond := '1'
 else
  aRespond := '0';
end;

btnStartClick and btnStopClick are used so you can activate the server manually. You can put the code in the OnCreate and OnDestroy events of the form to run automatically
0
Mahdi78Commented:
I think you will find all what you want for your project with @madshi
http://www.experts-exchange.com/M_4548.html
and his website http://www.madshi.net/
0
systanAuthor Commented:
@Mahdi
Madshi's code's are huge, and I don't wanna use jedi also.
If you have shorten the code and make it simple and cute by madshi or jedi, please provide a zip file of a short working code.

@Tiwnsoft
Yes, as I read the code, probably and possible it will run, but please test the code first, and send the zip file also.

@geert
Now that you got what we are trying to implement here, any comments?
0
systanAuthor Commented:
Here's my code system structure

@DLL
Type
function detect_from_Form:boolean; message a_mess_from_delphiform;
end;

function TShellExecuteHook.Execute(var ShellExecuteInfo: TShellExecuteInfo): HResult;
var filename:string;
     msgbxResult:integer;
begin
 filename:=shellexecuteInfo.lpFile;
{
 msgbxResult:=MessageBox(0,
                 PChar('Execute this file '+filename+'?'),
                 'Confirm',
                 MB_OKCANCEL or MB_TASKMODAL);
 if msgbxResult=IDOK then
   result:=1
 else
   result:=0;
}
 sendmessage ( filename_to_delphiform )
 result := detect_from_Form;
end;


@FORM
Type
proecudure detect_from_DL(var tmess: msg); message a_mess_from_DLL;
End;

proecudure detect_from_DL(var tmess: msg);
var thefilename:string;
begin
// receives the message from dll
// thefilename := msg.something_here ; ?
// sendmessage to delphi DLL
//  sendmessage ( 1_or_0_to_delphiDLL ); ?
end;


But, I don't know how it will work, and I don't know how to use delphi resources for building this.
0
systanAuthor Commented:
Ok, can someone edit this code to allow all aplications pending, not only "notepad",  NOT specific to "notepad only"


Well try to use this code for a moment for testing if it works sending and receiving message to delphi form and delphi 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);

          //CHANGES HERE
          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

// USELESS CODED AREA
{
          hTemp := HWND(wp);
          FillChar(szClass, 256, 0);
          GetClassName(hTemp, szClass, 256);
}

          // CHANGES HERE ALSO
          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.
0
systanAuthor Commented:
Ok, I'll try Twinsoft solution, mix with mahdi code

// 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);


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


      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;



//twinsoft code's here
 if aResullt = '1' then
  Result := CallWindowProc(Pointer(buf^.oldProc), Handle, Msg, wp, lp);
 else
   result:=0;
end;

   



  except
    Result := 0;
  end;
end;


But can someone edit the code not particular for "notepad", what if I open calculator, or msword, do I have to specify the classname for them?
0
systanAuthor Commented:
@Mahdi
The link that you point was good.

@Twinsoft
The code was great,  I test it with your Pipes

Here's the running code, but some problems  that I comment it at the end of the code.
//DLL
library mathook;

uses
Fpipes,
  Windows,
  Messages;

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

var
  map: DWord;
  buf: ^THookRec;
  aResult:string;

// new window proc - runs in context of target process
function MatWndProc(Handle: hWnd; Msg: uInt; wp: wParam; lp: lParam): LongInt; stdcall;
begin

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

  try
    case Msg of
      WM_CREATE:
      begin

 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);
end
else
begin
MessageBox(0, GetCommandLine, 'THIS WILL NOT CONTINUE TO OPEN', MB_OK);
result:=0;
/////////////////////This does not exit, it is keeps launching
end;

      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;

  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                       /////////This should not be specific
          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                       /////////This should not be specific
          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.


//APPLICATION
unit Unit1;
interface
uses Fpipes,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
     FServer: TPipeServer;
     procedure OnPipeData(Sender: TObject; aData: String; var aRespond: String);

  public
    { Public declarations }
   
  end;

var
  Form1: TForm1;

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;
showmessage(aData);
//respond 0 //test only
aRespond := '0';
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;

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

end.


Some other problem's:
1. It is specific to notepad or specific to one classname only?
Can you edit it, not be specific to a file

2. Why the notepad is being load in a Task Manager, only the notepad window can't be seen, but it is loaded
Is there a solution for this not to load it UNTIL a respons is Ok

3.connected question
OR  is  it  OK  even the file is being load in task manager?  or  it wasn't realy launch yet?
Can you explain something on this matter


Thank you
0
Mahdi78Commented:
Update for my first link DLL, the following code with detect "test.exe" application

library MatHook;

uses
  Windows,
  Messages, sysutils;

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  (ExtractFileName(GetCommandLine) <> 'test.exe') 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 (ExtractFileName(GetCommandLine) <> 'test.exe') 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.
0
Mahdi78Commented:
sorry it was wrong, the following will detect all application except explorer.exe

library MatHook;

uses
  Windows,
  Messages, sysutils;

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  ExtractFileName(GetCommandLine) <> 'explorer.exe' then
          begin             beep;
            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 ExtractFileName(GetCommandLine) <> 'explorer.exe' 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.
0
systanAuthor Commented:
Mahdi, there is an error when I launch all the applications,  correct me if I am wrong, you update/add only "(ExtractFileName(GetCommandLine) " sysutils.

I don't know upon your testing but as I noticed the code it is only specific to 1 classname only.

Even Twinsoft and Geert has no comment yet, But I'll wait with the correct code, I hope you can do it.
Here, we are talking with this accepted link:
http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_20798061.html
0
systanAuthor Commented:
Hello Twinsoft, you pipes code work great, but are you still there?
0
twinsoftCommented:
Yes i am, how can i help you ?
0
Mahdi78Commented:
@systan

Your question is good and you had very nice interact in topic, i suggest you to send an email to @madshi to help us, his mail is madshi@gmail.com
0
systanAuthor Commented:
Mahdi,
We are not dependent on madshi,  because he is not the only one who can solve this problem, and specially he's not around in e-e anymore,  we have experts here on ee who is capable to help impossible solution.   If not from you and Twinsoft,  the solution is impossible.
I just think positive.

Twinsoft,  
I hope you have read  ID:2947191, and I hope you can make good changes to the code.

Geert, any comment?
0
Geert GOracle dbaCommented:
i would contact madshi about this on his forum

i haven't got that much experience with hooks
and at the moment not much time to help
0
twinsoftCommented:
Hi, i too don't have much experience in hooks, but i would suggest a different approach:

1) Parse all running application using EnumWindows. Do this in a timer every 100 ms.
2) Compare the list of running apps with your list of 'forbitten' apps
3) Send a message to close an application that we don't want to be executed

This approach does not use a hook but instead a polling method that constantly checks the runing apps to determine if an app needs to be closed. If you think that is approach suites your needs, i can send you some code to show you how to use enumwindows and how to close an application from your program...
0
systanAuthor Commented:
Please look at some changes I've made,   its working now,   BUT its not perfect, it only applies to a few applications like notepad, calculator and other's,  but the bad news is,   it doesn't affect to all applications like explorer.exe(it will clear the desktop icons, when I open [my computer or my documents]), visual studio applications(it will delay a seconds to open), and some other applications will error and will not show.  I don't know where to find the perfect solution.


library mathook;

uses
Fpipes,
  Windows,
  Messages;

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

var
  map: DWord;
  buf: ^THookRec;
  aResult:string;
  dwAllocSize:DWORD;
  HookMsg: cardinal;
 
var
  hTemp: hWnd;
  szClass: array[0..255] of Char;


// 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

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


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

      end;

      // user definied message to stop subclassing
      // ([[[[[REGISTERWINDOWSMESSAGE]]]]] would be a better choice instead of WM_USER message!)
     // I HOPE SOME CHANGES TO [[[[[REGISTERWINDOWSMESSAGE]]]]
      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;

begin


  try
    if (nCode >= HC_ACTION) then
    begin
      Case nCode of
        HCBT_CREATEWND:
        begin
          hTemp := HWND(wp);
          {//useless code
          FillChar(szClass, 256, 0);
          GetClassName(hTemp, szClass, 256);
          if (szClass = 'Notepad') then
          }

if EnumThreadWindows(GetCurrentThreadId, @hTemp, 0) then
begin
GetWindowText(hTemp, szClass, SizeOf(szClass));
GetClassName(hTemp, szClass, SizeOf(szClass));
end;

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

        end;
        HCBT_DESTROYWND:
        begin
          {//useless code
          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), 'MyHook');
      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, 'MyHook');
        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.


Ok, I'll wait, thank you very much
0
systanAuthor Commented:
I updated the function with this:

The error is minimal, but still there is an error.


// 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



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));
end;


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

        end;


        HCBT_DESTROYWND:
        begin
           {//useless code
          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;
0
systanAuthor Commented:
I think error's is around here:



// 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
Result := CallWindowProc(Pointer(buf^.oldProc), Handle, Msg, wp, lp);
MessageBox(0, GetCommandLine, 'THIS WILL CONTINUE LAUNCHING', MB_OK);
end
else
begin
result := 1;
MessageBox(0, GetCommandLine, 'THIS WILL NOT CONTINUE TO OPEN', MB_OK);
end;


      end;

      // user definied message to stop subclassing
      // (RegisterWindowMessage 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);

  except
    Result := 0;
  end;


DefWindowProc(Handle,Msg,wP,lP);

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



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));
end;


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

        end;


        HCBT_DESTROYWND:
        begin
           {//useless code
          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;
0
systanAuthor Commented:
I will accept multiple solution
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.