home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / secure / selftest / selftest.u < prev    next >
Encoding:
Text File  |  1990-08-04  |  2.4 KB  |  85 lines
  1. {$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
  2. {$M 2048,0,6000}
  3.  
  4. UNIT selftest;
  5.  
  6. INTERFACE
  7.  
  8. IMPLEMENTATION
  9.  
  10. TYPE  tbuf = ARRAY [1..4096] OF BYTE;
  11. VAR   crc: WORD;
  12.       buf: ^tbuf;
  13.       f:   file;
  14.  
  15. {$F+}
  16. PROCEDURE makecrc (xx: WORD); EXTERNAL;
  17.   {$L crc.obj}
  18. {$F-}
  19.  
  20. PROCEDURE patchtest;
  21.   VAR s, s1:        ARRAY [1..5] OF CHAR;
  22.       x, comp:      STRING [7];
  23.       soll, ist, n: WORD;
  24.       patchadr:     LONGINT;
  25.  
  26.   PROCEDURE error (n: BYTE);
  27.     BEGIN
  28.       CASE n OF
  29.         1: WRITE ('Programm Read-Only !, ');
  30.         2: WRITE ('Da stimmt was nicht !.......', #8#8#8#8#8#8#8,', ');
  31.         3: WRITE ('Prüfsummenfehler, ');
  32.         4: WRITE ('nanu, patch not found ???, ');
  33.         5: WRITE ('Selbstkonfiguration abgeschlossen, ')
  34.         ELSE WRITE ('Unbekannter Fehler, nanu ???, ')
  35.       END;
  36.       WRITELN ('Ausführung abgebrochen.');
  37.       CLOSE (f);
  38.       HALT (128)
  39.     END;
  40.  
  41.   FUNCTION checksum: WORD;
  42.     VAR n: WORD;
  43.     BEGIN
  44.       NEW (buf); SEEK (f, 0); crc:= 8;
  45.       REPEAT BLOCKREAD (f, buf^, 4096, n); makecrc (n) UNTIL (n <> 4096);
  46.       checksum:= crc
  47.     END;
  48.  
  49.   PROCEDURE configure;
  50.     VAR  r:    INTEGER;
  51.          s1:   ARRAY [1..7] OF CHAR;
  52.          s2:   ARRAY [1..11] OF CHAR;
  53.          n, m: LONGINT;
  54.          x:    STRING;
  55.     BEGIN
  56.       n:= 0; REPEAT INC (n); SEEK (f, n); BLOCKREAD (f, s1, 7, r)
  57.       UNTIL ((s1 = comp) OR (n > FILESIZE (f) - 7));
  58.       IF (n > FILESIZE (f) - 7) THEN error (4);
  59.       m:= 0; REPEAT INC (m); SEEK (f, m); BLOCKREAD (f, s2, 11, r)
  60.       UNTIL ((s2 = 'was nicht !') OR (m > FILESIZE (f) - 11));
  61.       IF (m > FILESIZE (f) - 11) THEN error (4);
  62.       m:= m + 11; STR (m:7, x); FOR r:= 1 TO 7 DO s1 [r]:= x [r];
  63.       SEEK (f, n); BLOCKWRITE (f, s1, 7, r);
  64.       ist:= checksum; STR (ist:5, x); FOR r:= 1 TO 5 DO s1 [r]:= x [r];
  65.       SEEK (f, m); BLOCKWRITE (f, s1, 5, r);
  66.       error (5)
  67.     END;
  68.  
  69.   BEGIN
  70.     RESET (f, 1); IF (IORESULT <> 0) THEN error (1);
  71.     comp:= UPCASE ('c') + 'defgah'; x:= 'Cdefgah';
  72.     IF (x = comp) THEN configure;
  73.     VAL (x, patchadr, n); IF (n <> 0) THEN error (2);
  74.     SEEK (f, patchadr); BLOCKREAD (f, s, 5, n);
  75.     s1:= '.....';
  76.     SEEK (f, patchadr); BLOCKWRITE (f, s1, 5, n);
  77.     ist:= CHECKSUM;
  78.     SEEK (f, patchadr); BLOCKWRITE (f, s, 5, n);
  79.     VAL (s, soll, n); IF (n <> 0) THEN error (2);
  80.     If (soll <> ist) THEN error (3);
  81.     CLOSE (f)
  82.   END;
  83.  
  84. BEGIN ASSIGN (f, paramstr (0)); patchtest END.
  85.