common.lib

这个社区是虚拟社区使用的程序

###############################################################################
# Common.lib                                                                  #
###############################################################################
# UltraBoard Ver. 1.61 by UltraScripts.com                                    #
# Scripts written by Jacky W.W. Yung, [e-mail]              #
# Available from http://www.UltraScripts.com/UltraBoard/                      #
# --------------------------------------------------------------------------- #
# PROGRAM NAME : UltraBoard                                                   #
# VERSION : 1.61                                                              #
# LAST MODIFIED : 30/06/1999                                                  #
# =========================================================================== #
# COPYRIGHT NOTICE :                                                          #
#                                                                             #
# Copyright (c) 1999 Jacky Yung. All Rights Reserved.                         #
#                                                                             #
# This program is free software; you can change or modify it as you see fit.  #
# However, modified versions cannot be sold or distributed.  You cannot alter #
# the copyright and "powered by" notices throughout the scripts. These        #
# notices must be clearly visible to the end users.                           #
#                                                                             #
# WARRANTY DISCLAIMER:                                                        #
#                                                                             #
# THIS PROGRAM IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, BUT WITHOUT #
# ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF MERCHANTABILITY OR       #
# FITNESS FOR A PARTICULAR PURPOSE.                                           #
###############################################################################

###############################################################################
# Variables                                                                   #
###############################################################################

$Spliter="\|\^\|";

###############################################################################
# ParseForm                                                                   #
###############################################################################
sub ParseForm{
	my ($Buffer, @Pairs, $Pair, $Name, $Value);
	if($ENV{'REQUEST_METHOD'} eq "POST"){
    	read(STDIN, $Buffer, $ENV{'CONTENT_LENGTH'});
	}elsif($ENV{'REQUEST_METHOD'} eq "GET"){
		$Buffer=$ENV{'QUERY_STRING'};
	}
	@Pairs = split(/&/, $Buffer);
	foreach $Pair (@Pairs) {
		($Name, $Value) = split(/=/, $Pair);
		$Value =~ tr/+/ /;
		$Value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
		#$Value =~ s/<!--(.|\n)*-->//g;
		#$Value =~ s/\n/<br>/g;
		$Value =~ s/\r//g;
		$Value =~ s/^\s+//g;
		$Value =~ s/\s+$//g;
		$in{$Name} = $Value;
	}
}

###############################################################################
# CheckBanned                                                                 #
###############################################################################
sub CheckBanned {
	if ($Ban) {
		open(BAN,"$VarsPath/IPs.ban");
			flock(BAN,2) if ($FLock);
			my (@IPs)=<BAN>;
		close(BAN);
		chomp (@IPs);
		open(BAN,"$VarsPath/Hosts.ban");
			flock(BAN,2) if ($FLock);
			my (@Hosts)=<BAN>;
		close(BAN);
		chomp (@Hosts);
		foreach $IP (@IPs) {
			chomp ($IP);
			if ($ENV{'REMOTE_ADDR'}=~/^$IP/) {
				&ShowError("BANNED","Sorry, you have been banned.");
			}
		}
		if ($ENV{'REMOTE_HOST'}) {
			foreach $Host (@Hosts) {
				chomp ($Host);
				if ($ENV{'REMOTE_HOST'}=~/$Host$/) {
					&ShowError("BANNED","Sorry, you have been banned.");
				}
			}
		}		
	}
}

###############################################################################
# GetSession                                                                  #
###############################################################################
sub GetSession {
    my ($SessionID)=@_;
    return ("-1","") unless (-e "$SessionPath/$SessionID");
    open(SESSION,"$SessionPath/$SessionID");
		flock(SESSION,1) if ($FLock);
        my (@info)=<SESSION>;
        chomp (@info);
        my ($UserName, $Password)=@info;
	close(SESSION);
    $UserName =~ s/\\\|n/\n/g;
    $UserName =~ s/\$\|/\|/g;
    $Password =~ s/\\\|n/\n/g;
    $Password =~ s/\$\|/\|/g;
    return ($UserName, $Password);
}

