home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / txtutl / head.arc / HEAD.PAS < prev   
Pascal/Delphi Source File  |  1988-03-02  |  10KB  |  304 lines
  1. {----------------------------------------------------------------------------}
  2. {                                                                            }
  3. {     HEAD.EXE  --  Copyright (c) 1988 by Marcos R. Della                    }
  4. {                                                                            }
  5. {     The following code has been donated to the public domain for anyone    }
  6. {     out there to use.  All I request is that if you make changes, you      }
  7. {     rename the program so that if it is distributed, it is not confused    }
  8. {     with this version of the program.                                      }
  9. {                                                                            }
  10. {     Any changes or modifications to be incorporated into the program       }
  11. {     should be sent to the above person to be installed in the distribution }
  12. {     copy of the program.                                                   }
  13. {                                                                            }
  14. {     Version 01.00.00 - 01MAR88     Written specifically for the DMG BBS    }
  15. {                                                                            }
  16. {----------------------------------------------------------------------------}
  17. {                                                                            }
  18. {     head [-][ht][num] [path]filename                                       }
  19. {                                                                            }
  20. {     h - Count from the head of the file (num) lines                        }
  21. {     t - Count from the tail of the file (num) lines                        }
  22. {     - - negate the above.                                                  }
  23. {                                                                            }
  24. {     Ex.                                                                    }
  25. {          head h8 filename    - Displays the first 8 lines of the file      }
  26. {          head t6 filename    - Displays the last 8 lines of the file       }
  27. {          head -t6 filename   - Displays all but the last 6 lines           }
  28. {          head -h7 filename   - Displays all but the first 7 lines          }
  29. {                                                                            }
  30. {     Note:  At the moment, the program will not act correctly if there are  }
  31. {            more than 255 characters per line.  Future versions of this     }
  32. {            program will include the fix for this problem.                  }
  33. {                                                                            }
  34. {            This program will also take its input directly from the input   }
  35. {            buffer so you can use something along the lines of:             }
  36. {                                                                            }
  37. {                   garbage | head -h4 > welcome1.txt                        }
  38. {                                                                            }
  39. {            This will take the output of "garbage" and knock off the first  }
  40. {            4 lines of text and put the rest into the file "welcome1.txt"   }
  41. {                                                                            }
  42. {----------------------------------------------------------------------------}
  43.  
  44. TYPE  holdptr = ^holding;
  45.       holding = RECORD
  46.                    ptr      : holdptr;
  47.                    lne      : STRING[255];
  48.                    count    : INTEGER;
  49.                 END;
  50.       line    = STRING[80];
  51.       filen   = RECORD
  52.                    path     : line;
  53.                    filename : line
  54.                 END;
  55.  
  56. VAR   head     : holdptr;
  57.       ptr      : holdptr;
  58.       ptr1     : holdptr;
  59.       lines    : INTEGER;
  60.       fname    : filen;
  61.       filename : line;
  62.       tstf     : TEXT;
  63.       len      : INTEGER;
  64.       top      : BOOLEAN;
  65.       negate   : BOOLEAN;
  66.       done     : BOOLEAN;
  67.       keybd    : BOOLEAN;
  68.       count    : INTEGER;
  69.       hcount   : INTEGER;
  70.       i        : INTEGER;
  71.       temp     : line;
  72.  
  73. {----------------------------------------------------------------------------}
  74.  
  75. PROCEDURE error_sys(num : INTEGER);
  76. BEGIN
  77.    WRITE('Error - ');
  78.    CASE num OF
  79.       1 : WRITELN('Invalid parameter');
  80.       2 : WRITELN('Invalid filename');
  81.       3 : WRITELN('Invalid path specification');
  82.       4 : WRITELN('No file specified');
  83.       5 : WRITELN('File does not exist');
  84.       6 : WRITELN('Not enough memory')
  85.    END;
  86.    HALT(1)
  87. END;
  88.  
  89. {----------------------------------------------------------------------------}
  90.  
  91. FUNCTION check_filename(fname : line) : BOOLEAN;
  92. VAR   len  : BYTE ABSOLUTE fname;
  93.       dots : INTEGER;
  94.       dotp : INTEGER;
  95.       i    : INTEGER;
  96.  
  97. BEGIN
  98.    check_filename := TRUE;
  99.    dots := 0;
  100.    IF len > 0 THEN
  101.       FOR i := 1 TO len DO BEGIN
  102.          IF fname[i] = '.' THEN
  103.             dots := dots + 1;
  104.          IF NOT (fname[i] IN ['.','-','_','0'..'9','A'..'Z']) THEN
  105.             check_filename := FALSE
  106.       END;
  107.    IF dots > 1 THEN
  108.       check_filename := FALSE;
  109.    dotp := POS('.', fname);
  110.    IF (dotp > 9) OR (dotp = 1) OR ((dotp = 0) AND (len > 8)) OR
  111.       ((dotp > 0) AND (len > dotp + 3)) OR (fname = '') THEN
  112.       check_filename := FALSE
  113. END;
  114. {----------------------------------------------------------------------------}
  115.  
  116. PROCEDURE store_name(tmp : line);
  117. VAR   len : BYTE;
  118. BEGIN
  119.    tmp := tmp + '..';
  120.    len := LENGTH(tmp);
  121.    WHILE len > 0 DO BEGIN
  122.       tmp[len] := UPCASE(tmp[len]);
  123.       len := len - 1
  124.    END;
  125.    fname.path := '';
  126.    fname.filename := '';
  127.  
  128.    WHILE POS('\',tmp) > 0 DO BEGIN
  129.       fname.path := fname.path + COPY(tmp,1,POS('\',tmp));
  130.       DELETE(tmp,1,POS('\',tmp))
  131.    END;
  132.    IF (fname.path[LENGTH(fname.path)] = '\') AND (LENGTH(fname.path) > 1) THEN
  133.       DELETE(fname.path,LENGTH(fname.path),1);
  134.    fname.filename := COPY(tmp,1,POS('..',tmp) - 1);
  135.  
  136.    IF POS(':',fname.filename) > 0 THEN
  137.       BEGIN
  138.          fname.path := COPY(fname.filename,1,POS(':',fname.filename))
  139.                      + fname.path;
  140.          DELETE(fname.filename,1,POS(':',fname.filename))
  141.       END;
  142.  
  143.    IF (fname.path[2] = ':') AND (LENGTH(fname.path) = 2)  THEN
  144.       GETDIR(ORD(UPCASE(fname.path[1])) - 64,fname.path);
  145.    IF fname.path = '' THEN
  146.       GETDIR(0,fname.path)
  147. END;
  148.  
  149. {----------------------------------------------------------------------------}
  150.  
  151. PROCEDURE get_params(temp : line);
  152. VAR   code : INTEGER;
  153.       i    : INTEGER;
  154. BEGIN
  155.    IF POS('t',temp) > 0 THEN
  156.       top := FALSE;
  157.    IF (POS('h',temp) > 0) AND NOT top THEN
  158.       error_sys(1);
  159.    IF temp[1] = '-' THEN
  160.       IF POS('-',temp) > 1 THEN
  161.          error_sys(1)
  162.       ELSE
  163.          negate := TRUE;
  164.    i := 1;
  165.    WHILE i <= LENGTH(temp) DO BEGIN
  166.       IF temp[i] IN ['0'..'9'] THEN
  167.          BEGIN
  168.             DELETE(temp,1,i - 1);
  169.             i := LENGTH(temp);
  170.             VAL(temp,len,code);
  171.             IF code <> 0 THEN
  172.                error_sys(1)
  173.          END;
  174.       i := i + 1
  175.    END
  176. END;
  177.  
  178. {----------------------------------------------------------------------------}
  179.  
  180. FUNCTION eofcheck : BOOLEAN;
  181. BEGIN
  182.    IF keybd THEN
  183.       eofcheck := EOF(input)
  184.    ELSE
  185.       eofcheck := EOF(tstf)
  186. END;
  187.  
  188. {----------------------------------------------------------------------------}
  189.  
  190. BEGIN
  191.    IF ParamCount = 0 THEN
  192.       BEGIN
  193.          WRITELN('Usage:  head [-][ht][num] [path]filename');
  194.          HALT(2)
  195.       END;
  196.    len := 10;
  197.    top := TRUE;
  198.    negate := FALSE;
  199.    filename := '';
  200.    temp := ParamStr(1);
  201.    keybd := FALSE;
  202.    IF ParamCount = 1 THEN
  203.       BEGIN
  204.          keybd := TRUE;
  205.          IF (temp[1] = '-') AND (temp[2] IN [' ','h','t']) THEN
  206.             get_params(temp)
  207.          ELSE
  208.             IF (temp[1] IN ['h','t']) AND (temp[2] IN [' ','0'..'9'])
  209.                AND (LENGTH(temp) < 5) THEN
  210.                get_params(temp)
  211.             ELSE
  212.                BEGIN
  213.                   filename := temp;
  214.                   keybd := FALSE
  215.                END
  216.       END
  217.    ELSE
  218.       BEGIN
  219.          filename := ParamStr(2);
  220.          get_params(temp)
  221.       END;
  222.  
  223.    IF NOT keybd THEN
  224.       BEGIN
  225.          store_name(filename);
  226.          IF NOT check_filename(fname.filename) THEN
  227.             error_sys(2);
  228.  
  229.          {$I-} CHDIR(fname.path); {$I+}
  230.          IF IOresult <> 0 THEN
  231.             error_sys(3);
  232.  
  233.          ASSIGN(tstf,fname.filename);
  234.          {$I-} RESET(tstf); {$I+}
  235.          IF IOresult <> 0 THEN
  236.             error_sys(5)
  237.       END;
  238.    IF keybd THEN
  239.       RESET(input);
  240.  
  241.    IF (len * 270 > memavail) THEN
  242.       error_sys(6);
  243.  
  244.    done := FALSE;
  245.    NEW(head);
  246.    ptr := head;
  247.    count := 0;
  248.    hcount := 0;
  249.    WHILE NOT eofcheck AND NOT done DO BEGIN
  250.       count := count + 1;
  251.       IF keybd THEN
  252.          READLN(input,ptr^.lne)
  253.       ELSE
  254.          READLN(tstf,ptr^.lne);
  255.       ptr^.count := count;
  256.       IF top AND NOT negate THEN
  257.          IF (count <= len) THEN
  258.             IF count = len THEN
  259.                WRITE(ptr^.lne)
  260.             ELSE
  261.                WRITELN(ptr^.lne)
  262.          ELSE
  263.             done := TRUE;
  264.       IF top AND negate AND (count > len) THEN
  265.         IF eofcheck THEN
  266.             WRITE(ptr^.lne)
  267.          ELSE
  268.             WRITELN(ptr^.lne);
  269.  
  270.       IF NOT top THEN
  271.          IF hcount < len THEN
  272.             BEGIN
  273.                hcount := hcount + 1;
  274.                NEW(ptr^.ptr);
  275.                ptr := ptr^.ptr;
  276.             END
  277.          ELSE
  278.             BEGIN
  279.                ptr^.ptr := head;
  280.                ptr := head;
  281.                IF negate THEN
  282.                   IF eofcheck THEN
  283.                      WRITE(head^.lne)
  284.                   ELSE
  285.                      WRITELN(head^.lne);
  286.                ptr1 := head;
  287.                head := head^.ptr
  288.             END
  289.    END;
  290.    IF NOT top AND NOT negate THEN
  291.       WHILE hcount > 0 DO BEGIN
  292.          IF hcount > 1 THEN
  293.             WRITELN(head^.lne)
  294.          ELSE
  295.             WRITE(head^.lne);
  296.          ptr := head^.ptr;
  297.          DISPOSE(head);
  298.          head := ptr;
  299.          hcount := hcount - 1
  300.       END;
  301.    IF NOT keybd THEN
  302.       CLOSE(tstf)
  303. END.
  304.