Hola, gracias por haber respondido a mi mensaje.
El chat no tiene salas privadas, consta de un frame, con una página lateral donde se ven los usuarios que hay en el chat, una página inferior donde esta el input con el campo del usuario que entra y este a su vez abre la página de perl donde se empieza a escribir los mensajes y una página principal de chat que abre un html que es donde se envian los mensajes, la página de perl que existe de programacion de perl es la siguiente..
#!/usr/bin/perl
$imagedir = '../../../../graficas-perl/utiles';
$filepath='/var/www/graficas-perl/chat/';
$filext='.html';
$iecompatible=1;
$ChatRefresh = 5;
$chatLogging = '1';
$logFileName = 'historico.html';
$ChatMessageTime = 600;
@badwords = ("follar", "sexo", "puta", "puton", "huevos", "polla", "cipote", "cornudo", "tortillera", "pedorra", "pedorro", "caga", "cagado", "hijoputa", "cabron", "maricon", "mariquita", "gay", "pene", "lesbiana", "homosexual", "porno", "joder", "coño", "cuernos", "jodiendo", "f`?.?u`?.?c`?.?k"); #PROHIBE PALABRAS
my $thetime = time;
print "Content-type: text/html\nPragma: no-cache\n\n";
print "<html>\n";
print "<title></title>\n";
print "<head>\n";
#print "<bgSound src=\"../../../../graficas-perl/utiles/notify.wav\" id=\"sound\">";
print "</head>\n";
print "<BODY OnContextMenu=\"return false\" topmargin=0 leftmargin=0 bgcolor=#006200 TEXT=#FFFFFF OnLoad='document.isn.message.focus();'>\n";
&getform;
if (&getoldfile) {
&gettime;
&printform;
if ($form{'message'} ne "") { &printnewfile; }
else { &printnoframes; }
}
else
{
print "Esta página<I>$form{'room'}</I> no existe<BR>\n";
print "Administrador: <I>$filepath$form{'room'}$filext</I>\n";
}
print "</font></body></html>\n";
exit(0);
sub getform {
$buffer = "";
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs=split(/&/,$buffer);
foreach $pair (@pairs)
{
@a = split(/=/,$pair);
$name=$a[0];
$value=$a[1];
$value =~ s/\+/ /g;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s/~!/ ~!/g;
$value =~ s/\</\<\;/g; # html tag removal (remove these lines to enable HTML tags in messages)
$value =~ s/\>/\>\;/g; # html tag removal (remove these lines to enable HTML tags in messages)
$value =~ s/[\r\n]//g;
push (@data,$name);
push (@data,$value);
}
%form=@data;
%form;
}
sub getoldfile {
$form{'room'} =~ s/\W//g;
return 0 unless open(HTMLOLD, "$filepath$form{'room'}$filext");
@lines=<HTMLOLD>;
close(HTMLOLD);
return 1;
}
sub gettime {
$now_string = localtime;
@thetime = split(/ +/,$now_string);
@theclock = split(/:/,$thetime[3]);
$ampm = 'am';
if ($theclock[0] > 11)
{ $ampm = 'pm'; }
if ($theclock[0] == 0)
{ $theclock[0] = 12; }
if ($theclock[0] > 12)
{ $theclock[0] -= 12; }
else
{ $theclock[0] += 0; }
}
sub printform {
if (@badwords > 0) {
foreach $curse (@badwords) {
$form{'message'} =~ s/$curse/\<font color=red\>\%\&\#\%\<\/font\>/ig;
$form{'username'} =~ s/$curse/\<font color=red\>\%\&\#\%\<\/font\>/ig;
}
}
print << "EOF";
<CENTER><TABLE CELLSPACING=0 CELLPADDING=0>
<TR><TD>
<nobr><FORM name="isn" ACTION="$ENV{'SCRIPT_NAME'}" METHOD="POST" onSubmit="return JoinIn();">
<font face="verdana"><b>ESCRIBA MENSAJE: </font></b><input name=username type=hidden value="$form{'username'}">
<input name=room type=hidden value="$form{'room'}">
<input type=text name=message size=82 onfocus="javascript
:this.select()">
<input name=CHATCOLOR type=hidden value="$form{'CHATCOLOR'}" size="8">
<input type=submit value="Enviar">
</form></nobr>
</TD></TR>
</TABLE></CENTER>
EOF
}
sub printnewfile {
if($form{'username'} eq "1º_ESTADÍSTICA_MADRID_J.A" or $form{'username'} eq "2º_ESTADÍSTICA_MADRID_F.V" or $form{'username'} eq "3º_ESTADÍSTICA_MADRID_R.B" or $form{'username'} eq "4º_ESTADÍSTICA_MADRID_J.M" or $form{'username'} eq "5º_ESTADÍSTICA_MADRID_V.A" or $form{'username'} eq "10º_ESTADÍSTICA_MADRID_J.R"){
$color = "006200";
}else{
$color = "0000FF";
}
@fechas = localtime (time());
$ar = 1900 + @fechas[5];
$mes = @fechas[4] + 1;
$dia = @fechas[3];
$fechadia = @fechas[3]. "" .$mes. "" .$ar; # si no hay nada entre las comillas,junta los datos
my $thetime = time;
$newmessage = &Make_Color("<font size='2' color=#$color><B> $form{'username'}</B></font> <font face=\"Arial\" color=\"$form{'CHATCOLOR'}\"><img src=\"../../../../graficas-perl/utiles/arrow_bl.gif\" width=\"12\" height=\"8\" border=\"0\"> $form{'message'} &nb sp;</font><font size='2' color=#006600>(@fechas[2] : @fechas[1]) <!--$thetime//--> </font><br>\n");
open (NEW, ">$filepath$form{'room'}$filext");
print NEW "<HTML>\n";
print NEW "<HEAD>\n";
print NEW "<META HTTP-EQUIV=Refresh CONTENT=$ChatRefresh>\n";
print NEW "<META HTTP-EQUIV=Pragma CONTENT=no-cache>\n";
print NEW "<script LANGUAGE=\"javascript\">\n";
print NEW "function LogOff() {\n";
print NEW "parent.sendchat.document.forms[0].message.value = '`4 Ha salido de la aplicación de Estadística en Linea ';\n";
print NEW "parent.sendchat.document.forms[0].submit();\n";
print NEW "document.write('<html><body><center><font color=#006200>Tu login esta fuera<br>Por favor espera<br>Se cerrara en 2 segundos</center></font></body></html>');\n";
print NEW "if (!(parent.window.confirm(\"Estas seguro que quiere salir ahora?\"))) { return; }\n";
print NEW "setTimeout('parent.window.close();',3000);\n" ;
print NEW "}\n";
print NEW "</script>\n";
print NEW "<div align=\"right\"><table border=0 cellpadding=0 cellspacing=0 width=\"102%\" bgcolor=\"#006200\"><tr><td width=\"50%\" align=\"right\"><span style=background-color:#006200><b><font size=4 color=#ffffff face=Arial><img border=0 src=../../../../../graficas-perl/utiles/logogc_color2.gif width=21 height=30> Bienvenido a Estadística en línea <img border=0 src=../../../../../graficas-perl/utiles/message.jpg width=21 height=30></font></b></span></td><td width=\"50%\" align=\"right\" valign=\"top\" bgcolor=#006200><input type=\"button\" value=\"SALIR CORRECTAMENTE\" onclick=\"javascript
:LogOff()\"></td></tr></table></div><br>\n";
print NEW "</HEAD>\n";
print NEW "<BODY OnContextMenu=\"return false\" BGCOLOR=#FFFFFF topmargin=\"0\" leftmargin=\"0\">\n";
if ($iecompatible) {
print NEW $newmessage;
print $newmessage;
if ($chatLogging) {
my $now_string = gmtime;
if (open(CHATLOG, ">>$filepath/$logFileName")) {
print CHATLOG '<small>' . $now_string . '-' . '-</small>' . $newmessage;
close(CHATLOG);
}
}
for ($i = 1; $i < @lines; $i++)
{
$lines[$i] =~ m/<!--(\d*)\/\/-->/;
if ((time - $1) <= $ChatMessageTime)
{
print NEW "$lines[$i]";
print "$lines[$i]";
}
}
}
print NEW "</BODY></HTML>\n";
close NEW;
}
sub Make_Color {
my $st = shift;
my $result = '';
my $colors = 0;
my $i;
my $ch;
for ($i=0; $i < length($st); $i++) {
if (substr($st,$i,1) eq '`') {
$i++;
if ($i > length($st)) { next; }
$ch = substr($st,$i,1);
if ($ch eq '1') {$result .= '<font color="#0000FF">'; $colors++;}
elsif ($ch eq '2') {$result .= '<font color="#ffa000">'; $colors++;}
elsif ($ch eq '3') {$result .= '<font color="#339933">'; $colors++;}
elsif ($ch eq '4') {$result .= '<font color="#FF0000">'; $colors++;}
elsif ($ch eq '5') {$result .= '<font color="#330099">'; $colors++;}
elsif ($ch eq '6') {$result .= '<font color="#33CCFF">'; $colors++;}
elsif ($ch eq '7') {$result .= '<font color="#666666">'; $colors++;}
elsif ($ch eq '8') {$result .= '<font color="#5700AE">'; $colors++;}
elsif ($ch eq '9') {$result .= '<font color="#800000">'; $colors++;}
elsif ($ch eq '0') {$result .= '<font color="#9900CC">'; $colors++;}
elsif ($ch eq '!') {$result .= '<font color="#000000">'; $colors++;}
elsif ($ch eq 'A') {$result .= '<img src="../../../../graficas-perl/utiles/stop2.gif" border="0">'; $colors++;}
elsif ($ch eq '%') {$result .= '<img src="../../../../graficas-perl/utiles/stop1.gif" border="0"> '; $colors++;}
elsif ($ch eq '@') {$result .= '<img src="../../../../graficas-perl/utiles/smile3.gif" width="16" height="12" border="0">'; $colors++;}
elsif ($ch eq '$') {$result .= '<img src="../../../../graficas-perl/utiles/smile2.gif" width="16" height="12" border="0">'; $colors++;}
elsif ($ch eq '#') {$result .= '<img src="../../../../graficas-perl/utiles/smile1.gif" width="16" height="12" border="0">'; $colors++;}
} else {
$result .= substr($st,$i,1);
}
}
while ($colors--) { $result .= '</font>'; }
return ($result);
}
Te doy doy las gracias de nuevo, ahora me voy unos dias de vacaciones, por lo que no entrare en tu foro hasta pasadas las fiestas de año y reyes.
Un saludo
