setmembers.cgi

一个linux论坛

	    $usrname="${lbdir}$memdir/old/$memberfile" if (!(-e $usrname));
	    open (FILE, "$usrname");
    	    flock (FILE, 2) if ($OS_USED eq "Unix");
    	    $line = <FILE>;
    	    close (FILE);
	    undef $joineddate;
	    undef $lastgone;
	    undef $anzahl;
	    undef $lastpostdate;
	    undef $userad;
	    undef $visitno;
	    undef $anzahl1;
	    undef $anzahl2;
	    undef $emailaddr;
	    undef $membername;

    	    ($membername, $no, $no, $userad, $anzahl, $emailaddr, $no, $no, $no, $no, $no ,$no ,$no, $joineddate, $lastpostdate, $no, $timedifference, $no, $no, $no, $no, $no, $no, $no, $no, $rating, $lastgone, $visitno, $addjy, $meili, $mymoney, $postdel, $sex, $education, $marry, $work, $born, $chatlevel, $chattime, $jhmp, $useradd3, $useradd4, $onlinetime, $userquestion, $useradd6, $useradd7, $useradd8) = split(/\t/,$line);

	    ($anzahl1, $anzahl2) = split(/\|/,$anzahl);
	    $anzahl = $anzahl1 + $anzahl2;
	    ($lastpost, $posturl, $posttopic) = split(/\%\%\%/,$lastpostdate);
	    $lastgone = $lastpost   if ($lastpost > $lastgone);
	    $lastgone = $joineddate if ($joineddate > $lastgone);
	    
	    if ($lastgone <= $deltime) {
	        $membername =~ s/ /\_/isg;
		$membername =~ tr/A-Z/a-z/;

	        unlink ("${lbdir}$memdir/$membername.cgi");
	        unlink ("${lbdir}$memdir/old/$membername.cgi");
        	unlink ("${lbdir}$msgdir/in/${membername}_msg.cgi");
	        unlink ("${lbdir}$msgdir/out/${membername}_out.cgi");
        	unlink ("${lbdir}$msgdir/main/${membername}_mian.cgi");
	        unlink ("${lbdir}memfav/$membername.cgi");
        	unlink ("${lbdir}memblock/$membername.cgi");
	    	unlink ("${imagesdir}usravatars/$membername.gif");
    		unlink ("${imagesdir}usravatars/$membername.png");
	    	unlink ("${imagesdir}usravatars/$membername.jpg");
    		unlink ("${imagesdir}usravatars/$membername.swf");
	    	unlink ("${imagesdir}usravatars/$membername.bmp");

	        $delno ++;
	  	if ($sendtoemail eq "") { $sendtoemail = $emailaddr; } else { $sendtoemail = "$sendtoemail, $emailaddr"; }
	    }
	}
 	
  	if (($emailfunctions eq "on")&&($sendtoemail ne "")) {
            &sendmail($from, $from, $sendtoemail, $subject, $message);
        }
	$step++;
	print qq~<meta http-equiv="refresh" Content="0; url=$thisprog?action=delok&checkaction=yes&delno=$delno&step=$step&users=$users">
<tr><td bgcolor=#FFFFFF align=center colspan=2>
<font color=#333333><br>　如果你的浏览器没有自动前进，请<a href=$thisprog?action=delok&checkaction=yes&delno=$delno&step=$step&users=$users>点击继续</a>
</td></tr>
			~;

    } else {
        require "$lbdir" . "data/boardstats.cgi";

        $filetomake = "$lbdir" . "data/boardstats.cgi";
        $totalmembers=$totalmembers - $delno;
        &winlock($filetomake) if ($OS_USED eq "Nt");
        open(FILE, ">$filetomake");
        flock(FILE, 2) if ($OS_USED eq "Unix");
        print FILE "\$lastregisteredmember = \'$lastregisteredmember\'\;\n";
        print FILE "\$totalmembers = \'$totalmembers\'\;\n";
        print FILE "\$totalthreads = \'$totalthreads\'\;\n";
        print FILE "\$totalposts = \'$totalposts\'\;\n";
        print FILE "\n1\;";
        close (FILE);
        &winunlock($filetomake) if ($OS_USED eq "Nt");

        # Delete the database for the member

	unlink ("${lbdir}data/delmember.cgi");

        print qq~
        <tr>
        <td bgcolor=#EEEEEE align=center colspan=2>
        <font color=#333333><b>$delno 个过期注册用户已经被完整删除<BR>
        用户库已经全部更新</b><br><Br><a href=foruminit.cgi?action=uptop>点这儿更新用户排名一次</a><br>
        </td></tr>
         ~;
     }
}

