📄 chat.pl

📁 这个社区是虚拟社区使用的程序
💻 PL
字号:
#!/usr/bin/perl

use FileHandle;
if ($ENV{'SCRIPT_FILENAME'}){
$home_dir=substr($ENV{'SCRIPT_FILENAME'},0,rindex($ENV{'SCRIPT_FILENAME'},"/"));
}else{
$home_dir=substr($ENV{'PATH_TRANSLATED'},0,rindex($ENV{'PATH_TRANSLATED'},"\\"));
$home_dir=~ s/\\/\//g;
}
$home_dir="/cgi-bin/vrc/Sources/VRChat";
$fullurl= "http://$ENV{'SERVER_NAME'}$ENV{'SCRIPT_NAME'}";
$cgiurl=substr($fullurl,0,rindex($fullurl,"/"));

############ 无需修改,除非您是高手 #############################
print "Content-type: text/html;charset=gb2312\n\n";
$|++;
 do "$home_dir/get_data.pl";
 &get_data;
require "$home_dir/config.cfg";
require "$home_dir/Crypt.pm";
#require "$home_dir/color.cfg";
#require "$home_dir/level.cfg";
#require "$home_dir/allow.cfg";
my $ifh = new FileHandle("$homedir/room.list") || die"无法打开文件";
@rooms=<$ifh>;
 do "$home_dir/set_var.pl";
 &set_var;

if(-e "$homedir/check_time.txt"){
 do "$home_dir/check_time.pl";
 &check_time;
 }
