dxsmtprelay.pas

Well known and usefull component for delphi 7

                  SMTPRelaySessionThread^.DXSMTPSender.DisconnectFromSMTPServer;
                  if Assigned(fCleanOutBoundQueue) then
                     fCleanOutBoundQueue(RecordKey);
               end
               else begin
                  if Assigned(fSessionMessage) then begin
                     fSessionMessage(MailServer[LastMailServerTried],
                        MessageInfo,
                        SMTPRelaySessionThread^.DXSMTPSender.LastSenderMessage);
                     ProcessWindowsMessageQueue;
                  end;
                  SMTPRelaySessionThread^.DXSMTPSender.DisconnectFromSMTPServer;
                  Inc(LastMailServertried);
                  Inc(SessionErrors);
               end;
            end// rcpt
            else begin
               if Assigned(fSessionMessage) then begin
                  fSessionMessage(MailServer[LastMailServerTried],
                     MessageInfo,
                     SMTPRelaySessionThread^.DXSMTPSender.LastSenderMessage);
                  ProcessWindowsMessageQueue;
               end;
               Inc(SessionErrors);
            end;
         end// mailfrom
         else begin
            if Assigned(fSessionMessage) then begin
               fSessionMessage(MailServer[LastMailServerTried], MessageInfo,
                  SMTPRelaySessionThread^.DXSMTPSender.LastSenderMessage);
               ProcessWindowsMessageQueue;
            end;
            Inc(SessionErrors);
         end;
      end// connect
      else begin
         if Assigned(fConnectFailed) then begin
            fConnectFailed(MailServer[LastMailServerTried], MessageInfo);
            ProcessWindowsMessageQueue;
         end;
         Inc(LastMailServerTried);
      end;
   end; // with
end;

procedure TDXSMTPRelay.RemoveThread(Sender:TObject);
var
   ID:DWord;

begin
   MyRemoveCriticalSection.StartingWrite;
   ID:=TDXComponentSpawn(Sender).ID;
   if ID=0 then Exit;
   Dec(ID);
   with PSMTPRelaySessionThread(fDeliveryThread[ID])^ do begin
      if Assigned(DeliverySession) then begin
         DeliverySession:=TDXComponentSpawn.CreateThread(nil);
         DeliverySession.OnTimer:=TrySendingEmail;
         DeliverySession.OnTerminate:=RemoveThread;
{$IFNDEF LINUX}
         DeliverySession.Priority:=fPriority;
{$ENDIF}
      end;
      DXSMTPSender.DisconnectFromSMTPServer;
      ID:=0;
   end;
   MyRemoveCriticalSection.FinishedWrite;
end;

procedure TDXSMTPRelay.DNSResolveAll;
var
   Loop, MaxLoop:Integer;

begin
   Loop:=0;
   MaxLoop:=fQueue.Count;
   while (Loop<MaxLoop)and(fEnabled) do begin
      if not Assigned(PDXSMTPRelayControl(fQueue[Loop])^.MailServer) then
         if fSmartHostAddress<>'' then begin
            PDXSMTPRelayControl(fQueue[Loop])^.MailServer:=TStringList.Create;
            PDXSMTPRelayControl(fQueue[Loop])^.MailServer.Add(fSmartHostAddress);
         end
         else if MailServer(PDXSMTPRelayControl(fQueue[Loop])) then begin
            if Assigned(fResolve) then begin
               fResolve(PDXSMTPRelayControl(fQueue[Loop])^.MailTo,
                  PDXSMTPRelayControl(fQueue[Loop])^.MessageInfo);
               ProcessWindowsMessageQueue;
            end;
         end
         else begin
            if Assigned(fResolveFailed) then begin
               Inc(PDXSMTPRelayControl(fQueue[Loop])^.ResolveErrors);
               fResolveFailed(PDXSMTPRelayControl(fQueue[Loop])^.MailTo,
                  PDXSMTPRelayControl(fQueue[Loop])^.MessageInfo);
               ProcessWindowsMessageQueue;
            end;
         end;
      Inc(loop);
   end;
end;

procedure TDXSMTPRelay.Execute;
var
   Loop,
      MaxLoop:Integer;
   TmpAddress:TStringList;
   IsBusy:Boolean;
   SMTPRelaySessionThread:PSMTPRelaySessionThread;
   FindLoop:Integer;
   Running:Boolean;

