Отправка письма с вложением средствами Winsock API

← →
Klev (2004-05-30 16:09) [0]

Программа написана целиком на API. Надо отправить письмо с вложением. Использование MAPI нежелательно, поскольку создаваемая программа представляет собой нечто вроде почтового клиента.
Главное окно содержит список и edit. В список помещаются ответы SMTP сервера, а в edit - посланные строки.

Отправляемое письмо не доходит до адресата, хотя сервер и сообщает об успешной отправки почты.

Вот собственно, что отправлено:
HELO merlin.ru
MAIL FROM: Sender@mail.ru
RCPT TO: User@comail.ru
DATA
далее отправляется вложенный файл.

А вот ответы сервера:
220 mail.ru ESMTP Sun, 30 May 2004 15:48:38 +0400
250 mx1.mail.ru Helo www.mail.ru [xxx.xx.xx.xx]
250 OK
250 Accepted
354 Enter message, ending with "." on a line by itself
250 OK id=1B95Tz-1022GO-00
221 mx1.mail.ru closing connection

← →
Klev (2004-05-30 16:12) [1]

program MAIL;
{$R mail.RES}
uses
Windows,Messages,winsock, sysutils,base64unit;

var
wc:TwndClassex;
handle,list: Hwnd;
Msg: TMsg;
myadr:string="Smtp.mail.ru";
myusr:string="User@mail.ru";
header: string =
"From: "Sender" <sender@mail.ru>"+#13#10+
"To: "User" <User@mail.ru>"+#13#10+
"Subject: Windows must die!" + #13#10+
"X-Priority: 3"+ #13#10+
"X-MSMail-Priority: Normal"+ #13#10+
"X-Mailer: The OutГLюk express 5!"+ #13#10+
"Date: Sat, 9 Feb 2002 16:43:53 +0300"+ #13#10+
"Mime-Version: 1.0" + #13#10+
"Content-Type: multipart/mixed;" + #13#10+
"boundary="=_NextPart_41744410132625402663""+#13#10+ #13#10+
"This is a multipart MIME message." + #13#10+ #13#10+

"--=_NextPart_41744410132625402663" + #13#10+
"Content-Type: text/plain; charset="Windows-1251"" +#13#10+
"Content-Transfer-Encoding: 7bit" + #13#10+ #13#10+

"This is a sample message."+ #13#10+ #13#10+ #13#10+

"--=_NextPart_41744410132625402663" + #13#10+
"Content-Type: application/x-msdownload;"+ #13#10+
" name="filename.txt"" + #13#10+
"Content-Transfer-Encoding: base64"+ #13#10+
"Content-Disposition: attachment;"+ #13#10+
" filename="filename.txt""+#13#10+#13#10;

end_:string = "--=_NextPart_41744410132625402663--"+ #13#10 + #13#10;

function WriteFile_(hFile: THandle; Buffer:pointer; nNumberOfBytesToWrite: DWORD;
var lpNumberOfBytesWritten: DWORD; lpOverlapped: POverlapped): BOOL; stdcall; external kernel32 name "WriteFile";

procedure addtext(str:string);
var tmp1:string;
tmp:pchar;
begin
getmem(tmp,1024);
getwindowtext(getdlgitem(handle,102),tmp,1024);
//tmp:=getwndtext(getdlgitem(handle,102));
tmp1:=tmp;

tmp:=pchar(tmp1+str); //lstrcat(pchar(tmp),pchar(str))
setwindowtext(getdlgitem(handle,102),tmp);

end;

function EncodeBase64(const inStr: string ): string;

function Encode_Byte(b: Byte): char;
const
Base64Code: string[64] =
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
begin
Result := Base64Code[(b and $3F)+1];
end;

var
i: Integer;
begin
i := 1;
Result := "";
while i <=length(instr) do
begin
Result := Result + Encode_Byte(Byte(inStr[i]) shr 2);
Result := Result + Encode_Byte((Byte(inStr[i]) shl 4) or (Byte(inStr[i+1]) shr 4));
if i+1 <=Length(instr) then
Result := Result + Encode_Byte((Byte(inStr[i+1]) shl 2) or (Byte(inStr[i+2]) shr 6))
else
Result := Result + "=";
if i+2 <=Length(instr) then
Result := Result + Encode_Byte(Byte(inStr[i+2]))
else
Result := Result + "=";
Inc(i, 3);
end;
end;