if ($job eq "login") {
	$user_ref    = $FORM{'uref'};
	if ($user_ref) {
		if (!(-e "$MembersPath/../Sessions/$user_ref")) {
			print "<html><head>\n";
			print "<script Language=\"JavaScript\">\n";
			print "  alert(\"请先登陆社区!\");\n";
			print "</script></head></html>\n";
			exit;
		}
	}
	($UserID)=split(/\./,$user_ref);
	open(MEMBER,"$MembersPath/$UserID.info");
		my (@MemberData)=<MEMBER>;
	close(MEMBER);
	for (my ($i)=0;$i<=$#MemberData;$i++) {
		chomp ($MemberData[$i]);
		$MemberData[$i]=~s/\\n/\n/g;
	}
	@MemberData=&DecodeHTML(@MemberData);

	$user_level=1;
	$username=$MemberData[1];
	$Rank="";
	@MemberInfo23 = &DecodeDBOutput($MemberData[23]);
	open(GROUP,"$MembersPath/$MemberData[3].rank");
		while (<GROUP>) {
			@Group=&DecodeDBOutput($_);
			if ($MemberInfo23[0] eq $Group[0]) {
				$Rank=$Group[1];
				$user_level=$Group[2]+1;
				last;
			}
		}
	close(GROUP);

	$username=~ s/ /\_/g;

	$usersex = "⊙";
	$usersex = "♂" if ($MemberData[22] eq "male");
	$usersex = "♀" if ($MemberData[22] eq "female");
	$usersex =~ s/\n//g;

#	$userpassword = $MemberData[0];
	$userpassword=Crypt::crypt($MemberData[0],substr($MemberData[0], 0, 2));
	$userpassword=~s/\W+//;
	$password = crypt($userpassword, "wf");

	$userlevel = $user_level;
	$userlevel =~ s/\n//g;
	$userlevel = substr($userlevel,0,2);

foreach (@rooms){
   $_ =~ s/\n//g;
   if (!(-e "$homedir/temp/rooms/$_")){ #检查是否有对话档  
			my $ofh = new FileHandle(">$homedir/temp/rooms/$_") || die "无法打开文件\"$_\"";
			print $ofh "$messno‖says‖‖‖‖‖‖‖‖‖<font color=$text_color1>$title调试完毕，运行正常<br>欢迎使用功能强大的 $leve 聊天程序[$nday/$nmon/$nyear]</font>‖‖myself‖$normal_time‖‖end‖\n"; 
  }
}   	
   $room =shift(@rooms) ;		
   $exist="no";
   do "$home_dir/check_user.pl";
   do "$home_dir/write_online.pl";   
   do "$home_dir/return_whole.pl";   
   do "$home_dir/write_mess.pl";
   &check_user;
#   &write_online(online);
	unless(-e "$homedir/temp/$info.txt"){ #检查是否重复登陆
		if ($exist eq "no")  {   
			my $ofh = new FileHandle(">>$homedir/check_time.txt") || die "无法打开文件\"check_time.txt\"";
			print $ofh $info."=".$now_sec."\n";
			opendir(STAT,"$homedir/temp/rooms") || &error("无法打开目录$homedir/temp/rooms");
			@dir = readdir(STAT);
			closedir(STAT);
			foreach $allroom (sort @dir){
				if ($allroom ne '.' && $allroom ne '..'){
					$allroom =~ s/\n//;
					&write_mess(login,$room,$allroom);   
				}
			} 
		}
	}

	my $ofh = new FileHandle(">$homedir/temp/$info.txt") || die "无法打开文件\"$info.txt\"";#写用户标识文件
	print $ofh $now_sec."=".$room."\n";
   $check=0;
   &return_whole;
}
elsif ($job eq "logout") {
   $exist="no";
#   do "$home_dir/save.pl";
#   &save("logout");
   unlink ("$homedir/temp/$info.txt");
   do "$home_dir/write_online.pl"; 
   &write_online(outline);
   if ($exist ne "no") {
   opendir(STAT,"$homedir/temp/rooms") || &error("无法打开目录$homedir/temp/rooms");
	@dir = readdir(STAT);
   closedir(STAT);
foreach $allroom (sort @dir){
if ($allroom ne '.' && $allroom ne '..'){
   $allroom =~ s/\n//;
   do "$home_dir/write_mess.pl";
   &write_mess(logout,$room,$allroom);   
}
   } 
}
   do "$home_dir/return_logout.pl";
   &return_logout;
}
elsif ($job eq "settype") {
   #do "$home_dir/write_online.pl"; 
   #&write_online(online);
   do "$home_dir/return_type.pl";
   &return_type;
}
elsif ($job eq "look") {
   do "$home_dir/return_mess.pl";
   &return_mess;
}
elsif ($job eq "says") {
   do "$home_dir/write_online.pl"; 	
   &write_online(online);
   if ($kicked!=1) {
   do "$home_dir/write_mess.pl";
   &write_mess(says,$room,$room);
}
   do "$home_dir/return_mess.pl";
   &return_mess;
}
elsif ($job eq "online") {
   do "$home_dir/write_online.pl"; 
   &write_online(online);
   do "$home_dir/return_online.pl";   
   &return_online(online);
}
elsif ($job eq "adver") {
   do "$home_dir/write_online.pl"; 
   &write_online(online);
   do "$home_dir/adver.pl"; 
   &return_adver;
}
elsif ($job eq "set_midi") {
   if ($userlevel>=$level_midi) {
   do "$home_dir/set_midi.pl";	
   &set_midi;
   }
   else {&error("无此权限,注册后将会自动升级...");}
}
elsif ($job eq "read_ly") {
   do "$home_dir/set_midi.pl";	
   &read_ly;
}
elsif ($job eq "show") {
   do "$home_dir/set_midi.pl";	
   &show;
}
elsif ($job eq "show_music") {
   do "$home_dir/set_midi.pl";	
   &show_music;
} elsif ($job eq "setkick") {
   do "$home_dir/check_user.pl";
   &check_user;
   if ($userlevel>=$level_kick) {
   do "$home_dir/write_online.pl"; 
   &write_online(online);
   do "$home_dir/return_online.pl";   
   &return_online(kickout);
   }
   else {&error("无此权限,注册后将会自动升级...");}

} elsif ($job eq "cls") {
   if ($userlevel >= $level_cls) {
   &cls;
   &add_logo("logo.txt","清屏执行人：(ip.id.level）$userip‖$username‖$userlevel时间：$normal_time2"); # 记录logo文件
   opendir(STAT,"$homedir/temp/rooms") || &error("无法打开目录$homedir/temp/rooms");
	 @dir = readdir(STAT);
   closedir(STAT);
   foreach $allroom (sort @dir){
   if ($allroom ne '.' && $allroom ne '..'){
   $allroom =~ s/\n//;
   do "$home_dir/write_mess.pl";
   &write_mess(cls,$room,$allroom);   
}
   do "$home_dir/return_mess.pl";
   &return_mess;
  }
  }
   else {&error("无此权限,注册后将会自动升级...");} 

} elsif ($job eq "kickout") {
  if ($userlevel>=$level_kick) {
  if ($kickoutuser) {
   do "$home_dir/write_online.pl"; 
   &write_online(kickout);
   &add_logo("kick_logo.txt","执行人：(ip.id.level）$userip‖$username‖$userlevel   对象：（ip、id、level）$kickoutuser方式：$kickoutway时间：$normal_time2"); # 记录logo文件
   opendir(STAT,"$homedir/temp/rooms") || &error("无法打开目录$homedir/temp/rooms");
	 @dir = readdir(STAT);
   closedir(STAT);
foreach $allroom (sort @dir){
if ($allroom ne '.' && $allroom ne '..'){
   $allroom =~ s/\n//;
   do "$home_dir/write_mess.pl";
   &write_mess(kick,$room,$allroom);   
}
  }
   
  }
   do "$home_dir/return_mess.pl";
   unlink ("$homedir/temp/$userinfo");
   }
   else {&error("无此权限,注册后将会自动升级...");}
} elsif ($job eq "win0") {
   do "$home_dir/write_online.pl"; 
   &write_online(online);
   do "$home_dir/init_win0.pl"; 
   &init_win0;
} elsif ($job eq "online_user") {
   do "$home_dir/online_user.pl"; 
   &online_user;
   do "$home_dir/write_online.pl"; 
   &write_online(online);
}

