Thunderbird

[danten]

It is this right?
Load approx. 15 addresses takes 10 seconds.

Thunderbird personal contacts:

Delphi-Quellcode:

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo2: TMemo;
    pb: TProgressBar;
    procedure Button1Click(Sender: TObject);
  private
    procedure ExtractAdress;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1 : TForm1;
  pth : string;
  c,c1,x,y,i : integer;
  SL:TStringList;


implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  memo2.Clear;
  ExtractAdress;
end;

procedure TForm1.ExtractAdress;
begin
  try
  pth := 'C:\Users\<user_name>\AppData\Roaming\Thunderbird\Profiles\<profile_name>\abook.mab';
  SL := TStringList.Create;

  try
    SL.LoadFromFile(pth);
   for y := 23 downto 0 do
    begin
      SL.Delete(0);
    end;

  pb.Max := SL.Count -1;
  i := SL.Count;

  for c1 := 0 to SL.Count - 1 do
  begin
    Application.ProcessMessages;
    pb.Position := c1;
    SL.text:= (StringReplace(SL.text,'=','='+#13#10,[rfReplaceAll]));
    SL.text:= (StringReplace(SL.text,')',''#13#10+'',[rfReplaceAll]));
    SL.text := (StringReplace(SL.text,'@$${1{@','',[rfReplaceAll]));
    SL.Text := (StringReplace(SL.text,'@$$}1}@','',[rfReplaceAll]));
    SL.text := (StringReplace(SL.Text,'@$${2{@','',[rfReplaceAll]));
    SL.Text := (StringReplace(SL.text,'@$$}2}@','',[rfReplaceAll]));
    SL.text := (StringReplace(SL.Text,'@$${3{@','',[rfReplaceAll]));
    SL.Text := (StringReplace(SL.text,'@$$}3}@','',[rfReplaceAll]));
    SL.text := (StringReplace(SL.text,'@$${4{@','',[rfReplaceAll]));
    SL.Text := (StringReplace(SL.text,'@$$}4}@','',[rfReplaceAll]));
    SL.text := (StringReplace(SL.Text,'@$${5{@','',[rfReplaceAll]));
    SL.Text := (StringReplace(SL.text,'@$$}5}@','',[rfReplaceAll]));
    SL.text := (StringReplace(SL.Text,'@$${6{@','',[rfReplaceAll]));
    SL.Text := (StringReplace(SL.text,'@$$}6}@','',[rfReplaceAll]));
    SL.text := (StringReplace(SL.text,'@$${7{@','',[rfReplaceAll]));
    SL.Text := (StringReplace(SL.text,'@$$}7}@','',[rfReplaceAll]));
    SL.text := (StringReplace(SL.Text,'@$${8{@','',[rfReplaceAll]));
    SL.Text := (StringReplace(SL.text,'@$$}8}@','',[rfReplaceAll]));
    SL.text := (StringReplace(SL.Text,'@$${9{@','',[rfReplaceAll]));
    SL.Text := (StringReplace(SL.text,'@$$}9}@','',[rfReplaceAll]));
  end;

  for c := SL.Count - 1 downto 0 do
  begin
  if AnsiPos('@', SL[c]) <>  0 then
    Memo2.Lines.Add(SL[c]);
  end;

  for x := Memo2.Lines.Count - 1 downto 0 do
  begin
  if AnsiPos('<', Memo2.Lines[x]) <>  0 then
    Memo2.Lines.Delete(x);
  end;
  finally
    SL.Free;
    pb.Position := 0;
    if memo2.Text <> '' then
      ShowMessage('Email addresses successfully completed')
    else
      ShowMessage('There are no email addresses');
  end;
  except
    ShowMessage('Could not load file abook.mab');
  end;
end;