Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
Solved

# Search email

Posted on 2001-07-26
Medium Priority
160 Views
0
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
• 8
• 2

LVL 1

Accepted Solution

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
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;
delete(s,p,1);
end;
end;
closefile(infile);
end;

best regards
hamed
0

LVL 1

Expert Comment

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

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

Author Comment

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
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

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

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

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

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

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
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;
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
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

ID: 6339470
marinedestroyer2, are you here?

0

## Featured Post

Question has a verified solution.

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

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the inâ€¦
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGridâ€¦
In this episode Don builds upon the troubleshooting techniques by demonstrating how to properly monitor a vSphere deployment to detect problems before they occur. He begins the show using tools found within the vSphere suite as ends the show demonstâ€¦
In this video you will find out how to export Office 365 mailboxes using the built in eDiscovery tool. Bear in mind that although this method might be useful in some cases, using PST files as Office 365 backup is troublesome in a long run (more on tâ€¦
###### Suggested Courses
Course of the Month12 days, 1 hour left to enroll