elsif ($job eq "welcome") {
   do "$home_dir/welcome.pl"; 
   &welcome;
}
elsif ($job eq "save") {
   do "$home_dir/write_online.pl"; 
   &write_online(online);	
#   do "$home_dir/save.pl";
#   &save;
}
elsif ($job eq "look_spccmd") {
   do "$home_dir/write_online.pl"; 
   &write_online(online);	
   do "$home_dir/spccmd.pl"; 
   &look_spccmd;
}
elsif ($job eq "command_chinese") {
   do "$home_dir/write_online.pl"; 
   do "$home_dir/spccmd.pl"; 
   &write_online(online);	
   &command_chinese;
}

#############
sub chkempty {
$chkval = $_[0];
$chkerr = $_[1];
$chkval =~ s/ //g;
$chkval =~ s/<br>//g;
$chkval =~ s/\n//g;
if ($chkval eq "") { 
   &error("嘿嘿!此路不通...再试试别的方法?");
   }
}
#############
sub error {
$error_subject = $_[0];
print "<html><head><title>$title 错误</title>\n";
print "<script Language=\"JavaScript\">\n";
print "alert(\"$error_subject\");\n";
print "</script></head></html>\n";
 do "$home_dir/home.pl";
 &home ;
exit;
}
####################### HTML 页面尾部  ###################
sub Tailer {

 print "<table border=0 cellspacing=0 cellpadding=0 width=100%>\n";
 print "<tr><td width=100%></td></tr><tr><td bgcolor=\"#c0c0c0\"</td></tr><tr>\n";
 print "<td width=100%><p align=right><font color=#c3c3c3>$leve\n";
 print "</td></tr> </table>\n";
 print "</td></tr></table></center></div></body></html>";
}

##################### 记录 logo 文件#########
sub add_logo {

my $ifh = new FileHandle("$homedir/temp/$_[0]") || die "无法打开文件\"$_[0]\"";
my @lg = <$ifh>;
my $ofh = new FileHandle(">$homedir/temp/$_[0]") || die "无法打开文件\"$_[0]\"";
print $ofh "$_[1]\n";
	for ($i=0;$i<=$msgnum;$i++) {
	print $ofh @lg[$i];
	}
}
################遍历档案##########################
sub searchuser{

opendir(STAT,"$homedir/$_[0]") || &error("无法打开目录>>$_[0] ");
   @dir =  grep(!/^\./, readdir(STAT));
closedir(STAT);
return@dir;
}
###############################################################################
# DecodeDBOutput                                                              #
###############################################################################
sub DecodeDBOutput {
	my ($Output) = @_;
	my (@Outputs);
	chomp ($Output);
	@Outputs=split(/\Q$Spliter\E/, $Output);
	for (my($i)=0;$i<=$#Outputs;$i++){
		$Outputs[$i]=~s/\|\&\^\&\|/$Spliter/g;
	}
	@Outputs=&DecodeHTML(@Outputs);
	return wantarray ? @Outputs : $Outputs[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];
}

sub cls{
open(TEMP,"<$homedir/temp/$info.txt")|| &error("无法打开文件$info.txt");
       $dt = <TEMP>;
close(TEMP);
       ($date,$room,$last)= split(/=/, $dt);
open (MESS,">$homedir/temp/rooms/$room") || &error("无法打开文件rooms/$room");
       $total_mess1=0;
print MESS "cls‖$userip‖$username‖$userlevel‖‖‖‖‖‖‖‖‖‖‖‖‖$normal_time‖‖end‖\n";
       $total_mess1++;
 close(MESS);
}
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -