home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / multtsk / cpmult / demo / mtest.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-04-07  |  2.9 KB  |  111 lines
  1. {$R-,S-,I-,D-,F-,V-,B-,N-,L- }
  2. Program MTest;
  3.  
  4. { Programm zum Testen des Message-Passing
  5.   Christian Philipps Software-Technik
  6.   Stand: 01/89
  7. }
  8.  
  9. USES Dos, Crt, CpMulti;
  10.  
  11. VAR MessageBuffer : String;
  12.     SubNo         : TaskNoType;
  13.     BeepNo        : TaskNoType;
  14.  
  15. {-----------------------------------------------------------------------------}
  16.  
  17. PROCEDURE TaskMsgOut(txt : string);
  18.  
  19. { Sichere Ausgabe eines Strings }
  20.  
  21. BEGIN {TaskMsgOut}
  22.   BindCPU;
  23.   Writeln(txt);
  24.   ReleaseCPU;
  25. END;  {TaskMsgOut}
  26.  
  27. {-----------------------------------------------------------------------------}
  28.  
  29. {$F+}
  30. PROCEDURE Beep(P:Pointer);
  31.  
  32. { Erste SubTask }
  33.  
  34. BEGIN {Beep}
  35.   REPEAT
  36.     Sound(200);
  37.     Delay(5);
  38.     NoSound;
  39.   UNTIL Keypressed;
  40.  
  41.   TaskMsgOut('Beep: Senden an SubTask...');
  42.   IF Send(SubNo,@MessageBuffer,Length(MessageBuffer)+1,Wait) <> Task_OK
  43.      THEN Writeln('Beep: Empfangsstatus nicht O.K.')
  44.      ELSE Writeln('Beep: Nachricht wurde korrekt empfangen!');
  45.  
  46.   TaskMsgOut('Beep: Beenden der Veranstaltung...');
  47.   Terminate;
  48. END;  {Beep}
  49.  
  50. {-----------------------------------------------------------------------------}
  51.  
  52. PROCEDURE SubTask(P:Pointer);
  53.  
  54. { Zweite SubTask }
  55.  
  56. VAR Message : String;
  57.  
  58. BEGIN {SubTask}
  59.   TaskMsgOut('SubTask: Gestartet! - Schlafe für 5 Sekunden!');
  60.   Sleep(Seconds(5));
  61.  
  62.   TaskMsgOut('SubTask: Gehe auf Empfang mit Warten...');
  63.   IF Receive(BeepNo,@Message,Wait) <> Task_OK
  64.      THEN TaskMsgOut('SubTask: Fehler bei Receive!!!!')
  65.      ELSE TaskMsgOut('SubTask: Received: '+Message);
  66.  
  67.   TaskMsgOut('SubTask: Abholen der Message von Master-Task, so vorhanden');
  68.   IF Receive(AnyTask,@Message,NoWait) <> Task_OK
  69.      THEN TaskMsgOut('SubTask: Fehler bei Receive!!!!')
  70.      ELSE TaskMsgOut('SubTask: Received: '+Message);
  71.  
  72.   Writeln('SubTask: Message kam von Task Nr. ',ReceivedFrom);
  73.   TaskMsgOut('SubTask: Terminieren...!');
  74.   Terminate;
  75. END;  {SubTask}
  76. {$F-}
  77.  
  78. {-----------------------------------------------------------------------------}
  79.  
  80. BEGIN {Main}
  81.   ClrScr;
  82.   MessageBuffer := 'Dies ist eine Nachricht!!';
  83.  
  84.   Writeln('MasterTask: Starten der Beep-Task!');
  85.   BeepNo := CreateTask(Beep,NIL,Pri_User,500);
  86.   IF BeepNo < 0
  87.      THEN Writeln('MasterTask: Fehler beim Erzeugen der Beep-Task!');
  88.  
  89.   Writeln('MasterTask: Starten von SubTask!');
  90.   SubNo := CreateTask(SubTask,NIL,Pri_User,1000);
  91.   IF SubNo < 0
  92.      THEN BEGIN
  93.             Writeln('MasterTask: Task-Create failed!!');
  94.             Halt;
  95.           END;
  96.  
  97.   Sleep(Seconds(1));   { Laß Sub-Task zu Wort kommen }
  98.  
  99.   Writeln('MasterTask: Nun warten wir auf das Empfangen der Nachricht!');
  100.   IF Send(SubNo,@MessageBuffer,Length(MessageBuffer)+1,Wait) <> Task_OK
  101.      THEN Writeln('MasterTask: Empfangsstatus nicht O.K.')
  102.      ELSE Writeln('MasterTask: Nachricht wurde korrekt empfangen!');
  103.  
  104.   Writeln('MasterTask: schlafe für 2 Sekunden...');
  105.   Sleep(Seconds(2));
  106.  
  107.   Writeln('MasterTask: <RETURN> beendet!');
  108.   Readln;
  109.   NoSound;
  110. END. {Main}
  111.