Perl聊天室实例 - 百家拳原创软件教程网

1、聊天室

　　源代码：

　　(一)

　　#!/usr/bin/perl

　　# 根据说明修改以下设置

　　$saysback = "#ffffff"; #最新发言的背景

　　$saysword = "#000000"; #最新发言字色

　　$loginword = "#ff0000"; #进入公告的字色

　　$logoutword = "#ff0000"; #离开公告的字色

　　$onlineback = "#FFFFcc"; #Online区的背景

　　$onlineword = "#000080"; #Online区的字色

　　$typeback = "#000080"; #打字区的背景

　　$typeword = "#ffffff"; #打字区的字色

　　$funcback = "#FFFFcc"; #Func区的背景

　　$funcword = "#ffffff"; #Func区的字色

　　$reload = 12; # 无发言状态下每次更新发言的时间sec.

　　$reload_online = 30 #在线名单更新秒数

　　$kicktime = 3000; # 执行管制後解除的时间sec

　　$advert = 40; # 广告更新时间

　　$image_size = 5; # 图案大小

　　$allow_mess = 12; # mess笔数.

　　$allow_sex1 = 1; # 1=允许Sex在message区出现 2=Sex在messgae不出现但login,logout出现 0=Sex都不出现

　　$allow_sex2 = 1; # 1=允许Sex在online区出现 0=不出现

　　$allow_time = 1; # 1=允许time在message区出现 0=不出现

　　$time_miss = 0; # Server时区调整

　　$level_towho = 1; # 允许user使用私下谈话的Level

　　$level_seeprivate= 2; # 允许user看见别人私下对谈的level

　　$level_wordcolor = 1; # 允许user使用文字颜色的Level

　　$level_addsays = 1; # 允许user使用表情的level

　　$level_addimage = 1; # 允许user使用图案的level

　　$level_midi = 1; # 允许user点播Midi的level

　　$level_html = 2; # 允许user使用HTML的level

　　$level_seeip = 2; # 允许user看见IP的level

　　$level_kick = 3; # 允许user执行人员管制的level

　　$level_seelevel = 2; # 允许user看见user等级的level

　　$level_fun = 2; #使用趣语的等级

　　$level_sysadmin = 3; #使用管理功能的等级

　　$super[0] = "yishan‖test‖3"; # Super User的id,密码,权限最低user为1

　　$title = "彬彬聊天室"; #聊天室名称

　　#房间. 注意:请建立onlineN.cgi和saysN.cgi,N=1,2,3... 有多少房间就建多少个 chmod 666

　　@rooms = ("网络沙龙","失落的天空","恋爱俱乐部","不谈电脑");

　　#发言内容下面的链接

　　$link="<p><center><a href=http://www.computer.net.cn target='windows'>电脑资讯网</a></center>\n";

　　#---------------------------------------

　　#以下为路径&URL自动设置的不分,最好不要改

　　#---------------------------------------

　　$dir=&mypath; #获取当前文件所在的绝对路径

　　$myurl=&myurl; #获取当前文件所在的URL位置

　　$cgiurl = "$myurl/chat.cgi"; # chat.pl 的执行连结URL

　　$logouturl = "http://www.computer.net.cn"; # 离开聊天室後的URL

　　$kickouturl = "http://www.computer.net.cn"; # 从聊天室被踢走後的URL

　　$onlinefile = "$dir/online.cgi"; # 记录线上人员的档案 666

　　$messfile = "$dir/says.cgi"; # 记录发言的档案 666

　　$wordcolorfile = "$dir/wordcolor.txt"; # 文字颜色的档案 644

　　$addsaysfile = "$dir/addsays.txt"; # 附加表情的档案 644

　　$adverfile = "$dir/adver.txt"; # 广告的档案,如不需广告请留空白 644

　　$imagefile = "$dir/image.txt"; # 图案的档案 644

　　$midifile = "$dir/midi.txt"; # Midi的档案 644

　　$funfile = "$dir/fun.txt"; # Midi的档案 644

　　$passfile = "$dir/pass.cgi"; #密码文件 666

　　$settypegif = "$myurl/settype.gif"; # 名单按纽 644 Binary Mode

　　$onlinegif = "$myurl/online.gif"; # 线上名单 644 Binary Mode

　　$logoutgif = "$myurl/logout.gif"; # 离开按纽 644 Binary Mode

　　$setkickgif = "$myurl/setkick.gif"; # 人员管制按纽 644 Binary Mode

　　$setmidigif = "$myurl/setmidi.gif"; # 点播MIDI按纽 644 Binary Mode

　　$bg_type="$myurl/bg.gif"; #输入框背景 644 Binary Mode

　　# Setup End

　　##########

　　print "HTTP/1.0 200 OK\n";

　　print "Content-type: text/html;CHARSET=gb2312\n";

　　print "Pragma:no-cache\n\n";

　　$userlevel = 1;

　　$kicked = 0;

　　$kickoutway ="level1";

　　#$|=1;

　　&get_data;

　　&set_var;

　　&check_pass;

　　if ($job eq "login") {

　　$exist="no";

　　&write_online(online);

　　if ($exist eq "no") {

　　&write_mess(login);

　　}

　　&return_whole;

　　}

　　elsif ($job eq "logout") {

　　$exist="no";

　　&write_online(outline);

　　if ($exist ne "no") {

　　&write_mess(logout);

　　}

　　&return_logout;

　　}

　　elsif ($job eq "setfunc") {

　　&return_func;

　　}

　　elsif ($job eq "settype") {

　　&write_online(online);

　　&return_type;

　　}

　　elsif ($job eq "look") {

　　&write_online(online);

　　&return_mess;

　　}

　　elsif ($job eq "says") {

　　&write_online(online);

　　if ($kicked!=1) {&write_mess(says);}

　　&return_mess;

　　}

　　elsif ($job eq "online") {

　　&write_online(online);

　　&return_online(online);

　　}

　　elsif ($job eq "adver") {

　　&write_online(online);

　　&return_adver;

　　}

　　elsif ($job eq "setmidi") {

　　if ($userlevel>=$level_midi) {

　　&return_func;

　　}

　　else {&error("无权限");}

　　}

　　elsif ($job eq "setkick") {

　　if ($userlevel>=$level_kick) {

　　&write_online(online);

　　&return_online(kickout);

　　}

　　else {&error("无权限");}

　　}

　　elsif ($job eq "kickout") {

　　if ($userlevel>=$level_kick) {

　　if ($kickoutuser) {

　　&write_online(kickout);

　　}

　　&return_mess;

　　}

　　else {&error("无权限");}

　　}

　　elsif ($job eq "cls") {

　　if ($userlevel>=$level_sysadmin) {

　　&cls;

　　&return_mess;

　　}

　　else {&error("无权限")};

　　}

　　elsif ($job eq "showpass") {

　　if ($userlevel>=$level_sysadmin) {

　　&showpass;

　　}

　　else {&error("无权限");}

　　}

　　elsif ($job eq "changepass") {

　　if ($FORM{'pass1'} ne $FORM{'pass2'}){&error("两次密码不相同");}

　　&changepass;

　　}

　　###########

