?
Solved

Search email

Posted on 2001-07-26
10
Medium Priority
?
156 Views
Last Modified: 2010-04-06
How do you search for an email address in text files?? Please help. My email is creator@magix.com.sg
0
Comment
Question by:marinedestroyer2
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 8
  • 2
10 Comments
 
LVL 1

Accepted Solution

by:
h_mohsenian earned 600 total points
ID: 6322184
if i understand perfectly, u need a code that find all  e-mails in a textfile and for example add them to a listbox.

for execute the folowing code u must change Filename as ur file name and use a TListbox. i used spaces over a email address ! ( i have not any better way ! )

procedure TForm1.Button1Click(Sender: TObject);
var
  infile : textfile;
  filename, s : string;
  p : integer;
  i,p1,p2 : integer;
begin
Filename := 'mytext.txt'
assignFile(infile,Filename);
reset(infile);
while not eof(infile) do
begin
  readln(infile,s);
  while pos('@',s) > 0 do
  begin
    p := pos('@',s);
    for i := p downto 1 do
      if s[i] = ' ' then break;
    p1 := i+1;
    for i := p to length(s) do
      if s[i] = ' ' then break;
    p2 := i-1;
    ListBox1.Items.Add(copy(s,p1,p2-p1+1));
    delete(s,p,1);
  end;
end;
closefile(infile);
end;


best regards
hamed
0
 
LVL 1

Expert Comment

by:h_mohsenian
ID: 6325569
i had a mistake : space is not the just seperator char , now i use valid chars for email , the both for loops convert to :

   for i := p downto 1 do
     if not (s[i] in ['0'..'9','.','a'..'z','A'..'Z']) then break;
   p1 := i+1;
   for i := p to length(s) do
     if not (s[i] in ['0'..'9','.','a'..'z','A'..'Z']) then break;
   
maybe i have more mistake too ;-)

hamed
0
 

Author Comment

by:marinedestroyer2
ID: 6326756
Thank you......your script is great except that this part doesn't work....nonetheless....you deserve the points thank you.
:

  for i := p downto 1 do
    if not (s[i] in ['0'..'9','.','a'..'z','A'..'Z']) then break;
  p1 := i+1;
  for i := p to length(s) do
    if not (s[i] in ['0'..'9','.','a'..'z','A'..'Z']) then break;
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 

Author Comment

by:marinedestroyer2
ID: 6327450
One more thing, I am willing to give more points if you can tell me how to do this:
you see, I am trying to make this filter system where it scans the whole drive for .txt files and then it searches words in the text file and list it out. I have already done the searching file program but I do not know how to add it to this searching words program. My searching file program is below

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender:Tobject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  function FindFile(const filespec: TFileName; attributes: integer= faReadOnly Or faHidden Or faSysFile Or faArchive): TStringList;