###############################################################################
# CreateSession                                                               #
###############################################################################
sub CreateSession {
    my ($UserName, $Password)=@_;

    $UserName =~ s/\|/\$\|/g;
    $UserName =~ s/\n/\\\|n/g;

    $Password =~ s/\|/\$\|/g;
    $Password =~ s/\n/\\\|n/g;

    # Remove Older Sessions
    &RemoveSessions;

    # Build Session ID
    srand(time);
    my ($SessionID) = $UserName.".".time.(int(rand(99999)));

    open(SESSION,">$SessionPath/$SessionID");
		flock(SESSION,2) if ($FLock);
        print SESSION join ("\n", $UserName, $Password);
		flock(SESSION,8) if ($FLock);
	close(SESSION);
    return $SessionID;
}

###############################################################################
# RemoveSessions                                                              #
###############################################################################
sub RemoveSessions {
    my ($File);
    # Read Session Directory
    opendir (SESSIONS,"$SessionPath");
		my (@SessionFiles) = grep(!/^\.\.?$/,readdir(SESSIONS));
	closedir (SESSIONS);
    foreach $File (@SessionFiles) {
        if ((stat("$SessionPath/$File"))[9] + $CleanUpTime < time) {
            unlink("$SessionPath/$File");
        }
    }
}

###############################################################################
# SendEmail                                                                   #
###############################################################################
sub SendMail{
	local ($From, $Subject, $Message, $To) = @_;
	if ($EmailFunction eq "SMTP") {
		require "$LibPath/Sender.pm";
		ref ($Sender = new Mail::Sender {smtp => $SendMailLocation, from => $From})||&CGIError("Couldn't open the SMTP server<br>\n SMTP Path: $SendMailLocation<br>\nReason : $Mail::Sender::Error");
		(ref
			(	$Sender->MailMsg(
						{
							to => $To, 
							subject => $Subject,
							msg => $Message
						}
					)
			)
		)||&CGIError("Couldn't send the email by SMTP server<br>\n SMTP Path: $SendMailLocation<br>\nReason : $Mail::Sender::Error");
		$Sender->Close();
	}elsif ($EmailFunction eq "SendMail") {
		open (MAIL, "|$SendMailLocation -t") || &CGIError("Couldn't open the SendMail program<br>\nPath: $SendMailLocation<br>\nReason : $!");
			print MAIL "To: $To\n";
			print MAIL "From: $From\n";
			print MAIL "Subject: $Subject\n\n";
			print MAIL "$Message\n\n";
		close (MAIL);
	}
}

###############################################################################
# SaveMemberData                                                              #
###############################################################################
sub SaveMemberData {
	my ($ID,@Input)=@_;
	$ID=lc($ID);
	my ($Temp, $Return);
	@Input=&DecodeHTML(@Input);
	$Input[15]=&DecodeUBCodes($Input[15]);
	$tmp=&EncodeUBCodes($Input[15]);
	@Input=&EncodeHTML(@Input);
	$Input[15]=$tmp;
	for (my ($i)=0;$i<=$#Input;$i++) {
		$Input[$i] =~ s/\r//g;
	}
	$Return = join ("\n",@Input);
	open(INFO,">$MembersPath/$ID.info")||&CGIError("Couldn't create/write the $ID.info file<br>\nPath: $MembersPath<br>\nReason : $!");
		flock(INFO,2) if ($FLock);
			print INFO $Return;
		flock(INFO,8) if ($FLock);
	close(INFO);
}

###############################################################################
# GetMemberData                                                               #
###############################################################################
sub GetMemberData {
	my ($ID)=@_;
	$ID=lc($ID);
	open(INFO,"$MembersPath/$ID.info")||&CGIError("Couldn't open/read the $ID.info file<br>\nPath: $MembersPath<br>\nReason : $!");
		flock(INFO,1) if ($FLock);
		my (@INFO_DATA)=<INFO>;
	close(INFO);
	for (my ($i)=0;$i<=$#INFO_DATA;$i++) {
		chomp ($INFO_DATA[$i]);
		$INFO_DATA[$i]=~s/\\n/\n/g;
	}
	@INFO_DATA=&DecodeHTML(@INFO_DATA);
	return @INFO_DATA;
}

