Solved

Send mail via winsock API ?

Posted on 2004-04-16
5
887 Views
Last Modified: 2010-04-16
I have a mx resolver unit that sends email with winsock API ,how can i adjust it to use a local Smtp server instead of resolving the host , i dont have any code on me, if i can do this will this give me a small email component
instead of using indy? please help..
0
Comment
Question by:delphcon5
  • 2
  • 2
5 Comments
 
LVL 11

Expert Comment

by:shaneholmes
Comment Utility
Unfortunately, we wont be able to help with out knowing exactly what unit (and from whom) you got this resolver from,  or without seeing the code.....

SHane
0
 
LVL 19

Accepted Solution

by:
Melih SARICA earned 250 total points
Comment Utility
Here is the Code that u want ..

Working Properly.. Im using it for some COM objects

unit SMTP_Connections;
// *********************************************************************
//         Unit Name                            : SMTP_Connections                              *
//      Author                  : Melih SARICA (Non ZERO)                        *
//      Date                  : 01/17/2004                              *
//**********************************************************************      
interface
uses
  classes,StdCtrls;
Const
 WinSock='wsock32.dll';
 Internet=2;
 Stream=1;
 fIoNbRead = $4004667F;
 WinSMTP        = $0001;
 LinuxSMTP      = $0002;

Type

  TWSAData = packed record
    wVersion: Word;
    wHighVersion: Word;
    szDescription: array[0..256] of Char;
    szSystemStatus: array[0..128] of Char;
    iMaxSockets: Word;
    iMaxUdpDg: Word;
    lpVendorInfo: PChar;
  end;
  PHost = ^THost;
  THost = packed record
    name     : PChar;
    aliases  : ^PChar;
    addrtype : Smallint;
    length   : Smallint;
    addr     : ^pointer;
  end;

  TSockAddr=packed record
   Family:word;
   Port:word;
   Addr:LongInt;
   Zeros:array[0..7] of byte;
  end;


Function WSAStartup(Version:word; Var Data:TwsaData):integer; stdcall; far; external winsock;
Function socket(Family,Kind,Protocol:integer):integer; stdcall; far; external winsock;
Function shutdown(Socket,How:Integer):integer; stdcall; far; external winsock;
Function closesocket(socket:Integer):integer; stdcall; far; external winsock;
Function WSACleanup:integer; stdcall; far; external winsock;
Function bind(Socket:Integer; Var SockAddr:TSockAddr; AddrLen:integer):integer; stdcall; far; external winsock;
Function listen(socket,flags:Integer):integer; stdcall; far; external winsock;
Function connect(socket:Integer; Var SockAddr:TSockAddr; AddrLen:integer):integer; stdcall; far; external winsock;
Function accept(socket:Integer; Var SockAddr:TSockAddr; Var AddrLen:Integer):integer; stdcall; far; external winsock;
Function WSAGetLastError:integer; stdcall; far; external winsock;
Function recv(socket:integer; data:pchar; datalen,flags:integer):integer; stdcall; far; external winsock;
Function send(socket:integer; var data; datalen,flags:integer):integer; stdcall; far; external winsock;
Function gethostbyname(HostName:PChar):PHost; stdcall; far; external winsock;
Function WSAIsBlocking:boolean; stdcall; far; external winsock;
Function WSACancelBlockingCall:integer; stdcall; far; external winsock;
Function ioctlsocket(socket:integer; cmd: Longint; var arg: longint): Integer; stdcall; far; external winsock;
Function gethostname(name:pchar; size:integer):integer; stdcall; far; external winsock;

Procedure _authSendMail(MailServer,uname,upass,mFrom,mFromName,mToName,Subject:string;mto,mbody:TStringList);
Function ConnectServer(mhost:string;mport:integer):integer;
Function ConnectServerwin(mhost:string;mport:integer):integer;
Function DisConnectServer:integer;
function Stat: string;
function SendCommand(Command: String): string;
function SendData(Command: String): string;
function SendCommandWin(Command: String): string;
function ReadCommand: string;
function encryptB64(s:string):string;


var
  mconnHandle           : integer;
  mFin,mFOut            : Textfile;
  EofSock               : boolean;
  mactive               : boolean;
  mSMTPErrCode          : integer;
  mSMTPErrText          : string;
  mMemo                 : Tmemo;

implementation
uses sysutils,sockets,IdBaseComponent,
  IdCoder, IdCoder3to4, IdCoderMIME,inifiles;
var
  mClient               : TTcpClient;

