home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / t / tm20.zip / TM.PAS < prev   
Pascal/Delphi Source File  |  1993-03-19  |  3KB  |  145 lines
  1.  
  2. (*
  3.  * tm - simple replacement for Norton's TM utility
  4.  * S.H.Smith, 29-jan-89; public domain material.
  5.  *
  6.  *)
  7.  
  8. {$m 2000,0,0}
  9. {$r-}
  10.  
  11. uses CRT,DOS;
  12.  
  13. procedure p2(c: char; n: integer);
  14. begin
  15.    write(c);
  16.    if n < 10 then
  17.       write('0');
  18.    write(n);
  19. end;
  20.  
  21. const
  22.    days: array[0..6] of string[3] = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
  23.  
  24. var
  25.    i:          integer;
  26.    par:        string;
  27.    msg:        string;
  28.    left:       boolean;
  29.    prompt:     boolean;
  30.    h,m,s,s100: word;
  31.    d,y,dw:     word;
  32.  
  33.    procedure prompt_for_message;
  34.    const
  35.       timeout = 3 * 182;   {30 seconds}
  36.    var
  37.       clock:   longint absolute 0:$46c;
  38.       start:   longint;
  39.       res:     string;
  40.       c:       char;
  41.       con:     text;
  42.    begin
  43.       while keypressed do
  44.          c := readkey;
  45.  
  46.       assign(con,'con');
  47.       rewrite(con);
  48.       res := '';
  49.       write(con,msg,'? ');
  50.       c := '?';
  51.  
  52.       start := clock;
  53.       repeat
  54.          if keypressed then
  55.          begin
  56.             c := readkey;
  57.             if c = ^H then
  58.             begin
  59.                if res <> '' then
  60.                begin
  61.                   dec(res[0]);
  62.                   write(con,^H' '^H);
  63.                end;
  64.             end
  65.             else
  66.             if c <> ^M then
  67.             begin
  68.                res := res + c;
  69.                write(con,c);
  70.             end;
  71.          end
  72.          else
  73.          if clock > start+timeout then
  74.          begin
  75.             res := res + '<unknown>';
  76.             c := ^M;
  77.          end;
  78.       until c = ^M;
  79.       msg := res;
  80.       writeln(con);
  81.       close(con);
  82.    end;
  83.  
  84. begin
  85.    if paramcount = 0 then
  86.    begin
  87.       writeln('TM 2.0, Samuel H. Smith, Public domain material.');
  88.       writeln('Usage: TM [/LOG] [/L] [/P] [''message''] [>outfile]');
  89.       halt(1);
  90.    end;
  91.  
  92.    left := false;
  93.    prompt := false;
  94.    msg := '';
  95.    for i := 1 to paramcount do
  96.    begin
  97.       par := paramstr(i);
  98.  
  99.       if par[1] = '/' then
  100.       begin
  101.          if (par = '/L') or (par = '/l') then
  102.             left := true
  103.          else
  104.          if (par = '/P') or (par = '/p') then
  105.             prompt := true;
  106.       end
  107.       else
  108.  
  109.       if (par = 'start') or (par = 'stop') or (par = 'report') or
  110.          (par = 'START') or (par = 'STOP') or (par = 'REPORT') then
  111.       else
  112.  
  113.       if (par[1] = '''') or (par[1] = '"') then
  114.          msg := par
  115.       else
  116.       if msg = '' then
  117.          msg := par
  118.       else
  119.          msg := msg + ' ' + par;
  120.   end;
  121.  
  122.  
  123.    if (msg[1] = '"') or (msg[1] = '''') then
  124.       msg := copy(msg,2,length(msg)-2);
  125.  
  126.    if prompt then
  127.       prompt_for_message;
  128.  
  129.    if left then
  130.       while length(msg) < 56 do
  131.          msg := msg + ' ';
  132.  
  133.    write(msg:56);
  134.  
  135.    GetTime(h,m,s,s100);
  136.    p2(' ',h); p2(':',m); p2(':',s);
  137.  
  138.    GetDate(y,m,d,dw);
  139.    write(', ',days[dw]);
  140.    p2(' ',m); p2('-',d); p2('-',y-1900);
  141.  
  142.    writeln;
  143. end.
  144.  
  145.