begin
   if InExecute=True then exit;
   InExecute:=True;
   if fQueue.Count<fConcurrent then fConcurrent:=fQueue.Count;
   while (fDeliveryThread.Count<fConcurrent)and(fQueue.Count>0) do begin
      New(SMTPRelaySessionThread);
      with SMTPRelaySessionThread^ do begin
         DeliverySession:=TDXComponentSpawn.CreateThread(nil);
         DeliverySession.OnTimer:=TrySendingEmail;
         DeliverySession.OnTerminate:=RemoveThread;
{$IFNDEF LINUX}
         DeliverySession.Priority:=fPriority;
{$ENDIF}
         DXSMTPSender:=TDXSMTPSender.Create(nil);
         DXSMTPSender.Timeout:=fTimeout;
         DXSMTPSender.SMTPSenderMessage:=SMTPSenderMessages;
         ID:=0;
      end;
      fDeliveryThread.Add(SMTPRelaySessionThread);
   end;
   while (fEnabled)and(fQueue.Count>0) do begin
      MaxLoop:=fQueue.Count;
      FindLoop:=0;
      for Loop:=0 to MaxLoop-1 do begin
         if PDXSMTPRelayControl(fQueue[Loop])^.ConnectTries>-1 then begin
            if not Assigned(PDXSMTPRelayControl(fQueue[Loop])^.MailServer) then
               begin
               if MailServer(PDXSMTPRelayControl(fQueue[Loop])) then begin
                  if Assigned(fResolve) then begin
                     fResolve(PDXSMTPRelayControl(fQueue[Loop])^.MailTo,
                        PDXSMTPRelayControl(fQueue[Loop])^.MessageInfo);
                     ProcessWindowsMessageQueue;
                  end;
               end
               else begin
                  if Assigned(fResolveFailed) then begin
                     Inc(PDXSMTPRelayControl(fQueue[Loop])^.ResolveErrors);
                     fResolveFailed(PDXSMTPRelayControl(fQueue[Loop])^.MailTo,
                        PDXSMTPRelayControl(fQueue[Loop])^.MessageInfo);
                     ProcessWindowsMessageQueue;
                  end;
               end;
            end;
         end;
         with PDXSMTPRelayControl(fQueue[Loop])^ do begin
            if ConnectTries>-1 then begin
               if (ConnectTries<fMaxTries)and
                  (SessionErrors<fSessionErrors)and
                  (ResolveErrors<fResolveErrors)and
                  Assigned(MailServer) then begin
                  Running:=False;
                  while not Running do begin
                     SMTPRelaySessionThread:=fDeliveryThread[FindLoop];
                     with SMTPRelaySessionThread^ do begin
                        if DeliverySession.Suspended then begin
                           DeliverySession.ID:=FindLoop+1;
                           PDXSMTPRelayControl(fQueue[Loop])^.ID:=FindLoop+1;
                           DeliverySession.SetSessionData(fQueue[Loop]);
                           DeliverySession.Resume;
                           SMTPRelaySessionThread^.ID:=FindLoop+1;
                           Running:=True;
                        end;
                        Inc(FindLoop);
                        if FindLoop>=fDeliveryThread.Count then begin
                           FindLoop:=0;
                           if not PSMTPRelaySessionThread(
                              fDeliveryThread[FindLoop])^.
                              DeliverySession.
                              Suspended then DoSleepEx(fTimeout);
                        end;
                     end;
                  end;
               end; {if}
            end; {if}
         end; {with}
      end; {for}
      IsBusy:=False;
      FindLoop:=0;
      while (FindLoop<fDeliveryThread.Count)and(fEnabled) do begin
         SMTPRelaySessionThread:=fDeliveryThread[FindLoop];
         if SMTPRelaySessionThread^.ID<>0 then IsBusy:=True;
         Inc(FindLoop);
         if (FindLoop=fDeliveryThread.Count)and(IsBusy) then begin
            IsBusy:=False;
            FindLoop:=0;
            DoSleepEx(1000);
         end;
      end;
      if Assigned(fCleaningQueue) then begin
         fCleaningQueue(Self);
         ProcessWindowsMessageQueue;
      end;
      for Loop:=0 to MaxLoop-1 do begin
         if (PDXSMTPRelayControl(fQueue[Loop])^.ConnectTries>=fMaxTries)or
            (PDXSMTPRelayControl(fQueue[Loop])^.SessionErrors>=fSessionErrors)or
            (PDXSMTPRelayControl(fQueue[Loop])^.ResolveErrors>=fResolveErrors)
               then begin
            if Assigned(fTriesExceeded) then begin
               fTriesExceeded(PDXSMTPRelayControl(fQueue[Loop]));
               ProcessWindowsMessageQueue;
            end;
            PDXSMTPRelayControl(fQueue[Loop])^.ConnectTries:=-1;
         end;
      end;
      MyCleanupCriticalSection.StartingWrite;
      try
         TmpAddress:=TStringList.Create;
         TmpAddress.Sorted:=True;
         Loop:=0;
         while Loop<fQueue.Count do begin
            if PDXSMTPRelayControl(fQueue[Loop])^.ConnectTries=-1 then begin
               if
                  TmpAddress.IndexOf(PDXSMTPRelayControl(fQueue[Loop])^.MessageInfo)=-1 then
                  TmpAddress.Add(PDXSMTPRelayControl(fQueue[Loop])^.MessageInfo);
               if Assigned(PDXSMTPRelayControl(fQueue[Loop])^.MailServer) then
                  begin
                  PDXSMTPRelayControl(fQueue[Loop])^.MailServer.Free;
                  PDXSMTPRelayControl(fQueue[Loop])^.MailServer:=nil;
               end;
               Dispose(PDXSMTPRelayControl(fQueue[Loop]));
               fQueue.Delete(Loop);
            end
            else
               Inc(Loop);
         end;
         MaxLoop:=fQueue.Count;
         Loop:=0;
         while (Loop<MaxLoop)and(TmpAddress.Count>0) do begin
            if
               TmpAddress.IndexOf(PDXSMTPRelayControl(fQueue[Loop])^.MessageInfo)>-1
               then
               TmpAddress.Delete(TmpAddress.IndexOf(PDXSMTPRelayControl(fQueue[Loop])^.MessageInfo));
            Inc(Loop);
         end;
         TmpAddress.Sorted:=False;
         while (TmpAddress.Count)>0 do begin
            if Assigned(fMessageSent) then begin
               fMessageSent(TmpAddress[0]);
               ProcessWindowsMessageQueue;
            end;
            TmpAddress.Delete(0);
         end;
         if Assigned(fSaveQueue) then fSaveQueue(fQueue);
         if fQueue.Count>0 then begin
            while fQueue.Count>0 do begin
               if Assigned(PDXSMTPRelayControl(fQueue[0])^.MailServer) then begin
                  PDXSMTPRelayControl(fQueue[0])^.MailServer.Free;
                  PDXSMTPRelayControl(fQueue[0])^.MailServer:=nil;
               end;
               Dispose(PDXSMTPRelayControl(fQueue[0]));
               fQueue.Delete(0);
            end;
            if Assigned(fLoadQueue) then begin
               fLoadQueue(fQueue);
               DNSResolveAll;
            end;
         end;
      except
      end;
      MyCleanupCriticalSection.FinishedWrite;
      DoSleepEx(FInterval);
   end;
   fRunning:=False;
   while fDeliveryThread.Count>0 do begin
      SMTPRelaySessionThread:=fDeliveryThread[0];
      SMTPRelaySessionThread^.DeliverySession.Free;
      SMTPRelaySessionThread^.DXSMTPSender.Free;
      fDeliveryThread.Delete(0);
   end;
   InExecute:=False;