else {
        print qq~
        <tr>
        <td bgcolor=#EEEEEE align=center colspan=2>
        <font color=#990000><b>警告！！</b>
        </td></tr>
        
        <tr>
        <td bgcolor=#FFFFFF align=center colspan=2>
        <font color=#333333>完全删除所有符合条件的预删除用户，点击下面的链接继续。<BR>
        在预删除期间访问过论坛的用户不会被删除<p>
        <p>
        >> <a href="$thisprog?action=delok&checkaction=yes">开始删除</a> <<
        </td></tr>
        </table></td></tr></table>
        ~;
        }
}
} # end routine

sub viewletter {

open (FILE, "$lbdir/data/lbmember1.cgi");
my @membernames = <FILE>;
close (FILE);
undef @sortedfile;
foreach (@membernames) {
    chomp $_;
    ($names,$no) = split(/\t/,$_);
    push (@sortedfile, $names);
}

    @sortedfile = sort alphabetically(@sortedfile);
    
    foreach (@sortedfile) {
    	if ($_ =~ /^[\w\-]/) {
        $fr = substr($_, 0, 1);
        $fr =~ tr/a-z/A-Z/;
        }
        else {
           $fr =substr($_, 0, 2);
        }
        push(@letters,$fr);
        }
    @sortedletters = sort(@letters);
     
    print qq~
    <tr>
    <td bgcolor=#EEEEEE colspan=2><center>
    <font color=#990000><b>查看所有以 "$inletter" 开头的用户</b><p>
	<form action="setmembers.cgi" method=POST>
        <input type=hidden name="action" value="edit">
        <input type=text name="member" size=10 maxlength=16>
        <input type=submit value="快速定位">
        </form>
    注册用户大致列表：</center>~;

    $nowcount =0;
    foreach (@sortedletters) {
        unless ($_ eq "$ltr") {
            print qq~<br>~ if ($nowcount == int($nowcount/15)*15);
            print qq~&nbsp;<a href="$thisprog?action=viewletter&letter=~ . ($uri_escape eq "no" ? $_ : uri_escape($_)) . qq~">$_</a>&nbsp;~;
            $ltr = "$_";
            $nowcount ++;
        }
    }

    print qq~
    </td>
    </tr>          
    <tr>
    <td bgcolor=#FFFFFF align=center colspan=2>
    &nbsp;
    </td>
    </tr>          
    ~;
               
               
    foreach (@sortedfile) {
    	if ($_ =~ /^[\w\-]/) {
        $frr = substr($_, 0, 1);
        $frr =~ tr/a-z/A-Z/;
        }
        else {
           $frr =substr($_, 0, 2);
        }
        if ($inletter eq $frr) {
            $_ =~ s/\.cgi$//;
            $member = $_;
            &getmember("$member");
            &showmember;
            }
        }
        
   } # end route

