Recent

Author Topic: TProcess without freezing the main form - How ?!?  (Read 11157 times)

Amnon82

  • New Member
  • *
  • Posts: 37
TProcess without freezing the main form - How ?!?
« on: March 12, 2007, 10:32:18 am »
In Delphi I use this function to wait for ending a process without freezing the main form:

Code: [Select]
procedure RunAndWaitShell(Executable, Parameter: STRING; ShowParameter: INTEGER);
var
  Info: TShellExecuteInfo;
  pInfo: PShellExecuteInfo;
  exitCode: DWord;
begin
  {Pointer to Info}
  pInfo := @Info;
  {Fill info}
  with Info do
  begin
    cbSize := SizeOf(Info);
    fMask  := SEE_MASK_NOCLOSEPROCESS;
    wnd    := application.Handle;
    lpVerb := NIL;
    lpFile := PChar(Executable);
    {Parametros al ejecutable}
    {Executable parameters}
    lpParameters := PChar(Parameter + #0);
    lpDirectory  := NIL;
    nShow        := ShowParameter;
    hInstApp     := 0;
  end;
  {Execute}
  ShellExecuteEx(pInfo);

  {Wait to finish}
  repeat
    exitCode := WaitForSingleObject(Info.hProcess, 500);
    Application.ProcessMessages;
  until (exitCode <> WAIT_TIMEOUT);
end;


With this command I can't do it in linux:

Code: [Select]
procedure TForm1.Button1Click(Sender: TObject);
var AProcess1: TProcess;
begin
  AProcess1 := TProcess.Create(nil);
  AProcess1.CommandLine := 'gparted';
  AProcess1.Options := AProcess1.Options + [poWaitOnExit];
  AProcess1.Execute;
  AProcess1.Free;
  ShowMessage ('gparted ended');
end;


How can I reach the same goal in linux?

felipemdc

  • Administrator
  • Hero Member
  • *
  • Posts: 3538
RE: TProcess without freezing the main form - How ?!?
« Reply #1 on: March 12, 2007, 03:05:59 pm »
One solution is to do this on a new thread

Amnon82

  • New Member
  • *
  • Posts: 37
RE: TProcess without freezing the main form - How ?!?
« Reply #2 on: March 12, 2007, 03:24:09 pm »
How do I do that? Do you have an example for me?

felipemdc

  • Administrator
  • Hero Member
  • *
  • Posts: 3538
RE: TProcess without freezing the main form - How ?!?
« Reply #3 on: March 12, 2007, 03:34:58 pm »
Thank God for our documentation =) Without it, this would be a hard question to answer.

There is a complete tutorial here: http://wiki.lazarus.freepascal.org/Multithreaded_Application_Tutorial

Amnon82

  • New Member
  • *
  • Posts: 37
RE: TProcess without freezing the main form - How ?!?
« Reply #4 on: March 12, 2007, 03:37:12 pm »
I pray every day ;)

I found this snippet:

Code: [Select]
procedure TForm1.Run;
var
  fs: TFileStream;
  Buffer: string;
  Count: LongInt;
  i: Integer;
  Last: TDateTime;
begin
  if Running then exit;
  Running:=true;
  UpdateButton;
  try
    // open a file
    fs:=TFileStream.Create(Filename,fmOpenRead);
    try
      SetLength(Buffer,10);
      while true do begin

        // process all user events, like clicking on the button
        Application.ProcessMessages;
        if Aborting or Application.Terminated then break;

        // read some bytes
        Count:=fs.Read(Buffer[1],length(Buffer));
        if Count=0 then break;

        // process ...
        for i:=1 to Count do begin
          Last:=Now;
          repeat
          until Now-Last>(double(1)/fs.Size)/10000;
        end;

        // show progress
        ProgressBar1.Position:=ProgressBar1.Min
               +((ProgressBar1.Max-ProgressBar1.Min+1)*fs.Position) div fs.Size;
      end;
    finally
      fs.Free;
    end;
  except
    on E: Exception do begin
      MessageDlg('Error',E.Message,mtError,[mbCancel],0);
    end;
  end;
  Aborting:=false;
  Running:=false;
  UpdateButton;
end;
 

But when I do this it still freezes:

Code: [Select]
procedure TForm1.Button1Click(Sender: TObject);
var AProcess1: TProcess;
begin
  AProcess1 := TProcess.Create(nil);
  AProcess1.CommandLine := 'gparted';
  AProcess1.Options := AProcess1.Options + [poWaitOnExit];
  memo2.lines.add(DateToStr(Date) + '-' +TimeToStr(Time) + ' - gparted started') ;
  AProcess1.Execute;
  while AProcess1.Running do
  begin
    Application.ProcessMessages;
    end;
  AProcess1.Free;
  button3.click;
end;  


Seems I've to try more or read more ...

Amnon82

  • New Member
  • *
  • Posts: 37
RE: TProcess without freezing the main form - How ?!?
« Reply #5 on: March 12, 2007, 04:10:44 pm »
Thats what I want to reach:

Start for example 'gparted' by pressing a button.
The Mainform should not freeze.
After closing 'gparted' a message should appear.