###############################################################################
# ChangesChars                                                                #
###############################################################################
sub ChangesChars {
    my (@Chars) = @_;
	for (my($i)=0;$i<=$#Chars;$i++){
        $Chars[$i]  =~ s/\"/\\\"/g;
        $Chars[$i]  =~ s/\n\n/\<p\>\\n\\n/g;
        $Chars[$i]  =~ s/\n/\<br\>\\\n/g;
        $Chars[$i]  =~ s/\@/\\\@/g;
        $Chars[$i]  =~ s/^\s+//g;
        $Chars[$i]  =~ s/\s+$//g;
	}
	return wantarray ? @Chars : $Chars[0];
}

###############################################################################
# EncodeHTML                                                                  #
###############################################################################
sub EncodeHTML {
	my (@Encode) = @_;
	for (my($i)=0;$i<=$#Encode;$i++){
		$Encode[$i] =~ s/\</\&lt\;/g;
		$Encode[$i] =~ s/\>/\&gt\;/g;
		$Encode[$i] =~ s/\"/\&quot\;/g;
		$Encode[$i] =~ s/\'/\|APO\|/g;
		$Encode[$i] =~ s/\+/\|PLS\|/g;
		$Encode[$i] =~ s/\=/\|EQU\|/g;
		$Encode[$i] =~ s/\n\n/\<p\>\\n\\n/g;
		$Encode[$i] =~ s/\n/\<br\>\\n/g;
		$Encode[$i] =~ s/\s/\+/g;
		$Encode[$i] =~ s/\&/\&amp\;/g;
	}
	return wantarray ? @Encode : $Encode[0];
}

###############################################################################
# DecodeHTML                                                                  #
###############################################################################
sub DecodeHTML {
	my (@Decode) = @_;
	for (my($i)=0;$i<=$#Decode;$i++){
		$Decode[$i] =~ s/\&amp\;/\&/g;
		$Decode[$i] =~ s/\+/ /g;
		$Decode[$i] =~ s/\|EQU\|/\=/g;
		$Decode[$i] =~ s/\|PLS\|/\+/g;
		$Decode[$i] =~ s/\|APO\|/\'/g;
		$Decode[$i] =~ s/\&quot\;/\"/g;
		$Decode[$i]=~s/\\n/\n/g;
	}
	return wantarray ? @Decode : $Decode[0];
}

