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/<!--(.|\n)*-->//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">

<!--

function receiver(list) {

var listText='';

if((list.selectedIndex != -1)&&(list.selectedIndex != 0))

{ listText = list.options[list.selectedIndex].value; }

document.forms[0].tWords.value=listText;

}

function checkwords() {

if (document.forms[0].Private.checked==true) {

document.forms[0].towhoway.value='private';

}

else {

document.forms[0].towhoway.value='public';

}

document.forms[0].says.value=document.forms[0].tWords.value;

document.forms[0].tWords.value='';

if (checkempty(document.forms[0].says.value)==false) return false;

self.status='资料已送出';

document.forms[0].addsays.value=document.forms[0].tAction.options[document.forms[0].tAction.selectedIndex].value;

document.forms[0].addimage.value=document.forms[0].tImage.options[document.forms[0].tImage.selectedIndex].value;

document.forms[0].towho.value=document.forms[0].tObject.value;

document.forms[0].wordcolor.value=document.forms[0].Color.value;

// document.forms[0].tAction.selectedIndex=0;

document.forms[0].tImage.selectedIndex=0;

document.forms[0].tWords.focus();

return true;

}

function checkempty(txtval){

if (txtval.length==0) return false;

var i=0;

while (i<txtval.length) {

ch=txtval.substring(i,i+1);

if (!(ch==''||ch==' ')) return true;

i=i+1;

}

return false;

}

-->

</script>

<base target="main">

<style type="text/css">

<!--

a:link { font-size: 9pt; color: #CCCCCC; text-decoration: none}

a:visited { font-size: 9pt; color: #CCCCCC; text-decoration: none}

a:hover { color: #0099FF}

.username { border-style: none; background-color: #CCFFFF; font-size: 9pt}

.p9 { font-size: 9pt}.p12 { font-size: 12pt}-->

</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">

<!--

if (navigator.appName.indexOf('Netscape') != -1) {document.write('<td><input type="submit" value="

" ');}

else {document.write('<td><input type="text" value="" size="16" onFocus="document.forms[0].tWords.focus()"');};

document.write('name="tObject" class="username"></td>');

-->

</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<!--\n.font {font-family:宋体;font-size:9pt;color:#0f0f4f}\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">

<!--

td { font-size: 9pt;font-family:"宋体";}

.boy { color: #0000FF}

.girl { color: #FF0000}

.mask { color: #000000}

a:link { text-decoration: none}

a:hover { background-color: #666666; color: #FFFFFF}

a:visited { text-decoration: none}

-->

</style>

<script language="JavaScript">

<!--

function selectwho(list){

parent.frames[2].document.forms[0].tObject.value=list;

parent.frames[2].document.forms[0].tWords.focus();

parent.frames[2].document.forms[0].Private.checked=true;

parent.overselectenable=false;

}

function selectwho2(list){

parent.frames[2].document.forms[0].tObject.value=list;

parent.frames[2].document.forms[0].tWords.focus();

}

-->

</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 =~ /<!--autorefresh-->/) {

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‖

运行结果如下:

• ·CGI编程--Perl中使用CGI模块(一)
• ·费曼的最后旅程/走近费曼丛书(走近费曼丛书)|
• ·cgilib.pl的应用
• ·perl网上在线人数统计
• ·释迦牟尼/世界大人物丛书|报价￥7.10|图书
• ·近代来粤传教士评传/历史文化书系|报价￥27.
• ·Python入门第六章模块
• ·成为夏娃的亚当(附光盘)|报价￥20.20|图
• ·第五章Python数据结构
• ·追踪哥伦布的脚印/冒险家与发现者|报价￥17.