idsmtprelay.pas

photo.163.com 相册下载器 多线程下载

  SendCmd('QUIT', 221);    {Do not Localize}
end;

function TIdSMTPRelay.GetSupportsTLS: boolean;
begin
   Result := ( FCapabilities.IndexOf('STARTTLS')>-1); //do not localize
end;

procedure TIdSMTPRelay.ProcessException(AException: Exception; AEMailAddress : TIdEMailAddressItem);
var LE : EIdSMTPReplyError;
begin
           With FStatusList.Add do
           begin
             EmailAddress:=AEmailAddress.Address;
             Sent:=False;
             ExceptionMessage:=AException.Message;
             if AException is EIdSMTPReplyError then
             begin
               LE := AException as EIdSMTPReplyError;
               ReplyCode :=  LE.ErrorCode;
               EnhancedCode.ReplyAsStr := LE.EnhancedCode.ReplyAsStr;
             end;
           end;
           if Assigned(FOnDirectSMTPStatus) then
           begin
             FOnDirectSMTPStatus(Self, AEmailAddress, dmWorkEndWithException);
           end;
end;

procedure TIdSMTPRelay.ResolveMXServers(AAddress: String);
var
   IdDNSResolver1: TIdDNSResolver;
   DnsResource : TResultRecord;
   i:Integer;
   LDomain:String;
begin
  {
  Get the list of MX Servers for a given domain into FMXServerList
  }

  if Pos('@',AAddress)>0 then
  begin
     LDomain:=Copy(AAddress,IndyPos('@',AAddress)+1,Length(AAddress)-Pos('@',AAddress))
  end
  else
  begin
    raise EIdDirectSMTPCannotResolveMX.Create(Format(RSDirSMTPInvalidEMailAddress,[AAddress]));
  end;
  IdDNSResolver1:=TIdDNSResolver.Create(Self);
  FMXServerList.Clear;
  try
    try
      IdDNSResolver1.AllowRecursiveQueries:=True;
      if Assigned(IOHandler) and (IOHandler.ReadTimeOut <> 0) then
      begin
        //thirty seconds - maximum amount of time allowed for DNS query
        IdDNSResolver1.WaitingTime := IOHandler.ReadTimeout;
        //30000;
      end
      else
      begin
        IdDNSResolver1.WaitingTime := 30000;
      end;
      IdDNSResolver1.QueryType := [qtMX];
      IdDNSResolver1.Host:=DNSServer;
      IdDNSResolver1.Resolve(LDomain);

      if IdDNSResolver1.QueryResult.Count > 0 then
      begin
        for i := 0 to IdDNSResolver1.QueryResult.Count - 1 do
        begin
          DnsResource := IdDNSResolver1.QueryResult[i];
          if (DnsResource is TMXRecord) then
          begin
            FMXServerList.Add(TMXRecord(DnsResource).ExchangeServer);
          end;
        end;
      end;

      if FMXServerList.Count=0 then
      begin
        raise EIdDirectSMTPCannotResolveMX.Create(Format(RSDirSMTPNoMXRecordsForDomain,[LDomain]));
      end;
    finally
      IdDNSResolver1.Free;
    end;
  except
    raise;
  end;
end;

procedure TIdSMTPRelay.Send(AMsg: TIdMessage);
var LAllEntries, LCurDomEntries : TIdEMailAddressList;
    SDomains : TIdStrings;
    i : Integer;

  procedure InternalSend(const AMsg: TIdMessage;const AEmailAddresses: TIdEMailAddressList);
  var
    ServerIndex:Integer;
  begin
    if AEmailAddresses.Count = 0 then
    begin
      Exit;
    end;
    if Assigned(FOnDirectSMTPStatus) then
    begin
      FOnDirectSMTPStatus(Self, AEmailAddresses[0], dmWorkBegin);
    end;
    try
      try
       	if Assigned(FOnDirectSMTPStatus) then
        begin
          FOnDirectSMTPStatus(Self, AEmailAddresses[0], dmResolveMS);
        end;
        ResolveMXServers(AEMailAddresses[0].Address);
      	ServerIndex:=0;

	      if Assigned(FOnDirectSMTPStatus) then
        begin
          FOnDirectSMTPStatus(Self, AEmailAddresses[0], dmConecting);
        end;
        while (ServerIndex<=FMXServerList.Count-1) and not Connected do begin
          FHost := FMXServerList[ServerIndex];
          Connect(AEmailAddresses[0]);
        end;

        if not Connected then
        begin
           raise EIdTCPConnectionError.Create(Format(RSDirSMTPCantConnectToSMTPSvr,[AEmailAddresses[0].Address]));
        end;
       	if Assigned(FOnDirectSMTPStatus) then
        begin
          FOnDirectSMTPStatus(Self, AEmailAddresses[0], dmConected);
        end;
      	if Assigned(FOnDirectSMTPStatus) then
        begin
          FOnDirectSMTPStatus(Self, AEmailAddresses[0], dmSending);
        end;
        if MailAgent <>'' then
        begin
          AMsg.ExtraHeaders.Values[XMAILER_HEADER] := MailAgent;
        end;
        InternalSend(AMsg,AEmailAddresses);
        With FStatusList.Add do
        begin
          EmailAddress:=AEmailAddresses[0].Address;
          Sent:=True;
        end;
      	if Assigned(FOnDirectSMTPStatus) then
        begin
          FOnDirectSMTPStatus(Self, AEmailAddresses[0], dmWorkEndOK);
        end;
      except
        on E : Exception do
        begin
          ProcessException(E,AEmailAddresses[0]);
        end;
      end;
    finally
      Disconnect;
    end;
  end;