###############################################################################
# EncodeUBCodes                                                               #
###############################################################################
sub EncodeUBCodes {
	$_ = shift;
	
	$_ =~ s/\</\&lt\;/g;
	$_ =~ s/\>/\&gt\;/g;
	
	if ($UBCodes eq "on") {
		$_ =~ s/\\\\/\\<!--no-->/isg;
		$_ =~ s/\\\[/\[<!--no-->/isg;
		$_ =~ s/\\\]/<!--no-->\]/isg;
		$_ =~ s/\\\:/\:<!--no-->/isg;
		$_ =~ s/\\\;/\;<!--no-->/isg;
        $_ =~ s/\\\^/\;<!--no-->/isg;

		$_ =~ s/\\http:\/\/(\S+)/<a href=\"http:\/\/$1\"\ target=\"_blank\"><!--auto-->http:\/\/$1<\/a><!--auto-->/isg;

		$_ =~ s/\\(www.\S+)/<a href=\"http:\/\/$1\"\ target=\"_blank\"><!--autohttp-->http:\/\/$1<\/a><!--autohttp-->/isg;

		$_ =~ s/\\ftp:\/\/(\S+)/<a href=\"ftp:\/\/$1\"\ target=\"_blank\"><!--auto-->ftp:\/\/$1<\/a><!--auto-->/isg;

		$_ =~ s/\\(ftp.\S+)/<a href=\"ftp:\/\/$1\"\ target=\"_blank\"><!--autoftp-->ftp:\/\/$1<\/a><!--autoftp-->/isg;

		$_ =~ s/\\(\S+?)\@(\S+)/<a href=\"mailto:$1\@$2\"\><!--autoemail-->$1\@$2<\/a><!--autoemail-->/ig;

		$_ =~ s/\[img=(\S+?)\]/<img src=\"$1\" border=\"0\">/isg;

		$_ =~ s/\[url=http:\/\/(\S+?)\]/<!--http--><a href=\"http:\/\/$1\"\ target=\"_blank\">/isg;
		$_ =~ s/\[url=(\S+?)\]/<!--nohttp--><a href=\"http:\/\/$1\"\ target=\"_blank\">/isg;
		$_ =~ s/\[\/url\]/<\/a><!--url-->/isg;

		$_ =~ s/\[email=(\S+?)\]/<a href=\"mailto:$1\">/isg;
		$_ =~ s/\[\/email\]/<\/a><!--email-->/isg;

		$_ =~ s/\[b\]/<b>/isg;
		$_ =~ s/\[\/b\]/<\/b>/isg;

		$_ =~ s/\[i\]/<i>/isg;
		$_ =~ s/\[\/i\]/<\/i>/isg;

		$_ =~ s/\[u\]/<u>/isg;
		$_ =~ s/\[\/u\]/<\/u>/isg;

		$_ =~ s/\[1\]/<font size=\"1\">/isg;
		$_ =~ s/\[\/1\]/<\/font><!--1-->/isg;

		$_ =~ s/\[2\]/<font size=\"2\">/isg;
		$_ =~ s/\[\/2\]/<\/font><!--2-->/isg;

		$_ =~ s/\[3\]/<font size=\"3\">/isg;
		$_ =~ s/\[\/3\]/<\/font><!--3-->/isg;

		$_ =~ s/\[4\]/<font size=\"4\">/isg;
		$_ =~ s/\[\/4\]/<\/font><!--4-->/isg;

		$_ =~ s/\[fixed\]/<font face=\"Courier New\">/isg;
		$_ =~ s/\[\/fixed\]/<\/font><!--fixed-->/isg;

		$_ =~ s/\[sup\]/<sup>/isg;
		$_ =~ s/\[\/sup\]/<\/sup>/isg;

		$_ =~ s/\[sub\]/<sub>/isg;
		$_ =~ s/\[\/sub\]/<\/sub>/isg;

		$_ =~ s/\[center\]/<center>/isg;
		$_ =~ s/\[\/center\]/<\/center>/isg;

		$_ =~ s/\[color=(\S+?)\]/<font color=\"$1\">/isg;
		$_ =~ s/\[\/color\]/<\/font><!--color-->/isg;

		$_ =~ s/\[list\]/<li>/isg;

		$_ =~ s/\[pre\]/<pre>/isg;
		$_ =~ s/\[\/pre\]/<\/pre>/isg;

		#$_ =~ s/\[code\](.+?)\[\/code\]/<blockquote><font size=\"1\" face=\"$FontFace\">code:<\/font><hr><font face=\"Courier New\"><pre>$1<\/pre><\/font><hr><\/blockquote>/isg;
		
		#$_ =~ s/\[quote\]<br>(.+?)<br>\[\/quote\]/<blockquote><hr>$1<hr><\/blockquote>/isg;
		#$_ =~ s/\[quote\](.+?)\[\/quote\]/<blockquote><hr>$1<hr><\/blockquote>/isg;

		$_ =~ s/\:\-\)/<img src=\"$URLImages\/Happy.gif\" border=\"0\" align=\"middle\">/isg;
		$_ =~ s/\;\-\)/<img src=\"$URLImages\/Wilk.gif\" border=\"0\" align=\"middle\">/isg;