end;

procedure TDXSMTPRelay.setAlternativeDNS(value:string);
begin
   fAlternativeDNS:=Value;
   {$IFNDEF OBJECTS_ONLY}
   if (csDesigning in ComponentState) then exit;
   {$ENDIF}
   fDXMXResolver.AlternativeDNS:=Value;
end;

procedure TDXSMTPRelay.setTimeout(value:cardinal);
begin
   fTimeout:=Value;
end;

function TDXSMTPRelay.ConnectionsPending:Integer;
var
   Loop,
      MaxLoop:Integer;

begin
   Result:=0;
   if Assigned(fQueue) then begin
      Loop:=0;
      MyPendingCriticalSection.StartingWrite;
      try
         MaxLoop:=fQueue.Count;
         while Loop<MaxLoop do begin
            if PDXSMTPRelayControl(fQueue[Loop])^.ConnectTries>-1 then
               Inc(Result);
            Inc(loop);
         end;
      except
      end;
      MyPendingCriticalSection.FinishedWrite;
   end
   else
      Result:=0;
end;

procedure TDXSMTPRelay.AddToQueue(const MailFrom, MailTo, MessageInfo:string);
var
   SMTPRelayControl:PDXSMTPRelayControl;
   MailAddress:string;
   I:Integer;

begin
   MailAddress:=StringReplace(MailTo, ',', ';', [rfReplaceAll])+';';
   I:=CharPos(';', MailAddress);
   while I>0 do begin
      New(SMTPRelayControl);
      SMTPRelayControl^.MailTo:=Copy(MailAddress, 1, CharPos(';',
         MailAddress)-1);
      SMTPRelayControl^.MailFrom:=MailFrom;
      SMTPRelayControl^.MessageInfo:=MessageInfo;
      SMTPRelayControl^.ConnectTries:=0;
      SMTPRelayControl^.LastMailServerTried:=0;
      SMTPRelayControl^.SessionErrors:=0;
      SMTPRelayControl^.ResolveErrors:=0;
      SMTPRelayControl^.MailServer:=nil;
      MyAddCriticalSection.StartingWrite;
      try
         fQueue.Add(SMTPRelayControl);
      except
         ;
      end;
      MyAddCriticalSection.FinishedWrite;
      Delete(MailAddress, 1, I);
      I:=CharPos(';', MailAddress);
   end;
end;

procedure TDXSMTPRelay.ResumeProcessing;
begin
   if fQueue.Count<1 then
      if Assigned(fLoadQueue) then fLoadQueue(fQueue);
   SetEnabled(True);
end;

constructor TSMTPRelayThread.CreateTimerThread(TT:TDXSMTPRelay);
begin
   inherited Create(true);
   self.tt:=tt;
   FreeOnTerminate:=true;
end;

procedure TSMTPRelayThread.Execute;
begin
   TT.Execute;
   if Assigned(TT.fDoneProcessing) then
      TT.fDoneProcessing(Self);
   TT.fRunning:=False;
   Terminate;
end;

procedure TDXSMTPRelay.SMTPSenderMessages(MessageFromServer:string); 
begin
   if Assigned(fSMTPSenderMessage) then begin
      fSMTPSenderMessage(MessageFromServer);
      ProcessWindowsMessageQueue;
   end;
end;

end.