home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sp15demo.zip / libsrc.zip / LIBSRC / PROCESS.PAS < prev    next >
Pascal/Delphi Source File  |  1996-02-25  |  6KB  |  208 lines

  1. UNIT Process;
  2.  
  3. {**************************************************************************
  4.  *                 General Unit for Speed-Pascal/2                        *
  5.  *                                                                        *
  6.  *                                                                        *
  7.  * Copyright (C) 1995..96 SpeedSoft                                       *
  8.  *                                                                        *
  9.  * Basic objects for process and thread handling                          *
  10.  *                                                                        *
  11.  **************************************************************************}
  12.  
  13.  
  14. INTERFACE
  15.  
  16. USES Os2Def,BseDos,Dos;
  17.  
  18. TYPE
  19.      PProcess=^TProcess;
  20.      TProcess=OBJECT
  21.                    TheExeName:STRING;
  22.                    TheParams:STRING;
  23.                    TheProcessID:ULONG;
  24.                    TheProcessPID:PID;
  25.                    TheStartData:STARTDATA;
  26.                    ObjBuf:STRING;
  27.                    CONSTRUCTOR Init(ExeName,Params:STRING);
  28.                    FUNCTION Run:LONGWORD;
  29.                    DESTRUCTOR Done;
  30.               END;
  31.  
  32.      PThread=^TThread;
  33.      TThread=OBJECT
  34.                    TheThreadProc:PROCEDURE(Param:POINTER);
  35.                    TheThreadData:POINTER;
  36.                    TheStackSize:ULONG;
  37.                    TheThreadTID:TID;
  38.                    Suspended:BOOLEAN;
  39.                    CONSTRUCTOR Init(ThreadProc,ThreadData:POINTER;
  40.                                     ThreadStack:ULONG);
  41.                    PROCEDURE Run;
  42.                    PROCEDURE Kill;
  43.                    PROCEDURE Suspend;
  44.                    PROCEDURE Resume;
  45.                    PROCEDURE ThreadProc;
  46.                    PROCEDURE SetPriority(aClass,Delta:ULONG);
  47.                    FUNCTION HasEnded:BOOLEAN;
  48.                    DESTRUCTOR Done;
  49.              END;
  50.  
  51.  
  52. IMPLEMENTATION
  53.  
  54. {***************************************************************************
  55.  *                                                                         *
  56.  *                                                                         *
  57.  *     Object TProcess                                                     *
  58.  *                                                                         *
  59.  ***************************************************************************}
  60.  
  61.  
  62. CONSTRUCTOR TProcess.Init(ExeName,Params:STRING);
  63. VAR s:STRING;
  64.     rc:ULONG;
  65.     AppType:ULONG;
  66. BEGIN
  67.      IF pos('\',ExeName)=0 THEN
  68.      BEGIN
  69.           GetDir(0,s);
  70.           IF s[length(s)]='\' THEN dec(s[0]);
  71.           ExeName:=s+'\'+ExeName;
  72.      END;
  73.      IF Pos('.',ExeName)=0 THEN ExeName:=ExeName+'.EXE';
  74.  
  75.      TheExeName:=ExeName;
  76.      TheParams:=params;
  77.  
  78.      TheStartData.Length:=sizeof(STARTDATA);
  79.      TheStartData.Related:=SSF_RELATED_CHILD;
  80.      TheStartData.FgBg:=SSF_FGBG_BACK;
  81.      TheStartData.TraceOpt:=SSF_TRACEOPT_NONE;
  82.      TheStartData.PgmTitle:=@TheExeName;
  83.      TheStartData.PgmName:=@TheExeName;
  84.      TheStartData.PgmInputs:=@TheParams;
  85.      TheStartData.TermQ:=NIL;
  86.      TheStartData.Environment:=NIL;
  87.      TheStartData.InheritOpt:=SSF_INHERTOPT_SHELL;
  88.  
  89.      rc:=DosQueryAppType(ExeName,AppType);
  90.  
  91.      IF rc<>0 THEN TheStartData.SessionType:=SSF_TYPE_DEFAULT
  92.      ELSE
  93.      BEGIN
  94.           IF ((AppType AND 32=32)OR(AppType=3)) THEN {DOS}
  95.              TheStartData.SessionType:=SSF_TYPE_VDM
  96.           ELSE TheStartData.SessionType:=SSF_TYPE_DEFAULT;
  97.      END;
  98.  
  99.      TheStartData.IconFile:=NIL;
  100.      TheStartData.PgmHandle:=0;
  101.      TheStartData.PgmControl:=SSF_CONTROL_VISIBLE;
  102.      TheStartData.InitXPos:=30;
  103.      TheStartData.InitYPos:=40;
  104.      TheStartData.InitXSize:=200;
  105.      TheStartData.InitYSize:=140;
  106.      TheStartData.Reserved:=0;
  107.      TheStartData.ObjectBuffer:=@ObjBuf;
  108.      TheStartData.ObjectBuffLen:=256;
  109.  
  110.      TheProcessID:=0;
  111.      TheProcessPID:=0;
  112. END;
  113.  
  114. FUNCTION TProcess.Run:LONGWORD;
  115. BEGIN
  116.      Run:=DosStartSession(TheStartData,TheProcessId,TheProcessPID);
  117. END;
  118.  
  119. DESTRUCTOR TProcess.Done;
  120. BEGIN
  121. END;
  122.  
  123. {***************************************************************************
  124.  *                                                                         *
  125.  *                                                                         *
  126.  *     Object TThread                                                      *
  127.  *                                                                         *
  128.  ***************************************************************************}
  129.  
  130.  
  131. CONSTRUCTOR TThread.Init(ThreadProc,ThreadData:POINTER;ThreadStack:ULONG);
  132. BEGIN
  133.      TheThreadProc:=ThreadProc;
  134.      TheThreadData:=ThreadData;
  135.      IF ThreadStack<16384 THEN ThreadStack:=16384;
  136.      TheStackSize:=ThreadStack;
  137.      TheThreadTID:=0;
  138.      Suspended:=FALSE;
  139. END;
  140.  
  141. PROCEDURE TThread.ThreadProc;CDECL;
  142. VAR p:PROCEDURE(Param:POINTER);
  143. BEGIN
  144.      p:=TheThreadProc;
  145.      p(TheThreadData);
  146.      {Clear TID if Thread resumed}
  147.      TheThreadTID:=0;
  148. END;
  149.  
  150. PROCEDURE TThread.Run;
  151. BEGIN
  152.      DosCreateThread(TheThreadTID,@ThreadProc,POINTER(SELF),
  153.                      STACK_COMMITTED,TheStackSize);
  154. END;
  155.  
  156. PROCEDURE TThread.Kill;
  157. VAR r:ULONG;
  158. LABEL l;
  159. BEGIN
  160.      IF TheThreadTID<>0 THEN
  161.      BEGIN
  162. l:
  163.           r:=DosKillThread(TheThreadTID);
  164.           IF r=170 THEN  {Thread busy}
  165.           BEGIN
  166.                DosSleep(50);
  167.                goto l;
  168.           END;
  169.      END;
  170.      TheThreadTID:=0;
  171. END;
  172.  
  173. PROCEDURE TThread.Suspend;
  174. BEGIN
  175.      IF TheThreadTID<>0 THEN IF not Suspended THEN
  176.      BEGIN
  177.           DosSuspendThread(TheThreadTID);
  178.           Suspended:=TRUE;
  179.      END;
  180. END;
  181.  
  182. PROCEDURE TThread.Resume;
  183. BEGIN
  184.      IF TheThreadTID<>0 THEN IF Suspended THEN
  185.      BEGIN
  186.           DosResumeThread(TheThreadTID);
  187.           Suspended:=FALSE;
  188.      END;
  189. END;
  190.  
  191. PROCEDURE TThread.SetPriority(aClass,Delta:ULONG);
  192. BEGIN
  193.      IF TheThreadTID<>0 THEN
  194.        DosSetPriority(PRTYS_THREAD,aClass,Delta,TheThreadTID);
  195. END;
  196.  
  197. FUNCTION TThread.HasEnded:BOOLEAN;
  198. BEGIN
  199.      HasEnded:=TheThreadTID=0;
  200. END;
  201.  
  202. DESTRUCTOR TThread.Done;
  203. BEGIN
  204.      Kill;
  205. END;
  206.  
  207. BEGIN
  208. END.