sub viewip {
    unless($inletter eq "findsame"){
	$inletters=$inletter;
	$inletter=($inletter !~/\./)?$inletter.".":$inletter;
	$inletter=~s/\./\\\./g;
	}
    %iplist=();%sameiplist=();@thatiplist=();
open (FILE, "$lbdir/data/lbmember4.cgi");
my @ipfile = <FILE>;
close (FILE);
chomp @file;
	foreach(@ipfile){
		(my $membername,my $getip)=split(/\t/,$_);
		if($inletter ne "findsame"){
			push (@thatiplist,$membername) if($getip =~/^$inletter/);
		}else{
			$sameiplist{$getip}="" unless(defined($sameiplist{$getip}));
			$sameiplist{$getip}.=qq(<a href="$thisprog?action=edit&member=$membername">$membername</a>,);
		}
		($getip,$getip2)=split(/, /,$getip);
		$getip = $getip2 if (($getip2 ne "")&&($getip2 ne "unknown"));
		$getip=~s/\.([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})$//;
		$iplist{$getip}="$getip" unless(defined($iplist{$getip}));
	}
	@iplist=keys %iplist;
    @iplist = sort(@iplist);
    
    print qq~
    <tr><td bgcolor=#EEEEEE align=center colspan=2><font color=#990000><b>寻找以特定ＩＰ注册的用户</b></font></td></tr>
    <tr><td bgcolor=#FFFFFF align=left colspan=2>　　　　　　　　　　<b>说明:</b><br>
　　　　　　　　　　你如果要寻找一个 IP，可以直接输入 IP 地址在这里，比如： 202.100.200.100。<br>
　　　　　　　　　　如果你要寻找一个 C 类网，那么你可以不输入 IP 的最后一位，比如：202.100.200. <br>
　　　　　　　　　　如果你要寻找一个 B 类网，那么你可以不输入 IP 的最后两位，比如：202.100. <br>
　　　　　　　　　　注意上面的写法，如果寻找的是一个 C 类或者 B 类网，请最后保留点号(.)，切记！</td></tr>
    <tr>
    <form action="setmembers.cgi" method=POST><input type=hidden name="action" value="viewip"><td bgcolor=#EEEEEE align=center colspan=2><input type=text name="letter" size20 maxlength=16> <input type=submit value="寻找用户"></td></form></tr>
    <tr>
    <form action="setmembers.cgi" method=POST><input type=hidden name="action" value="viewip"><input type=hidden name="letter" value="findsame"><td bgcolor=#EEEEEE align=center colspan=2><input type=submit value="寻找所有相同ＩＰ的用户"></td></form></tr>
    <tr><td bgcolor=#FFFFFF align=center colspan=2 height="20"></td></tr>
    <tr><td bgcolor=#EEEEEE align=center colspan=2><font color=#990000><b>注册ＩＰ大致列表</b></font></td></tr>
    <tr><td bgcolor=#FFFFFF align=left colspan=2>　　　　　　　　　　~;

    $nowcount =0;
    foreach (@iplist) {
        	$ipshow=sprintf("% 3s",$_);
        	$ipshow=~s/\s/\&nbsp\;/g;
            print qq~<br>　　　　　　　　　　~ if ($nowcount == int($nowcount/15)*15);
            print qq~ <a href="$thisprog?action=viewip&letter=$_">$ipshow</a> ~;
            $nowcount ++;
    }

    print qq~
    </td></tr>
    <tr><td bgcolor=#FFFFFF align=center colspan=2 height="20"></td></tr>~;
    if($inletter ne "findsame"){
    print qq~
    <tr><td bgcolor=#EEEEEE align=center colspan=2><font color=#990000><b>所有ＩＰ以 "$inletters" 开头的用户</b></font></td></tr>
    <tr><td bgcolor=#FFFFFF align=center colspan=2 height="20"></td></tr>
    ~;
		foreach (@thatiplist) {
			$member = $_;
			&getmember("$member");
			&showmember;
			}
    }else{
    print qq~
    <tr><td bgcolor=#EEEEEE align=center colspan=2><font color=#990000><b>所有相同ＩＰ的用户</b></font></td></tr>
    <tr><td bgcolor=#FFFFFF align=left colspan=2>　　　　　　　　　　<b>注意:</b><br>
　　　　　　　　　　相同ＩＰ不一定代表是同一人。<br></td></tr>
    ~;
		while(($ip,$thisiplist)=each(%sameiplist)){
			my @listofthisip=split(/\,/,$thisiplist);
			my $listofthisipc=@listofthisip;
			next if($listofthisipc <= 1);
			$listofthisip=join(",",@listofthisip);
    print qq~
    <tr><td bgcolor=#EEEEEE colspan=2 align=center><font color=#333333><b>ＩＰ为 "<font color=#990000>$ip</font>" 的用户</b></font></td></tr>
    <tr><td bgcolor=#FFFFFF colspan=2 align=left>$listofthisip</td></tr>
    <tr><td bgcolor=#FFFFFF> </td><td bgcolor=#FFFFFF> </td></tr>
    ~;
		}
	}
}


##################################################################################
######## Subroutes (Show member) 


sub showmember {

    $joineddate = &longdate("$joineddate");
    
    $cleanmember = $member;
    $cleanmember =~ s/\_/ /g;
    
    ## Sort last post, and where
    
    ($postdate, $posturl, $posttopic) = split(/\%%%/,$lastpostdate);
    
    if ($postdate ne "没有发表过") {
        $postdate = &longdate("$postdate");
        $lastpostdetails = qq~最后发表 <a href="$posturl">$posttopic</a> 在 $postdate~;
        }
        else {
            $lastpostdetails = "没有发表过";
            }

    if ($membercode eq "banned") {
        $unbanlink = qq~ | [<a href="$thisprog?action=unban&member=~ . ($uri_escape eq "no" ? $member : uri_escape($member)) . qq~">取消禁止发言</a>]~;
        }
    $totlepostandreply = $numberofposts+$numberofreplys;
    print qq~
    <tr>
    <td bgcolor=#EEEEEE colspan=2 align=center><font face=$font color=$fontcolormisc><b><font color=$fonthighlight>"$cleanmember"</b> 的详细资料 　 [ <a href="$thisprog?action=edit&member=~ . ($uri_escape eq "no" ? $member : uri_escape($member)) . qq~">编辑</a> ] | [ <a href="$thisprog?action=deletemember&member=~ . ($uri_escape eq "no" ? $member : uri_escape($member)) . qq~">删除</a> ]$unbanlink</font></td></tr>
    <tr>
    <td bgcolor=#FFFFFF width=30%><font color=#333333><b>注册时间：</b></font></td>
    <td bgcolor=#FFFFFF><font color=#333333>$joineddate</font></td></tr>
    <tr>
    <td bgcolor=#FFFFFF width=30%><font color=#333333><b>注册ＩＰ：</b></font></td>
    <td bgcolor=#FFFFFF><font color=#333333>$ipaddress</font> (<a href="$thisprog?action=viewip&letter=$ipaddress">找相同ＩＰ的用户</a>)</td></tr>
    <tr>
    <td bgcolor=#FFFFFF><font color=#333333><b>用户头衔：</b></font></td>
    <td bgcolor=#FFFFFF><font color=#333333>$membertitle</font></td></tr>