With this code all works but the mainform freezes:

Code: [Select]
procedure TForm1.Button1Click(Sender: TObject);
var AProcess1: TProcess;
begin
  AProcess1 := TProcess.Create(nil);
  AProcess1.CommandLine := 'gparted';
  AProcess1.Options := AProcess1.Options + [poWaitOnExit];
  AProcess1.Execute;
  AProcess1.Free;
  ShowMessage ('gparted ended');
end;


Is there a way to add process messages of the mainform?

Code: [Select]
Application.ProcessMessages;

Also when I run 'fdisk -l' I want to display the results in a memo without freezing the mainform.

Amnon82

  • New Member
  • *
  • Posts: 37
RE: TProcess without freezing the main form - How ?!?
« Reply #6 on: March 12, 2007, 04:57:52 pm »
Well I tried to convert the function to pascal/lazarus:

Code: [Select]
procedure Processandwait(Executable : String);
var
  exitCode: integer;
  AProcess1: TProcess;
begin
  try
  AProcess1 := TProcess.Create(nil);
  AProcess1.CommandLine := Executable;
  AProcess1.Options := AProcess1.Options; //+ [poWaitOnExit];
 
 {Execute}
  AProcess1.Execute;

  {Wait to finish}
  while AProcess1.running do
  begin
  repeat
//   sleep (50);
     exitCode := Aprocess1.ExitStatus;
    Application.ProcessMessages;
  until (exitCode = 0);
  end;

  finally
    AProcess1.Free;
    end;
end;


But there is a mistake in it ... cos I've to much cpu load.

Here the delphicode again:

Code: [Select]
procedure RunAndWaitShell(Executable, Parameter: STRING; ShowParameter: INTEGER);
var
  Info: TShellExecuteInfo;
  pInfo: PShellExecuteInfo;
  exitCode: DWord;
