#!Perl use CGI::Carp qw(fatalsToBrowser); use CGI qw/:all/; $q = CGI->new(); start(); sub start() { ## erste func die ausgeführt wird...-> keine parameter; my $keksvalue = readc(frpg); if($keksvalue eq ''){ funcis(999, '') } elsif($keksvalue =~ /(\d\d\d)\,(.*)/){ funcis($1, $2); setonline($1); } else{ fc() } } sub funcis() { ##wählt beim aufruf passende function aus -><- $huid = shift; $hcupwd = shift; if( $huid ne '999'){ ($huid,$hun,$huwerte,$huavat,$hutitel,$hurasse,$huberuf,$huherk,$hubtrg,$hulip,$hugold,$huinv,$uhsign,$hupm,$humail,$huregd,$hulbt,$humailz,$hukarte,$hupwd,$hustat) = riuser($huid); if($hcupwd ne "$hupwd"){ fc(); } else { my $datens = &CGIDlesen; my %dat = &CGIDaufbereiter($datens); if($dat{func} eq 'justs'){ justs($uid) } if($dat{func} eq 'justdo'){ justdo($uid, $dat{fn}, $dat{param}) } ##if($dat{func} eq ''){ logins() } ##if($dat{func} eq 'ashowf'){ ashowf($uid) } ##if($dat{func} eq 'reg'){ aregs($dat{un}, $dat{mail}, $dat{mailz}, $dat{rasse}, $dat{herk}, $dat{beru}, $dat{wish}, $dat{frage}, $dat{antwort}) } ##if($dat{func} eq 'newts'){ anewts($uid,$dat{uf},$dat{geg}) } ##if($dat{func} eq 'newt'){ anewt($uid,$dat{uf},$dat{geg}) } ##if($dat{func} eq 'newgs'){ anewgs($uid,$dat{uf}) } ##if($dat{func} eq 'newg'){ anewt($uid,$dat{uf},$dat{geg}) } ##if($dat{func} eq 'newus'){ anewts($uid,$dat{uf},$dat{geg}) } ##if($dat{func} eq 'newu'){ anewt($uid,$dat{uf},$dat{geg}) } ##if($dat{func} eq 'pms'){ apms($uid) } ##if($dat{func} eq 'editp'){ pedit($uid, $upwd, $dat{pwd1}, $dat{pwd2}, $dat{mailz}, $dat{co}, $dat{avat}, $dat{pwd}) } ##if($dat{func} eq 'paedits'){ ashowf($uid) } ##if($dat{func} eq 'paedits'){ ashowf($uid) } } } else { my $datens = &CGIDlesen; my %dat = &CGIDaufbereiter($datens); if($dat{func} eq ''){ showf(); } if($dat{func} eq 'justs'){ justs($uid); } if($dat{func} eq 'justdo'){ justdo($dat{fn}, $dat{param}); } } } sub readc(){ ##liest einen keks-> $keksvalue = readc($cname); my $cname = shift; my $read = $q->cookie("$cname"); return $read; } sub setc() { ## setzt einen keks->setc($cname, $cvalue); my $cname = shift; my $cvalue = shift; my $cookie = $q->cookie(-name=>"$cname", -value=>"$cvalue"); print header(-type=>'text/html', -cookie=>$cookie ); } sub CGIDlesen ##-> $daten = cgilesen; ready!!! { local $cgidaten; if( $ENV{REQUEST_METHOD} eq 'POST') { read(STDIN, $cgidaten , $ENV{'CONTENT_LENGHT'}); } else { $cgidaten = $ENV{QUERY_STRING}; } return $cgidaten; } sub CGIDaufbereiter { ##->%daten = cgiwandler($cgidaten von leser); ready!! my ($cgidatenskalar, $name, $daten); my @cgidatenliste; my %cgidatenhash; if( $_[0] ) { $cgidatenskalar = $_[0]; } else { print STDERR "Es wurden keine Daten an den CGIDatenaufbereiter uebergeben\n"; } @cgidatenliste = split(/[&;]/ , $cgidatenskalar); foreach $listeneintrag (@cgidatenliste) { $listeneintrag =~ s/\+/ /go; ($name, $daten) = split( /=/ , $listeneintrag ); $name =~ s/\%(..)/pack("c",hex($1))/ge; $daten =~ s/\%(..)/pack("c",hex($1))/ge; $cgidatenhash{$name} = $daten; } return %cgidatenhash; } sub justs() { ##if($huid < 11) { printhead(); printtree('Funktion manuell starten|justs'); printang(); print <<"ENDE";

Funktion manuell starten

Funktionsname:
Parameter der Funktion

