Mega Code Archive

 
Categories / Delphi / Files
 

How to extract email addresses from Outlook .dbx files

Title: How to extract email addresses from Outlook .dbx files 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.