Procedure _authSendMail(MailServer,uname,upass,mFrom,mFromName,mToName,Subject:string;mto,mbody:TStringList);
var
  tmpstr        : string;
  cnt           : integer;
  mstrlist      : Tstrings;
  RecipientCount: integer;
begin
 if ConnectServerWin(Mailserver,25) = 250 then
    begin
      Sendcommandwin('AUTH LOGIN ');
      SendcommandWin(encryptB64(uname));
      SendcommandWin(encryptB64(upass));
      SendcommandWin('MAIL FROM: '+mfrom);
      for cnt:=0 to mto.Count -1 do
            SendcommandWin('RCPT TO: '+mto[cnt]);
      Sendcommandwin('DATA');
      SendData('Subject: '+Subject);
      SendData('From: "'+mFromName+'" <'+mfrom+'>');
      SendData('To: '+mToName);
      SendData('Mime-Version: 1.0');
      SendData('Content-Type: multipart/related; boundary="Esales-Order";');
      SendData('      type="text/html"');
      SendData('');
      SendData('--Esales-Order');
      SendData('Content-Type: text/html;');
      SendData('        charset="iso-8859-9"');
      SendData('Content-Transfer-Encoding: QUOTED-PRINTABLE');
      SendData('');
      for cnt := 0 to mbody.Count -1  do
        SendData(mbody[cnt]);
      Senddata('');
      SendData('--Esales-Order--');
      Senddata(' ');
      mSMTPErrText:=SendCommand(crlf+'.'+crlf);
      try
        mSMTPErrCode:=strtoint(copy(mSMTPErrText,1,3));
      except
      end;
      SendData('QUIT');
     DisConnectServer;
    end;

end;


function Stat: string;
var
  s : string;
begin
   s:=ReadCommand;
   result:=s;
end;

function EchoCommand(Command: String): string;
begin
  SendCommand(Command);
  Result:=ReadCommand;
end;

function ReadCommand: string;
var
  tmp :  string;
begin
  repeat
   ReadLn(mfin,tmp);
   if Assigned(mmemo) then
      mmemo.Lines.add(tmp);
   until (length(tmp)<4) or (tmp[4]<>'-');
   result:=tmp
end;
function SendData(Command: String): string;
begin
   Writeln(mfout,Command);
end;

function SendCommand(Command: String): string;
begin
   Writeln(mfout,Command);
   result:=stat;
end;

