|
|
| 用delphi实现读取foxmail的地址。 |
|
|
|
作者：未知 来源：未知 加入时间：2004-9-19 |
//今日读了各位仁兄之文章，深感黑道光荣，以下是狗兄我自写代码在d6上实现，也就不加赘述，各位参考着看代码吧。不过，在遍历ind文件时好像还有问题，请各位兄兄斧正！谢！ unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; Button2: TButton; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } public procedure FindFiles(StartDir: string); procedure getemail(filestr:string); { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var headbuf:array[0..$41] of char; recbuf:array[0..$b1] of char; name:array[0..$21] of char; email:array[0..$41] of char; f:file; i:integer; begin AssignFile(F,ExtractFilePath(application.ExeName)+'address.ind'); // f:=tfilestream.Create(ExtractFilePath(application.ExeName)+'address.ind',fmOpenReadWrite); reset(f,1); seek(f,$40); while not eof(f) do begin for i :=0 to $21 do name[i]:=char(0); for i:=0 to $41 do email[i]:=char(0); //BlockRead(FromF, Buf, SizeOf(Buf), NumRead); Blockread(f,recbuf,$b0); if recbuf[$4]='1' then continue; if recbuf[$11]='1' then continue; for i:=0 to ord(recbuf[$21]) do begin name[i]:=recbuf[i+$13]; end; for i:=0 to ord(recbuf[$33]) do email[i]:=recbuf[i+$34]; memo1.Lines.Add(name); memo1.Lines.Add('********************'); memo1.Lines.Add(email); end; closefile(f); end; procedure TForm1.FindFiles(StartDir: string); var SR: TSearchRec; //用来储存返回的文件的一些数据 IsFound: Boolean;//做为一个标志 begin IsFound :=FindFirst(StartDir+'*.ind', faAnyFile-faDirectory, SR) = 0; //在startdir里面查找htm文件 while IsFound do begin //如果找到htm文件 // GetEmailAddress(startdir+sr.Name); getemail(startdir+sr.Name); //这里调用我们自己定义的函数，传递的参数是startdir+sr.name也就是该文件的绝对路径。 //注意，这里的函数 GetEmailAddress我们等一下再来描述 IsFound := FindNext(SR) = 0; //继续查找htm文件，只到标志isfound为false end; FindClose(SR); IsFound := FindFirst(StartDir+'*.*', faAnyFile, SR) = 0; //现在是查找所有的文件 while IsFound do begin if ((SR.Attr and faDirectory) <> 0) and(SR.Name[1] <> '.') then findfiles(startdir+sr.Name+'\'); //如果该文件是目录，并且不是"."或者".."，那么就在该目录里继续查找，也就是在这里递归了。 IsFound := FindNext(SR) = 0; end; FindClose(SR); end; procedure TForm1.FormCreate(Sender: TObject); begin end; procedure TForm1.FormDestroy(Sender: TObject); begin end; procedure TForm1.getemail(filestr: string); var headbuf:array[0..$41] of char; recbuf:array[0..$b1] of char; name:array[0..$21] of char; email:array[0..$41] of char; f:file; i:integer; begin AssignFile(F,filestr); reset(f,1); seek(f,$40); while not eof(f) do begin for i :=0 to $21 do name[i]:=char(0); for i:=0 to $41 do email[i]:=char(0); //BlockRead(FromF, Buf, SizeOf(Buf), NumRead); Blockread(f,recbuf,$b0); if recbuf[$4]='1' then continue; if recbuf[$11]='1' then continue; for i:=0 to ord(recbuf[$21]) do begin name[i]:=recbuf[i+$13]; end; for i:=0 to ord(recbuf[$33]) do email[i]:=recbuf[i+$34]; memo1.Lines.Add(name); memo1.Lines.Add('********************'); memo1.Lines.Add(email); end; closefile(f); end; procedure TForm1.Button2Click(Sender: TObject); begin findfiles('D:\Foxmail\'); end; end.
 | 
|
相关文章：
相关软件： |
|
| 网络工具 | 系统工具
| 应用软件 | 多媒体类
| 联络聊天 | 行业软件
| 图形图像 | 安全相关
| 编程开发 |
教育教学 |
游戏娱乐 |
本类阅读TOP10