Отправка почты на API

 
 
function _RegReadString(_hkey:longint;const ValueName:string; var Value:string;const SubKey:string):Boolean;
var Key:HKey; BufLen,Typed:DWord;
begin
 Result:=False; Value:=EmptyStr;
 if RegOpenKeyEx(_hkey,pchar(subkey),0,KEY_READ,Key)=ERROR_SUCCESS then
  begin
   Typed:=REG_SZ;
   BufLen:=$FFFF; SetLength(Value,BufLen);
   if RegQueryValueEx(Key,PChar(ValueName),
     nil,@Typed,@Value[1],@BufLen)=ERROR_SUCCESS then
    begin
     if BufLen>0 then SetLength(Value,BufLen-1) else Value:=EmptyStr;
     Result:=True;
    end;
   RegCloseKey(Key);
  end;
end;
 
function _HostToIP(Name: string):string;
var  
 wsdata : TWSAData;
  hostName : array [0..255] of char;  
 hostEnt : PHostEnt;  
 addr : PChar;  
begin  
 WSAStartup ($0101, wsdata);  
 gethostname (hostName, sizeof (hostName));  
 StrPCopy(hostName, Name);  
 hostEnt := gethostbyname (hostName);  
 if Assigned (hostEnt) then  
   if Assigned (hostEnt^.h_addr_list) then  
     begin  
     addr := hostEnt^.h_addr_list^;  
 if Assigned (addr) then  
 begin  
 Result := Format ('%d.%d.%d.%d', [byte (addr [0]),  
 byte (addr [1]), byte (addr [2]), byte (addr [3])]);  
 end;
 end;  
   WSACleanup;  
end;
 
function GetSMTPServer:string;
var s,j:string;
begin
result := '';
_regreadstring(hkey_current_user,'Default Mail Account',s,'Software\Microsoft\Internet Account Manager');
if s = '' then exit;
_regreadstring(hkey_current_user,'SMTP Server',j,'Software\Microsoft\Internet Account Manager\Accounts\' + s);
result := j;
end;
 
procedure SendStr(Sock:cardinal;str: String);
var
  I: Integer;
begin
  for I:=1 to Length(str) do
  if send(sock,str[I],1,0)=SOCKET_ERROR then exit;
end;
 
procedure ConnectAndSend(from,_to,st:string);
var
  wsadata:  TWSADATA;
  sin: TSockAddrIn;
  sock: TSocket;
  MySmtp : String;
  iaddr: Integer;
  buf: array[0..255] of char;
begin
MySmtp := _HostToIP(getsmtpserver);
WSAStartUp(257, wsadata);
sock:=socket(AF_INET,SOCK_STREAM,IPPROTO_IP);
sin.sin_family := AF_INET;
htons(25);
sin.sin_port := htons(25);
iaddr:=inet_addr(PChar(MySmtp));
sin.sin_addr.S_addr:=iaddr;
connect(sock,sin,sizeof(sin));
recv(sock,buf,sizeof(buf),0);
sendstr(sock,'HELO google.com'+#13#10);
recv(sock,buf,sizeof(buf),0);
sendstr(sock,'MAIL FROM: '+from+#13#10);
recv(sock,buf,sizeof(buf),0);
sendstr(sock,'RCPT TO: '+_to+#13#10);
recv(sock,buf,sizeof(buf),0);
sendstr(sock,'DATA'+#13#10);
recv(sock,buf,sizeof(buf),0);
sendstr(sock,st);
sendstr(sock,#13#10'.'#13#10);
recv(sock,buf,sizeof(buf),0);
sendstr(sock,'QUIT'#13#10);
recv(sock,buf,sizeof(buf),0);
closesocket(sock);
end;

По идее этот код должен отправлять почту через SMTP сервер по умолчанию.
Но он НЕ ДЕЛАЕТ этого, т.е. он пересылает данные на сервак, но письмо НЕ ОТПРАВЛЯЕТСЯ.

Если кто знает в чем дело, подскажите пожалуйста.

Добавлено 24.09.04, 14:35
Сорри, все работает, просто на mail.tula.net стоит какой-то тупой антивирь, и не пропускает почти никакие вложения (zip архив с текстом внутри).

А процедурой перевода вложенного файла в текст письма не подулишся/алгоритмом.???

M

Тема перенесена из Delphi -> Delphi: Система, Windows API