home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / wunderki.zip / THREAD.PAS < prev    next >
Pascal/Delphi Source File  |  1993-09-30  |  1KB  |  58 lines
  1. Program ThreadTest;  {--- 1993 Matthias Withopf / c't ---}
  2.  
  3. Uses
  4.   Crt;
  5.  
  6.   Function DosCreateThread(Proc : Pointer;Var TID : Word;
  7.                Stack : Pointer) : Word; Far;
  8.     External 'DOSCALLS' Index 145;
  9.   Function DosWrite(Handle : Word;Str : PChar;Count : Word;
  10.             Var WCount : Word) : Word; Far;
  11.     External 'DOSCALLS' Index 138;
  12.   Function DosExit(x : Word;ExitCode : Word) : Word; Far;
  13.     External 'DOSCALLS' Index 5;
  14.  
  15. Const
  16.   Thread1Terminated : Boolean = False;
  17.  
  18. {$S-} { Stack-Überprüfung sollte deaktiviert werden. }
  19.  
  20.   Procedure Thread1; Far;
  21.   Const
  22.     Str = 'Jetzt ist Thread1 aktiv.'^M^J;
  23.   Var
  24.     w : Word;
  25.   Begin
  26.     Repeat
  27.       DosWrite(1,Str,Length(Str),w);
  28.       Delay(700);
  29.       If KeyPressed then
  30.     Begin
  31.       Thread1Terminated := True;
  32.       { Beende nur Thread1, nicht Programm. }
  33.       DosExit(0,0);
  34.     End;
  35.     Until False;
  36.   End;
  37.  
  38. {$S+} { Stack-Überprüfung kann wieder aktiviert werden. }
  39.  
  40. Const
  41.   StackSize = 8192;
  42. Var
  43.   Thread1ID : Word;
  44.   Stack1    : Pointer;
  45. Begin
  46.   GetMem(Stack1,StackSize);         { Alloziere Stack für Thread1. }
  47.   DosCreateThread(@Thread1,         { Zeiger auf Prozedur f. Thread}
  48.           Thread1ID,
  49.           { Ende des Stackbereichs als Anfangswert für SS:SP. }
  50.           @PChar(Stack1)[StackSize]);
  51.   Repeat
  52.     WriteLn('Der Hauptprogramm ist aktiv.');
  53.     Delay(1100);
  54.   Until Thread1Terminated;
  55.   FreeMem(Stack1,StackSize);         { Gib Stack für Thread1 frei. }
  56.   WriteLn('Programm-Ende');
  57. End.
  58.