// .::MAILxTractor by Ct757::.
// [v0.1 alpha]
//
// [http://ct757.net.ru]

program MAILxTract;

{$APPTYPE CONSOLE}

uses
  Windows, SysUtils, Masks;

const
  file_name = 'e_mails.txt';
  num_of_exts = 5;

type
  PList = ^TList;
  TList = record
    mail: string[255];
    Next: PList;
  end;

type
  _exts = array[1..num_of_exts] of string[10];

var
  exts: _exts = ('*.TXT', '*.HTML', '*.HTM', '*.XML', '*.RTF');
  first_in_list: PList;
  last_in_list: PList;

function IsMailInList(mail: string): Boolean;
var
  p: PList;

begin
  p:=first_in_list;
  while (p^.mail<>mail) and (p^.Next<>nil) do
    p:=p^.Next;
  Result:=(p<>last_in_list);
end;

procedure GetMailsFromString(s: string);
var
  i, j: Integer;
  host, uname: string;

begin
  j:=Pos('@', s);
  while j>0 do
    begin
      host:='';
      uname:='';
      i:=j;
      s[j]:=' ';
      while (s[i+1] in ['a'..'z']) or
            (s[i+1] in ['A'..'Z']) or
            (s[i+1] in ['0'..'9']) or
            (s[i+1]='.') do
        begin
          host:=host+s[i+1];
          Inc(i);
        end;
      i:=j;
      if (host<>'') and (Pos('.', host)>0) then
        begin
          while (s[i-1] in ['a'..'z']) or
                (s[i-1] in ['A'..'Z']) or
                (s[i-1] in ['0'..'9']) or
                (s[i-1]='.') or (s[i-1]='_') or (s[i-1]='-') do
            Dec(i);
          if (s[i]<>'.') and (s[i]<>'_') and (s[i]<>'-') then
            uname:=Copy(s, i, j-i);
          if (uname<>'') and (host[Length(host)]<>'.') and (host[1]<>'.') and
             (uname[Length(uname)]<>'.') and (uname[1]<>'.') then
            if not IsMailInList(uname+'@'+host) then
              begin
                last_in_list^.mail:=uname+'@'+host;
                new(last_in_list^.Next);
                last_in_list:=last_in_list^.Next;
                last_in_list^.Next:=nil;
              end;
        end;
      j:=Pos('@', s);
    end;
end;

procedure GetmailsFromFile(const from_name: string);
var
  f_from: TextFile;
  s: string;

begin
  {$I-}
  AssignFile(f_from, from_name);
  Reset(f_from);
  if IOResult=0 then
    begin
      while not eof(f_from) do
        begin
          ReadLn(f_from, s);
          GetMailsFromString(s);
        end;
      CloseFile(f_from);
    end;
  {$I+}
end;

procedure ScanFiles(const szPath: string);
var
  w32fd: WIN32_FIND_DATA;
  hFind: DWORD;
  i: Integer;

begin
  hFind:=FindFirstFile(PChar(szPath+'*.*'), w32fd);
  if hFind<>INVALID_HANDLE_VALUE then
    begin
      repeat
        if ((w32fd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)<>0) and
           (w32fd.cFileName[0]<>'.') then
          ScanFiles(szPath+''+w32fd.cFileName+'\');
        i:=1;
        while (i<=num_of_exts) and not (MatchesMask(w32fd.cFileName, exts[i])) do
          Inc(i);
        if (i>0) and (i<6) then
          GetMailsFromFile(szPath+'\'+w32fd.cFileName);
      until FindNextFile(hFind, w32fd)=false;
      Windows.FindClose(hFind);
    end;
end;

function InitMailsFile: Boolean;
var
  f: TextFile;

begin
  {$I-}
  AssignFile(f, file_name);
  ReWrite(f);
  Result:=(IOResult=0);
  CloseFile(f);
  {$I+}
end;

procedure Copyright;
begin
  WriteLn('=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=');
  WriteLn('   ::MAILxTractor by Ct757::     ');
  WriteLn('       http://ct757.net.ru       ');
  WriteLn('=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=');
  WriteLn;
end;

function SaveResultsToFile(f_name: string): Boolean;
var
  f: TextFile;

begin
  {$I-}
  AssignFile(f, f_name);
  Append(f);
  if IOResult=0 then
    begin
      while first_in_list^.Next<>last_in_list do
        begin
          WriteLn(f, first_in_list^.mail);
          first_in_list:=first_in_list^.Next;
        end;
      CloseFile(f);
      Result:=true;
    end else
      Result:=false;
  {$I+}
end;

procedure InitList;
begin
  New(first_in_list);
  last_in_list:=first_in_list;
end;

procedure ScanAll;
var
  drives, err_mode: DWORD;
  i: Integer;

begin
  drives:=GetLogicalDrives;
  err_mode:=SetErrorMode(SEM_FAILCRITICALERRORS);
  for i:=1 to 25 do
    if (drives and (i shl 1))<>0 then
      ScanFiles(Char(i+65)+':\');
  SetErrorMode(err_mode);
end;

begin
  InitList;
  Copyright;
  if not InitMailsFile then
    WriteLn('Error: couldn''t create output file!') else
    begin
      Write('Searching e-mails...');
      ScanAll;
      WriteLn('OK!');
      Write('Saving to file...');
      if SaveResultsToFile(file_name) then
        WriteLn('OK!') else
        WriteLn('Error!');
    end;
  WriteLn;
  WriteLn('Press <enter> to exit...');
  ReadLn;
end.