Arno, I tested your version of the code in my projects and it works fine. So I would like to see these changes in the next version of ICS.
Regards Bjørnar -----Original Message----- From: [EMAIL PROTECTED] [mailto:[EMAIL PROTECTED] On Behalf Of Arno Garrels Sent: 7. april 2008 17:00 To: ICS support mailing Subject: Re: [twsocket] SMTPProt.pas Bjørnar Nielsen wrote: > Arno, > > I think you know this bether than me, but I think you are right. > Calling RequestDone with errormessage would also solve the problem > for me. A "500" status code were probably more suitable indicating a persistent error, like '500 Internal client error ..'. I changed DoHighLevelAsync in my copy as below, anybody any veto? My projects only use the non-highlevel methods, so I never hit that. procedure TCustomSmtpClient.DoHighLevelAsync; begin {$IFDEF TRACE} TriggerDisplay('! HighLevelAsync ' + IntToStr(FRequestResult)); {$ENDIF} if FState = smtpAbort then begin {$IFDEF TRACE} TriggerDisplay('! Abort detected'); {$ENDIF} FFctSet := []; FHighLevelResult := 426; FRequestResult := 426; { SJF } FErrorMessage := '426 Operation aborted.'; end; FNextRequest := DoHighLevelAsync; if FRequestResult <> 0 then begin { Previous command had errors } { EHLO wasn't supported, so just log in with HELO } if FFctPrv = smtpFctEhlo then FFctSet := [smtpFctHelo] else begin FHighLevelResult := FRequestResult; if (FFctPrv = smtpFctQuit) or (not (smtpFctQuit in FFctSet)) then FFctSet := [] else FFctSet := [smtpFctQuit]; end; end; try if smtpFctConnect in FFctSet then begin FFctPrv := smtpFctConnect; FFctSet := FFctSet - [FFctPrv]; Connect; Exit; end; if smtpFctHelo in FFctSet then begin FFctPrv := smtpFctHelo; FFctSet := FFctSet - [FFctPrv]; Helo; Exit; end; if smtpFctEhlo in FFctSet then begin FFctPrv := smtpFctEhlo; FFctSet := FFctSet - [FFctPrv]; Ehlo; Exit; end; if smtpFctAuth in FFctSet then begin FFctPrv := smtpFctAuth; FFctSet := FFctSet - [FFctPrv]; Auth; Exit; end; if smtpFctVrfy in FFctSet then begin FFctPrv := smtpFctVrfy; FFctSet := FFctSet - [FFctPrv]; Vrfy; Exit; end; if smtpFctMailFrom in FFctSet then begin FFctPrv := smtpFctMailFrom; FFctSet := FFctSet - [FFctPrv]; MailFrom; Exit; end; if smtpFctRcptTo in FFctSet then begin FFctPrv := smtpFctRcptTo; FFctSet := FFctSet - [FFctPrv]; RcptTo; Exit; end; if smtpFctData in FFctSet then begin FFctPrv := smtpFctData; FFctSet := FFctSet - [FFctPrv]; Data; Exit; end; if smtpFctQuit in FFctSet then begin FFctPrv := smtpFctQuit; FFctSet := FFctSet - [FFctPrv]; Quit; Exit; end; except on E : Exception do begin {$IFDEF TRACE} TriggerDisplay('! ' + E.ClassName + ': "' + E.Message + '"'); {$ENDIF} FHighLevelResult := 500; FRequestResult := 500; FErrorMessage := '500 Internal client error ' + E.ClassName + ': "' + E.Message + '"'; end; end; {$IFDEF TRACE} TriggerDisplay('! HighLevelAsync done'); {$ENDIF} FFctSet := []; FNextRequest := nil; FRequestDoneFlag := FALSE; TriggerRequestDone(FHighLevelResult); end; {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} > > Regards Bjørnar > > -----Original Message----- > From: [EMAIL PROTECTED] > [mailto:[EMAIL PROTECTED] On Behalf Of Arno Garrels > Sent: 7. april 2008 12:15 > To: ICS support mailing > Subject: Re: [twsocket] SMTPProt.pas > > Bjørnar, > > Won't it be smarter to trigger RequestDone with an error and the > exception message? > Someting like: > > procedure TCustomSmtpClient.DoHighLevelAsync; > [..] > try > [..] > except > on E:Exception do begin > {$IFDEF TRACE} > TriggerDisplay('! ' + E.ClassName + ': "' + E.Message + > '"'); > {$ENDIF} > FHighLevelResult := 427; // Just invented this error > number hopefully not in use > FRequestResult := 427; > FErrorMessage := '427 ' + E.ClassName + ': "' + > E.Message + '"'; > end; > end; {Bjørnar} > > {$IFDEF TRACE} TriggerDisplay('! HighLevelAsync done'); {$ENDIF} > FFctSet := []; > FNextRequest := nil; > FRequestDoneFlag := FALSE; > TriggerRequestDone(FHighLevelResult); > end; > > Bjørnar Nielsen wrote: >> I think there is a wakness/bug in the smtpprot.pas: >> >> procedure TCustomSmtpClient.RcptTo; >> >> begin >> >> if FRcptName.Count <= 0 then >> >> raise SmtpException.Create('RcptName list is empty'); >> >> >> >> FItemCount := -1; >> >> RcptToNex >> >> >> >> When this exception is raised, I cant catch it anywhere. No >> bgexception, no requestdone. I added try/except in this procedure >> (all the code in this procedure inside the try): >> >> procedure TCustomSmtpClient.DoHighLevelAsync; >> >> like this: >> >> except {Bjørnar} >> >> on E:Exception do {Bjørnar} >> >> HandleBackGroundException(E); {Bjørnar} >> >> end; {Bjørnar} >> >> >> >> then I was able to catch it and shut down and release the >> smtp-component. Any comments on this change? >> >> >> >> Regards Bjørnar >> >> >> No virus found in this outgoing message. >> Checked by AVG. >> Version: 7.5.519 / Virus Database: 269.22.5/1356 - Release Date: >> 02.04.2008 16:14 > -- > To unsubscribe or change your settings for TWSocket mailing list > please goto http://lists.elists.org/cgi-bin/mailman/listinfo/twsocket > Visit our website at http://www.overbyte.be > > No virus found in this incoming message. > Checked by AVG. > Version: 7.5.519 / Virus Database: 269.22.8/1362 - Release Date: > 06.04.2008 11:12 > > > No virus found in this outgoing message. > Checked by AVG. > Version: 7.5.519 / Virus Database: 269.22.8/1362 - Release Date: > 06.04.2008 11:12 -- To unsubscribe or change your settings for TWSocket mailing list please goto http://lists.elists.org/cgi-bin/mailman/listinfo/twsocket Visit our website at http://www.overbyte.be No virus found in this incoming message. Checked by AVG. Version: 7.5.519 / Virus Database: 269.22.8/1362 - Release Date: 06.04.2008 11:12 No virus found in this outgoing message. Checked by AVG. Version: 7.5.519 / Virus Database: 269.22.9/1364 - Release Date: 07.04.2008 18:38 -- To unsubscribe or change your settings for TWSocket mailing list please goto http://lists.elists.org/cgi-bin/mailman/listinfo/twsocket Visit our website at http://www.overbyte.be
