home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 05 / titel / stontest.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1990-02-09  |  3.6 KB  |  142 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    STONTEST.PAS                        *)
  3. (*  Checkt das angegebene Laufwerk auf den Stoned-Virus   *)
  4. (*  Mögliche Laufwerke : A..C, C: wird als Festplatte     *)
  5. (*  angenommen.                                           *)
  6. (*  Aufruf : STONTEST <Laufwerk:>                         *)
  7. (*           (c) 1990  W.Rinke  &  TOOLBOX                *)
  8. (* ------------------------------------------------------ *)
  9. PROGRAM StonedTest;
  10.  
  11. USES Dos, Crt;
  12.  
  13. CONST
  14.   Log  : STRING = 'PARTCODE.LOG';
  15.   Look : STRING = 'Stoned';
  16.  
  17. TYPE
  18.   BufType = ARRAY [1..512] OF CHAR;
  19.  
  20. VAR
  21.   Regs   : Registers;
  22.   Buffer : BufType;
  23.   i      : INTEGER;
  24.   ID, dv : STRING;
  25.   f      : TEXT;
  26.   fopen  : BOOLEAN;
  27.  
  28.   PROCEDURE RdSec(Sec, Drv : INTEGER; VAR Buf : BufType);
  29.   BEGIN
  30.     Regs.ah := 2;
  31.     Regs.al := 1;                     { einen Sektor lesen }
  32.     Regs.dh := 0;                     { Seite              }
  33.     Regs.ch := 0;                     { Zylinder           }
  34.     Regs.cl := Sec;                   { Sektor             }
  35.     Regs.dl := Drv;                   { Laufwerk           }
  36.     Regs.es := Seg(Buf);
  37.     Regs.bx := Ofs(Buf);
  38.     Intr($13, Regs);
  39.   END;
  40.  
  41.   FUNCTION Ja : BOOLEAN;
  42.   VAR
  43.     ch : CHAR;
  44.   BEGIN
  45.     ch := ReadKey;
  46.     IF UpCase(ch) = 'J' THEN
  47.       Ja := TRUE
  48.     ELSE
  49.       Ja := FALSE;
  50.   END;
  51.  
  52.   FUNCTION OpenLogFile : BOOLEAN;
  53.   VAR
  54.     ch : CHAR;
  55.   BEGIN
  56.     OpenLogFile := TRUE;
  57.     Assign(f, Log);
  58.     {$I-}
  59.     Reset(f);
  60.     {$I+}
  61.     IF IOResult = 0 THEN BEGIN
  62.       Write('Logdatei existiert bereits. ');
  63.       WriteLn('Überschreiben [J/N] ? ');
  64.       IF Ja THEN
  65.         Rewrite(f)
  66.       ELSE
  67.         OpenLogFile := FALSE;
  68.     END ELSE
  69.       Rewrite(f);
  70.   END;
  71.  
  72.   FUNCTION GetCurrDrive : INTEGER;
  73.   BEGIN
  74.     Regs.ah := $19;
  75.     MsDos(Regs);
  76.     GetCurrDrive := Regs.al;
  77.   END;
  78.  
  79.   FUNCTION DriveSpec(VAR Drive : STRING) : INTEGER;
  80.   VAR
  81.     dummy : INTEGER;
  82.     mb    : BYTE;
  83.   BEGIN
  84.     CASE ParamCount OF
  85.       0 : BEGIN                        { Standard-Laufwerk }
  86.             mb := 0;
  87.             dummy := GetCurrDrive;
  88.             Drive := Chr(dummy + 65) + ':';
  89.             IF dummy = 2 THEN
  90.               DriveSpec := $80;               { Festplatte }
  91.           END;
  92.       1 : BEGIN
  93.             Drive := ParamStr(1);
  94.             IF (Drive = 'a:') OR (Drive = 'A:') THEN
  95.               DriveSpec := 0
  96.             ELSE
  97.               IF (Drive = 'b:') OR (Drive = 'B:') THEN
  98.                 DriveSpec := 1
  99.               ELSE
  100.                 IF (Drive = 'c:') OR (Drive = 'C:') THEN
  101.                   DriveSpec := $80
  102.                 ELSE BEGIN
  103.                   WriteLn('Ungültige Laufwerksangabe');
  104.                   Close(f);
  105.                   Halt;
  106.                 END;
  107.           END;
  108.     ELSE
  109.       WriteLn('Ungültige Anzahl von Parametern');
  110.       Close(f);
  111.       Halt;
  112.     END;
  113.   END;
  114.  
  115.   PROCEDURE Alarm;
  116.   VAR
  117.     i : INTEGER;
  118.   BEGIN
  119.     FOR i := 1 TO 3 DO BEGIN
  120.       Sound(2000); Delay(200); NoSound; Delay(400);
  121.     END;
  122.   END;
  123.  
  124. BEGIN
  125.   ID := '';  dv := '';
  126.   fopen := OpenLogFile;
  127.   RdSec(1, DriveSpec(dv), Buffer);
  128.   FOR i := 1 TO 512 DO BEGIN
  129.     IF fopen THEN Write(f, Buffer[i]);
  130.     IF Buffer[i] > #64 THEN
  131.       IF Buffer [i] < #123 THEN
  132.         ID := ID + Buffer[i];
  133.   END;
  134.   Close(f);
  135.   IF Pos(Look, ID) <> 0 THEN BEGIN
  136.     Alarm;
  137.     Write('Laufwerk ', dv);
  138.     WriteLn(' ist infiziert (Stoned-Virus)!');
  139.   END;
  140. END.
  141. (* ------------------------------------------------------ *)
  142. (*               Ende von STONTEST.PAS                    *)