　　sub get_data {

　　@querys = split(/&/, $ENV{'QUERY_STRING'});

　　foreach $query (@querys) {

　　($name, $value) = split(/=/, $query);

　　$FORM{$name} = $value;

　　if ($name eq "userpassword") {

　　$userid = "$FORM{'userid'}";

　　$userpassword = "$FORM{'userpassword'}";

　　foreach $super_line (@super) {

　　($chkuserid,$chkuserpassword,$chkuserlevel, $last) = split(/‖/, $super_line);

　　if (($userid eq $chkuserid) && ($userpassword eq $chkuserpassword)) {

　　$userlevel = $chkuserlevel;

　　if ($userlevel>=$level_html) {

　　$allow_html = 1;

　　}

　　}

　　}

　　}

　　}

　　if ($FORM{'pass'}) {$pass=$FORM{'pass'};}

　　read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});

　　@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///g;

　　if (($allow_html != 1) && ($name ne "cmd")) {

　　$value =~ s/<([^>]|\n)*>//g;

　　$value =~ s/<//g;

　　}

　　else {

　　unless ($name eq 'says') {

　　$value =~ s/<([^>]|\n)*>//g;

　　$value =~ s/<//g;

　　}

　　}

　　$FORM{$name} = $value;

　　if ($name eq "userpassword") {

　　$userid = "$FORM{'userid'}";

　　$userpassword = "$FORM{'userpassword'}";

　　foreach $super_line (@super) {

　　($chkuserid,$chkuserpassword,$chkuserlevel,$last) = split(/‖/, $super_line);

　　if (($userid eq $chkuserid) && ($userpassword eq $chkuserpassword)) {

　　$userlevel = $chkuserlevel;

　　if ($userlevel>=$level_html) {

　　$allow_html = 1;

　　}

　　}

　　}

　　}

　　}

　　if ($FORM{'pass'}) {$pass=$FORM{'pass'};}

　　}

　　##########

　　sub set_var {

　　if ($FORM{'job'}) {

　　$job = "$FORM{'job'}";

　　&chkempty($job,"无工作指示");

　　}

　　else {

　　# &error("无工作指示");

　　$page="login";

　　&showpage;

　　}

　　if ($FORM{'username'}) {

　　$username = "$FORM{'username'}";

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

　　$username =~ s/"//g;

　　$username =~ s/<//g;

　　$username =~ s/>//g;

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

　　$username =~ s/‖//g;

　　$username =~ s/;//g;

　　$username =~ s/ //g;

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

　　&chkempty($username,"无匿名");

　　}

　　else {

　　&error("无匿名");

　　}

　　if ($FORM{'usersex'}) {

　　$usersex = "$FORM{'usersex'}";

　　$usersex =~ s/\n//g;

　　&chkempty($usersex,"无性别");

　　}

　　else {

　　&error("无性别");

　　}

　　if ($FORM{'towhoway'}) {

　　$towhoway = "$FORM{'towhoway'}";

　　$towhoway =~ s/\n//g;

　　}

　　if ($FORM{'towho'}) {

　　$towho = "$FORM{'towho'}";

　　$towho =~ s/\n//g;

　　}

　　if ($FORM{'wordcolor'}) {

　　$wordcolor = "$FORM{'wordcolor'}";

　　$wordcolor =~ s/\n//g;

　　}

　　if ($FORM{'says'}) {

　　$says = "$FORM{'says'}";

　　$says =~ s/\n//g;

　　$says =~ s/‖//g;

　　&chkempty($says,"无发言");

　　}

　　else {

　　if ($job eq "says") {

　　&error("无发言");

　　}

　　}

　　if ($FORM{'addsays'}) {

　　$addsays = "$FORM{'addsays'}";

　　$addsays =~ s/\n//g;

　　$addsays =~ s/‖//g;

　　}

　　if ($FORM{'addimage'}) {

　　$addimage = "$FORM{'addimage'}";

　　$addimage =~ s/\n//g;

　　$addimage =~ s/‖//g;

　　}

　　if ($FORM{'midiurl'}) {

　　$midiurl = "$FORM{'midiurl'}";

　　$midiurl =~ s/\n//g;

　　$midiurl =~ s/‖//g;

　　}

　　if ($FORM{'kickoutuser'}) {

　　$kickoutuser = "$FORM{'kickoutuser'}";

　　$kickoutuser =~ s/\n//g;

　　}

　　if ($FORM{'kickoutway'}) {

　　$kickoutway = "$FORM{'kickoutway'}";

　　$kickoutway =~ s/\n//g;

　　}

　　if ($FORM{'logouturl'}) {

　　$logouturl = "$FORM{'logouturl'}";

　　$logouturl =~ s/\n//g;

　　}

　　if ($FORM{'foururl'}) {

　　$foururl = "$FORM{'foururl'}";

　　$foururl =~ s/\n//g;

　　}

　　if ($FORM{'fourscrolling'}) {

　　$fourscrolling = "$FORM{'fourscrolling'}";

　　$fourscrolling =~ s/\n//g;

　　}

　　$userip = $ENV{'REMOTE_ADDR'};

　　($nsec,$nmin,$nhour,$nday,$nmon,$nyear,$wday,$yday,$isdst) = localtime(time+(3600*$time_miss));

　　if ($nsec<10) {$nsec="0$nsec";}

　　if ($nmin<10) {$nmin="0$nmin";}

　　if ($nhour<10) {$nhour="0$nhour";}

　　$nmon=$nmon+1;

　　if ($nmon<10) {$nmon="0$nmon";}

　　if ($nday<10) {$nday="0$nday";}

　　$normal_time ="$nhour\:$nmin\:$nsec";

　　$now_sec =$nsec + ($nmin*60) + ($nhour*60*60) + ($nday*24*60*60);

　　$cut1_sec =$now_sec-($reload*4.2);

　　$cut2_sec =$now_sec+($reload*4.2);

　　$cut3_sec =$now_sec-($kicktime);

　　$cut4_sec =$now_sec+($kicktime);

　　$reload_double=$reload*3;

　　$userinfo ="&room=$FORM{'room'}&username=$username&pass=$pass&usersex=$usersex&userid=$userid&userpassword=$userpassword";

　　foreach $room_id (@rooms){

　　$room_no++;

　　if ($FORM{'room'} eq $room_id){

　　$onlinefile = "$dir/online$room_no\.cgi"; # 记录线上人员的档案

　　$messfile = "$dir/says$room_no\.cgi"; # 记录发言的档案

　　$room="$FORM{'room'}";

　　}

　　}

　　}

　　#########

　　sub return_whole {

　　print "<html><head><title>$title-$room</title>\n";

　　print "<frameset rows="*,120" border=0 frameborder=0 framespacing=0>\n";

　　if (($foururl) && ($fourscrolling)) {

　　print " <frameset cols="110,*,100" border=0 frameborder=0 framespacing=0>\n";

　　print " <frame src="$foururl" name="four" scrolling=$fourscrolling marginwidth=0 noresize>\n";

　　}

　　else {

　　print " <frameset cols="*,150" border=0 frameborder=0 framespacing=0>\n";

　　}

　　print " <frame src="$cgiurl?pass=$pass&job=look$userinfo" name="one" noresize>\n";

　　print " <frame src="$cgiurl?pass=$pass&job=online$userinfo" name="three" noresize marginwidth=0>\n";

　　print " </frameset>\n";

　　print " <frameset cols="*,150" border=0 frameborder=0 framespacing=0>\n";

　　print " <frame src="$cgiurl?pass=$pass&job=settype$userinfo" name="two" marginwidth=0>\n";

　　print " <frame src="$cgiurl?pass=$pass&job=setfunc$userinfo" name="five" marginwidth=0>\n";

　　print " </frameset>\n";

　　print "</frameset>\n";

　　print "</head></html>\n";

　　}