begin
  {Pointer to Info}
  pInfo := @Info;
  {Fill info}
  with Info do
  begin
    cbSize := SizeOf(Info);
    fMask  := SEE_MASK_NOCLOSEPROCESS;
    wnd    := application.Handle;
    lpVerb := NIL;
    lpFile := PChar(Executable);
    {Parametros al ejecutable}
    {Executable parameters}
    lpParameters := PChar(Parameter + #0);
    lpDirectory  := NIL;
    nShow        := ShowParameter;
    hInstApp     := 0;
  end;
  {Execute}
  ShellExecuteEx(pInfo);

  {Wait to finish}
  repeat
    exitCode := WaitForSingleObject(Info.hProcess, 500);
    Application.ProcessMessages;
  until (exitCode <> WAIT_TIMEOUT);
end;

Marc

  • Administrator
  • Hero Member
  • *
  • Posts: 2557
RE: TProcess without freezing the main form - How ?!?
« Reply #7 on: March 12, 2007, 05:36:28 pm »
replace sleep(50) with sleep (250)

250 ms is still ok for user responses and wo'n load your sytem to much
//--
{$I stdsig.inc}
//-I still can't read someones mind
//-Bugs reported here will be forgotten. Use the bug tracker

Amnon82

  • New Member
  • *
  • Posts: 37
RE: TProcess without freezing the main form - How ?!?
« Reply #8 on: March 12, 2007, 05:47:31 pm »
Actual code is this:

Code: [Select]
procedure Processandwait(Executable : String);
var
  AProcess1: TProcess;
  exitcode, i  : integer;
begin
  I:= 0;
  try
  AProcess1 := TProcess.Create(nil);
  AProcess1.CommandLine := Executable;
  AProcess1.Options := AProcess1.Options; //+ [poWaitOnExit];
 
 {Execute}
  AProcess1.Execute;

  {Wait to finish}
  while AProcess1.running do
  begin
  repeat
  // begin
  I:= I + 1;
   sleep (500);
  form1.caption := 'Code: '+ inttostr(Aprocess1.ExitStatus) + ' L:'+ inttostr(i);
   Application.ProcessMessages;
   exitCode := Aprocess1.ExitStatus;
  // if (exitcode = 0) or Application.Terminated then break;
  // end;
  until (exitcode = 0);
  end;
 
  finally
    AProcess1.Free;
    end;

end;


The loop never ends even if gedit is closed. How to stop the loop?

Amnon82

  • New Member
  • *
  • Posts: 37
RE: TProcess without freezing the main form - How ?!?
« Reply #9 on: March 12, 2007, 06:09:09 pm »
This variant won't work either:

Code: [Select]
procedure Processandwait(Executable : String);
var
  AProcess1: TProcess;
  exitcode, i  : integer;
begin
  I:= 0;
  try
  AProcess1 := TProcess.Create(nil);
  AProcess1.CommandLine := Executable;
  AProcess1.Options := AProcess1.Options; //+ [poWaitOnExit];
 
 {Execute}
  AProcess1.Execute;
  form1.caption :=  inttostr(Aprocess1.ExitStatus);
  sleep ( 250);
  {Wait to finish}
  while AProcess1.exitstatus= 0 do
  begin
  repeat
  // begin
  I:= I + 1;
  sleep (500);
  form1.caption :=  ' L:'+ inttostr(i);
   Application.ProcessMessages;
   exitCode := Aprocess1.ExitStatus;
  // if (exitcode = 0) or Application.Terminated then break;
  // end;
  until (aprocess1.running = false);
  end;
 
  finally
    AProcess1.Free;
    end;

end;


still the loop ...

ExitStatus should be zero after closing and one during running.
Running should be true during running and false after ending the process.

How can I fix the loop?

Amnon82

  • New Member
  • *
  • Posts: 37
Working code - Processandwait function
« Reply #10 on: March 12, 2007, 06:21:11 pm »
Here is my working code:

Code: [Select]
//Processandwait example by Amnon82
//Version 20070312-1
//
//Create a form with one button on it.
//Copy this sourcecode to your pas.
//Compile it in lazarus.


unit unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons, Process;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{ TForm1 }

procedure Processandwait(Executable : String);
var
  AProcess1: TProcess;
  exitcode, i  : integer;
begin
  I:= 0;
  try
  AProcess1 := TProcess.Create(nil);
  AProcess1.CommandLine := Executable;
  AProcess1.Options := AProcess1.Options;
 
 {Execute}
  AProcess1.Execute;
  {Wait to finish}
  while AProcess1.running = true do
  begin
  I:= I + 1;
  sleep (300);
  form1.caption :=  ' L:'+ inttostr(i);
   Application.ProcessMessages;
  end;
 
  finally
    AProcess1.Free;
    end;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin

 Processandwait('gedit');
 Showmessage('gedit closed');
end;

initialization
  {$I unit1.lrs}

end.          

Ericktux

  • Sr. Member
  • ****
  • Posts: 306
Re: TProcess without freezing the main form - How ?!?
« Reply #11 on: January 24, 2021, 04:53:18 am »
Hello friend, thanks for sharing, I just made some modifications.

Code: Pascal  [Select][+][-]
  1. procedure Processandwait(programa, Parametros: String; ocultar, esperar:Boolean);
  2. var
  3.   AProcess1: TProcess;
  4. begin
  5.   try
  6.   AProcess1 := TProcess.Create(nil);
  7.   if ocultar then  AProcess1.ShowWindow:=swohide;  // hide the launched application
  8.   AProcess1.Executable:=programa;
  9.   AProcess1.CommandLine := Parametros;
  10.   AProcess1.Execute;
  11.  
  12.      if esperar then  // wait for the launched application to finish
  13.         begin
  14.              while AProcess1.running = true do
  15.              begin
  16.               Application.ProcessMessages;
  17.              end;
  18.         end;
  19.  
  20.   finally
  21.     AProcess1.Free;
  22.     end;
  23. end;

example:

Code: Pascal  [Select][+][-]
  1. procedure TForm1.Button1Click(Sender: TObject);
  2. begin
  3.   // Processandwait('mspaint.exe','',false,true);   // other example
  4.   // Processandwait('C:\Windows\system32\notepad.exe','',false,true);  // other example of use
  5.   // Processandwait('','cmd.exe /c ping www.google.com',false,true);  // other example, all inside of parametros
  6.   Processandwait('C:\Windows\system32\cmd.exe','ping www.google.com',false,true);
  7.   ShowMessage('finish');
  8. end;

for now it works perfectly in windows.  :)  :)
« Last Edit: January 25, 2021, 03:14:51 am by Ericktux »

Edson

  • Hero Member
  • *****
  • Posts: 1253
Re: TProcess without freezing the main form - How ?!?
« Reply #12 on: January 25, 2021, 04:55:24 am »
I recommend to use my library https://github.com/t-edson/UnTerminal

It's a wrapper for TProcess and work using events.
Lazarus 2.0.10 - FPC 3.2.0 - x86_64-win64 on Windows 8

Thaddy

  • Hero Member
  • *****
  • Posts: 12209
Re: TProcess without freezing the main form - How ?!?
« Reply #13 on: January 25, 2021, 08:54:40 am »
You may want to use TAsyncProcess
https://lazarus-ccr.sourceforge.io/docs/lcl/asyncprocess/tasyncprocess.html
It is compatible with TProcess, but won't freeze the main form.
« Last Edit: January 25, 2021, 08:58:20 am by Thaddy »
Manuals, manuals, manuals first.
You have incompetence and sheer incompetence.

marcov

  • Administrator
  • Hero Member
  • *
  • Posts: 10402
  • FPC developer.
Re: TProcess without freezing the main form - How ?!?
« Reply #14 on: September 19, 2022, 01:59:08 pm »
You may want to use TAsyncProcess
https://lazarus-ccr.sourceforge.io/docs/lcl/asyncprocess/tasyncprocess.html
It is compatible with TProcess, but won't freeze the main form.

An attempt has been made to integrate TProcess variants back into trunk (and the 3.2.x branch), hopefully obsoleting special variants like TProcessUTF8 and TAsyncPprocess in time.

TProcess nowadays has an idle event to run the event loop too.
« Last Edit: September 19, 2022, 02:01:22 pm by marcov »

 

TinyPortal © 2005-2018