home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 03 / tricks / code.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-11-29  |  2.1 KB  |  82 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     CODE.PAS                           *)
  3. (*    Routine zum Einlesen eines getakteten Codeworts     *)
  4. (*           und Demo für Turbo Pascal 3.0/4.0            *)
  5. (*         (c) 1989 Christian Ramsauer & TOOLBOX          *)
  6. (* ------------------------------------------------------ *)
  7. PROGRAM Code;
  8.  
  9. USES Crt, Dos;                          (* Turbo Viernull *)
  10.  
  11. CONST cl  = 10;
  12.       abw = 25;
  13.       cw : STRING[cl] = 'Teststring';
  14.       ct : ARRAY[2..cl] OF INTEGER =
  15.               (100, 100, 100, 100, 100, 100, 100, 100, 100);
  16.  
  17. VAR   i, t1, t2, t3 : INTEGER;
  18.       ch            : CHAR;
  19.       stop          : BOOLEAN;
  20.  
  21.   PROCEDURE CodePruefen;
  22.  
  23.     FUNCTION Time : INTEGER;            (* Turbo Viernull *)
  24.     VAR h, m, s, s100 : WORD;
  25.     BEGIN
  26.       GetTime(h, m, s, s100);
  27.       Time := s * 100 + s100;
  28.     END;
  29.  
  30. {   FUNCTION Time : INTEGER;                (* Turbo Drei *)
  31.     VAR regs : RECORD
  32.                  ax,bx,cx,dx,bp,si,di,ds,es,flags : INTEGER;
  33.                END;
  34.     BEGIN
  35.       regs.ax := $2C00;
  36.       MsDos(regs);
  37.       Time := Hi(regs.dx) * 100 + Lo(regs.dx);
  38.     END;
  39.  
  40.     FUNCTION ReadKey : CHAR;
  41.     VAR ch : CHAR;
  42.     BEGIN
  43.       Read(Kbd, ch);
  44.       ReadKey := ch);
  45.     END;
  46. }
  47.  
  48.   BEGIN
  49.     stop := TRUE;
  50.     REPEAT UNTIL KeyPressed;
  51.     i := 1;
  52.     ch := ReadKey;
  53.     IF ch = cw[i] THEN stop := FALSE;
  54.     WHILE (i < cl) AND (ch <> #13) DO BEGIN
  55.       i  := i + 1;
  56.       t1 := Time;
  57.       ch := ReadKey;
  58.       t2 := Time;
  59.       t3 := t2 - t1;
  60.       IF t3 < 0 THEN t3 := 6000 - t3;
  61.       IF (t3 > ct[i] + abw) OR (t3 < ct[i] - abw) OR
  62.          (ch <> cw[i]) THEN stop := TRUE;
  63.     END;
  64.     REPEAT
  65.       ch := ReadKey;
  66.     UNTIL ch = #13;
  67.     IF stop THEN BEGIN
  68.       WriteLn('Falscher Code!', #7);
  69.       Delay(1000);
  70.       HALT;
  71.     END;
  72.     WriteLn('Code ist richtig eingegeben worden...');
  73.   END;
  74.  
  75. BEGIN
  76.   CodePruefen;
  77.   REPEAT UNTIL KeyPressed;
  78. END.
  79.  
  80. (* ------------------------------------------------------ *)
  81. (*                   Ende von CODE.PAS                    *)
  82.