home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / drdobbs / 1989 / 01 / mod2ut.asc < prev    next >
Text File  |  1989-01-02  |  8KB  |  237 lines
  1. _STRUCTURED PROGRAMMING_
  2.  
  3. by Kent Porter
  4.  
  5. [LISTING ONE]
  6.  
  7.  
  8.    1| MODULE Memory;
  9.    2| 
  10.    3| (* Reports amount of memory available, excluding this program       *)
  11.    4| (* JPI TopSpeed Modula-2                                            *)
  12.    5| (* K. Porter, DDJ, January '89                                      *)
  13.    6| 
  14.    7| IMPORT SYSTEM, IO, Lib;
  15.    8| 
  16.    9| VAR   MainMem, MemUsable      : LONGCARD;
  17.   10|       MemSize [0040H : 0013H] : CARDINAL;
  18.   11| (* ---------------------------------------------------------------- *)
  19.   12| 
  20.   13| PROCEDURE PSP() : LONGCARD;           (* Return byte address of PSP *)
  21.   14| 
  22.   15| VAR   Reg : SYSTEM.Registers;
  23.   16| 
  24.   17| BEGIN
  25.   18|   Reg.AH := 51H;  (* Undocumented: same as 62H but works in DOS 2.n *)
  26.   19|   Lib.Intr (Reg, 21H);
  27.   20|   RETURN (LONGCARD (Reg.BX) * 16);
  28.   21| END PSP;
  29.   22| 
  30.   23| (* ---------------------------------------------------------------- *)
  31.   24| 
  32.   25| BEGIN
  33.   26|   MainMem := LONGCARD (MemSize) * 1024;    (* Total memory in bytes *)
  34.   27|   MemUsable := MainMem - PSP();
  35.   28|   IO.WrStr ('Available memory is ');
  36.   29|   IO.WrLngCard (MemUsable, 1);
  37.   30|   IO.WrStr (' bytes');
  38.   31|   IO.WrLn;
  39.   32| END Memory.
  40.  
  41.  
  42. [LISTING TWO]
  43.  
  44.    1| MODULE sd;
  45.    2| 
  46.    3| (* Lists all subdirectories in the current directory *)
  47.    4| (* JPI TopSpeed Modula-2                             *)
  48.    5| (* K. Porter, DDJ, January '89                       *)
  49.    6| 
  50.    7| IMPORT FIO, IO;
  51.    8| 
  52.    9| VAR    F     : FIO.DirEntry;
  53.   10|        Found : BOOLEAN;
  54.   11|        Count : CARDINAL;
  55.   12| 
  56.   13| BEGIN
  57.   14|   Count := 0;
  58.   15|   Found := FIO.ReadFirstEntry ("*.*",
  59.   16|                FIO.FileAttr {FIO.directory}, F);
  60.   17|   WHILE Found DO
  61.   18|     IF FIO.directory IN F.attr THEN
  62.   19|       IF F.Name[0] # '.' THEN
  63.   20|         IO.WrStr (F.Name); IO.WrLn;
  64.   21|         INC (Count);
  65.   22|       END;
  66.   23|     END;
  67.   24|     Found := FIO.ReadNextEntry (F);
  68.   25|   END;
  69.   26|   IO.WrCard (Count, 1);
  70.   27|   IO.WrStr (' directories found');
  71.   28|   IO.WrLn;
  72.   29| END sd.
  73.  
  74.  
  75. [LISTING THREE]
  76.  
  77.    1| MODULE Where;
  78.    2| 
  79.    3| (* Searches directory structure from the root, listing all occur-   *)
  80.    4| (*   rences of a filename matching the search argument              *)
  81.    5| (* JPI TopSpeed Modula-2                                            *)
  82.    6| (* K. Porter, DDJ, January '89                                      *)
  83.    7| 
  84.    8| IMPORT FIO, IO, SYSTEM, Lib, Str;
  85.    9| FROM FIO IMPORT FileAttr, readonly, hidden, system, directory,
  86.   10|                 archive;
  87.   11| 
  88.   12| TYPE  string = ARRAY [0..79] OF CHAR;
  89.   13| 
  90.   14| CONST DefaultDrive = 0;
  91.   15|       Backspace = CHR(8);
  92.   16| 
  93.   17| VAR   arg, curdir, xfer  : string;
  94.   18|       DriveName          : ARRAY [0..3] OF CHAR;
  95.   19|       count, p, s, d     : CARDINAL;
  96.   20|       curdrive, newdrive : SHORTCARD;
  97.   21|       cx [40H:50H]       : SHORTCARD;        (* ROM BIOS cursor col *)
  98.   22| 
  99.   23| (* ---------------------------------------------------------------- *)
  100.   24| 
  101.   25| PROCEDURE ClrSol;             (* Clear from cursor to start of line *)
  102.   26| 
  103.   27| BEGIN
  104.   28|   WHILE cx # 0 DO
  105.   29|     IO.WrChar (Backspace);
  106.   30|     IO.WrChar (' ');
  107.   31|     IO.WrChar (Backspace);
  108.   32|   END;
  109.   33| END ClrSol;
  110.   34| 
  111.   35| (* ---------------------------------------------------------------- *)
  112.   36| 
  113.   37| PROCEDURE SearchDir (Path : ARRAY OF CHAR);
  114.   38|                               (* Recursive directory search routine *)
  115.   39| 
  116.   40| VAR  F         : FIO.DirEntry;
  117.   41|      WholePath : string;
  118.   42|      Found     : BOOLEAN;
  119.   43| 
  120.   44| BEGIN
  121.   45|   FIO.ChDir (Path);                                (* Set directory *)
  122.   46|   FIO.GetDir (DefaultDrive, WholePath);        (* Get full pathname *)
  123.   47|   Str.Concat (WholePath, DriveName, WholePath);        (* Add drive *)
  124.   48|   ClrSol;                                 (* Clear to start of line *)
  125.   49|   IO.WrStr (WholePath);                           (* List directory *)
  126.   50| 
  127.   51|   (* Search for filename matches in this directory *)
  128.   52|   Found := FIO.ReadFirstEntry (arg, FileAttr {readonly, hidden,
  129.   53|                                system, directory, archive}, F);
  130.   54|   WHILE Found DO
  131.   55|     IF Str.Length (WholePath) > 3 THEN IO.WrChar ('\') END;
  132.   56|     IO.WrStr (F.Name);
  133.   57|     IF directory IN F.attr THEN
  134.   58|       IO.WrStr (" <DIR>");
  135.   59|     END;
  136.   60|     IO.WrLn;                                            (* New line *)
  137.   61|     IO.WrStr (WholePath);
  138.   62|     INC (count);                                (* Count occurrence *)
  139.   63|     Found := FIO.ReadNextEntry (F);               (* Get next match *)
  140.   64|   END;
  141.   65| 
  142.   66|   (* Now recursively search any subs under this directory *)
  143.   67|   Found := FIO.ReadFirstEntry ("*.*", FileAttr {directory}, F);
  144.   68|   WHILE Found DO
  145.   69|     IF (directory IN F.attr) AND (F.Name[0] # '.') THEN
  146.   70|       SearchDir (F.Name);                         (* Recursive call *)
  147.   71|       FIO.ChDir (WholePath);           (* Restore dir to this level *)
  148.   72|     END;
  149.   73|     Found := FIO.ReadNextEntry (F);                  (* Do next sub *)
  150.   74|   END;
  151.   75| END SearchDir;
  152.   76| 
  153.   77| (* ---------------------------------------------------------------- *)
  154.   78| 
  155.   79| PROCEDURE GetDrive() : SHORTCARD;     (* Get currently active drive *)
  156.   80| 
  157.   81| VAR   Reg : SYSTEM.Registers;
  158.   82| 
  159.   83| BEGIN
  160.   84|   Reg.AH := 19H;
  161.   85|   Lib.Intr (Reg, 21H);
  162.   86|   RETURN (Reg.AL);
  163.   87| END GetDrive;
  164.   88| 
  165.   89| (* ---------------------------------------------------------------- *)
  166.   90| 
  167.   91| PROCEDURE SetDrive (Drive : SHORTCARD);        (* Set default drive *)
  168.   92| 
  169.   93| VAR   Reg : SYSTEM.Registers;
  170.   94| 
  171.   95| BEGIN
  172.   96|   Reg.AH := 0EH;
  173.   97|   Reg.DL := Drive;
  174.   98|   Lib.Intr (Reg, 21H);
  175.   99| END SetDrive;
  176.  100| 
  177.  101| (* ---------------------------------------------------------------- *)
  178.  102| 
  179.  103| BEGIN   (* Main body of WHERE *)
  180.  104| 
  181.  105|   (* Initialize *)
  182.  106|   FIO.GetDir (0, curdir);                  (* Remember where we are *)
  183.  107|   curdrive := GetDrive();                              (* and drive *)
  184.  108|   count := 0;
  185.  109|   FOR p := 0 TO 3 DO DriveName[p] := CHR(0) END;
  186.  110| 
  187.  111|   (* Get the name to search for *)
  188.  112|   IF Lib.ParamCount() > 0 THEN
  189.  113|     Lib.ParamStr (arg, 1);
  190.  114|   ELSE
  191.  115|     IO.WrStr ("Filename? ");
  192.  116|     IO.RdStr (arg);
  193.  117|   END;
  194.  118| 
  195.  119|   (* Select another drive, strip out designator if necessary *)
  196.  120|   IF arg[1] = ':' THEN
  197.  121|     DriveName[0] := CAP (arg[0]);
  198.  122|     newdrive := SHORTCARD (ORD (CAP (arg[0])) - ORD ('A'));
  199.  123|     SetDrive (newdrive);                           (* Set new drive *)
  200.  124|     IF arg[2] = '\' THEN s := 3 ELSE s := 2 END;
  201.  125|     d := 0;
  202.  126|     FOR p := s TO Str.Length (arg) DO (* Strip out drive designator *)
  203.  127|       xfer[d] := arg[p];
  204.  128|       INC (d);
  205.  129|       xfer[d] := CHR (0);
  206.  130|     END;
  207.  131|     Str.Copy (arg, xfer);                       (* Copy back to arg *)
  208.  132|   END;
  209.  133| 
  210.  134|   (* Build name of target drive *)
  211.  135|   IF DriveName[0] = CHR(0) THEN
  212.  136|     DriveName[0] := CHR (curdrive + 65)
  213.  137|   END;
  214.  138|   Str.Concat (DriveName, DriveName, ":\");
  215.  139| 
  216.  140|   (* Add wildcard prefix/suffix as necessary *)
  217.  141|   IF arg[0] = '.' THEN
  218.  142|     Str.Concat (arg, "*", arg);         (* Stick in wildcard prefix *)
  219.  143|   END;
  220.  144|   IF Str.Pos (arg, ".") = MAX (CARDINAL) THEN
  221.  145|     Str.Concat (arg, arg, ".*");          (* Append wildcard suffix *)
  222.  146|   END;
  223.  147| 
  224.  148|   (* Begin search at root *)
  225.  149|   SearchDir ("\");
  226.  150| 
  227.  151|   (* Report matches found *)
  228.  152|   ClrSol;
  229.  153|   IO.WrCard (count, 1);
  230.  154|   IO.WrStr (" matches found");
  231.  155|   IO.WrLn;
  232.  156| 
  233.  157|   (* Restore user's original environment *)
  234.  158|   SetDrive (curdrive);
  235.  159|   FIO.ChDir (curdir);
  236.  160| END Where.
  237.