ENDE printfood(); #} else { #bnabna(); #} } sub justdo() { my $rout = shift; my $par = shift; eval(&{$rout}($par)); } sub printhead() { ##kopf der hauptseiten ausgeben ->printhead( print "Content-type: text/html\n\n"; print <<"ENDE"; F-RPG II ENDE } sub printtree() { ##schreibt den baum -> printtre($ufid, $gid, $tid); my $ufid = $_[0]; my $gid = $_[1]; my $tid = $_[2]; print <<"ENDE";
'; } sub printang() { ## schreibt 'angemeldet als...'-> printang($uid) if($huid == 999){ printlog(); } else { my @us = riuser($huid); my($ufid, $gid, $tid) = split(/\,/, $us[16]); my($tn, $tvis, $tlbt) = readta($ufid, $gid, $tid); my($lbid, $lbun, $lbuid, $lbdt) = lastbtr($lastbt); my $ausg = "
  F-rpg - Übersicht
ENDE my $ufid2 = $ufid; if($ufid2 =~ /(^\D\D\D.+?)|(.+)/) { my($pn, $pid) = split(/\|/, $ufid); print '     '."$pn".'
'; } else { if($ufid ne ''){ my($ufid, $ufn, $ufbes, $ufvisi, $uflbid, $uflbuid, $uflbun, $uflbdt) = readu($ufid); print '     '."$ufn".'
'; } if($gid ne ''){ my($gn, $gbes, $gvisi, $glbt, $gt) = readg($gid, $ufid); print '        '."$gn".'
'; } if($tid ne ''){ my($tn, $tvis, $tlbt) = readta($ufid, $gid, $tid); print '        &nb sp;  '."$tn".'
'; } } print '		Angemeldet als $us[1]
$us[8]".' Beiträge ¬>'." $us[4]".'
Dein letzter war in/im
und wurde"; if("$huid" eq "$lbuid"){ $ausg = "$ausg".' nicht beantwortet.
'; } else { $ausg = "$ausg".' beantwortet.
'; } print "$ausg"; } } sub printfood() { ##ausgabe des regulären seitenendes ->printfoot(); online(); print <<"ENDE"; Aktionen
PM's
Inventar
Profil


Würfel
  

This Skript is written by BT-Code Gmbh.

ENDE } sub online() { ##zeigt onlineuser an ->online(); my $onli = 'online.dat'; open(ONL, "<$onli"); my @onl = ; close(ONL); my $ntemp = time; my $user = 'Onlineanzeige
zZ. sind ***'; my $anz = '0'; foreach (@onl) { my($uname, $uid, $uip, $otemp, $stemp)=split(/\;/,$_); my $dif = $ntemp - $otemp; if($dif <= 180) { $user = "$user".''."$uname".','; } } $user = "$user".'

'; $user =~ s/\*\*\*/$anz User online:/; print "$user"; } sub bnabna() { printhead(); my $tree = 'Befehl nicht ausführbar|bnab'; printtree(); printang(); print <<'ENDE';



Befehl nicht ausführbar!!

Sie sind nicht autorisiert!

Falls du denkst dieses Problem hätte nicht auftreten dürfen wende dich an das Orakel der Pyra oder schreib eine Pm an Pyra...
ENDE printfood(); } sub printlog() { ##lässt user einloggenung anzeigen-> printlog(); print <<'ENDE';
Username:
Passwort:
ENDE } sub showf() { ##liest forumübersicht aus foren.dat ein und gibt sie aus-> showf($uid); my $uid = $huid; my $foren = 'foren.dat'; open(FORN, "<$foren"); my @foren = ; close(FORN); ##my($uid, $uname, $uwerte, $uavatar, $utitel, $urasse, $uberuf, $uherkunft, $ubeitraege, $ulastip, $ugold, $uinventar, $usignatur, $upm, $umail, $ureg, $ulastb, $umailz, $ukarte, $upwd, $ustat) = riuser($uid); my($ulastb1, $ulastb2)= split(/\,/, $hulbt); my $ausg = '

'; my $farb = 0; foreach (@foren) { my($fid, $fname, $fbes, $fvis, $flbt)=split(/\;/,$_); my($flbtid, $flbtun, $flbtuid, $flbtdt) = lastbtr($flbt); my $visible = 0; my @visi = split(/\,/, $fvis); foreach (@visi) { if($_ eq $uid){ $visible = 1; } if($_ eq '999'){ $visible = 1 } } my $visia = @visi; if($visia == 0) { $visible = 1; } if($uid < 10){ $visible = 1; } if($visible != 0) { my $farb++; my $farbe = '#431705'; if(($farb %= 2) == 0){ $farbe = '#925e2f'; } $ausg = "$ausg".""; } } $ausg = "$ausg"."
$fname
$fbes		Letzter Beitrag von $flbtun $flbtdt
"; printhead(); printtree('192'); printang(); print "$ausg"; printfood(); }