Živě.cz o počítačích a internetu

Tipy a triky v Delphi, díl 185. – adresy ze souboru DBX

Jan Šindelář 18.5.2005

Dnes se naučíme získat seznam emailových adres z datových souborů programu Outlook Express. Nebude to tentokrát žádná čistá práce, ale půjdeme na věc hrubou silou.

Získat seznam emailových adres se může hodit pro řadu účelů, například pro případ zálohování či sdílení adres s jiným počítačem. V řadě případů ale nemáme všechny kontakty uloženy v adresáři a jsou tak "pouze" součástí datových souborů s emailovými zprávami.

V programu Outlook Express jsou emailové zprávy uloženy v souborech s koncovkou DBX. U novějších verzí systému řady 2000/XP je lze najít v adresáři s dokumenty pro příslušného přihlášeného uživatele, ale jejich lokalitu lze různými způsoby i změnit. Každé složce (Doručená pošta, Koncepty atd.. včetně uživatelem definovaných složek) odpovídá příslušný soubor DBX. Právě z takových souborů budeme emailové zprávy získávat.

Jistě by bylo elegantní použít nějakou sofistikovanou metodu jako třeba OLE nebo přímo rozlousknout a využít formát souboru DBX. My na to však půjdeme primitivním způsobem. Otevřeme-li si soubor v Poznámkovém bloku, můžeme si všimnout, že ačkoliv obsahuje řadu kusů textu v podobě nečitelných znaků, texty emailů a samozřejmě i adresy jsou čitelné. Náš úkol bude tedy spočívat v tom, že projdeme celý soubor a vyhledáme v něm pouze emailové adresy, které poté vypíšeme.

Celý dnešní úkol se nám tedy zredukoval vlastně jen na to, jak poznat v bloku textu emailovou adresu od zbytku znaků. Vycházet můžeme ze zavináče, který je součástí každé adresy. Na obě strany od zavináče pak najdeme zbytek adresy. Nesmíme však zapomenout, že v adrese mohou být kromě písmen i další znaky jako například tečka či pomlčka.

Kód, který jsem našel a mírně upravil pro náš dnešní příklad není úplně dokonalý, pár vylepšení by si samozřejmě zasloužil a chtělo by to i zjednodušit některé konstrukce, ale na druhou stranu je zase v této podobě poměrně dobře vidět, jak samotné procházení textem probíhá. Pozdější úpravu kódu tedy ponechám na vás a teď se vrhneme na náš projekt.

Formulář bude vlastně obsahovat jen tři komponenty. Button, OpenDialog a Memo. Tlačítko celou akci spustí a aktivuje OpenDialog. Po výběru souboru DBX se pak spustí jeho procházení a nalezené adresy jsou vypisovány do komponenty Memo.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure CheckEMail(FilePath: string);
var
  I, hFile, buffersize, Err: Integer;
  Buffer: PChar;
  StrEmail: string;
  tsrFile: TSearchRec;

begin
  Err := FindFirst(FilePath, FaAnyFile, tsrFile);
  if Err = 0 then buffersize := tsrFile.Size
            else buffersize := -1;
  FindClose(tsrFile);
  hFile := FileOpen(FilePath, fmOpenRead);
  try
    if hFile = 0 then Exit;
    GetMem(Buffer, bufferSize + 1);
    ZeroMemory(Buffer, BufferSize + 1);
    try
      FileRead(hFile, Buffer^, BufferSize);
      I := 0;
      while I <= BufferSize - 1 do
      begin
        StrEmail := ``;
        if Buffer[I] = `<` then
        begin
          Inc(I);
          while (Buffer[I] <> `@`) and (I <= BufferSize) do
          begin
            if (Buffer[I] = CHR(45)) or (Buffer[I] = CHR(46)) or (Buffer[I] = CHR(90)) or ((Buffer[I] > CHR(49)) and (Buffer[I] <= CHR(57))) or ((Buffer[I] >= CHR(65)) and (Buffer[I] <= CHR(90))) or ((Buffer[I] >= CHR(97)) and (Buffer[I] <= CHR(122))) then StrEmail := StrEmail + Buffer[I]
            else
            begin
              StrEmail := ``;
              Break;
            end;
            Inc(I);
          end;
          if StrEmail <> `` then
          begin
            StrEmail := StrEmail + `@`;
            Inc(I);
            while (Buffer[I] <> `.`) and (I <= BufferSize) do
            begin
              if (Buffer[I] = CHR(45)) or (Buffer[I] = CHR(46)) or (Buffer[I] = CHR(90)) or ((Buffer[I] >= CHR(49)) and (Buffer[I] <= CHR(57))) or ((Buffer[I] >= CHR(65)) and (Buffer[I] <= CHR(90))) or ((Buffer[I] >= CHR(97)) and (Buffer[I] <= CHR(122))) then StrEmail := StrEmail + Buffer[I]
              else
              begin
                StrEmail := ``;
                Break;
              end;
              Inc(I);
            end;
            if StrEmail <> `` then
            begin
              StrEmail := StrEmail + `.`;
              Inc(i);
              while (Buffer[I] <> `>`) and (I <= BufferSize) do
              begin
                if (Buffer[I] = CHR(45)) or (Buffer[I] = CHR(46)) or (Buffer[I] = CHR(90)) or ((Buffer[I] >= CHR(49)) and (Buffer[I] <= CHR(57))) or ((Buffer[I] >= CHR(65)) and (Buffer[I] <= CHR(90))) or ((Buffer[I] >= CHR(97)) and (Buffer[I] <= CHR(122))) then StrEmail := StrEmail + Buffer[I]
                else
                begin
                  StrEmail := ``;
                  Break;
                end;
                Inc(I);
              end;
              if StrEmail <> `` then
              begin
                Form1.Memo1.Lines.Add(StrEmail);
                Application.ProcessMessages;
                Inc(I);
              end;
            end;
          end;
        end
        else
          Inc(I);
      end;
    finally
      FreeMem(Buffer);
    end;
  finally
    FileClose(hFile);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Button1.Enabled := False;
  if OpenDialog1.Execute then CheckEMail(OpenDialog1.FileName);
  Button1.Enabled := True;
end;

end.

Kód je poněkud delší, proto bude určitě rozumné si stáhnout ukázkovou aplikaci na konci článku. Příklad má ještě jeden nedostatek, který možná většina z vás zaznamenala již při letmém pohledu na kód. Problém je v tom, že program prochází soubor opravdu primitivně a do nalezeného seznamu přidá skutečně každou adresu, na kterou narazí, tedy i ty, které už v seznamu dávno jsou. Výsledkem je tak seznam, který obsahuje řadu adres několikrát, což je pochopitelné, protože kromě lidí, kterým napíšeme jen jednou, pak určitě existuje skupina adresátů, kterým píšeme často. Proto by bylo vhodné získaný seznam profiltrovat na duplicitní záznamy a nebo tuto filtraci provádět už přímo během procházení souborem.

A to je tedy pro dnešek vše. Pusťte se do experimentování a dnešní ukázkový příklad můžete stahovat zde.