很多人想要的代码!(50分)

Carem · 2002-11-11

是个很久以前就有的东西，一直没有去试验，今日做起来老是不行，作者说可以在系统 目录下产生maillist.lst，但是我不行，我肯定错了，但是错那里了？请各位指教！ program zrzj; uses   windows,   messages,   Registry,   sysutils,   shellapi,   inifiles; {$R *.res} var HK:HKEY; IeCache:array[0..255] of char; IeCacheLen:integer; S:string; procedure WriteAddress(Address:string); var F:textfile; S,Str:string; CanWrite:boolean; Path:array[0..255] of char; begin GetwindowsDirectory(path,256); //首先取得系统目录，到时候把email地址列表文件保存到这里。 Str:=Strpas(Path); CanWrite:=true; AssignFile(F,Str+'/maillist.lst'); if FileExists(Str+'/maillist.lst')=false then    begin //如果不存在maillist.lst，则信建一个文件maillist.lst来存放email地址。    Rewrite(F);    writeln(F,Address);    Closefile(F);    exit;    end else        begin        Reset(f);        while not Eof(F) do           begin           Readln(F,S);           if Address=S then              begin              CanWrite:=false;              break;              end;           end;         CloseFile(F);        end; //上面用来和文件里以经存在的地址一个一个的进行效验，如果不存在就写到列表里去。 if CanWrite then    begin    Append(F);    Writeln(F,Address);    CloseFile(F);    end; end; procedure GetEmailAddress(FileName:string); var F:textfile; S:string;//用来装每次读一行的字符串 Address:string;//得到的email地址 i,Position:integer; begin AssignFile(F,FileName); Reset(f); while not Eof(f) do begin Address:=''; //首先清空address Readln(f,s); //读取一行字符串到s中 Position:=Pos('mailto:',S); //查找首个"mailto:"在s中的地址，如果一行中含有多个"mailto:"则需要你自己修改修改 if Position > 0 then   begin   for i:=Position+7 to length(S) do //这里position+7里的7表示"mailto:"的长度     begin     if ((Upcase(s)<=#90) and (Upcase(s)>=#64)) or ((S<=#57) and (S>=#48)) or (S='.') then //判断是否有效字符       Address:=Address+S     else       break;     end;       if (Address<>'') and (Pos('@',Address)<>0) then //如果是有效地址，就把它写到列表中去。 //但是，可能这个地址以前已经存在在这个列表中， //所以我定义了一个函数WriteAddress来判断是否存在该地址 //如果不存在，就添加到地址列表中去。          WriteAddress(Address);   end; end; closefile(f); end; procedure FindFiles(StartDir: string); var   SR: TSearchRec;   //用来储存返回的文件的一些数据   IsFound: Boolean;//做为一个标志 begin   IsFound :=FindFirst(StartDir+'*.htm', faAnyFile-faDirectory, SR) = 0; //在startdir里面查找htm文件   while IsFound do begin //如果找到htm文件     GetEmailAddress(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; IeCacheLen:=256; RegOpenKey(HKEY_CURRENT_USER,'Software/Microsoft/Windows/CurrentVersion/Explorer/Shell Folders/',HK); RegQueryValueEx(HK,'Cache',nil,nil,@IeCache,@ieCacheLen); //读取IE缓存的路径 S:=Strpas(IeCache)+'/'; //在刚才取得的路径后面加一个'/' FindFiles(S); //调用我们自己写的函数 end; end.

zjfeng · 2002-11-12

ysai · 2002-11-12

