Recent

Author Topic: TProcess without freezing the main form - How ?!?  (Read 9693 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: 3541
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: 3541
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: 2519
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

  • Full Member
  • ***
  • Posts: 230
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: 1135
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: 10704
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 »

 

TinyPortal © 2005-2018