begin
  LAllEntries := TIdEMailAddressList.Create(nil);
  try
    LAllEntries.EMailAddresses :=
      AMsg.Recipients.EMailAddresses +
      AMsg.CCList.EMailAddresses +
      AMsg.BccList.EMailAddresses;
    SDomains := TIdStringList.Create;
    try
      LAllEntries.GetDomains(SDomains);
      LCurDomEntries := TIdEMailAddressList.Create(nil);
      try
        for i := 0 to SDomains.Count -1 do// LCurDomEntries.Count -1 do
        begin
          LAllEntries.AddressesByDomain(LCurDomEntries,SDomains[i]);
          InternalSend(AMsg,LCurDomEntries);
        end;
      finally
        FreeAndNil(LCurDomEntries);
      end;
    finally
      FreeAndNil(SDomains);
    end;
  finally
    FreeAndNil(LAllEntries);
  end;
end;

procedure TIdSMTPRelay.SetDNSServer(const Value: String);
begin
  FDNSServer := Value;
end;

procedure TIdSMTPRelay.SetHost(const Value: String);
begin
  raise EIdDirectSMTPCannotAssingHost.Create(RSDirSMTPCantAssignHost);
end;

procedure TIdSMTPRelay.SetOnStatus(const Value: TIdSMTPRelayStatus);
begin
  FOnDirectSMTPStatus := Value;
end;

procedure TIdSMTPRelay.SetSSLOptions(const Value: TIdSSLSupportOptions);
begin
  FSSLOptions.Assign(Value);
end;

procedure TIdSMTPRelay.SetUseEhlo(const AValue: Boolean);
begin
  inherited;
  FSSLOptions.FSSLSupport := noSSL;
end;

{ TIdSMTPRelayStatusList }

function TIdSMTPRelayStatusList.Add: TIdSMTPRelayStatusItem;
begin
  Result:=TIdSMTPRelayStatusItem(inherited Add);
end;

function TIdSMTPRelayStatusList.GetItems(
  Index: Integer): TIdSMTPRelayStatusItem;
begin
   Result:=TIdSMTPRelayStatusItem(inherited Items[Index]);
end;

procedure TIdSMTPRelayStatusList.SetItems(Index: Integer;
  const Value: TIdSMTPRelayStatusItem);
begin
  Items[Index].Assign(Value);
end;

{ TIdSMTPRelayStatusItem }

constructor TIdSMTPRelayStatusItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FEnhancedCode := TIdSMTPEnhancedCode.Create;
  Sent := DEF_SENT;
  ReplyCode :=   DEF_REPLY_CODE;
end;

destructor TIdSMTPRelayStatusItem.Destroy;
begin
  FreeAndNil(FEnhancedCode);
  inherited Destroy;
end;

procedure TIdSMTPRelayStatusItem.SetEmailAddress(const Value: String);
begin
  FEmailAddress := Value;
end;

procedure TIdSMTPRelayStatusItem.SetEnhancedCode(
  const Value: TIdSMTPEnhancedCode);
begin
  FEnhancedCode.ReplyAsStr := Value.ReplyAsStr;
end;

procedure TIdSMTPRelayStatusItem.SetExceptionMessage(const Value: String);
begin
  FExceptionMessage := Value;
end;

procedure TIdSMTPRelayStatusItem.SetReplyCode(const Value: Integer);
begin
  FReplyCode := Value;
end;

procedure TIdSMTPRelayStatusItem.SetSent(const Value: Boolean);
begin
  FSent := Value;
end;

{ TIdSSLSupportOptions }

procedure TIdSSLSupportOptions.Assign(Source: TPersistent);
var LS : TIdSSLSupportOptions;
begin
  if (Source is TIdSSLSupportOptions) then
  begin
    LS := TIdSSLSupportOptions(Source);
    SSLSupport := LS.FSSLSupport;
    TryImplicitTLS := LS.TryImplicitTLS;
  end
  else
  begin
    inherited;
  end;
end;

constructor TIdSSLSupportOptions.Create(AOwner: TIdSMTPRelay);
begin
  inherited Create;
  FOwner := AOwner;
  FSSLSupport := DEF_SSL_SUPPORT;
  FTryImplicitTLS := DEF_TRY_IMPLICITTLS;
end;

procedure TIdSSLSupportOptions.SetSSLSupport(const Value: TIdSSLSupport);
begin
  if (Value<>noSSL) and ((csLoading in FOwner.ComponentState)=False) then
  begin
    FOwner.CheckIfCanUseTLS;
  end;
  if (Value<>noSSL) and (FOwner.UseEhlo=False) then
  begin
    FOwner.FUseEHLO := True;
  end;
  if (Value=noSSL) then
  begin
    FTryImplicitTLS := False;
  end;
  FSSLSupport := Value;
end;

procedure TIdSSLSupportOptions.SetTryImplicitTLS(const Value: Boolean);
begin
  if Value and ((csLoading in FOwner.ComponentState)=False) then
  begin
    FOwner.CheckIfCanUseTLS;
  end;
  if Value and (Self.FSSLSupport=NoSSL) then
  begin
    SSLSupport := SupportSSL;
  end;
  FTryImplicitTLS := Value;
end;

end.