idemailaddress.pas

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

  nFirst := FindFirstOf('("< @' + TAB, AText);   {Do not Localize}
  if nFirst <> 0 then
  begin
    nBracketCount := 0;
    bInAddress := False;
    bAddressInLT := False;
    bInQuote := False;
    bAfterAt := False;
    repeat
      case AText[nFirst] of
        ' ', TAB :             {Do not Localize}
        begin
          if nFirst = 1 then
          begin
            Delete(AText, 1, 1);
          end else
          begin
            // Only valid if in a name not contained in quotes - keep the space.
            if bAfterAt then begin
              FAddress := FAddress + Trim(Copy(AText, 1, nFirst - 1));
            end else begin
              FName := FName + Copy(AText, 1, nFirst);
            end;
            IdDelete(AText, 1, nFirst);
          end;
        end;
        '(' :                                {Do not Localize}
        begin
          Inc(nBracketCount);
          if (nFirst > 1) then
          begin
            // There's at least one character to the name    {Do not Localize}
            if bInAddress then
            begin
              FAddress := FAddress + Trim(Copy(AText, 1, nFirst - 1));
            end else
            begin
              if nBracketCount = 1 then
              begin
                FName := FName + Copy(AText, 1, nFirst - 1);
              end;
            end;
            IdDelete(AText, 1, nFirst);
          end else
          begin
            Delete(AText, 1, 1);
          end;
        end;
        ')' :                                {Do not Localize}
        begin
          Dec(nBracketCount);
          IdDelete(AText, 1, nFirst);
        end;
        '"' :                              {Do not Localize}
        begin
          if bInQuote then
          begin
            if bAddressInLT then
            begin
              FAddress := FAddress + Trim(Copy(AText, 1, nFirst - 1));
            end else
            begin
              FName := FName + Trim(Copy(AText, 1, nFirst - 1));
            end;
            IdDelete(AText, 1, nFirst);
            bInQuote := False;
          end else
          begin
            bInQuote := True;
            Delete(AText, 1, 1);
          end;
        end;
        '<' :                             {Do not Localize}
        begin
          if nFirst > 1 then
          begin
            FName := FName + Copy(AText, 1, nFirst - 1);
          end;
          FName := TrimAllOf(' ' + TAB, Trim(FName));    {Do not Localize}
          bAddressInLT := True;
          bInAddress := True;
          Delete(AText, 1, nFirst);
        end;
        '>' :                            {Do not Localize}
        begin
          // Only searched for if the address starts with '<'    {Do not Localize}
          bInAddress := False;
          bAfterAt := False;
          FAddress := FAddress +
            TrimAllOf(' ' + TAB, Trim(Copy(AText, 1, nFirst - 1)));  {Do not Localize}
          IdDelete(AText, 1, nFirst);
        end;
        '@' :                 {Do not Localize}
        begin
          bAfterAt := True;
          if bInAddress then
          begin
            FAddress := FAddress + Copy(AText, 1, nFirst);
            IdDelete(AText, 1, nFirst);
          end else
          begin
            if bAddressInLT then
            begin
              // Strange use. For now raise an exception until a real-world
              // example can be found.
              // Basically, it's formatted as follows:    {Do not Localize}
              //    <[e-mail]> some-text @ some-text
              // or:
              //    some-text <[e-mail]> some-text @ some-text
              // where some text may be blank.
              //CC: Note you used to arrive here if the From header in an email
              //included more than one address (which was subsequently changed)
              //because our code did not parse the From header for multiple
              //addresses.  That may have been the reason for this code.
              raise EIdEmailParseError.Create(RSEMailSymbolOutsideAddress);
            end else
            begin
              // If at this point, we're either supporting an e-mail address    {Do not Localize}
              // on it's own, or the old-style valid format:    {Do not Localize}
              //    "Name" [e-mail]
              bInAddress := True;
              FAddress := FAddress + Copy(AText, 1, nFirst);
              IdDelete(AText, 1, nFirst);
            end;
          end;
        end;
        '.' :                {Do not Localize}
        begin
          // Must now be a part of the domain part of the address.
          if bAddressInLT then
          begin
            // Whitespace is possible around the parts of the domain.
            FAddress := FAddress +
              TrimAllOf(' ' + TAB, Trim(Copy(AText, 1, nFirst - 1))) + '.'; {Do not Localize}
            AText := TrimLeft(Copy(AText, nFirst + 1, MaxInt));
          end else
          begin
            // No whitespace is allowed if no wrapping <> characters.
            FAddress := FAddress + Copy(AText, 1, nFirst);
            IdDelete(AText, 1, nFirst);
          end;
        end;
        '\' :                   {Do not Localize}
        begin
          // This will only be discovered in a bracketted or quoted section.
          // It's an escape character indicating the next cahracter is    {Do not Localize}
          // a literal.
          if bInQuote then
          begin
            // Need to retain the second character
            if bInAddress then
            begin
              FAddress := FAddress + Copy(AText, 1, nFirst - 1);
              FAddress := FAddress + AText[nFirst + 1];
            end else
            begin
              FName := FName + Copy(AText, 1, nFirst - 1);
              FName := FName + AText[nFirst + 1];
            end;
          end;
          IdDelete(AText, 1, nFirst + 1);
        end;
      end;


      // Check for bracketted sections first: ("<>" <> "" <"">) - all is ignored
      if nBracketCount > 0 then
      begin
        // Inside a bracket, only three charatcers are special.
        // '(' Opens a nested bracket: (One (Two (Three )))    {Do not Localize}
        // ')' Closes a bracket    {Do not Localize}
        // '/' Escape character: (One /) /( // (Two /) ))    {Do not Localize}
        nFirst := FindFirstOf('()\', AText);     {Do not Localize}

      // Check if in quote before address: <"My Name"@domain.example> is valid
      end else if bInQuote then
      begin
      // Inside quotes, only the end quote and escape character are special.
        nFirst := FindFirstOf('"\', AText);   {Do not Localize}

      // Check if after the @ of the address: domain.example>
      end else if bAfterAt then
      begin
        if bAddressInLT then
        begin
          // If the address is enclosed, then only the '(', '.' & '>' need be    {Do not Localize}
          // looked for, trimming all content when found: domain  .  example >
          nFirst := FindFirstOf('.>(', AText);       {Do not Localize}
        end else
        begin
          nFirst := FindFirstOf('.( ', AText);  {Do not Localize}
        end;

      // Check if in address: <[e-mail]>
      end else if bInAddress then
      begin
        nFirst := FindFirstOf('"(@>', AText);   {Do not Localize}

      // Not in anything - check for opening charactere
      end else
      begin
        // Outside brackets
        nFirst := FindFirstOf('("< @' + TAB, AText);    {Do not Localize}
      end;
    until nFirst = 0;
    if bInAddress and not bAddressInLT then
    begin
      FAddress := FAddress + TrimAllOf(' ' + TAB, Trim(AText));   {Do not Localize}
    end;
  end else
  begin
    // No special characters, so assume a simple address
    FAddress := AText;
  end;
end;



{ TIdEMailAddressList }

function TIdEMailAddressList.Add: TIdEMailAddressItem;
begin
  Result := TIdEMailAddressItem(inherited Add);
end;

constructor TIdEMailAddressList.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner, TIdEMailAddressItem);
end;

procedure TIdEMailAddressList.FillTStrings(AStrings: TIdStrings);
var
  idx: Integer;
begin
  for idx := 0 to Count - 1 do
  begin
    AStrings.Add(GetItem(idx).Text);
  end;
end;

function TIdEMailAddressList.GetItem(Index: Integer): TIdEMailAddressItem;
begin
  Result := TIdEMailAddressItem(inherited Items[Index]);
end;

function TIdEMailAddressList.GetEMailAddresses: string;
var
  idx: Integer;
begin
  Result := '';   {Do not Localize}
  for idx := 0 to Count - 1 do
  begin
    if Result = '' then
      Result := GetItem(idx).Text
    else
      Result := Result + ', ' + GetItem(idx).Text; {Do not Localize}
  end;
end;

procedure TIdEMailAddressList.SetItem(Index: Integer;
  const Value: TIdEMailAddressItem);
begin
  inherited SetItem(Index, Value);
end;

procedure TIdEMailAddressList.SetEMailAddresses(AList: string);
var
  EMail : TIdEMailAddressItem;
  iStart: Integer;
  sTemp: string;
  nInBracket: Integer;
  bInQuote : Boolean;
begin
  Clear;

  if (Trim(AList) = '') then Exit;   {Do not Localize}

  iStart := FindFirstOf(':;(", ' + TAB, AList); {Do not Localize}
  if iStart = 0 then begin
    EMail := Add;
    EMail.Text := TrimLeft(AList);
  end else begin
    sTemp := '';                   {Do not Localize}
    nInBracket := 0;
    bInQuote := False;
    repeat
      case AList[iStart] of
        ' ', TAB: begin                 {Do not Localize}
          if iStart = 1 then begin
            sTemp := sTemp + AList[iStart];
            IdDelete(AList, 1, 1);
          end else begin
            sTemp := sTemp + Copy(AList, 1, iStart);
            IdDelete(AList, 1, iStart);
          end;
        end;
        ':' :                           {Do not Localize}
        begin
          // The start of a group - ignore the lot.
          IdDelete(AList, 1, iStart);
          sTemp := '';                 {Do not Localize}
        end;
        ';' :                          {Do not Localize}
        begin
          // End of a group.  If we have something (groups can be empty),
          // then process it.
          sTemp := sTemp + Copy(AList, 1, iStart - 1);
          if Trim(sTemp) <> '' then begin
            EMail := Add;
            EMail.Text := TrimLeft(sTemp);
            sTemp := '';                     {Do not Localize}
          end;
          // Now simply remove the end of the group.
          IdDelete(AList, 1, iStart);
        end;
        '(': begin                     {Do not Localize}
          Inc(nInBracket);
          sTemp := sTemp + Copy(AList, 1, iStart);
          IdDelete(AList, 1, iStart);
        end;
        ')': begin                     {Do not Localize}
          Dec(nInBracket);
          sTemp := sTemp + Copy(AList, 1, iStart);
          IdDelete(AList, 1, iStart);
        end;
        '"': begin                     {Do not Localize}
          sTemp := sTemp + Copy(AList, 1, iStart);
          IdDelete(AList, 1, iStart);
          bInQuote := not bInQuote;
        end;
        ',': begin                       {Do not Localize}
          sTemp := sTemp + Copy(AList, 1, iStart - 1);
          EMail := Add;
          EMail.Text := sTemp;
          // added - Allen .. saves blank entries being added
          if (Trim(Email.Text) = '') or (Trim(Email.Text) = '<>') then   {Do not Localize}
          begin
            FreeAndNil(Email);
          end;
          sTemp := '';    {Do not Localize}
          IdDelete(AList, 1, iStart);
        end;
        '\': begin                                     {Do not Localize}
          // Escape character - simply copy this char and the next to the buffer.
          sTemp := sTemp + Copy(AList, 1, iStart + 1);
          IdDelete(AList, 1, iStart + 1);
        end;
      end;

      if nInBracket > 0 then begin
        iStart := FindFirstOf('(\)', AList);    {Do not Localize}
      end else if bInQuote then begin
        iStart := FindFirstOf('"\', AList);    {Do not Localize}
      end else begin
        iStart := FindFirstOf(':;(", ' + TAB, AList);  {Do not Localize}
      end;
    until iStart = 0;

    // Clean up the content in sTemp
    if (Trim(sTemp) <> '') or (Trim(AList) <> '') then begin
      sTemp := sTemp + AList;
      EMail := Add;
      EMail.Text := TrimLeft(sTemp);
      // added - Allen .. saves blank entries being added
      if (Trim(Email.Text) = '') or (Trim(Email.Text) = '<>') then   {Do not Localize}
      begin
        FreeAndNil(Email);
      end;
    end;
  end;
end;

procedure TIdEMailAddressList.SortByDomain;
var
  i, j: Integer;
  LTemp: string;
begin
  for i := Count -1 downto 0 do
  begin
    for j := 0 to Count -2 do
    begin
      if IndyCompareStr(Items[J].Domain , Items[J + 1].Domain)> 0 then begin
        LTemp := Items[j].Text;

        Items[j].Text := Items[j+1].Text;
        Items[j+1].Text := LTemp;
      end;
    end;
  end;
end;

procedure TIdEMailAddressList.GetDomains(AStrings: TIdStrings);
var
  i: Integer;
  LCurDom: string;
begin
  if Assigned(AStrings) then
  begin
    AStrings.Clear;
    for i := 0 to Count-1 do
    begin
      LCurDom :=  Lowercase(Items[i].Domain);
      if AStrings.IndexOf( LCurDom ) = -1 then
      begin
        AStrings.Add( LCurDom );
      end;
    end;
  end;
end;

procedure TIdEMailAddressList.AddressesByDomain(AList: TIdEMailAddressList;
  const ADomain: string);
var
  i: Integer;
  LDomain: string;
  LCurDom: string;
  LEnt : TIdEMailAddressItem;
begin
  LDomain := LowerCase(ADomain);
  AList.Clear;
  for i := 0 to Count-1 do
  begin
    LCurDom := LowerCase(Items[i].Domain);
    if LCurDom = LDomain then
    begin
      LEnt := AList.Add;
      LEnt.Text := Items[i].Text;
    end;
  end;
end;

end.