function code:pointer;
Const
Base64MaxLength = 72;
Var
hFile,fs,f1:cardinal;
base64String:String;
Base64:TBase64;
Buf:Array[0..2] Of Byte;
buf1:pointer;

begin

base64String:="";
hFile:=CreateFile( pchar("c:\filename.txt"),GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);

fs:=getfilesize(hfile,nil);
buf1:=pointer(localalloc(LMEM_FIXED,fs+round(fs*0.5)));
zeromemory(buf1,fs+round(fs*0.5));
FillChar(Buf,SizeOf(Buf),#0);

Repeat
Base64.ByteCount:=FileRead(hFile,Buf,SizeOf(Buf));
Move(Buf,Base64.ByteArr,SizeOf(Buf));
base64String:=base64String+CodeBase64(Base64);
If Length(base64String)>=Base64MaxLength Then
Begin {If Length}

StrCopy(StrEnd(buf1),pchar(base64string) );

base64String:="";
End; {If Length}
Until Base64.ByteCount < 3;

StrCopy(StrEnd(buf1),pchar(base64string) );

FileClose(hFile);
f1:=filecreate("c:\test.txt");

writefile_(f1,buf1,strlen(buf1),fs,0);

fileclose(f1);
result:=buf1;
end;

function Mail: boolean;
type
TaPInAddr = array [0..255] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
pptr : PaPInAddr;
I ,sds: Integer;
adress:string;
s:TSocket;
WSAData:TWSAData;
ph:PHostEnt;
InAddr: TInAddr;
iaddr: integer;
addr:TSockAddrIn;
buf: array[0..255] of char;
s1:string;
pself:pointer;
sb:char;
label ex;
procedure sender(str:string);
var
i1:integer;
begin
for i1:=1 to Length(str) do
if send(s, str[i1] , 1, 0) = SOCKET_ERROR then exit;
end;

begin
ListBox_AddString(list,"Start!");
result:=false;
adress:= myadr;
if WSAStartUp(257, WSAData) <> 0 then Exit;

s := socket(AF_INET,SOCK_STREAM,IPPROTO_IP);

if s = INVALID_SOCKET then Exit;
ListBox_AddString(list,"Socketted!");
iaddr := inet_addr(PChar(adress));
ListBox_AddString(list,"Adress:"+adress);
if iaddr <=0 then
begin
ph := gethostbyname(PChar(adress));
if ph = nil then goto ex;
pptr := PaPInAddr(ph^.h_addr_list);
I := 0;
while pptr^[I] <> nil do
begin
InAddr:= pptr^[I]^;
inc(i);
addr.sin_addr:=inaddr;
// Коннектимся с серваком
addr.sin_family := AF_INET;
addr.sin_port := htons(25);
if (connect(s, addr,sizeof(addr))) =0 then break;
ListBox_AddString(list,"Connected!");
end;
end
else

begin
addr.sin_family := AF_INET;
addr.sin_port := htons(25);
addr.sin_addr.S_addr:=iaddr;
end;
if (connect(s, addr,sizeof(addr))) >0 then exit;

i:=recv(s,buf,sizeof(buf),0);
if (i = SOCKET_ERROR) then exit;
s1:=buf;
ListBox_AddString(list,s1);
if pos("220", s1) <=0 then exit;

fillchar(buf,255,0);
sender("HELO www.mail.ru"#13#10);
addtext("HELO www.mail.ru"#13#10);

i:=recv(s,buf,sizeof(buf),0);
if (i = SOCKET_ERROR) then goto ex;
s1:=buf;
ListBox_AddString(list,s1);
if pos("250", s1) <=0 then goto ex;

fillchar(buf,255,0);
sender("MAIL FROM: Sender@mail.ru"#13#10);
addtext("MAIL FROM: Sender@mail.ru"#13#10);

i:=recv(s,buf,sizeof(buf),0);
if (i = SOCKET_ERROR) then goto ex;
s1:=buf;
ListBox_AddString(list,s1);
if pos("250", s1) <=0 then goto ex;
adress:="RCPT TO: "+myusr+""+#13#10;
fillchar(buf,255,0);

sender(adress);
addtext(adress);

i:=recv(s,buf,sizeof(buf),0);
if (i = SOCKET_ERROR) then goto ex;
s1:=buf;
ListBox_AddString(list,s1);
if pos("25", s1) <=0 then goto ex;

fillchar(buf,255,0);
sender("DATA"#13#10);
addtext("DATA"#13#10);
i:=recv(s,buf,sizeof(buf),0);
if (i = SOCKET_ERROR) then goto ex;
s1:=buf;
ListBox_AddString(list,s1);

if pos("354", s1) <=0 then goto ex;
sender(header);
addtext(header);
pself:=code;

for sds:=0 to strlen(pself) do begin
copymemory(@sb,pointer(cardinal(pself)+sds),1);
sender(sb);
end;

sender(#13#10);
sender(end_);
addtext(end_);

fillchar(buf,255,0);
sender(#13#10"."#13#10);
if recv(s,buf,sizeof(buf),0) = SOCKET_ERROR then goto ex;
s1:=buf;
ListBox_AddString(list,s1);
if pos("250", s1) <=0 then goto ex;

sender("QUIT"#13#10);
if recv(s,buf,sizeof(buf),0) = SOCKET_ERROR then goto ex;
ListBox_AddString(list,buf);

result:=true;
ex: CloseSocket(s);
if result = true then
begin
ListBox_AddString(list,"Send - OK:"+myadr);
end else ListBox_AddString(list," Cant send mail:"+myadr);
localfree(cardinal(pself));
end;

← →
Klev (2004-05-30 16:13) [2]

Для кодирования файла используется юнит Base64Unit:

unit Base64Unit;

interface
Const
//base64 алфавит
base64ABC="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";

Type
TBase64 = Record //структура для работы с base64
ByteArr : Array [0..2] Of Byte;//массив из трех байтов
ByteCount:Byte; //количество считанных байт
End;

//кодируем base64
Function CodeBase64(Base64:TBase64):String;

implementation
//==============================CodeBase64======================================
//кодируем base64
Function CodeBase64(Base64:TBase64):String;
Var
N,M:Byte;
Dest, //результат - 6-ти битное число с base64-кодом
Sour:Byte; //исходное 8-ми битное число
NextNum:Byte;// флаг-счетчик для начала работы со следующим 6-ти битным числом
Temp:Byte; //вспомогательная переменная используется для проверки старшего байта
//8-ми битного исходного числа
Begin {CodeBase64}
//обнуляем результат
Result:="";
//инициализируем флаг - "следущее 6-ти битное число"
NextNum:=1;
//обнуляем 6-ти битный результат
Dest:=0;
//будем работать с массивом из трех байтов
For N:=0 To 2 Do
Begin {For N}
//берем очередной байт-источник
Sour:=Base64.ByteArr[N];
//пройдемся по всем 8-ми битам байта источника
For M:=0 To 7 Do
Begin {For M}
//будем работать не с самим байтом источником, а с его копией
Temp:=Sour;
//делаем побитный сдвиг влево для байта-источника и байта-приемника
Temp:=Temp SHL M;
Dest:=Dest SHL 1;
//если старший бит байта-источника равен 1
If (Temp And 128) = 128 Then
//в байте приемнике устанавливаем младший бит в 1
Dest:=Dest Or 1;
//увеличиваем счетчик перехода к следующему байту-приемнику
Inc(NextNum);
//если обработаны все 6 битов числа-приемника
If NextNum > 6 Then
Begin {If NextNum}
//заполняем результат функции, добавляя к нему символ из строки base64-алфавита
//с кодом на 1 больше, чем Dest (base64 коды начинаются с 0, а код первого
//символа строки base64-алфавита 1).
Result:=Result+base64ABC[Dest+1];
//обнуляем счетчик обработанных бит 6-ти битного числа-премника
NextNum:=1;
//обнуляем число-приемник
Dest:=0;
End; {If NextNum}
End; {For M}
End;{For N}
//добавим конечный знак = (равно)
//один знак, если обрабатываются два байта и два знака, если обрабатывается 1 байт
//не забываем, что кодированный стринг состоит из 4 символов
If Base64.ByteCount < 3 Then
For N:=0 To (2 - Base64.ByteCount) Do
Result[4-N]:="=";

End;
End.

← →
Erik1 (2004-05-31 11:27) [3]

Делать тебе нечего, возми Indy и отправляй Emal на SMNP сервер.

Отправка письма с вложением средствами Winsock API Найти похожие ветки