最近在想這個東西
給程式一個含有網址的檔案
程式就會把這些網址裡所包括下一層的網址另存到另一個網址去了
(當然也可以另存包括的e-mail囉)
用perl寫不到50行就搞定了
不過還在寫一些重複出現的網址檢查步驟
perl程式碼如下
-------------------------------------------------------------------
#!perl
use LWP::Simple;
print "輸入要尋找的網址：";
my $url=<> ;
my $file='tmp.html';
my $GoURL='GoURL.txt';
my $mailURL='mailURL.txt';
chomp $url;
my $url1=$url;
$url1 =~ s/[?].*//g;
print "$url1";
my $www = get("$url");
getstore($www, tmp.html); # 存入檔案
open(html,"> $file")||print "不能寫入$file";
print html "$www";
close(html);
open (html,"< $file")||print "不能開啟$file";
open (mailurl,">>$mailURL")||print "不能開啟$mailURL";
open (url,">>$GoURL")||print "不能開啟$GoURL";
while($line=<html>){
chomp $line;
if($line =~ /(href="\S{1,100}\")/is){
my $url2=$1;
$url2 =~ s/href\=//ig;
$url2 =~ s/"//g;
if($url2 =~ /b(/.*)/is){
print url "$url1$1\n";
}elsif($1 =~ /b(h.*)/is){
print url "$url2\n";
}elsif($url2 =~ /([?].*)/is){
print "$1\n";
}elsif($url2 =~ /b(m.*)/is){
my $mail=$1;
$mail =~ s/mailto://g;
if($mail =~ /(.*@.*)/ ){
print mailurl "$1\n";
}
}
}
if($line =~ /(w{1,20}dw{1,20}@S{1,20}[.]S{1,20}tw)/is){
print mailurl "$1\n";
}
if($line =~ /(w{1,20}dw{1,20}@S{1,20}[.]com)/is){
print mailurl "$1\n";
}
if($line =~ /(w{1,20}dw{1,20}@S{1,20}[.]org)/is){
print mailurl "$1\n";
}
if($line =~ /(w{1,20}dw{1,20}@S{1,20}[.]hk)/is){
print mailurl "$1\n";
}
}
close(url);
close(mailurl);
close(html);
------------------------------------------------------------------
會自行產生GoURL.txt來放置收集到的網址
mailURL.txt來放置收集到的e-mail
比對兩次的關係，這會比對.com和.tw結尾的
比對成功，所以找到bk20403@yahoo.com和bk20403@yahoo.com.tw
這是試用版，現在的新版就己改進這個問題了，只比對一次
像我程式的這一段也做了限制只找.tw .com .org .hk的e-mail結尾的
==================================================
if($line =~ /(w{1,20}dw{1,20}@S{1,20}[.]S{1,20}tw)/is){
print mailurl "$1\n";
}
if($line =~ /(w{1,20}dw{1,20}@S{1,20}[.]com)/is){
print mailurl "$1\n";
}
if($line =~ /(w{1,20}dw{1,20}@S{1,20}[.]org)/is){
print mailurl "$1\n";
}
if($line =~ /(w{1,20}dw{1,20}@S{1,20}[.]hk)/is){
print mailurl "$1\n";
}
是以免有心人拿去賣錢啦，所以做了限制~
沒有留言:
張貼留言