var
  Form1: TForm1;



  implementation

  function FindFile(const filespec: TFileName;
                    attributes: integer): TStringList;
  var
    spec: string;
    list: TStringList;

  procedure RFindFile(const folder: TFileName);
  var
    SearchRec: TSearchRec;
  begin
    // Locate all matching files in the current
    // folder and add their names to the list
    if FindFirst(folder + spec, attributes, SearchRec)=0 then begin
      try
        repeat
          if (SearchRec.Attr and faDirectory = 0) or
             (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
            list.Add(folder + SearchRec.Name);
        until FindNext(SearchRec) <> 0;
      except
        FindClose(SearchRec);
        raise;
      end;
      FindClose(SearchRec);
    end;
    // Now search the subfolders
    if FindFirst(folder + '*', attributes
        Or faDirectory, SearchRec) = 0 then
    begin
      try
        repeat
          if ((SearchRec.Attr and faDirectory) <> 0) and
             (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
            RFindFile(folder + SearchRec.Name + '\');
        until FindNext(SearchRec) <> 0;
      except
        FindClose(SearchRec);
        raise;
      end;
      FindClose(SearchRec);
    end;
  end; // procedure RFindFile inside of FindFile

  begin // function FindFile
    list := TStringList.Create;
    try
      spec := ExtractFileName(filespec);
      RFindFile(ExtractFilePath(filespec));
      Result := list;
    except
      list.Free;
      raise;
    end;
  end;




  procedure TForm1.Button1Click(Sender: TObject);
  var
    list: TStringList;
  begin
    list := FindFile('C:\*.pas');
    ListBox1.Items.Assign(list);
    list.Free;
  end;

{$R *.DFM}

end.

0
 
LVL 1

Expert Comment

by:h_mohsenian
ID: 6329344
thanks marinedestroyer2,

my second code had just a little bug :

in the first loop p changes to p-1 and in second p changes to p+1 then we pass the '@' char , infact :


 for i := p-1 downto 1 do
   if not (s[i] in ['0'..'9','.','a'..'z','A'..'Z']) then break;
 p1 := i+1;
 for i := p+1 to length(s) do
   if not (s[i] in ['0'..'9','.','a'..'z','A'..'Z']) then break;

i suggested u this code becouse it is more complete.

sorry , now i have not delphi ( where i am now ). i will see your code later.

best regards
hamed
0
 
LVL 1

Expert Comment

by:h_mohsenian
ID: 6329358
i think that is better u ask ur q as a dependent q , therefor u can get yr need faster.

sorry again
hamed
0
 
LVL 1

Expert Comment

by:h_mohsenian
ID: 6329607
i see ur code again and now have Delphi,

i think u want a programm that search all of the .txt files in a directory ( and its subdirectories ) and find all emails that had written in that files and add them to a Listbox( not add filenames to a listbox )

now if it is exactly ur need. I worte ur app ( by a little correction of ur code and my first code ). give me your email. i will send u the application.

best regards
hamed
0
 
LVL 1

Expert Comment

by:h_mohsenian
ID: 6329614
sorry, it seems your new q is deferent to ur last q.is your example in your q, is just an example or is ur exact need
0
 
LVL 1

Expert Comment

by:h_mohsenian
ID: 6329621
the code is : ( see it , if it was you need us it )

all of them are important , ichanged some lines :

unit email2Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    ListBox1: TListBox;
    ListBox2: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    procedure FindEmailsFromFile(filename : string);    { Private declarations }
    function FindFile(const filespec: TFileName; attributes: integer= faReadOnly Or faHidden Or faSysFile
      Or faArchive): TStringList;
  public
    { Public declarations }
  end;



var
  Form1: TForm1;

implementation



procedure TForm1.FindEmailsFromFile(filename : string);
var
infile : textfile;
s : string;
p : integer;
i,p1,p2 : integer;
begin
assignFile(infile,Filename);
reset(infile);
while not eof(infile) do
begin
 readln(infile,s);
 while pos('@',s) > 0 do
 begin
   p := pos('@',s);
   for i := p-1 downto 1 do
     if not (s[i] in ['0'..'9','.','a'..'z','A'..'Z']) then break;
   p1 := i+1;
   for i := p+1 to length(s) do
     if not (s[i] in ['0'..'9','.','a'..'z','A'..'Z']) then break;
   p2 := i-1;
   ListBox2.Items.Add(copy(s,p1,p2-p1+1));
   delete(s,p,1);
 end;
end;
closefile(infile);
end;



 function TForm1.FindFile(const filespec: TFileName;
                   attributes: integer): TStringList;
 var
   spec: string;
   list: TStringList;
 procedure RFindFile(const folder: TFileName);
 var
   SearchRec: TSearchRec;
 begin
   // Locate all matching files in the current
   // folder and add their names to the list
   if FindFirst(folder + spec, attributes, SearchRec)=0 then begin
     try
       repeat
         if (SearchRec.Attr and faDirectory = 0) or
            (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
            begin
              list.Add(folder + SearchRec.Name);
              FindEmailsFromFile(folder + SearchRec.Name);
            end;
       until FindNext(SearchRec) <> 0;
     except
       FindClose(SearchRec);
       raise;
     end;
     FindClose(SearchRec);
   end;
   // Now search the subfolders
   if FindFirst(folder + '*', attributes
       Or faDirectory, SearchRec) = 0 then
   begin
     try
       repeat
         if ((SearchRec.Attr and faDirectory) <> 0) and
            (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
           RFindFile(folder + SearchRec.Name + '\');
       until FindNext(SearchRec) <> 0;
     except
       FindClose(SearchRec);
       raise;
     end;
     FindClose(SearchRec);
   end;
 end; // procedure RFindFile inside of FindFile

 begin // function FindFile
   list := TStringList.Create;
   try
     spec := ExtractFileName(filespec);
     RFindFile(ExtractFilePath(filespec));
     Result := list;
   except
     list.Free;
     raise;
   end;
 end;

procedure TForm1.Button1Click(Sender: TObject);
 var
   list: TStringList;
 begin
   list := FindFile('E:\hamed\*.txt');
   ListBox1.Items.Assign(list);
   list.Free;
 end;

 {$R *.DFM}

end.



0
 
LVL 1

Expert Comment

by:h_mohsenian
ID: 6339470
marinedestroyer2, are you here?

could that code help you?
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Michael from AdRem Software outlines event notifications and Automatic Corrective Actions in network monitoring. Automatic Corrective Actions are scripts, which can automatically run upon discovery of a certain undesirable condition in your network.…
In this video, Percona Director of Solution Engineering Jon Tobin discusses the function and features of Percona Server for MongoDB. How Percona can help Percona can help you determine if Percona Server for MongoDB is the right solution for …
Suggested Courses

752 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question