home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9303 / pastrick / protokol.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-02  |  1.8 KB  |  89 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     PROTOKOL.PAS                       *)
  3. (*             (c) 1993 Thomas Mertens & DMV              *)
  4. (* ------------------------------------------------------ *)
  5. {$M 4096,0,0}
  6. {$I-}
  7. PROGRAM Protokoll;
  8.  
  9. USES Dos, Crt;
  10.  
  11. CONST
  12.   pa = 'PRT EIN um ';
  13.   pd = 'PRT AUS um ';
  14.   pf = 'C:\DOS\MYPRT.PRT';
  15.   pw = 'EXIT';
  16.  
  17. VAR
  18.   p, b : STRING;
  19.   ep   : BOOLEAN;
  20.  
  21.   PROCEDURE Sz(Ausgabe : STRING);
  22.   VAR
  23.     f : Text;
  24.   BEGIN
  25.     Assign(f, pf);
  26.     Append(f);
  27.     IF IOResult <> 0 THEN
  28.       Rewrite(f);
  29.     WriteLn(f, Ausgabe);
  30.     Close(f);
  31.   END;
  32.  
  33.   FUNCTION Up(a : STRING) : STRING;
  34.   VAR
  35.     z : BYTE;
  36.   BEGIN
  37.     FOR z := 1 TO Length(a) DO
  38.       a[z] := UpCase(a[z]);
  39.     Up := a;
  40.   END;
  41.  
  42.   FUNCTION d2s : STRING;
  43.   VAR
  44.     h, m, s : WORD;
  45.     dt_buf  : STRING;
  46.  
  47.     FUNCTION w2s(a : WORD) : STRING;
  48.     VAR
  49.       bf : STRING;
  50.     BEGIN
  51.       Str(a, bf);
  52.       IF Length(bf) = 1 THEN bf := '0' + bf;
  53.       w2s := bf;
  54.     END;
  55.  
  56.   BEGIN
  57.     GetTime(h, m, s, s);
  58.     dt_buf := w2s(h) + ':';
  59.     dt_buf := dt_buf + w2s(m) + ' am ';
  60.     GetDate(h, m, s, s);
  61.     dt_buf := dt_buf + w2s(s) + '.';
  62.     dt_buf := dt_buf + w2s(m) + '.';
  63.     d2s := dt_buf;
  64.   END;
  65.  
  66. BEGIN
  67.   CheckBreak := FALSE;
  68.   ep         := FALSE;
  69.   sz(pa + d2s);
  70.   REPEAT
  71.     GetDir(0, p);
  72.     WriteLn(p); Write('>');
  73.     ReadLn(b);
  74.     IF up(b) = up(pw) THEN BEGIN
  75.       b  := pd + d2s;
  76.       ep := TRUE;
  77.     END;
  78.     IF b <> '' THEN sz(b);
  79.     IF ep THEN Halt(0);
  80.     SwapVectors;
  81.     Exec(GetEnv('COMSPEC'), '/C' + b);
  82.     SwapVectors;
  83.     WriteLn;
  84.   UNTIL FALSE;
  85. END.
  86. (* ------------------------------------------------------ *)
  87. (*                Ende von PROTOKOL.PAS                   *)
  88.  
  89.