　　#############

　　sub return_type {

　　if ($userlevel>=$level_towho) {

　　open(ONLINE,"$onlinefile") || error("$!");

　　#flock(ONLINE,1);

　　@online = <ONLINE>;

　　#flock(ONLINE,8);

　　close(ONLINE);

　　@online = sort @online;

　　}

　　if ($userlevel>=$level_wordcolor) {

　　open(WORDCOLOR,"$wordcolorfile") || error("$!");

　　@wordcolor = <WORDCOLOR>;

　　close(WORDCOLOR);

　　}

　　if ($userlevel>=$level_addsays) {

　　open(ADDSAYS,"$addsaysfile") || error("$!");

　　@addsays = <ADDSAYS>;

　　close(ADDSAYS);

　　}

　　if ($userlevel>=$level_addimage) {

　　open(IMAGE,"$imagefile") || error("$!");

　　@image = <IMAGE>;

　　close(IMAGE);

　　}

　　if ($userlevel>=$level_fun) {

　　open(FUN,"$funfile") || error("$!");

　　@fun = <FUN>;

　　close(FUN);

　　}

　　#print "<html><head><title>type</title>\n";

　　#print "<script Language="JavaScript">\n";

　　#print "function receiver(list)\n";

　　#print " { var listText='';\n";

　　#print " if((list\.selectedIndex != -1)&&(list\.selectedIndex != 0))\n";

　　#print " { listText = list\.options[list\.selectedIndex]\.value; }\n";

　　#print " document\.forms[0]\.saystemp\.value=listText;\n";

　　#print " }\n";

　　#print "function chksays() {\n";

　　#print " document\.forms[0]\.says\.value=document\.forms[0]\.saystemp\.value;\n";

　　#print " var tt=chkempty(document\.forms[0]\.says\.value);\n";

　　#print " if (tt==false) {\n";

　　#print " alert("请输入发言");\n";

　　#print " return tt;\n";

　　#print " }\n";

　　#print " self.status="资料已送出";\n";

　　#print " if (document\.forms[0]\.autocls\.checked==true) {\n";

　　#print " document\.forms[0]\.saystemp\.value='';\n";

　　#print " }\n";

　　#print " return true;\n";

　　#print "}\n\n";

　　#print "function chkempty(txtval){\n";

　　#print " if (txtval\.length==0)\n";

　　#print " return false;\n";

　　#print " var i=0;\n";

　　#print " while (i<txtval\.length) {\n";

　　#print " if (txtval\.substring(i,i+1) !=" ")\n";

　　#print " return true;\n";

　　#print " i=i+1;\n";

　　#print " }\n";

　　#print " return false;\n";

　　#print "}\n";

　　#print "</script>\n";

　　#print "</head>\n";

　　#print "<body bgcolor=$typeback text=$typeword>\n";

　　#print "<basefont size=2>\n";

　　#print "<div align=right><table border=0>\n";

　　#print "<form method=POST action="$cgiurl?job=says$userinfo" target="one" onsubmit="return(chksays())">\n";

　　#print "<tr><td valign=top align=right>\n";

　　#print "<input type=text name="saystemp" size="50">\n";

　　#print "<input type=hidden name="says" value="says">\n";

　　#print "<input type=submit value="送出发言">\n";

　　#print "<input type="checkbox" name="autocls" value="yes" checked>自动清除 \n";

　　#if ($userlevel>=$level_towho) {

　　# print "方式:<select name="towhoway">\n";

　　# print "<option value="public" ";

　　# if ($towhoway eq "public") {print "selected";}

　　# print ">完全公开\n";

　　# print "<option value="private" ";

　　# if ($towhoway eq "private") {print "selected";}

　　# print ">私下对谈\n";

　　# print "</select>\n";

　　# print "对象:<select name="towho">\n";

　　# print "<option value="toall‖toall‖toall">全部\n";

　　# $lastcheck="";

　　# foreach $online_line (@online) {

　　# ($mark,$chkuserip,$chkusername,$chkuserlevel,$chkusersex,$chktime,$chksec,$chkkickout,$chkkickoutway,$markend,$last) = split(/‖/, $online_line);

　　# if (($mark eq "online") && ($markend eq "end")) {

　　# if (!(($chkuserip eq $userip) && ($chkusername eq $username) && ($chkuserlevel eq $userlevel))) {

　　# if ($lastcheck ne "$chkuserip‖$chkusername‖$chkuserlevel") {

　　# if (!(($chkkickout eq "kickouted") && ($userlevel<$level_kick))) {

　　# print "<option value="$chkuserip‖$chkusername‖$chkuserlevel" ";

　　# if ($towho eq "$chkuserip‖$chkusername‖$chkuserlevel") {print "selected";}

　　# print ">$chkusername\n";

　　# }

　　# }

　　# $lastcheck = "$chkuserip‖$chkusername‖$chkuserlevel";

　　# }

　　# }

　　# }

　　# print "</select>\n";

　　# print "<input type=reset value="清除发言">\n";

　　#}

　　#else {

　　# print "<input type=hidden name="towho" value="toall‖toall‖toall">\n";

　　#}

　　#

　　#if ($userlevel>=$level_wordcolor) {

　　# srand;

　　# $ram=int(rand($#wordcolor+1));

　　#

　　# $temp=0;

　　# print "颜色:<select name="wordcolor">\n";

　　# foreach $wordcolor_line (@wordcolor) {

　　# if (($wordcolor_line =~ /"$wordcolor"/) || ((!($wordcolor)) && ($temp eq $ram))) {

　　# $wordcolor_line =~ s/>/ selected>/g;

　　# }

　　# print "$wordcolor_line";

　　# $temp=$temp+1;

　　# }

　　# print "</select>\n";

　　#}

　　#

　　#if ($userlevel>=$level_addsays) {

　　# print "表情:<select name="addsays">\n";

　　# print "<option value="">面无表情\n";

　　# foreach $addsays_line (@addsays) {

　　# if ($addsays_line =~ /"$addsays"/) {

　　# $addsays_line =~ s/>/ selected>/g;

　　# }

　　# print "$addsays_line";

　　# }

　　# print "</select>\n";

　　#}

　　#

　　#if ($userlevel>=$level_addimage) {

　　# print "图案:<select name="addimage">\n";

　　# print "<option value="">不贴图案\n";

　　# foreach $image_line (@image) {

　　# if ($image_line =~ /"$addimage"/) {

　　# $image_line =~ s/>/ selected>/g;

　　# }

　　# print "$image_line";

　　# }

　　# print "</select>\n";

　　#}

　　#if ($userlevel>=$level_addimage) {

　　# print "趣语:<select name="fun" onchange='receiver(this);'>\n";

　　# print "<option value="">不选\n";

　　# foreach $fun_line (@fun) {

　　# print "$fun_line";

　　# }

　　# print "</select>\n";

　　#}

　　#

　　#print "</td><td valign=top align=left>\n";

　　#print "<input type=submit value="送出发言">\n";

　　#print "<input type=reset value="清除发言">\n";

　　#print "</td></tr>\n";

　　#print "</form>\n";

　　#print "</table>\n";

　　#print "</div></body></html>\n";

　　print<<TYPE;

　　<html>

　　<head>

　　<meta http-equiv="content-type" content="text/html; charset=gb2312">

　　<title>CHATTING ROOM</title>

　　<script Language="JavaScript">

　　

　　</script>

　　<base target="main">

　　<style type="text/css">

　　

　　</style>

　　</head>

　　<body bgcolor="#999999"

　　onload="document.forms[0].tObject.value='大家';document.forms[0].tWords.focus()"

　　onScroll="window.scroll(0,0)" background="$bg_type"

　　topMargin="0" leftMargin="0" MARGINWIDTH="0" MARGINHEIGHT="0" text="#FFFFFF">

　　<form method="post" action="$cgiurl?room=$room&reload=$reload&job=says$userinfo"

　　onsubmit="return(checkwords());" target="one">

　　<input type="hidden" name="says" value><input

　　type="hidden" name="Words_num" value="%Words_num%"><input type="hidden" name="Start_time"

　　value="%Start_time%"><input type="hidden" name="addsays" value><input type="hidden"

　　name="addimage" value><input type="hidden" name="towho" value><table width="100%" border="0"

　　cellspacing="0" cellpadding="0"><input type="hidden" name="towhoway" value="public"><input type="hidden" name="wordcolor" value>

　　<tr>

　　<td align="left" valign="top"><table border="0" cellspacing="0" cellpadding="0">

　　<tr>

　　<td width="308" height="34" valign="bottom"><table border="0" cellspacing="0"

　　cellpadding="0">

　　<tr>

　　<td nowrap>

　　您</td>

　　<td><select name="tAction" onChange="document.forms[0].tWords.focus()" class="p12"

　　size="1">

　　TYPE

　　if ($userlevel>=$level_addsays) {

　　# print "表情:<select name="addsays">\n";

　　print "<option value="">面无表情\n";

　　foreach $addsays_line (@addsays) {

　　if ($addsays_line =~ /"$addsays"/) {

　　$addsays_line =~ s/>/ selected>/g;

　　}

　　print "$addsays_line";

　　}

　　# print "</select>\n";

　　}

　　print<<TYPE;

　　</select></td>

　　<td>地</td>

　　</tr>

　　</table>

　　</td>

　　<td><table border="0" cellspacing="0" cellpadding="0" height="32">

　　<tr>

　　<td class="p9"><font color="black">对</font></td>

　　<script language="JavaScript">

　　

　　</script>

　　<td nowrap class="p9"><font color="gray"><label

　　for="fp1">悄悄话</label></font></td>

　　<td class="p9"><input type="checkbox" name="Private" value="ON" class="p9" id="fp1"

　　onClick="document.forms[0].tWords.focus()" > </td>

　　</tr>

　　</table>

　　</td>

　　</tr>

　　</table>

　　<table border="0" cellspacing="0" cellpadding="0">

　　<tr>

　　<td nowrap>

　　说</td>

　　<td><input type="text" name="tWords" value maxlength="120" size="50" class="p12"

　　wsize="56"></td>

　　<td><select name="tImage" onChange="document.forms[0].tWords.focus()" class="p12" size="1">

　　TYPE

　　if ($userlevel>=$level_addimage) {

　　# print "图案:<select name="addimage">\n";

　　print "<option value="">不贴图案\n";

　　foreach $image_line (@image) {

　　if ($image_line =~ /"$addimage"/) {

　　$image_line =~ s/>/ selected>/g;

　　}

　　print "$image_line";

　　}

　　# print "</select>\n";

　　}

　　print<<TYPE;

　　</select> </td>

　　</tr>

　　</table>

　　<table border="0" cellspacing="0" cellpadding="0" height="42">

　　<tr>

　　<td nowrap><font color="66cc66">趣语</font></td>

　　<td class="p9">

　　TYPE

　　if ($userlevel>=$level_addimage) {

　　print "<select name="fun" onchange='receiver(this);'>\n";

　　print "<option value="">不选\n";

　　foreach $fun_line (@fun) {

　　print "$fun_line";

　　}

　　# print "</select></td>\n";

　　}

　　if ($userlevel>=$level_sysadmin) {

　　$item1="<a href=$cgiurl?job=cls$userinfo target="one">清除屏幕</a>";

　　$item2="<a href=$cgiurl?job=showpass&$userinfo target="one">查看信息</a>";

　　}

　　print<<TYPE;

　　</select></td>

　　<td width="400" align="right"><table border="0" cellspacing="0" cellpadding="12">

　　<tr nowrap valign="middle" align="center">

　　<td>$item1</td>

　　<td>$item2</td>

　　<td><a href="mailto:$mail">站长信箱</a></td>

　　<td><a href="$cgiurl">聊天首页</a></td>

　　</tr>

　　</table>

　　</td>

　　</tr>

　　</table>

　　</td>

　　</tr>

　　<td nowrap><font color="66cc66">色彩</font>

　　TYPE

　　if ($userlevel>=$level_wordcolor) {

　　srand;

　　$ram=int(rand($#wordcolor+1));

　　$temp=0;

　　# print "颜色:<select name="wordcolor">\n";

　　print "<select name="Color" onChange="document.forms[0].tWords.focus()" class="p9" size="1">\n";

　　foreach $wordcolor_line (@wordcolor) {

　　if (($wordcolor_line =~ /"$wordcolor"/) || ((!($wordcolor)) && ($temp eq $ram))) {

　　$wordcolor_line =~ s/>/ selected>/g;

　　}

　　print "$wordcolor_line";

　　$temp=$temp+1;

　　}

　　print "</select></td>\n";

　　}

　　print <<TYPE;

　　</table>

　　<div align="right"><p>

　　<input type="submit" value="Submit" name="B1"></p>

　　</div>

　　</form>

　　</body>

　　</html>

　　TYPE

　　}

　　#############

　　sub return_func {

　　if ($userlevel>=$level_midi) {

　　open(MIDI,"$midifile") || die $!;

　　#flock(MIDI,1);

　　@midi = <MIDI>;

　　#flock(MIDI,8);

　　close(MIDI);

　　}

　　print "<html><head><title>func</title>\n";

　　print "<script Language="JavaScript">\n";

　　if ($midiurl) {

　　print "function browver(){\n";

　　print " if ((navigator\.userAgent\.indexOf("Mozilla/3\.0") \!= -1 ) || ( navigator\.userAgent\.indexOf("Mozilla/4\.0") \!= -1 ))\n";

　　print " return 1;\n";

　　print " else\n";

　　print " return 2;\n";

　　print "}\n";

　　}

　　print "function takevalue() {\n";

　　if ($userlevel>=$level_towho) {

　　print "document\.forms[0]\.towhoway\.value=parent\.frames[2]\.document\.forms[0]\.towhoway\.value[parent\.frames[2]\.document\.forms[0]\.towhoway\.selectedIndex]\.value;\n";

　　print "document\.forms[0]\.towho\.value=parent\.frames[2]\.document\.forms[0]\.towho\.options[parent\.frames[2]\.document\.forms[0]\.towho\.selectedIndex]\.value;\n";

　　}

　　if ($userlevel>=$level_wordcolor) {print "document\.forms[0]\.wordcolor\.value=parent\.frames[2]\.document\.forms[0]\.wordcolor\.options[parent\.frames[2]\.document\.forms[0]\.wordcolor\.selectedIndex]\.value;\n";}

　　if ($userlevel>=$level_addsays) {print "document\.forms[0]\.addsays\.value=parent\.frames[2]\.document\.forms[0]\.addsays\.options[parent\.frames[2]\.document\.forms[0]\.addsays\.selectedIndex]\.value;\n";}

　　if ($userlevel>=$level_addimage) {print "document\.forms[0]\.addimage\.value=parent\.frames[2]\.document\.forms[0]\.addimage\.options[parent\.frames[2]\.document\.forms[0]\.addimage\.selectedIndex]\.value;\n";}

　　print "return true;\n";

　　print "}\n";

　　print "</script>\n";

　　print "</head>\n";

　　print "<body bgcolor=$funcback text=$funcword>\n";

　　print "<basefont size=2><center>\n";

　　print "<form method=POST action=$cgiurl?pass=$pass&job=settype$userinfo target="two" onsubmit="return(takevalue());">\n";

　　if ($userlevel>=$level_towho) {

　　print "<input type=hidden name="towhoway" value="">";

　　print "<input type=hidden name="towho" value="">";

　　}

　　if ($userlevel>=$level_wordcolor) {print "<input type=hidden name="wordcolor" value="">";}

　　if ($userlevel>=$level_addsays) {print "<input type=hidden name="addsays" value="">";}

　　if ($userlevel>=$level_addimage) {print "<input type=hidden name="addimage" value="">";}

　　if (($level_towho==1) || ($level_wordcolor==1) || ($level_addsays==1) || ($level_addimage==1)) {

　　# print "<input type=image name="Enter" src=$settypegif border=0>\n";

　　}

　　if ($adverfile ne "") {

　　print "<a href=$cgiurl?pass=$pass&job=online$userinfo target="three"><img src=$onlinegif border=0></a>\n";

　　}

　　if ($userlevel>=$level_kick) {print "<a href=$cgiurl?pass=$pass&job=setkick$userinfo target="one"><img src=$setkickgif border=0></a>\n";}

　　print "<a href=$cgiurl?pass=$pass&job=logout$userinfo&logouturl=$logouturl target="_top"><img src=$logoutgif border=0></a>\n";

　　print "</form>\n";

　　if ($userlevel>=$level_midi) {

　　print "<form method=post action=$cgiurl?pass=$pass&job=setmidi$userinfo target=five>\n";

　　print "<select name="midiurl">\n";

　　foreach $midi_line (@midi) {

　　($mark,$chkmidiname,$chkmidiurl,$markend,$last) = split(/‖/, $midi_line);

　　if (($mark eq "midi") && ($markend eq "end")) {

　　print "<option value="$chkmidiurl" ";

　　if ($chkmidiurl eq $midiurl) {

　　print "selected";

　　}

　　print ">$chkmidiname\n";

　　}

　　}

　　print "</select>\n";

　　print "<input type=image name="Enter" src=$setmidigif border=0>\n";

　　print "</form>\n";

　　}

　　if ($midiurl) {

　　print "<bgsound src="$midiurl" loop="-1">\n";

　　}

　　print "</center></body></html>\n";

　　}

　　##########

　　sub write_mess {

　　$write_mess_subject=$_[0];

　　$towho="$towho‖$towho‖$towho";

　　open(MESS,"$messfile") || error("$!");

　　#flock(MESS,1);

　　@mess = <MESS>;

　　#flock(MESS,8);

　　close(MESS);

　　open(MESS,">$messfile") || error("$!");

　　#flock(MESS,2);

　　$total_mess1=0;

　　$total_mess2=0;

　　if ($write_mess_subject eq "says") {

　　print MESS "says‖$userip‖$username‖$userlevel‖$usersex‖$towhoway‖$towho‖$wordcolor‖$addsays‖$says‖$addimage‖$normal_time‖end‖\n";

　　if (($towhoway eq "private") && ($towho ne "大家‖大家‖大家")) {$total_mess2++;}

　　else {$total_mess1++;}

　　}

　　elsif ($write_mess_subject eq "login") {

　　print MESS "login‖$userip‖$username‖$userlevel‖$usersex‖‖‖‖‖‖‖‖‖$normal_time‖end‖\n";

　　$total_mess1++;}

　　elsif ($write_mess_subject eq "logout") {

　　print MESS "logout‖$userip‖$username‖$userlevel‖$usersex‖‖‖‖‖‖‖‖‖$normal_time‖end‖\n";

　　$total_mess1++;}

　　foreach $mess_line (@mess) {

　　($mark,$chkuserip,$chkusername,$chkuserlevel,$chkusersex,$chktowhoway,$chktowhoip,$chktowhoname,$chktowholevel,$chkwordcolor,$chkaddsays,$chksays,$chkaddimage,$chktime,$markend,$last) = split(/‖/, $mess_line);

　　if ((($mark eq "says") || ($mark eq "login") || ($mark eq "logout")) && ($markend eq "end")) {

　　if ($mark eq "says") {

　　if (($chktowhoway eq "private") && (($chktowhoip ne "toall") || ($chktowhoname ne "toall") || ($chktowholevel ne "toall"))) {

　　if (($total_mess2<$allow_mess) && ($total_mess1<$allow_mess)) {print MESS "$mess_line";}

　　$total_mess2++;}

　　else {

　　if ($total_mess1<$allow_mess) {print MESS "$mess_line";}

　　$total_mess1++;}

　　}

　　elsif (($mark eq "login") || ($mark eq "logout")) {

　　if ($total_mess1<$allow_mess) {print MESS "$mess_line";}

　　$total_mess1++;}

　　}

　　}

　　#flock(MESS,8);

　　close(MESS);

　　}

　　##########

　　sub return_mess {

　　open(MESS,"$messfile") || error("$!");

　　#flock(MESS,1);

　　@mess = <MESS>;

　　#flock(MESS,8);

　　close(MESS);

　　if (($kicked==1) && ($kickoutway eq "level1")) {

　　print "<html><head><title>$title</title>\n";

　　print "<META HTTP-EQUIV=REFRESH CONTENT="1;URL=$kickouturl"></head>\n";

　　print "<body bgcolor=#000000 text=#ffffdd>\n";

　　print "<center><h2>您将自动跳离本视窗</h2></center>\n";

　　print "</body></html>\n";

　　}

　　else {

　　print "<html><head><title>Look</title>\n";

　　print "<META HTTP-EQUIV=REFRESH CONTENT="$reload;URL=$cgiurl?room=$room&reload=$reload&job=look$userinfo">\n";

　　print "<style type="text/css">\n</style>\n";

　　print "</head>\n";

　　print "<body bgcolor=$saysback text=$saysword>\n";

　　print "<basefont size=2>\n";

　　print "<span class=font>\n";

　　foreach $mess_line (@mess) {

　　($mark,$chkuserip,$chkusername,$chkuserlevel,$chkusersex,$chktowhoway,$chktowhoip,$chktowhoname,$chktowholevel,$chkwordcolor,$chkaddsays,$chksays,$chkaddimage,$chktime,$markend,$last) = split(/‖/, $mess_line);

　　if ((($mark eq "says") || ($mark eq "login") || ($mark eq "logout")) && ($markend eq "end")) {

　　local($chkusername1) ="$chkusername";

　　local($chktowhoname1) ="$chktowhoname";

　　local($chkusername1) ="<u>$chkusername</u>" if ($chkusername eq $username);

　　local($chktowhoname1) ="<u>$chktowhoname</u>" if ($chktowhoname eq $username);

　　if ($allow_sex1==0) {$chkusersex="";}

　　elsif ($allow_sex1==1) {$chkusersex="<font size=-2>$chkusersex</font>";}

　　elsif (($allow_sex1==2) && (($mark eq "login") || ($mark eq "logout"))) {$chkusersex="<font size=-2>$chkusersex</font>";}

　　else {$chkusersex="";}

　　if ($allow_time==1) {$chktime="<font size=-3>($chktime)</font>";}

　　else {$chktime="";}

　　if ($userlevel>=$level_seeip) {$showip="<font size=-3>[$chkuserip]</font>";}

　　else {$showip="";}

　　if ($chkaddimage ne "") {$chkaddimage="<font face=wingdings size=$image_size>$chkaddimage</font>";}

　　if ($mark eq "says") {

　　if (($chktowhoip eq "大家") && ($chktowhoname eq "大家") && ($chktowholevel eq "大家")) {

　　print "<font size=+1 color=$chkwordcolor>$chkusersex$chkusername1$showip$chkaddsays<font size=+1 color=black>说：</font>$chksays$chkaddimage</font>$chktime\n";}

　　elsif ((($chktowhoip ne "大家") || ($chktowhoname ne "大家") || ($chktowholevel ne "大家")) && ($chktowhoway eq "public")) {

　　print "<font size=+1 color=$chkwordcolor>$chkusersex$chkusername1$showip$chkaddsays<font size=+1 color=black>对</font>$chktowhoname1<font size=+1 color=black>说：</font>$chksays$chkaddimage</font>$chktime\n";}

　　elsif ((($chktowhoip ne "大家") && ($chktowhoname ne "大家") && ($chktowhoway eq "private")) && (($username eq $chkusername) or ($username eq $chktowhoname) or ($userlevel>$chkuserlevel))) {

　　$chkaddsays =~ s/说//g;

　　print "<font size=+1 color=$chkwordcolor><b>$chkusersex$chkusername1$showip$chkaddsays<font color=black>只对$chktowhoname1说</b>：</font>$chksays$chkaddimage</font>$chktime\n";}

　　}

　　elsif ($mark eq "login") {

　　print "<font size=+2 color=$loginword>$title公告：$chkusersex$chkusername1$showip进入聊天室$chktime</font>\n";}

　　elsif ($mark eq "logout") {

　　print "<font size=+2 color=$logoutword>$title公告：$chkusersex$chkusername1$showip离开聊天室了$chktime</font>\n";}

　　}

　　}

　　print "$link";

　　print "</span></body></html>\n";

　　}

　　}

　　##########

　　sub write_online {

　　$write_online_subject = $_[0];

　　open(ONLINE,"$onlinefile") || die $!;

　　#flock(ONLINE,1);

　　@online = <ONLINE>;

　　#flock(ONLINE,8);

　　close(ONLINE);

　　@online = sort @online;

　　$lastcheck = "";

　　$done = 0;

　　open(ONLINE,">$onlinefile") || die $!;

　　#flock(ONLINE,2);

　　foreach $online_line (@online) {

　　($mark,$chkuserip,$chkusername,$chkuserlevel,$chkusersex,$chktime,$chksec,$chkkickout,$chkkickoutway,$markend,$last)=split(/‖/,$online_line);

　　if (($mark eq "online") && ($markend eq "end")) {

　　if ($lastcheck ne "$chkuserip‖$chkusername‖$chkuserlevel") {

　　if (($write_online_subject eq "online") && ($chkuserip eq $userip) && ($chkusername eq $username) && ($chkuserlevel eq $userlevel)) {

　　print ONLINE "online‖$userip‖$username‖$userlevel‖$usersex‖$normal_time‖$now_sec‖$chkkickout‖$chkkickoutway‖end‖\n";

　　if ($chkkickout eq "kickouted") {

　　$kicked =1;

　　$kickoutway=$chkkickoutway;

　　}

　　$done=1;

　　}

　　elsif (($write_online_subject eq "outline") && ($chkuserip eq $userip) && ($chkusername eq $username) && ($chkuserlevel eq $userlevel) && ($chkkickout ne "kickouted")) {

　　print ONLINE "";

　　$exist="yes";

　　}

　　elsif (($write_online_subject eq "kickout") && ($kickoutuser eq "$chkuserip‖$chkusername‖$chkuserlevel")) {

　　print ONLINE "online‖$kickoutuser‖$chkusersex‖$normal_time‖$now_sec‖kickouted‖$kickoutway‖end‖\n";

　　$done=1;

　　}

　　else {

　　if ((($chksec<$cut1_sec) || ($chksec>$cut2_sec)) && ($chkkickout ne "kickouted")) {

　　print ONLINE "";

　　}

　　elsif ((($chksec<$cut3_sec) || ($chksec>$cut4_sec)) && ($chkkickout eq "kickouted")) {

　　print ONLINE "";

　　}

　　else {

　　print ONLINE "$online_line";

　　}

　　}

　　}

　　$lastcheck = "$chkuserip‖$chkusername‖$chkuserlevel";

　　}

　　}

　　if (($write_online_subject eq "online") && ($done==0)) {

　　print ONLINE "online‖$userip‖$username‖$userlevel‖$usersex‖$normal_time‖$now_sec‖‖‖end‖\n";

　　}

　　elsif (($write_online_subject eq "kickout") && ($done==0)) {

　　print ONLINE "online‖$kickoutuser‖‖$normal_time‖$now_sec‖kickouted‖$kickoutway‖end‖\n";

　　}

　　#flock(ONLINE,8);

　　close(ONLINE);

　　}

　　#############

　　sub return_online {

　　$return_online_subject = $_[0];

　　open(ONLINE,"$onlinefile") || error("$!");

　　#flock(ONLINE,1);

　　@online = <ONLINE>;

　　#flock(ONLINE,8);

　　close(ONLINE);

　　@online = sort @online;

　　$online_total=0;

　　foreach $online_line (@online) {

　　($mark,$chkuserip,$chkusername,$chkuserlevel,$chkusersex,$chktime,$chksec,$chkkickout,$chkkickoutway,$markend,$last)=split(/‖/,$online_line);

　　$online_total++;

　　}

　　if ($return_online_subject eq "online") {

　　if ($adverfile ne "") {$temp="adver";}

　　else {$temp="online";}

　　print "<html><head><title>online</title>\n";

　　print "<META HTTP-EQUIV=REFRESH CONTENT="$reload_online;URL=$cgiurl?room=$room&job=$temp$userinfo">\n";

　　print<<STYLE;

　　<style type="text/css">

　　

　　</style>

　　<script language="JavaScript">

　　

　　</script>

　　</head>

　　STYLE

　　print "<body bgcolor=$onlineback text=$onlineword>\n";

　　print "<basefont size=2>\n";

　　print " <table border="0" cellpadding="2" width="100%"><td width="29%" valign="top" align="center">\n";

　　#print "<tbody>\n";

　　print " <tr>\n";

　　print " <td width="100%" align="center" bgcolor="#FFFFFF" colspan="2">\n";

　　print " <table border="1" width="100%" bordercolor="#8985D8" cellspacing="0" cellpadding="2">\n";

　　print " <tr>\n";

　　print " <td bgcolor="#8985D8" bordercolor="#FFFFFF" align="center" colspan="2"><span style="font-family: 宋体; font-size: 9pt"><font color="#FFFFFF">线上名单</font></span></td>\n";

　　print " </tr>\n";

　　print " <tr>\n";

　　print " <td COLSTART="1" bordercolor="#FFFFFF"><div align="center"><center>\n";

　　#print "总人数: $online_total\n";

　　# print "<center><b>线上名单</b>\n";

　　# print "<table border=0>\n";

　　}

　　elsif ($return_online_subject eq "kickout") {

　　print "<html><head><title>人员列表</title>\n";

　　print "<META HTTP-EQUIV=REFRESH CONTENT="$reload_online;URL=$cgiurl?room=$room&job=setkick$userinfo"></head>\n";

　　print "<body bgcolor=$saysback text=$saysword>\n";

　　print "<basefont size=2>\n";

　　print "<center><font size=5><b>人员列表</b></font>\n";

　　print "<table border=1>\n";

　　print "<form method=POST action="$cgiurl?room=$room&job=kickout$userinfo" target="one" onsubmit="self.status='资料已送出'; return true;">\n";

　　print "<tr bgcolor=ffddff><td>选取</td><td>人员识别</td><td>权限等级</td><td>最後出现时间</td><td>管制状态</td></tr>\n";

　　}

　　$lastcheck = "";

　　foreach $online_line (@online) {

　　($mark,$chkuserip,$chkusername,$chkuserlevel,$chkusersex,$chktime,$chksec,$chkkickout,$chkkickoutway,$markend,$last)=split(/‖/,$online_line);

　　if (($mark eq "online") && ($markend eq "end")) {

　　if (($lastcheck ne "$chkuserip‖$chkusername‖$chkuserlevel") && (!(($return_online_subject eq "online") && ($userlevel<$level_seelevel) && ($chkkickout eq "kickouted")))) {

　　if (($return_online_subject eq "kickout") && ($userlevel>=$level_kick)) {

　　print "<tr bgcolor=ffffdd><td>";

　　if ($chkuserlevel<$userlevel) {

　　print "<input type=radio name="kickoutuser" value="$chkuserip‖$chkusername‖$chkuserlevel">";

　　}

　　else {

　　print "----";

　　}

　　print "</td>";

　　print "<td><font size=-1>$chkusersex</font>$chkusername($chkuserip)</td>";

　　if ($chkuserlevel<$userlevel) {print "<td>$chkuserlevel级</td>";}

　　elsif ($chkuserlevel>=$userlevel) {print "<td>$userlevel级</td>";}

　　print "<td>$chktime</td>";

　　if ($chkkickout eq "kickouted") {

　　print "<td>Kicked by $chkkickoutway</td>";

　　}

　　else {

　　# print "<td>.</td>";

　　}

　　print "</tr>\n";

　　}

　　else {

　　# print "<tr><td>";

　　print "<a href="javascript:selectwho('$chkusername');" onmouseover="javascript:selectwho2('$chkusername');" class="$chkusersex">";

　　if ($allow_sex2==1) {print "<font size=-2>$chkusersex</font>";}

　　print "$chkusername";

　　if ($userlevel>=$level_seelevel) {

　　if ($chkuserlevel<$userlevel) {print "<font size=-1>[$chkuserlevel]";}

　　if ($chkuserlevel>=$userlevel) {print "<font size=-1>[$userlevel]";}

　　if ($chkkickout eq "kickouted") {print "Kicked($chkkickoutway)";}

　　print "</font></a>";

　　}

　　# print "\n总人数: $online_total\n";

　　# print "</td></tr>";

　　}

　　}

　　$lastcheck = "$chkuserip‖$chkusername‖$chkuserlevel";

　　}

　　}

　　#print "</table>\n";

　　print "<a href="javascript:selectwho('大家');" onmouseover="javascript:selectwho2('大家');">总人数: $online_total</a>\n";

　　print " </tr>\n";

　　#print "</tbody>\n";

　　print " </table></tr></table>\n";

　　if (($return_online_subject eq "kickout") && ($userlevel>=$level_kick)) {

　　print "<select name="kickoutway">\n";

　　print "<option value="level1" selected>自动跳离视窗\n";

　　print "<option value="level2">攻击(不停开启新窗口)\n";

　　print "<option value="level3">浏览器当机\n";

　　# print "<option value="level3">禁止发言,免费版无法使用\n";

　　# print "<option value="level4">视窗炸弹,免费版无法使用\n";

　　print "</select>\n";

　　if ($userlevel>=$level_allipkick) {

　　# print "<input type=checkbox name="allip" value="yes">针对IP管制(所有相同IP都踢出),免费版无法使用\n";

　　}

　　print "<input type=submit value="执行"><input type=reset value="清除">\n";

　　print "</form>\n";

　　}

　　print "</center></body></html>\n";

　　}

　　#############

　　sub return_adver {

　　open(ADVER,"$adverfile") || die $!;

　　@adver = <ADVER>;

　　close(ADVER);

　　srand;

　　$ram=int(rand($#adver+1));

　　$aaa=0;

　　foreach $adver_line (@adver) {

　　# ($mark,$chktitle,$chkadver,$markend,$last) = split(/‖/, $adver_line);

　　($mark,$chkadver,$markend,$last)=split(/‖/,$adver_line);

　　if (($mark eq "adver") && ($markend eq "end")) {

　　if ($aaa==$ram) {

　　$adverram=$chkadver;

　　}

　　}

　　$aaa=$aaa+1;

　　}

　　open(MAIN,"$adverram") || die $!;

　　@main = <MAIN>;

　　close(MAIN);

　　foreach $main_line (@main) {

　　if ($main_line =~ //) {

　　print "<META HTTP-EQUIV=REFRESH CONTENT="$reload_double;URL=$cgiurl?pass=$pass&job=online$userinfo">\n";

　　}

　　else {

　　print "$main_line";

　　}

　　}

　　}

　　#############

　　sub return_logout {

　　print "<html><head><title>$title</title>\n";

　　print "<META HTTP-EQUIV=REFRESH CONTENT="2;URL=$logouturl"></head>\n";

　　print "<body bgcolor=#000000 text=#ffffdd>\n";

　　print "<center><h2>您已离开聊天室<hr width=400 size=1>You have already logged out from chat room</h2></center>\n";

　　print "</body></html>\n";

　　}

　　#############

　　sub chkempty {

　　$chkval = $_[0];

　　$chkerr = $_[1];

　　$chkval =~ s/ //g;

　　$chkval =~ s///g;

　　$chkval =~ s/\n//g;

　　if ($chkval eq "") {

　　&error($chkerr);

　　}

　　}

　　#############

　　sub error {

　　$error_subject = $_[0];

　　print "<html><head><title>$title 错误</title>\n";

　　print "</head>\n";

　　print "<body bgcolor=$saysback text=$saysword>\n";

　　print "<center><h1>\n";

　　print "错误：$error_subject\n";

　　print "</h1></center></body></html>\n";

　　exit;

　　}

　　sub mypath

　　{

　　local $filename,$mypath;

　　$filename=__FILE__;

　　if ($filename=~/\\/) { $filename=~ s/\\/\//g;}

　　if ($filename) {

　　$mypath=substr($filename,0,rindex($filename,"/"));

　　}

　　else {

　　$mypath=substr($ENV{'PATH_TRANSLATED'},0,rindex($ENV{'PATH_TRANSLATED'},"\"));

　　$mypath=~ s/\\/\//g;

　　}

　　return $mypath;

　　}

　　sub myurl

　　{

　　local $myurl,$server_port;

　　if ($ENV{'SERVER_PORT'} ne '80') { $server_port=$ENV{'SERVER_PORT'};}

　　#---------------------------------------------------------------------------

　　$fullcgiurl = "http://$ENV{'SERVER_NAME'}$server_port$ENV{'SCRIPT_NAME'}";

　　#---------------------------------------------------------------------------

　　#$cgiurl的结果为如： http://www.hoyi.net/script/webbbs/forum.pl

　　$myurl=substr($fullcgiurl,0,rindex($fullcgiurl,"/"));

　　return $myurl;

　　}

　　sub check_pass {

　　open(USER,"$passfile") || die $!;

　　#flock(USER,1);

　　@user = <USER>;

　　#flock(USER,8);

　　close(USER);

　　foreach $user_line (@user) {

　　($user_name,$user_pass,$last) = split(/‖/, $user_line);

　　if ($username eq $user_name) {

　　$user_mark=1;

　　if ($pass ne $user_pass) {&error("密码错误");}

　　}

　　}

　　if ($user_mark==0) {

　　open(USER,">>$passfile") || die $!;

　　#flock(USER,1);

　　print (USER "$username‖$pass‖PassWord List\n");

　　#flock(USER,8);

　　close(USER);

　　}

　　}

　　sub showpage{

　　$room_no=0;

　　foreach $room_id (@rooms){

　　$room_no++;

　　open(ONLINE,"$dir/online$room_no\.cgi") || die $!;

　　#flock(ONLINE,1);

　　@online = <ONLINE>;

　　#flock(ONLINE,8);

　　close(ONLINE);

　　@online = sort @online;

　　$online_total=0;

　　foreach $online_line (@online) {

　　($mark,$chkuserip,$chkusername,$chkuserlevel,$chkusersex,$chktime,$chksec,$chkkickout,$chkkickoutway,$markend,$last)=split(/‖/,$online_line);

　　$online_total++;

　　}

　　$roomhtml=$roomhtml . "<option value="$room_id">$room_id($online_total)\n";

　　}

　　open (PAGE, "$dir/$page\.htm") || error("File Not Found!!!!");

　　while (<PAGE>){

　　s/\$cgiurl/$cgiurl/g;

　　s/\$title/$title/g;

　　s/\$room/$roomhtml/g;

　　print $_;

　　}

　　close (PAGE);

　　exit;

　　}

　　sub cls{

　　open(SAYS,">$messfile") || die $!;

　　#flock(SAYS,1);

　　print SAYS "says‖$userip‖$title公告‖3‖‖public‖大家‖大家‖大家‖0088ff‖‖管理员<b>$username</b>清除了屏幕上的内容。‖‖$normal_time‖end‖\n";

　　#flock(SAYS,8);

　　close(SAYS);

　　}

　　sub showpass{

　　open(USER,"$passfile") || die $!;

　　#flock(USER,1);

　　@user = <USER>;

　　#flock(USER,8);

　　close(USER);

　　print "<html><head><title>用户信息</title>\n";

　　# print "<META HTTP-EQUIV=REFRESH CONTENT="$reload_double;URL=$cgiurl?pass=$pass&job=setkick$userinfo"></head>\n";

　　print "<body bgcolor=$saysback text=$saysword>\n";

　　print "<basefont size=2>\n";

　　print "<center><font size=5><b>用户信息</b></font>\n";

　　print "<table border=1>\n";

　　print "<tr bgcolor=ffddff><td>用户名</td><td>密码</td></tr>\n";

　　foreach $user_line (@user) {

　　($user_name,$user_pass,$last) = split(/‖/, $user_line);

　　print "<tr><td>$user_name</td><td>$user_pass</td></tr>\n";

　　}

　　print "</table>\n";

　　print "<input type="button" value="返回" onclick="javascript:history.go(-1);">\n";

　　print "</center></body></html>\n";

　　exit;

　　}

　　sub changepass{

　　open(USER,"$passfile") || error("$!");

　　#flock(USER,1);

　　@user = <USER>;

　　#flock(USER,8);

　　close(USER);

　　open(USER,">$passfile") || error("$!");

　　foreach $user_line (@user) {

　　($chkuser,$chkpass,$last) = split(/‖/, $user_line);

　　if ($username eq $chkuser) {

　　if ($pass eq $chkpass){

　　print (USER "$username‖$FORM{'pass1'}‖PassWord List\n");

　　$user_mark=1;

　　}

　　else{

　　print (USER "$chkuser‖$chkpass‖PassWord List\n");

　　&error("密码错误!");

　　}

　　}

　　else{

　　print (USER "$chkuser‖$chkpass‖PassWord List\n");

　　}

　　}

　　close(USER);

　　if ($user_mark==1){

　　$page="changesucc";

　　&showpage;

　　}

　　else{

　　&error("怎么回事? 没有找到您的资料!");

　　}

　　}

　　（二）login‖127.0.0.1‖Binbin‖3‖Boy‖‖‖‖‖‖‖‖‖17:51:43‖end‖

　　says‖127.0.0.1‖super‖3‖boy‖public‖127.0.0.1‖aa‖1‖0088ff‖淫淫笑的说‖gdfgsdgf‖I‖21:31:29‖end‖

　　says‖127.0.0.1‖super‖3‖boy‖public‖127.0.0.1‖aa‖1‖0088ff‖毛手毛脚的说‖gdfgsdgf‖I‖21:31:21‖end‖

　　says‖127.0.0.1‖super‖3‖boy‖public‖toall‖toall‖toall‖0088ff‖毛手毛脚的说‖gdfgsdgf‖I‖21:31:13‖end‖

　　says‖127.0.0.1‖super‖3‖boy‖public‖toall‖toall‖toall‖0088ff‖‖gdfgsdgf‖‖21:31:03‖end‖

　　says‖127.0.0.1‖super‖3‖boy‖public‖toall‖toall‖toall‖0088ff‖‖w‖‖21:28:21‖end‖

　　says‖127.0.0.1‖super‖3‖boy‖public‖toall‖toall‖toall‖0088ff‖‖adfa‖‖21:28:14‖end‖

　　login‖127.0.0.1‖d‖1‖boy‖‖‖‖‖‖‖‖‖21:27:59‖end‖

　　login‖127.0.0.1‖fds‖1‖boy‖‖‖‖‖‖‖‖‖21:26:21‖end‖

　　logout‖127.0.0.1‖super‖1‖boy‖‖‖‖‖‖‖‖‖21:26:09‖end‖

　　says‖127.0.0.1‖super‖3‖boy‖public‖toall‖toall‖toall‖0088ff‖‖fafdasfd‖‖21:26:03‖end‖

　　login‖127.0.0.1‖super‖3‖boy‖‖‖‖‖‖‖‖‖21:25:52‖end‖

　　运行结果如下:
本文来自：http://www.linuxpk.com/2938.html