Извлечь Email адреса из DBX файлов Outlook

Delphi , Интернет и Сети , Почтовый клиент

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

unit ExtractEmailsFunc;

 interface

 uses
   Windows, SysUtils;

 procedure CheckEMail(FilePath: string);

 implementation

 var
   BufferSize: Integer;

 function VerifyFile(strFileName: string): Integer;
 var
   intErro: Integer;
   tsrFile: TSearchRec;
 begin
   intErro := FindFirst(strFileName, FaAnyFile, tsrFile);
   if intErro = 0 then Result := tsrFile.Size
    else
      Result := -1;
   FindClose(tsrFile);
 end;

 procedure CheckEMail(FilePath: string);
 var
   I: Integer;
   hFile: Integer;
   Buffer: PChar;
   StrEmail: string;
 begin
   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
              begin
               StrEmail := StrEmail + Buffer[I];
             end
              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
                begin
                 StrEmail := StrEmail + Buffer[I];
               end
                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
                  begin
                   StrEmail := StrEmail + Buffer[I];
                 end
                  else
                  begin
                   StrEmail := '';
                   Break;
                 end;
                 Inc(I);
               end;
               if StrEmail <> '' then
                begin
                 WriteLn(StrEmail);
                 Inc(I);
               end;
             end;
           end;
         end
          else
            Inc(I);
       end;
     finally
       FreeMem(Buffer);
     end;
   finally
     FileClose(hFile);
   end;
 end;

 begin
   BufferSize := VerifyFile(ParamStr(1));
   if BufferSize <= 0 then Exit;
   CheckEMail(ParamStr(1));
 end.

Программа на Delphi для извлечения электронных адресов из файлов DBX (архивы Outlook) с помощью процедуры CheckEMail. Вот подробное описание кода:

Функция VerifyFile: эта функция проверяет, существует ли файл и возвращает его размер в байтах, если он найден, или -1, если не найден.

Процедура CheckEMail: эта процедура читает содержимое файла DBX, указанного параметром FilePath, и извлекает электронные адреса из него. Она использует буфер для хранения данных файла и затем итерирует через буфер, чтобы найти электронные адреса в формате <email>@domain.com>. Вот, как она работает: 1. Она открывает файл для чтения с помощью FileOpen. 2. Она выделяет память для буфера с помощью GetMem и инициализирует его нулями. 3. Она читает весь файл в буфер с помощью FileRead. 4. Она итерирует через буфер, ищет электронные адреса, которые начинаются с < и заканчиваются >. 5. Когда электронный адрес найден, она извлекает его, читая символы, пока не встретит @, ., или конец буфера. 6. Она пишет извлеченный электронный адрес на консоль с помощью WriteLn.

Главная программа: главная программа вызывает функцию VerifyFile для проверки существования первого аргумента командной строки (путь к файлу) и, если он существует, вызывает процедуру CheckEMail с этим файлом. Чтобы использовать эту программу, просто скомпилируйте ее и запустите из командной строки, указав путь к файлу DBX в качестве аргумента:

ExtractEmailsFunc.exe C:\Path\To\DBXFile.dbx

Это выведет все электронные адреса из файла DBX на консоль. Обратите внимание: эта программа предполагает, что файл DBX находится в формате, совместимом с Outlook. Если вы используете другой клиент электронной почты, это может не работать правильно.

Извлечь Email адреса из DBX файлов Outlook: программный код на Delphi, который позволяет извлекать электронные почтовые адреса из файлов формата DBX, используемых в приложении Microsoft Outlook.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Почтовый клиент ::