program MailList; uses   windows,   messages,   Registry,   sysutils,   shellapi,   inifiles; {$R *.res} var   HK:HKEY;   IeCache:array[0..255] of char;   IeCacheLen:integer;   S:string; procedure WriteAddress(Address:string); var   F:textfile;   S,Str:string;   CanWrite:boolean;   Path:array[0..255] of char; begin   GetwindowsDirectory(path,256);   //首先取得系统目录，到时候把email地址列表文件保存到这里。   Str:=Strpas(Path);   CanWrite:=true;   AssignFile(F,Str+'/maillist.lst');   if FileExists(Str+'/maillist.lst')=false then   begin     //如果不存在maillist.lst，则信建一个文件maillist.lst来存放email地址。      Rewrite(F);      writeln(F,Address);      Closefile(F);      exit;    end else begin      Reset(f);      while not Eof(F) do      begin        Readln(F,S);        if Address=S then        begin          CanWrite:=false;          break;        end;     end;     CloseFile(F);   end;   //上面用来和文件里以经存在的地址一个一个的进行效验，如果不存在就写到列表里去。   if CanWrite then   begin     Append(F);     Writeln(F,Address);     CloseFile(F);   end; end; procedure GetEmailAddress(FileName:string); var   F:textfile;   S:string;//用来装每次读一行的字符串   Address:string;//得到的email地址   i,Position:integer; begin   AssignFile(F,FileName);   Reset(f);   while not Eof(f) do   begin     Address:='';     //首先清空address     Readln(f,s);     //读取一行字符串到s中     Position:=Pos('mailto:',S);     //查找首个"mailto:"在s中的地址，如果一行中含有多个"mailto:"则需要你自己修改修改     if Position > 0 then     begin       for i:=Position+7 to length(S) do       //这里position+7里的7表示"mailto:"的长度       begin         if ((Upcase(s)<=#90) and (Upcase(s)>=#64)) or ((S<=#57) and (S>=#48)) or (S='.') then         //判断是否有效字符         Address:=Address+S         else           break;       end;       if (Address<>'') and (Pos('@',Address)<>0) then       //如果是有效地址，就把它写到列表中去。       //但是，可能这个地址以前已经存在在这个列表中，       //所以我定义了一个函数WriteAddress来判断是否存在该地址       //如果不存在，就添加到地址列表中去。         WriteAddress(Address);     end;   end;   closefile(f); end; procedure FindFiles(StartDir: string); var   SR: TSearchRec;   //用来储存返回的文件的一些数据   IsFound: Boolean;//做为一个标志 begin   IsFound :=FindFirst(StartDir+'*.htm', faAnyFile-faDirectory, SR) = 0;   //在startdir里面查找htm文件   while IsFound do   begin     //如果找到htm文件     GetEmailAddress(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;   IeCacheLen:=256;   RegOpenKey(HKEY_CURRENT_USER,'Software/Microsoft/Windows/CurrentVersion/Explorer/Shell Folders/',HK);   RegQueryValueEx(HK,'Cache',nil,nil,@IeCache,@ieCacheLen);   //读取IE缓存的路径   S:=Strpas(IeCache)+'/';   //在刚才取得的路径后面加一个'/'   FindFiles(S);   //调用我们自己写的函数 end;  begin   WriteAddress('a@a.com'); end. 注意,不是写在C:/ 而是写在C:/WINNT,也就是系统目录

Carem · 2002-11-12

to ysai: 我知道是系统目录，但是你是否运行过此代码？根本没有创建任何文件的迹象！

ysai · 2002-11-12

我当然运行了,在我的C:/WINNT下出现了那个文件 看我加的代码,就是加黑的部分,如果你没有运行我的代码,请不要这么快下结论, 因为你给的代码根本没有执行语句,也就是说程序根本没有作用,没有主体.

Carem · 2002-11-12

to ysai: 非常感谢你的帮助，是我自己没看清楚，得罪之处多多原谅，希望你以后继续指教！多谢了！ [

]

很多人想要的代码!(50分)

Carem

Unregistered / Unconfirmed

zjfeng

Unregistered / Unconfirmed

ysai

Unregistered / Unconfirmed

Carem

Unregistered / Unconfirmed

ysai

Unregistered / Unconfirmed

Carem

Unregistered / Unconfirmed

Similar threads