home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / Pascal / Snippets / ProcPuppy 1.0 / ProcPuppy.p < prev    next >
Encoding:
Text File  |  1995-01-11  |  7.9 KB  |  251 lines  |  [TEXT/PJMM]
  1. {ProcPuppy is my simple process management program, related to ProcDoggie but far simpler.}
  2. {My only regret is that TerminateProcess takes so much space. I should probably remove it in}
  3. {order to mae the program simpler, but that makes it less useful as a utility.}
  4.  
  5. program ProcPuppy;
  6.  
  7.     uses
  8. {$IFC UNDEFINED THINK_PASCAL}
  9.         Memtypes, Quickdraw, OSIntf, ToolIntf, PackIntf, 
  10. {$ENDC}
  11.         Processes, TransSkel;
  12.  
  13.     var
  14.         m, infoMenu, switchMenu, terminateMenu: MenuHandle;
  15.         dummy: Boolean;
  16.         r: Rect;
  17.         w: WindowPtr;
  18.  
  19.     const
  20.         kMaxProc = 50;
  21.  
  22.     var
  23.         iErr: OSErr;
  24.         PSN: ProcessSerialNumber;
  25.         psnList: array[0..kMaxProc] of ProcessSerialNumber;
  26.         pInfo: array[0..kMaxProc] of ProcessInfoRec;
  27.         numProc: Integer;
  28.         procName: array[0..kMaxProc] of Str255;
  29.         curProc: Integer;
  30.  
  31.     procedure About;    { Reponse to "About" selection            }
  32.     begin
  33.     end;
  34.  
  35. {The following function copied from ProcDoggie}
  36.     function TerminateProcess (theProcessNum: ProcessSerialNumber): OSErr;
  37. {I don't feel like including several units just for one Apple Event!}
  38.         const
  39.             typeProcessSerialNumber = 'psn ';
  40.             kCoreEventClass = 'aevt';
  41.             kAEQuitApplication = 'quit';
  42.             kAutoGenerateReturnID = -1;         { AECreateAppleEvent will generate a session-unique ID }
  43.             kAnyTransactionID = 0;              { no transaction is in use }
  44.             kAENoReply = $00000001;             { Sender doesn't want a reply to event }
  45.             kAENormalPriority = $00000000;      { Post message at the end of event queue }
  46.             kNoTimeOut = -2;                    { wait until reply comes back, however long it takes }
  47.         type
  48.             DescType = ResType;
  49.             AEDesc = record
  50.                     descriptorType: DescType;
  51.                     dataHandle: Handle;
  52.                 end;
  53.             AEAddressDesc = AEDesc;             { an AEDesc which contains addressing data }
  54.             AEDescList = AEDesc;                { a list of AEDesc is a special kind of AEDesc }
  55.             AERecord = AEDescList;              { AERecord is a list of keyworded AEDesc }
  56.             AppleEvent = AERecord;              { an AERecord that contains an AppleEvent }
  57.             AEEventClass = packed array[1..4] of CHAR;
  58.             AEEventID = packed array[1..4] of CHAR;
  59.             AESendMode = LONGINT;               { Type of parameter to AESend }
  60.             AESendPriority = INTEGER;           { Type of priority param of AESend }
  61.         function AEDisposeDesc (var theAEDesc: AEDesc): OSErr;
  62.         inline
  63.             $303C, $0204, $A816;
  64.         function AECreateDesc (typeCode: DescType; dataPtr: Ptr; dataSize: Size; var result: AEDesc): OSErr;
  65.         inline
  66.             $303C, $0825, $A816;
  67.         function AECreateAppleEvent (theAEEventClass: AEEventClass; theAEEventID: AEEventID; target: AEAddressDesc; returnID: INTEGER; transactionID: LONGINT; var result: AppleEvent): OSErr;
  68.         inline
  69.             $303C, $0B14, $A816;
  70.         function AESend (theAppleEvent: AppleEvent; var reply: AppleEvent; sendMode: AESendMode; sendPriority: AESendPriority; timeOutInTicks: LONGINT; idleProc: ProcPtr; filterProc: ProcPtr): OSErr;
  71.         inline
  72.             $303C, $0D17, $A816;
  73.  
  74.         var
  75.             theDoomed: AEAddressDesc; {PSN descriptor of process to be terminated}
  76.             quitEvent: AppleEvent;    {'quit' AppleEvent}
  77.             reply: AppleEvent;    {Reply from receiving application; ignored}
  78.             error: OSErr;
  79.  
  80.         procedure RecoverError (error: Integer);
  81.             var
  82.                 result: OSErr;
  83.         begin
  84.             if theDoomed.dataHandle <> nil then
  85.                 result := AEDisposeDesc(theDoomed);(*◊*)
  86.             if quitEvent.dataHandle <> nil then
  87.                 result := AEDisposeDesc(quitEvent);(*◊*)
  88.             TerminateProcess := error;
  89.             EXIT(TerminateProcess)
  90.         end;
  91.  
  92.     begin
  93.         theDoomed.dataHandle := nil;
  94.         quitEvent.dataHandle := nil;
  95.         reply.dataHandle := nil;
  96.  
  97.         (* Create the Process Serial Number event descriptor *)
  98.         error := AECreateDesc(typeProcessSerialNumber, Ptr(@theProcessNum), SIZEOF(theProcessNum), theDoomed); (*<*)
  99.         if error <> noErr then
  100.             RecoverError(error);
  101.  
  102.         (* Create 'quit' event with the specified process serial number *)
  103.         error := AECreateAppleEvent(kCoreEventClass, kAEQuitApplication, theDoomed, kAutoGenerateReturnID, kAnyTransactionID, quitEvent); (*<*)
  104.         if error <> noErr then
  105.             RecoverError(error);
  106.  
  107.         (* Send the 'quit' event *)
  108.         error := AESend(quitEvent, reply, kAENoReply, kAENormalPriority, kNoTimeOut, nil, nil); (*<*)
  109.         if error <> noErr then
  110.             RecoverError(error);
  111.  
  112.         (* PSN in the AppleEvent, so can dispose of PSN descriptor *)
  113.         error := AEDisposeDesc(theDoomed);(*◊*)
  114.  
  115.         (* Dispose of the 'quit' AppleEvent *)
  116.         error := AEDisposeDesc(quitEvent)(*◊*)
  117.     end;
  118.  
  119. {Step through the process list and fill in our process list arrays and the menus}
  120.  
  121.     procedure UpdateProcessList;
  122.         var
  123.             i, length: Integer;
  124.     begin
  125. {Remove all old menu items}
  126.         length := CountMItems(infoMenu);
  127.         for i := 1 to length do
  128.             DelMenuItem(infoMenu, 1);
  129.         length := CountMItems(switchMenu);
  130.         for i := 1 to length do
  131.             DelMenuItem(switchMenu, 1);
  132.         length := CountMItems(terminateMenu);
  133.         for i := 1 to length do
  134.             DelMenuItem(terminateMenu, 1);
  135.  
  136. {Step through the process list}
  137.         PSN.highLongOfPSN := 0;
  138.         PSN.lowLongOfPSN := kNoProcess;
  139.         iErr := GetNextProcess(PSN);
  140.         numProc := 0;
  141.         while iErr = noErr do
  142.             begin
  143.                 numProc := numProc + 1;
  144.                 psnList[numProc] := PSN;
  145.                 pInfo[numProc].processInfoLength := SIZEOF(ProcessInfoRec);
  146.                 pInfo[numProc].processName := @procName[numProc];
  147.                 pInfo[numProc].processAppSpec := nil;
  148.                 if noErr = GetProcessInformation(PSN, pInfo[numProc]) then
  149.                     begin
  150.                         AppendMenu(infoMenu, pInfo[numProc].processName^);
  151.                         AppendMenu(switchMenu, pInfo[numProc].processName^);
  152.                         AppendMenu(terminateMenu, pInfo[numProc].processName^);
  153.                     end;
  154.                 iErr := GetNextProcess(PSN);
  155.             end;
  156.     end;
  157.  
  158.     procedure DoFileMenu (item: integer);
  159.     begin
  160.         case item of
  161.             1: 
  162.                 UpdateProcessList;
  163.             3: 
  164.                 SkelWhoa;            { Tell SkelMain to quit                }
  165.         end; {case}
  166.     end;
  167.  
  168.     procedure DoInfoMenu (item: integer);
  169.     begin
  170.         ShowWindow(w);
  171.         SelectWindow(w);
  172.         curProc := item;
  173.         SetPort(w);
  174.         InvalRect(w^.portRect);
  175.     end;
  176.  
  177.     procedure DoSwitchMenu (item: integer);
  178.     begin
  179.         iErr := SetFrontProcess(psnList[item]);
  180.     end;
  181.  
  182.     procedure DoTerminateMenu (item: integer);
  183.     begin
  184.         iErr := TerminateProcess(psnList[item]);
  185.         UpdateProcessList;
  186.     end;
  187.  
  188.     procedure Mouse (thePt: Point; t: longint; mods: integer);
  189.     begin
  190.     end;
  191.  
  192.     procedure Idle;
  193.     begin
  194.     end;
  195.  
  196.     procedure Update (resized: Boolean);
  197.         function MyNumToString (l: Longint): Str255;
  198.             var
  199.                 s: Str255;
  200.         begin
  201.             NumToString(l, s);
  202.             MyNumToString := s;
  203.         end;
  204.     begin
  205.         EraseRect(w^.portRect);
  206.         MoveTo(10, 20);
  207.         DrawString(pInfo[curProc].processName^);
  208.         MoveTo(10, 40);
  209.         DrawString(stringof('Type: ', OSType(pInfo[curProc].processType)));
  210.         MoveTo(10, 60);
  211.         DrawString(stringof('Type: ', pInfo[curProc].processSignature));
  212.         MoveTo(10, 80);
  213.         DrawString(stringof('Size: ', pInfo[curProc].processSize div 1024, 'k'));
  214.         MoveTo(10, 100);
  215.         DrawString(stringof('Free memory: ', pInfo[curProc].processFreeMem div 1024, 'k'));
  216.     end;
  217.  
  218.     procedure Key (ch: char; mods: integer);
  219.     begin
  220.     end;
  221.  
  222. begin
  223.     SkelInit(6, nil);                                        { Initialize                    }
  224.     SkelApple('(Om ProcPuppy…', @About);                { Handle Desk Accessories            }
  225.     m := NewMenu(2, 'File');                                { Create Menu                }
  226.     AppendMenu(m, 'Update process list/P;(-;Quit/Q');
  227.     dummy := SkelMenu(m, @DoFileMenu, nil, true);    { Tell Transkel to handle it            }
  228.  
  229.     infoMenu := NewMenu(3, 'Info');                        { Create Menu                }
  230.     switchMenu := NewMenu(4, 'Switch');                { Create Menu                }
  231.     terminateMenu := NewMenu(5, 'Terminate');        { Create Menu                }
  232.  
  233.     UpdateProcessList;                                        {Update list and fill menus}
  234.  
  235.     dummy := SkelMenu(infoMenu, @DoInfoMenu, nil, true);                { Tell Transkel to handle it            }
  236.     dummy := SkelMenu(switchMenu, @DoSwitchMenu, nil, true);        { Tell Transkel to handle it            }
  237.     dummy := SkelMenu(terminateMenu, @DoTerminateMenu, nil, true);    { Tell Transkel to handle it            }
  238.  
  239.     curProc := 1;
  240.  
  241.     r.top := 50;
  242.     r.left := 20;
  243.     r.bottom := 200;
  244.     r.right := 250;
  245.     w := NewCWindow(nil, r, 'ProcPuppy', true, documentProc, WindowPtr(-1), true, 0);
  246.     SetPort(w);
  247.     dummy := SkelWindow(w, @Mouse, @Key, @Update, nil, nil, nil, @Idle, true);
  248.  
  249.     SkelMain;                                                { loop til quit selected                }
  250.     SkelClobber;                                            { clean up                                }
  251. end.