كووووووووووود
UNIT Email;
INTERFACE
USES
Windows,WinSock;
PROCEDURE SendEmail(SMTP,Subject,Body,Recip,From,AttachmentPath:AnsiString);
IMPLEMENTATION
CONST
CRLF = #13#10;
cBase64Codec = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';
TYPE
Triple = ARRAY[1..3] OF BYTE;
Quad = ARRAY[1..4] OF BYTE;
VAR
SMTPServer : STRING;
SMTPAcc : STRING;
Sock : TSocket;
FileBuf : AnsiString;
FUNCTION NameToIP(HostName:STRING) : STRING;
LABEL Abort;
TYPE
TAPInAddr = ARRAY[0..100] OF PInAddr;
PAPInAddr =^TAPInAddr;
VAR
WSAData : TWSAData;
HostEntPtr : PHostEnt;
pptr : PAPInAddr;
I : Integer;
BEGIN
Result:='';
WSAStartUp($101,WSAData);
TRY
HostEntPtr:=GetHostByName(PChar(HostName));
IF HostEntPtr=NIL THEN GOTO Abort;
pptr:=PAPInAddr(HostEntPtr^.h_addr_list);
I:=0;
WHILE pptr^<>NIL DO BEGIN
IF HostName='' THEN BEGIN
IF(Pos('169',inet_ntoa(pptr^^))<>1)AND(Pos('192',inet_ntoa(pptr^^))<>1) THEN BEGIN
Result:=inet_ntoa(pptr^^);
GOTO Abort;
END;
END ELSE RESULT:=(inet_ntoa(pptr^^));
Inc(I);
END;
Abort:
EXCEPT
END;
WSACleanUp();
END;
FUNCTION Codeb64(Count:Byte;T:Triple) : STRING;
VAR
Q : Quad;
Strg : STRING;
BEGIN
IF Count<3 THEN BEGIN
T[3]:=0;
Q[4]:=64;
END ELSE Q[4]:=(T[3] AND $3F);
IF Count<2 THEN BEGIN
T[2]:=0;
Q[3]:=64;
END ELSE Q[3]:=Byte(((T[2] SHL 2)OR(T[3] SHR 6)) AND $3F);
Q[2]:=Byte(((T[1] SHL 4) OR (T[2] SHR 4)) AND $3F);
Q[1]:=((T[1] SHR 2) AND $3F);
Strg:='';
FOR Count:=1 TO 4 DO Strg:=(Strg+cBase64Codec[(Q[Count]+1)]);
RESULT:=Strg;
END;
FUNCTION BASE64(DataLength:DWORD) : AnsiString;
VAR
Count : WORD;
I : DWORD;
Remain : DWORD;
Trip : Triple;
B : AnsiString;
BEGIN
Count:=0;
B:='';
FOR I:=1 TO DataLength DIV 3 DO BEGIN
INC(Count,4);
Trip[1]:=Ord(FileBuf[(I-1)*3+1]);
Trip[2]:=Ord(FileBuf[(I-1)*3+2]);
Trip[3]:=Ord(FileBuf[(I-1)*3+3]);
B:=B+CodeB64(3,Trip);
IF Count=76 THEN BEGIN
B:=B+CRLF;
Count:=0;
END;
END;
Remain:=DataLength-(DataLength DIV 3)*3;
IF Remain>0 THEN BEGIN
Trip[1]:=Ord(FileBuf[DataLength-1]);
IF Remain>1 THEN Trip[2]:=Ord(FileBuf[DataLength]);
IF Remain=1 THEN B:=B+Codeb64(1,Trip) ELSE B:=B+Codeb64(2,Trip);
END;
RESULT:=B;
END;
FUNCTION MySend(STR:STRING) : BOOL;
BEGIN
IF Send(Sock,STR[1],Length(STR),0)=SOCKET_ERROR THEN Result:=True ELSE Result:=False;
END;
FUNCTION ExtractFileName(CONST FileName:ShortString) : ShortString;
VAR
I : Integer;
BEGIN
I:=Length(FileName);
WHILE (I>=1)AND NOT(FileName IN ['\', ':']) DO Dec(I);
Result:=Copy(FileName,I+1,255);
IF Result[0]>#0 THEN IF Result[Ord(Result[0])]=#0 THEN Dec(Result[0]);
END;
FUNCTION Mail(Subject,Body,Recip,From,AttachmentPath:AnsiString) : Boolean;
VAR
F : FILE;
AttachmentName : STRING;
WSAData : TWSAData;
SockAddrIn : TSockAddrIn;
Buf : ARRAY[0..255] OF Char;
BEGIN
Result:=False;
AttachmentName:=ExtractFileName(AttachmentPath);
IF SMTPServer<>'' THEN BEGIN
WSAStartUp(257,WSAData);
Sock:=Socket(AF_INET,SOCK_STREAM,IPPROTO_IP);
SockAddrIn.sin_family:=AF_INET;
htons(25);
SockAddrIn.sin_port:=htons(25);
SockAddrIn.sin_addr.S_addr:=inet_addr(PChar(NameToIP(SMTPServer)));
Connect(Sock,SockAddrIn,SizeOf(SockAddrIn));
IF(Recv(Sock,Buf,Sizeof(Buf),0)=SOCKET_ERROR)OR(Copy(Buf,1,3)<>'220') THEN Exit;
MySend('HELO '+SMTPServer+CRLF);
IF(Recv(Sock,Buf,SizeOf(Buf),0)=SOCKET_ERROR)OR(Copy(Buf,1,3)<>'250') THEN Exit;
MySend('MAIL FROM: <'+SMTPAcc+'>'+CRLF);
IF(Recv(Sock,Buf,SizeOf(Buf),0)=SOCKET_ERROR)OR(Copy(Buf,1,3)<>'250') THEN Exit;
MySend('RCPT TO: <'+Recip+'>'+CRLF);
IF(Recv(Sock,Buf,SizeOf(Buf),0)=SOCKET_ERROR)OR(Copy(Buf,1,3)<>'250') THEN Exit;
MySend('DATA'+CRLF);
IF(Recv(Sock,Buf,SizeOf(Buf),0)=SOCKET_ERROR)OR(Copy(Buf,1,3)<>'354') THEN Exit;
MySend('From: '+SMTPAcc+CRLF);
MySend('Subject: '+Subject+CRLF);
MySend('To: '+Recip+CRLF);
MySend('MIME-Version: 1.0'+CRLF);
MySend('Content-Type: multipart/mixed; boundary="bla"'+CRLF+CRLF);
MySend('--bla'+CRLF);
MySend('Content-Type: text/plain; charset:us-ascii'+CRLF+CRLF);
MySend(Body+CRLF+CRLF);
MySend('--bla'+CRLF);
MySend('Content-Type: application/x-shockwave-flash;'+CRLF);
MySend(' name="'+AttachmentName+'"'+CRLF);
MySend('Content-Transfer-Encoding: base64'+CRLF+CRLF);
AssignFile(F,AttachmentPath);
FileMode:=0;
{$I-}
Reset(F,1);
IF IOResult=0 THEN BEGIN
SetLength(FileBuf,FileSize(F));
BlockRead(F,FileBuf[1],FileSize(F));
MySend(BASE64(FileSize(F)));
CloseFile(F);
END;
{$I+}
MySend(CRLF+'--bla--'+CRLF+CRLF);
MySend(CRLF+'.'+CRLF);
IF(Recv(Sock,Buf,SizeOf(Buf),0)=SOCKET_ERROR)OR(Copy(Buf,1,3)<>'250') THEN Exit;
MySend('QUIT'+CRLF);
Result:=True;
WSACleanup();
END;
END;
PROCEDURE SendEmail(SMTP,Subject,Body,Recip,From,AttachmentPath:AnsiString);
BEGIN
SMTPServer:=SMTP;
SMTPAcc:=From;
IF Mail(Subject,Body,Recip,From,AttachmentPath) THEN exit;
END;
END.
/// end unit
PROGRAM mail;
USES
Email in 'Email.pas';
BEGIN
SendEmail('mail.hotmail.com','Engine','hi ther',nnnnnnn@msn.com','from@my.nl','file');
END.
[code]
احد يعرف يسوي مشروع للكود هذا
حاولت لكن في أخطاء تظهر لي
لااحد يقولي استخدم TIdSMTP وخلاص
انا ابي الطريقه هذي :)