home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / MBUG / MBUG053.ARC / U.PAS < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  5KB  |  142 lines
  1. Program U;         { Show USER status }
  2. {*************************************}
  3.  
  4. {*************************************
  5.  **   Program : U        May 1987   **
  6.  **                                 **
  7.  **   A Utility to Indicate which   **
  8.  **   User areas on the currently   **
  9.  **   logged  disc  are  occupied.  **
  10.  **                                 **
  11.  **   Author  : Robert A Smith.     **
  12.  **             Briar Hill. Melb.   **
  13.  **             Victoria 3088.      **
  14.  **                                 **
  15.  **   Version : 1.1                 **
  16.  **   Date    : 25-5-87             **
  17.  *************************************}
  18. Type                      {Image of System File Control Block}
  19.   FCBlock     = Array[0..15] of Byte; 
  20. Const
  21.   SetDMA      = 26;       {BDOS Function Call}
  22.   SetUser     = 32;       {BDOS Function Call}
  23.   GetUser     = 32;       {BDOS Function Call}
  24.   SearchFirst = 17;       {BDOS Function Call}
  25.   HiLightOn   = #27#41;   {Sequence to start inverse chars}
  26.   HiLightOff  = #27#40;   {Sequence to stop  inverse chars}
  27.   SearchMask  : FCBlock   {Wild-Card mask                 }
  28.               = (0,63,63,63,63,63,63,63,63,63,63,63,0,0,0,0);
  29.  
  30. Var
  31.   Occupied  : Array[0..15] of Boolean; {'Occupied User' flag register}
  32.   DMAbuffer : Array[1..128] of Byte;   {Buffer used for disc search}
  33.   FCBbuffer : FCBlock;                 {FCB used for Wild-Card search}
  34.   Count,                               {General counter}
  35.   User,                                {User search pointer}
  36.   CurrentUser : Integer;               {Current User number storage}
  37.  
  38. Procedure InitialiseDMA;
  39. {**********************}
  40. Begin
  41.      {Call System to set temporary read buffer}
  42.   Bdos(SetDMA,Addr(DMAbuffer));
  43. End;
  44. Procedure InitialiseFCB;
  45. {**********************}
  46. Begin
  47.      {Put search mask into search File Control Block}
  48.   Move(SearchMask,FCBbuffer,Sizeof(FCBlock));
  49. End;
  50. Procedure GetCurrentUser;
  51. {***********************}
  52. Begin
  53.      {Call System to obtain current User number}
  54.   CurrentUser:=Bdos(GetUser,255);
  55. End;
  56. Procedure SearchForOccupiedUsers;
  57. {*******************************}
  58. Begin
  59.   Gotoxy(9,4); Write ('Now checking User ');
  60.   Delay(1000); {Cosmetic delay}
  61.      {Set-up loop to search all User numbers}
  62.   For User:=0 to 15 do
  63.   Begin
  64.        {Initialise, or reset, flag for a User}
  65.     Occupied[User]:=False;
  66.        {Call System to change to this User}
  67.     Bdos(SetUser,User);
  68.        {Advise what User is being searched}
  69.     Gotoxy(27,4); Write (User:2);
  70.        {Call System to search this User for any file}
  71.     If Bdos(SearchFirst,Addr(FCBbuffer)) < 255
  72.        {If a file is found, set flag for this User}
  73.     Then Occupied[User]:=True;
  74.   End;
  75. End;
  76.  
  77. Procedure DisplayHeading;
  78. {***********************}
  79. Begin
  80.      {Output a line of dashes}
  81.   Gotoxy( 8,2); For Count:=1 to 65 do Write ('-');
  82.      {Display heading}
  83.   Gotoxy(20,2); Writeln (' Users containing files on current disc ');
  84.   Writeln;
  85. End;
  86. Procedure DisplayResults;
  87. {***********************}
  88. Begin
  89.   Gotoxy(8,4);
  90.      {Set-up loop to display status of all Users}
  91.   For User:=0 to 15 do
  92.   Begin
  93.     If Occupied[User]
  94.        {Show User number in inverse}
  95.     Then Write (' ',HiLightOn,User:2,' ',HiLightOff)
  96.        {Show User number in normal}
  97.     Else Write (' ',          User:2,' '           );
  98.   End;
  99.   Writeln;
  100. End;
  101.  
  102. Procedure RestoreCurrentUser;
  103. {***************************}
  104. Begin
  105.      {Restore original User number}
  106.   Bdos(SetUser,CurrentUser);
  107. End;
  108.  
  109. Procedure DisplayCurrentUser;
  110. {***************************}
  111. Begin
  112.      {Output a line of dashes}
  113.   Gotoxy( 8,6); For Count:=1 to 65 do Write ('-');
  114.      {Display original User number}
  115.   Gotoxy(30,6); Writeln (' Current User is ',CurrentUser:2,' ');
  116. End;
  117. BEGIN{Actual program starts here}
  118.      {Clear the screen}
  119.   Clrscr;              
  120.      {Set-up an area in memory for incoming disc data}
  121.   InitialiseDMA;
  122.      {Set-up an area in memory for disc search information}
  123.   InitialiseFCB;
  124.      {Display on screen what the program is about}
  125.   DisplayHeading;
  126.      {Obtain current User number for later restoration}
  127.   GetCurrentUser;
  128.      {Check-out each User for files & display progress}
  129.   SearchForOccupiedUsers;
  130.      {Display each User, hilighting those found containing files}
  131.   DisplayResults;
  132.      {Re-establish original User number}
  133.   RestoreCurrentUser;
  134.      {Display original User number for Operators benefit}
  135.   DisplayCurrentUser;
  136. END.
  137.  User number}
  138.   Bdos(SetUser,CurrentUser);
  139. End;
  140.  
  141. Procedure DisplayCurrentUser;
  142. {***************