function SendCommandWin(Command: String): string;
begin
   Writeln(mfout,Command+#13);
   result:=stat;
end;

Function FillBlank(Source:string;number:integer):string;
var
  a: integer;
begin
 result:='';
 for a:=length(trim(source)) to number do
   result:=Result+' ';
End;

Function IpToLong(ip:string):LongInt;
 var
  x,i:byte;
  ipx:array[0..3] of byte;
  v:integer;
 begin
  Result:=0;
  longint(ipx):=0; i:=0;
  for x:=1 to length(ip) do
   if ip[x]='.' then begin
    inc(i);
    if i=4 then exit;
   end else begin
    if not (ip[x] in ['0'..'9']) then exit;
    v:=ipx[i]*10+ord(ip[x])-ord('0');
    if v>255 then exit;
    ipx[i]:=v;
   end;
  result:=longint(ipx);
 end;

Function HostToLong(AHost:string):LongInt;
 Var
  Host:PHost;
 begin
  Result:=IpToLong(AHost);
  if Result=0 then begin
   Host:=GetHostByName(PChar(AHost));
   if Host<>nil then Result:=longint(Host^.Addr^^);
  end;
 end;

Function LongToIp(Long:LongInt):string;
 var
  ipx:array[0..3] of byte;
  i:byte;
 begin
  longint(ipx):=long;
  Result:='';
  for i:=0 to 3 do result:=result+IntToStr(ipx[i])+'.';
  SetLength(Result,Length(Result)-1);
 end;

procedure Disconnect(Socket:integer);
 begin
  ShutDown(Socket,1);
  CloseSocket(Socket);
 end;

function CallServer(Server:string; Port:word):integer;
 var
  SockAddr:TSockAddr;
 begin
  Result:=socket(Internet,Stream,0);
  if Result=-1 then exit;
  FillChar(SockAddr,SizeOf(SockAddr),0);
  SockAddr.Family:=Internet;
  SockAddr.Port:=swap(Port);
  SockAddr.Addr:=HostToLong(Server);
  if Connect(Result,SockAddr,SizeOf(SockAddr))<>0 then begin
   Disconnect(Result);
   Result:=-1;
  end;
 end;

function OutputSock(Var F:TTextRec):integer; far;
 begin
  if F.BufPos<>0 then begin
   Send(F.Handle,F.BufPtr^,F.BufPos,0);
   F.BufPos:=0;
  end;
  Result:=0;
 end;

function InputSock(var F: TTextRec): Integer; far;
 Var
  Size:longint;
 begin
  F.BufEnd:=0;
  F.BufPos:=0;
  Result:=0;
  Repeat
   if (IoctlSocket(F.Handle, fIoNbRead, Size)<0) then begin
    EofSock:=True;
    exit;
   end;
  until (Size>=0);
  F.BufEnd:=Recv(F.Handle,F.BufPtr,F.BufSize,0);
  EofSock:=(F.Bufend=0);
 end;


function CloseSock(var F:TTextRec):integer; far;
 begin
  Disconnect(F.Handle);
  F.Handle:=-1;
  Result:=0;
 end;

function OpenSock(var F: TTextRec): Integer; far;
begin
  if F.Mode = fmInput then begin
    EofSock:=False;
    F.BufPos:=0;
    F.BufEnd:=0;
    F.InOutFunc := @InputSock;
    F.FlushFunc := nil;
  end else begin
    F.Mode := fmOutput;
    F.InOutFunc := @OutputSock;
    F.FlushFunc := @OutputSock;
  end;
  F.CloseFunc := @CloseSock;
  Result:=0;
end;
Procedure AssignCrtSock(Socket:integer; Var Input,Output:TextFile);
 begin
  with TTextRec(Input) do begin
    Handle := Socket;
    Mode := fmClosed;
    BufSize := SizeOf(Buffer);
    BufPtr := @Buffer;
    OpenFunc := @OpenSock;
  end;
  with TTextRec(Output) do begin
    Handle := Socket;
    Mode := fmClosed;
    BufSize := SizeOf(Buffer);
    BufPtr := @Buffer;
    OpenFunc := @OpenSock;
  end;
  Reset(Input);
  Rewrite(Output);
 end;

Function ConnectServer(mhost:string;mport:integer):integer;
var
  tmp : string;
begin
   mClient:=TTcpClient.Create(nil);
   mClient.RemoteHost:=mhost;
   mClient.RemotePort:=inttostr(mport);
   mClient.Connect;
   mconnhandle:=callserver(mhost,mport);
   if (mconnHandle<>-1) then
      begin
       AssignCrtSock(mconnHandle,mFin,MFout);
       tmp:=stat;
       tmp:=SendCommand('HELO bellona.com.tr');
       if copy(tmp,1,3) = '250' then
         begin
          result:=strtoint(copy(tmp,1,3)) ;
         end;
      end;
  end;

Function ConnectServerWin(mhost:string;mport:integer):integer;
var
  tmp : string;
begin
   mClient:=TTcpClient.Create(nil);
   mClient.RemoteHost:=mhost;
   mClient.RemotePort:=inttostr(mport);
   mClient.Connect;
   mconnhandle:=callserver(mhost,mport);
   if (mconnHandle<>-1) then
      begin
       AssignCrtSock(mconnHandle,mFin,MFout);
       tmp:=stat;
       tmp:=SendCommandWin('HELO bellona.com.tr');
       if copy(tmp,1,3) = '250' then
         begin
          result:=strtoint(copy(tmp,1,3)) ;
         end;
      end;
  end;

Function DisConnectServer:integer;
begin
   closesocket(mconnhandle);
   mClient.Disconnect;
   mclient.Free;
End;

function encryptB64(s:string):string;
var
   hash1 : TIdEncoderMIME ;
   p: string;
begin
  if s <> '' then
       begin
         hash1:=TIdEncoderMIME.Create(nil);
         p:=hash1.Encode(s);
         hash1.Free;
       end;
  Result:=p;
end;

end.
0
 

Author Comment

by:delphcon5
Comment Utility
sorry i had to find my code, this is the email unit,  can i config this to use a selected host,
if i dont recieve more input i will accept non_zero 's answer.

UNIT Email;

INTERFACE

USES
  Windows, MXResolver, WinSock, StrList;

TYPE
  TSMTPEngine = CLASS(TObject)
  PRIVATE
    Sock    : TSocket;
    FileBuf : AnsiString;
    FUNCTION MySend(STR:STRING) : Boolean;
    FUNCTION MyRecv(Code:STRING) : Boolean;
    FUNCTION NameToIP(HostName:STRING) : STRING;
    FUNCTION ExtractFileName(CONST FileName:ShortString) : ShortString;
  PUBLIC
    Recip, Body, From, Subject, Attachment : AnsiString;
    FUNCTION SendEmail : Boolean;
END;

PROCEDURE Base64Encode(CONST InBuffer;InSize:Cardinal;VAR OutBuffer); OVERLOAD; REGISTER;
PROCEDURE Base64Encode(CONST InText:AnsiString;VAR OutText:AnsiString); OVERLOAD;

IMPLEMENTATION

FUNCTION TSMTPEngine.NameToIP(HostName:STRING) : STRING;
TYPE
  TAPInAddr = ARRAY [0..100] OF PInAddr;
  PAPInAddr =^TAPInAddr;
VAR
  I          : Integer;
  WSAData    : TWSAData;
  HostEntPtr : PHostEnt;
  pptr       : PAPInAddr;
BEGIN
  Result:='';
  WSAStartUp($101,WSAData);
  TRY
    HostEntPtr:=GetHostByName(pChar(HostName));
    IF HostEntPtr<>NIL THEN BEGIN
      pptr:=PAPInAddr(HostEntPtr^.h_addr_list);
      I:=0;
      WHILE pptr^[I]<>NIL DO BEGIN
        Result:=(inet_ntoa(pptr^[I]^));
        Inc(I);
      END;
    END;
  EXCEPT
  END;
  WSACleanUp();
END;

PROCEDURE Base64Encode(CONST InBuffer;InSize:Cardinal;VAR OutBuffer); REGISTER;
CONST
  cBase64Codec : ARRAY [0..63] OF AnsiChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
VAR
  ByThrees : Cardinal;
  LeftOver : Cardinal;
  Line     : Word;
ASM
  mov ESI,[EAX]
  mov EDI,[ECX]
  mov EAX,EBX
  mov ECX,$03
  xor EDX,EDX
  div ECX
  mov ByThrees,EAX
  mov LeftOver,EDX
  lea ECX,cBase64Codec[0]
  xor EAX,EAX
  xor EBX,EBX
  xor EDX,EDX
  cmp ByThrees,0
  jz  @@LeftOver
  mov Line,0
  @@LoopStart:
  inc Line
  LODSW
  mov BL,AL
  shr BL,2
  mov DL,BYTE PTR [ECX+EBX]
  mov BH,AH
  and BH,$0F
  rol AX,4
  and AX,$3F
  mov DH,BYTE PTR [ECX+EAX]
  mov AX,DX
  STOSW
  LODSB
  mov BL,AL
  shr BX,6
  mov DL,BYTE PTR [ECX+EBX]
  and AL,$3F
  xor AH,AH
  mov DH,BYTE PTR [ECX+EAX]
  mov AX,DX
  STOSW
  cmp Line,19
  jnz @@ugor
  mov AX,$0A0D
  STOSW
  mov Line,0
  @@ugor:
  dec ByThrees
  jnz @@LoopStart
  @@LeftOver:
  cmp LeftOver, 0
  jz  @@Done
  xor EAX,EAX
  xor EBX,EBX
  xor EDX,EDX
  LODSB
  shl AX,6
  mov BL,AH
  mov DL,BYTE PTR [ECX+EBX]
  dec LeftOver
  jz  @@SaveOne
  shl AX,2
  and AH,$03
  LODSB
  shl AX,4
  mov BL,AH
  mov DH,BYTE PTR [ECX+EBX]
  shl EDX,16
  shr AL,2
  mov BL,AL
  mov DL,BYTE PTR [ECX+EBX]
  mov DH,'='
  jmp @@WriteLast4
  @@SaveOne:
  shr AL,2
  mov BL,AL
  mov DH,BYTE PTR [ECX+EBX]
  shl EDX,16
  mov DH,'='
  mov DL,'='
  @@WriteLast4:
  mov EAX,EDX
  ror EAX,16
  STOSD
  @@Done:
END;

PROCEDURE Base64Encode(CONST InText:AnsiString;VAR OutText:AnsiString); OVERLOAD;
VAR
  PIn     : Pointer;
  POut    : Pointer;
  InSize  : Cardinal;
  OutSize : Cardinal;
BEGIN
  InSize:=Length(InText);
  OutSize:=(InSize DIV 3) SHL 2;
  IF InSize MOD 3>0 THEN Inc(OutSize,4);
  Outsize:=Outsize+Outsize DIV 20;
  SetLength(OutText,OutSize);
  PIn:=@InText[1];
  POut:=@OutText[1];
  Base64Encode(PIn,InSize,POut);
END;

FUNCTION TSMTPEngine.MySend(STR:STRING) : Boolean;
BEGIN
  IF Send(Sock,STR[1],Length(STR),0)=SOCKET_ERROR THEN Result:=True ELSE Result:=False;
END;

FUNCTION TSMTPEngine.ExtractFileName(CONST FileName:ShortString) : ShortString;
VAR
  I : Integer;
BEGIN
  I:=Length(FileName);
  WHILE (I>=1)AND NOT(FileName[I] IN ['\', ':']) DO Dec(I);
  Result:=Copy(FileName,I+1,255);
END;

FUNCTION TSMTPEngine.MyRecv(Code:STRING) : Boolean;
VAR
  Buf : ARRAY [0..2048] OF Char;
BEGIN
  ZeroMemory(@Buf[0],SizeOf(Buf));
  IF(Recv(Sock,Buf,SizeOf(Buf),0)=SOCKET_ERROR)OR(Copy(Buf,1,3)<>Code) THEN Result:=False ELSE Result:=True;
  {$IFDEF Debug}
    Write(Buf);
  {$ENDIF}
END;

FUNCTION TSMTPEngine.SendEmail : Boolean;
VAR
  I          : Byte;
  F          : FILE;
  WSAData    : TWSAData;
  P          : AnsiString;  
  MXResolver : TMXResolver;
  SockAddrIn : TSockAddrIn;
BEGIN
  Result:=False;
  MXResolver:=TMXResolver.Create(Copy(Recip,Pos('@',Recip)+1,Length(Recip)));
  IF MXResolver.ListOfSMTPServers.Count=0 THEN Exit;
  FOR I:=0 TO MXResolver.ListOfSMTPServers.Count-1 DO BEGIN
    IF MXResolver.ListOfSMTPServers.Strings(I)<>'' THEN BEGIN
      {$IFDEF Debug}
        Writeln('Send mail:'#13#10);
      {$ENDIF}
      WSAStartUp(257,WSAData);
      Sock:=Socket(AF_INET,SOCK_STREAM,IPPROTO_IP);
      SockAddrIn.sin_family:=AF_INET;
      SockAddrIn.sin_port:=htons(25);
      SockAddrIn.sin_addr.S_addr:=inet_addr(pChar(NameToIP(MXResolver.ListOfSMTPServers.Strings(I))));
      Connect(Sock,SockAddrIn,SizeOf(SockAddrIn));
      IF NOT MyRecv('220') THEN Break;
      MySend('HELO net.com'#13#10);
      IF NOT MyRecv('250') THEN Break;
      MySend('MAIL FROM: <'+From+'>'#13#10);
      IF NOT MyRecv('250') THEN Break;
      MySend('RCPT TO: <'+Recip+'>'#13#10);
      IF NOT MyRecv('250') THEN Break;
      MySend('DATA'#13#10);
      IF NOT MyRecv('354') THEN Break;
      MySend('From: '+From+#13#10+
             'To: '+Recip+#13#10+
             'Subject: '+Subject+#13#10+
             'MIME-Version: 1.0'#13#10+
             'Content-Type: multipart/mixed; boundary="bla"'#13#10#13#10+
             '--bla'#13#10+
             'Content-Type: text/plain; charset:us-ascii'#13#10#13#10+
             Body+#13#10#13#10+
             '--bla'+#13#10+
             'Content-Type: application/x-shockwave-flash;'#13#10+
             '    name="'+ExtractFileName(Attachment)+'"'#13#10+
             'Content-Transfer-Encoding: base64'#13#10#13#10);
      AssignFile(F,Attachment);
      FileMode:=0;
      {$I-}
      Reset(F,1);
      IF IOResult=0 THEN BEGIN
        SetLength(FileBuf,FileSize(F));
        BlockRead(F,FileBuf[1],FileSize(F));
        Base64Encode(FileBuf,P);
        MySend(P);
        CloseFile(F);
      END;
      {$I+}
      MySend(#13#10'--bla--'#13#10'.'#13#10);
      IF NOT MyRecv('250') THEN Break;
      MySend('QUIT'#13#10);
      Result:=True;
      WSACleanup();
      Exit;
    END;
  END;
END;

END.

0
 
LVL 19

Expert Comment

by:Melih SARICA
Comment Utility
To use the SMTP server in ur local machine.. set the localhost as ur servername in the code...

Using the Local SMTP server, most important thing is  to set the correct parameters in ur SMTP server properties.. This wot u care about .. Normally, a local SMTP dont relay messages to the original SMTP server. U ave to select a relay server to send messages among the internet ..

In ur Scenerio, Wot is the exact problem u ave..

0
 

Author Comment

by:delphcon5
Comment Utility
nevermind i got it,
0

Featured Post

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Illustrator's Shape Builder tool will let you combine shapes visually and interactively. This video shows the Mac version, but the tool works the same way in Windows. To follow along with this video, you can draw your own shapes or download the file…
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now