EmailExtractor

{ Started writing on 2010.05.07 by Kulverstukas || last update: 2010.05.15 }
unit emailextracter;

interface

uses
  Classes,SysUtils,FileUtil,LResources,Forms,Controls,Graphics,Dialogs,StdCtrls,
  Menus, greetz;

type

  { TForm1 }

  TForm1 = class(TForm)
    emailText:TLabel;
    emailCount:TLabel;
    ListBox1:TListBox;
    Select:TButton;
    Extract:TButton;
    Edit1:TEdit;
    MainMenu1:TMainMenu;
    MenuItem1:TMenuItem;
    procedure ExtractClick(Sender:TObject);
    procedure SelectClick(Sender:TObject);
    procedure MenuItem1Click(Sender:TObject);

  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  OldPath, NewPath : string;
  OldEmailDump, NewEmailDump : text;
  saveDialog :TSaveDialog;
implementation

{ TForm1 }
{$I-}
//======================================= // program procedures start here
function FindMail (Line : ansistring) : ansistring;
var i, i1, i2 : longint;
const delimiter = ' !@#$%^&*()[];,"''<>|.   ';
 begin
  result := '';           // null the variable
   i := Pos('@',Line);    // determine exact position of @ in string
//========
 if i = 0 then exit;  // Search down for any delimiter that could be in front of e-mail address
  i1 := i;
   repeat
    Dec(i1);  // decrease i1 by 1 bit
   until (i1 < 1) or (Pos(Copy(Line,i1,1),Delimiter) <> 0); // until i1 is less then 1
    Inc(i1);   // increase i1 by 1 bit if it is less then 1
//========
  i2 := i;   // Search until we find a dot
   repeat
    Inc(i2);
   until (i2 > Length(Line)) or (Pos(Copy(Line,i2,1),Delimiter) <> 0);
//========
 if (i2 > Length(Line)) or (Copy(Line,i2,1) <> '.') then   // If we didn't find a dot, then it's not an e-mail address
  begin
   result := '';
   exit;
  end;
//========
  repeat     // We continue to find another delimiter that would end the address
   Inc(i2);
  until (i2 > Length(Line)) or (Pos(Copy(Line,i2,1),Delimiter) <> 0);
   Dec(i2);
//========
  result := Copy(Line,i1,i2 - i1 + 1);
end;
//=======================================
procedure ExtractMail;
 var email, line : AnsiString;
     mailCount : integer;
begin
 Form1.Extract.Enabled := false;
 Form1.ListBox1.Clear;
 mailCount := 0;
 OldPath := Form1.Edit1.Text;
 NewPath := saveDialog.FileName;
 Assign(OldEmailDump, OldPath);
 Reset(OldEmailDump);
 Assign(NewEmailDump, NewPath);
 ReWrite(NewEmailDump);
  Repeat
   ReadLn(OldEmailDump, line);
    email := FindMail(line);
     if email <> '' then
      begin
       Form1.Refresh;
       mailCount := mailCount + 1;
       Form1.emailCount.Caption := IntToStr(mailCount);
       Form1.ListBox1.Items.Add('Found email: '+email);
       Form1.ListBox1.TopIndex := -1 + Form1.ListBox1.Items.Count;  // scroll down the list to the last item automaticaly
       WriteLn(NewEmailDump, email);
      end;
  until EoF(OldEmailDump);
 Close(OldEmailDump);
 Close(NewEmailDump);
end;

//======================================= // object procedures start here
procedure TForm1.SelectClick(Sender:TObject);
var
  openDialog : TOpenDialog;    // Open dialog variable. Used as Record.
begin
//=======
  openDialog := TOpenDialog.Create(self);  // assign the dialog to the variable
  openDialog.InitialDir := GetCurrentDir;  // open directory where exe was launched from
  openDialog.Options := [ofFileMustExist];  // only allow existing files
  openDialog.Filter := 'Any file|*.*|Text files - *.txt|*.txt|SQL dumps - *.sql|*.sql';
  openDialog.FilterIndex := 1;  // define what option is default defined in Filter
  openDialog.Title := 'Select a dump';
//=======
   if openDialog.Execute  // continue if a user has selected a file and clicked OK
    then
     begin
      Edit1.Text := openDialog.FileName;
     end;
end;
//=======================================
procedure TForm1.MenuItem1Click(Sender:TObject);
begin
  Form4.ShowModal;
end;
//=======================================
procedure TForm1.ExtractClick(Sender:TObject);
begin
//==========
  if FileExists(Form1.Edit1.Text) then
   begin
//==========
  saveDialog := TSaveDialog.Create(self); // assign Save file dialog to saveDialog variable
  saveDialog.Title := 'Save your Email dump';  // title of the save dialog
  saveDialog.InitialDir := GetCurrentDir;  // get dir the extracter is in
  saveDialog.Filter := 'Any file|*.*';     // allow any file
  saveDialog.DefaultExt := 'txt';         // default extension. If no extension is provided the it's gonna be txt anyway
   if saveDialog.Execute then
    begin
     ExtractMail;
    end;
//==========
   end
  else
   begin
    ShowMessage('File doesn''t exist. Feed me with existing file!');
   end;
//==========
end;

//=======================================
initialization
  {$I emailextracter.lrs}

end.