Извлечь Email адреса из DBX файлов OutlookDelphi , Интернет и Сети , Почтовый клиентИзвлечь Email адреса из DBX файлов Outlook
Оформил: DeeCo 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. Извлечь Email адреса из DBX файлов Outlook: программный код на Delphi, который позволяет извлекать электронные почтовые адреса из файлов формата DBX, используемых в приложении Microsoft Outlook. Комментарии и вопросыМатериалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта. :: Главная :: Почтовый клиент ::
|
||||
©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007 |