Forka procesi

Če rajši delate z linuxom.
Odgovori
Fortuna
Prispevkov: 1097
Pridružen: 26.06.2004 09:59:52

Forka procesi

Odgovor Napisal/-a Fortuna » 02.06.2006 09:16:32

Koda: Izberi vse

program TestFork;
 
 {$APPTYPE CONSOLE}
 
 uses
  SysUtils,
  Libc;

var
   ForkedProcessHandle: __pid_t;
   bForked: Boolean;
 
 procedure ForkNow;
 begin
   bForked := true;
   ForkedProcessHandle := fork;
 end;
 
 function IsForked: Boolean;
 begin
   Result := (ForkedProcessHandle = 0) and bForked;
 end;
 
 var
   Lf: Integer;
 
 begin
   sigignore(SIGCHLD);
   bForked := false;
 
   WriteLn('do some stuff');
 
   WriteLn('before fork');
   ForkNow;
   WriteLn('after fork - we have dublicated the process');
 
   if IsForked then begin
     WriteLn('do some stuff in forked process (wait 5s)');
     for Lf := 0 to 50 do begin
       Write('f');
       sleep(100);
     end;
   end else begin
     WriteLn('do stuff in original process (wait 10)');
     for Lf := 0 to 100 do begin
       Write('o');
       sleep(100);
     end;
   end;
 
   WriteLn;
 
   if IsForked then
     WriteLn('forked process end')
   else
     WriteLn('original process end');
 end.
  


Ko zaženem to kodo
mi na konzoli lepo dela

Koda: Izberi vse

 
o some stuff
before fork
after fork - we have dublicated the process
do some stuff in forked process (wait 5s)
fafter fork - we have dublicated the process
do stuff in original process (wait 10)
oofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofo
forked process end
ooooooooooooooooooooooooooooooooooooooooooooooooo
original process end

 

Ko pa to codo skušam predelat na gumb.


Koda: Izberi vse

 
unit Unit1;

interface

uses
  SysUtils, Types, Classes, Variants, QTypes, QGraphics, QControls, QForms, 
  QDialogs, QStdCtrls,Libc;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }


  end;

var
  Form1: TForm1;
         ForkedProcessHandle: __pid_t;
   bForked: Boolean;

implementation

{$R *.xfm}


 procedure ForkNow;
 begin
   bForked := true;
   ForkedProcessHandle := fork;
 end;
 
 function IsForked: Boolean;
 begin
   Result := (ForkedProcessHandle = 0) and bForked;
 end;
procedure TForm1.Button1Click(Sender: TObject);
 var
   Lf: Integer;
 
 begin
   sigignore(SIGCHLD);
   bForked := false;
 
   WriteLn('do some stuff');
 
   WriteLn('before fork');
   ForkNow;
   WriteLn('after fork - we have dublicated the process');
 
   if IsForked then begin
     WriteLn('do some stuff in forked process (wait 5s)');
     for Lf := 0 to 50 do begin
       Write('f');
       sleep(100);
     end;
   end else begin
     WriteLn('do stuff in original process (wait 10)');
     for Lf := 0 to 100 do begin
       Write('o');
       sleep(100);
     end;
   end;
 
   WriteLn;
 
   if IsForked then
     WriteLn('forked process end')
   else
     WriteLn('original process end');


end;

end.

 


Dobim pa takšno konzolo.

Koda: Izberi vse

 

do some stuff
before fork
after fork - we have dublicated the process
do some stuff in forked process (wait 5s)
fafter fork - we have dublicated the process
do stuff in original process (wait 10)
oofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofofo
forked process end
ooooooooooooooooooooooooooooooooooooooooooooooooo
original process end
X Error: BadPixmap (invalid Pixmap parameter) 4
  Major opcode:  54
Xlib: unexpected async reply (sequence 0x1a32)!

 
In potem čez nekaj časa zablokira program.

Kje ga lomim?

Kakšna ideja?
Lp.

Odgovori