init III

Perl Nachrichtenticker Chat/client_tk.pl

@@ -0,0 +1,350 @@
+#!/usr/bin/perl
+
+# benutze Threads
+use Thread;
+
+# benutze Multicast
+use IO::Socket::Multicast;
+
+# TK zur Fensterdarstellung verwenden
+use Tk;
+use Tk::MsgBox;
+
+# wav Dateien abspielen ist auch toll
+#use Win32::MediaPlayer;
+
+# für JSON Objekt in die alle vom server gesendeten Nachrichten gekapselt sind.
+use JSON::XS;
+
+# Saubere Programmierung erzwingen
+use strict;
+
+# Alle Nachrichten vom Server
+my @messages :shared;
+
+# Flag das neue Nachricht erhalten wurde
+my $new_message :shared;
+
+# Flag ob Alarmierung stattfinden soll
+my $AlarmAn :shared;
+
+# Thread ID des Multicast Listener
+my $thr;
+
+# Die letzte, also aktuellste Nachricht
+my $pub_lastmessage :shared;
+
+#my $pub_timerlastmessage :shared;
+
+# Nachricht die übermittelt wird (aus Eingabezeile des Fensters) wird in dieser Variable hinterlegt
+my $eingegeben :shared;
+
+# Nachricht die von diesem Client zuletzt gesendet wurde
+my $zuletztgesendet :shared;
+$zuletztgesendet="initiale Nachricht um zuverhindern das \$zuletztgesendet in \$pub_lastmessage gematcht werden kann und auch die erst nachricht per alarm bekannt gegeben wird";
+
+# Zähler der Timeraufrufe zählt um festzustellen wie viele Umläufe keine MCast mehr empfangen wurde
+# wird vom Empfangs-Thread wieder zurückgesetzt
+my $unterbrechung :shared;
+
+# Handle des Timerobjekts
+my $timer_id;
+
+# Multicast IP Adresse, wird per Parameter übergeben
+my $MCASTIP :shared;
+
+# Port des Multicast Stroms, wird als Parameter übergeben
+my $MCASTPORT :shared;
+
+# IP Adresse des Senders, wird aus STARTOFMESSAGES extrahiert
+my $TCPIP :shared;
+
+# Port auf den Sender hört um neue Nachrichten anzunehmen, wird aus STARTOFMESSAGES extrahiert
+my $TCPPORT :shared;
+
+# Alarmierung wird per Default auf 'ein' gesetzt
+$AlarmAn = 1;
+
+# Wenn Parameter 0, der erste, keinen Inhalt hat wurde Client ohne Parameter gestartet
+if ($ARGV[0] eq "") {
+    # Fehlermeldung und Programmende
+    wrong_start();
+}
+
+# Versuch aus dem ersten übergebenen Parameter die Multicast Adresse und den zugehörigen Port zu extrahieren
+($MCASTIP,$MCASTPORT) = split(/:/, $ARGV[0]);
+
+# Weitere Parameter werden ignoriert
+
+# Wenn Parameterformat nicht korrekt bleibt IP oder Port leer
+if ($MCASTIP eq "" or $MCASTPORT eq "") {
+    # Fehlermeldung und Programmende
+    wrong_start();
+}
+
+# Neues Fensterobjekt erzeugen
+my $main = new MainWindow(-title=>'Möp Tool');
+
+# Frameobjekt im Fensterobjekt mit verschiedenen Eigenschaften wird erzeugt
+# nimmt später Statuslabel, LetzteNachrichtLabel und Eingabezeile auf
+my $top_f=$main->Frame(-width=>500, -height=>200)->pack(-side=>'top', -padx=>5, -pady=>5);
+
+# Ein weiteres Frameobjekt, das die Schaltflächen aufnimmt
+my $bottom_f=$main->Frame()->pack(-side=>'top', -padx=>5, -pady=>5);
+
+# Configure Event des Fensters wird abgefangen und ein resize verhindert
+$main->bind('<Configure>' => sub {
+    my $xe = $main->XEvent;
+    $main->maxsize($xe->w, $xe->h);
+    $main->minsize($xe->w, $xe->h);
+});
+
+# Labelobjekte im oberen Frame erzeugen
+my $status_label = $top_f->Label(-text => 'Alarm an');
+my $news_label   = $top_f->Label(-text => '');
+
+# Eingabeobjekt erzeugen und Variable $eingegeben wird referenziert, dadurch landen alle Eingaben in dieser globalen Variable
+my $eingabe = $top_f->Entry(-width=>150, -textvariable => \$eingegeben);
+
+# Die Schaltflächen Senden,AlarmAnAus, Nachrcíchten werden erzeugt
+my $left1=$bottom_f->Frame()->pack(-side=>'left', -fill=>'none');
+my $left2=$bottom_f->Frame()->pack(-side=>'left', -fill=>'none');
+my $left3=$bottom_f->Frame()->pack(-side=>'left', -fill=>'none');
+
+# Standardaktion bei <Return> wird definiert, selbe Aktion wie bei Betätigung der Senden Schaltfläche (Aufruf sub senden_click)
+$eingabe->bind('<Return>', \&senden_click );
+
+# Senden Knopf wird definiert, Beschriftung und Aktion (Aufruf sub senden_click)
+my $send_button = $left1->Button(
+   '-text' => 'Senden',
+   '-command' => \&senden_click,
+);
+
+# Alarm An/Aus Knopf definiert, Beschriftung und Aktion (Aufruf sub start_click)
+my $startstop_button = $left2->Button(
+   '-text' => 'Alarm an/aus',
+   '-command' => \&start_click,
+);
+
+# Nachrichten Knopf definiert, Beschriftung und Aktion (Popup mit den letzten Nachrichten)
+my $news_button = $left3->Button(
+   '-text' => 'Nachrichten',
+   '-command' => sub {
+			# Alle Nachrichten zu einem Array zusammensetzen und an jede Nachricht ein \n anhängen
+			# Darstellung der Arrayelemente in der Messagebox damit untereinander
+			my @msg=join ("\n", @messages);
+			# Messagebox definieren
+			my $db=$main->messageBox(-title=>'Nachrichten', -message=>"@msg", -type=>'ok');
+			# und anzeigen
+			$db->show;
+		    },
+);
+
+# Statuslabel wird angezeigt und nach Westen 'w' ausgerichtet, also links
+$status_label->pack(-anchor => 'w');
+
+# Letzte Nachricht Label wird angezeigt und nach Westen 'w' ausgerichtet, also links
+$news_label->pack(-anchor => 'w');
+
+# Eingabefeld wird angezeigt und nach Westen 'w' ausgerichtet, also links
+#$eingabe->pack(-side => 'left');
+$eingabe->pack(-anchor => 'w');
+
+# Knöpfe werden angezeigt
+$send_button->pack;
+$startstop_button->pack;
+$news_button->pack;
+
+# Multicast Empfangs Thread wird gestartet
+$thr = new Thread \&WaitForMessage;
+
+# Timer wird angestartet, alle 100 ms, Funktionsaufruf
+$timer_id = $main->repeat(100, \&timer);
+
+# MainLoop des TK
+MainLoop;
+
+# Timerfunktion wird alle 100ms aufgerufen
+sub timer {
+    # Zähler, kein MCast empfangen, wird im Mcast Empfangsthread zurückgesetzt falls doch Mcast kommt
+    $unterbrechung++;
+    
+    # Zeigt die letzte, aktuellste Nachricht an, pub_message wird vom Mcast thread gesetzt
+    $news_label->configure(-text=>"$pub_lastmessage");
+    
+    # wenn Alamierung erfolgen soll
+    if ($AlarmAn==1) {
+	# UND eine neue Nachricht erhalten wurde
+	if ($new_message == 1) {
+	    # Neue Nachricht Flag zurücksetzen, damit Alarmierung nur ein mal erfolgt
+	    $new_message=0;
+	    
+	    # UND wenn die letzte Nachricht NICHT vom eigenen Client kam
+	    unless ($pub_lastmessage =~ /$zuletztgesendet/) {
+		#my $winmm = new Win32::MediaPlayer;  # new object
+		#$winmm->load('alarm.mp3');        # Load music file
+		#$winmm->play;                     # Play the music
+		#   und Popup mit Inhalt der letzten Nachricht anzeigen
+		my $db=$main->MsgBox(-title=>"Neue Nachricht", -message=>"$pub_lastmessage", -type=>"ok");
+		$db->Show;
+	    }
+	}
+    }
+    # Wenn 20 Durchläufe kein MCast empfangen wurde
+    if ($unterbrechung >= 20) {
+	# ... Senderinfos zurücksetzen, damit kann keine neue Nachricht vom Client abgesetzt werden
+	$TCPIP="";
+	$TCPPORT="";
+    }
+    # Status Label Text neu zusammen bauen
+    
+    my $statustext="";
+    # Nachricht beginnt mit 'Alarm an', 'Alarm aus' je nach gesetztem Flag
+    if ($AlarmAn==0) {
+	$statustext = "Alarm aus";
+    }
+    else {
+	$statustext = "Alarm an";
+    }
+    # Nachricht geht weiter mit Informationen zum Sender
+    if ($TCPIP eq "") {
+	$statustext .= " - Server unbekannt";
+    }
+    else {
+	$statustext .= " - Server $TCPIP:$TCPPORT";
+    }
+    # Nachricht Label setzen
+    $status_label->configure(-text => $statustext);
+}
+
+# wird aufgerufen wenn Nachricht gesendet werden soll
+sub senden_click {
+    # Wenn Text nicht leer ist
+    if ($eingegeben ne "") {
+	# UND Sender IP nicht unbekannt ist
+	if ($TCPIP ne "") {
+	    # socket öffnen
+	    my $tcpsock = IO::Socket::INET->new(PeerAddr => "$TCPIP",
+                                    PeerPort => $TCPPORT,
+                                    Proto    => "tcp",
+                                    Type     => SOCK_STREAM)
+	    or die "Couldn't connect to $TCPIP : $TCPPORT $@\n";
+	    # Nachricht zusammen bauen und formatieren
+	    
+	    #my $zusenden = $eingegeben =~ /(.{50})/;
+	    my $zusenden = $eingegeben;
+	    
+	    # Nachricht auf 120 Zeichen Länge begrenzen und mit Umgebungsvariable 'USERNAME' ergänzen
+	    my $selbst_gesendet = sprintf "%-.140s", $eingegeben;
+	    $zusenden = sprintf "%-.140s (%s)",$eingegeben,$ENV{USERNAME};
+	    
+	    # Nachricht auf socket senden
+	    print $tcpsock "$zusenden";
+	    
+	    # socket wieder schließen
+	    close ($tcpsock);
+	    
+	    # Eigene zuletzt gesendete Nachricht speichern
+	    $zuletztgesendet=$selbst_gesendet;
+	    
+	    # Eingabezeile leeren
+	    $eingegeben="";
+	}
+    }
+}
+
+# Wird aufgerufen bei Betätigung der Schaltfläche 'Alarm An/Aus'
+# Wechselt zwischen Status 'Alarmierung an', 'Alarmierung aus'
+sub start_click {
+    # wenn Alarmierung ausgeschaltet ist
+    if ($AlarmAn==0) {
+	# Alarmierung einschalten
+	$AlarmAn = 1;
+    }
+    # wenn Alarmierung eingeschaltet ist
+    else {
+	# Alarmierung ausschalten
+	$AlarmAn = 0;
+    }
+}
+
+# Wird als Thread gestartet und nimmt Multicastnachrichten an
+sub WaitForMessage {
+    # socket eröffnen, IP und Port kommen als Übergabeparameter
+    my $sock = IO::Socket::Multicast->new(LocalPort=>$MCASTPORT);
+    $sock->mcast_add("$MCASTIP") || die "Couldn't set group: $!\n";
+    
+    # Beim Anstarten des Threads wird gesetzt das noch keine Daten empfangen wurden
+    # oldlastmessage enthält die letzte Nachricht der vorhergehenden Durchlaufs
+    my $oldlastmessage="";
+    # lastmessage enthält die letzte Nachricht des aktuellen Durchlaufs
+    my $lastmessage="";
+    
+    # Nimmt die aktuell empfangenen Daten auf
+    my $jdata;
+
+    # neues json objekt anlegen    
+    my $JSONObject = JSON::XS->new->ascii->pretty->allow_nonref();
+    
+    # enthält die gesendeten daten nach umwandlung vom json objekt zum array
+    my @sentdata;
+    
+    # Solange Daten vom socket geholt werden können
+    while ($sock->recv($jdata,10000)) {
+	# Mcast unterbrechung zurücksetzen, Programm wird damit signalisiert das Mcast empfangen wird
+	$unterbrechung = 0;
+	
+	# empfangen daten sind JSON objekt, also zunächt dekodieren
+	@sentdata = @{$JSONObject->decode($jdata)};
+	
+	# erhaltene nachrichten leeren um neu zu beginnen
+	@messages=();
+	
+	foreach my $data(@sentdata) {
+	    chomp $data;
+	    # Wenn die Nachricht 'STARTOFMESSAGES' enthält, handelt es sich um die erste Nachricht
+            if ($data =~ /STARTOFMESSAGES/) {
+		# aus diesen Daten werden dann IP und Port des Senders gewonnen
+		# Sender schickt diese Daten mit
+		(undef,$TCPIP,$TCPPORT) = split/#/,$data;
+		# Nachrichten Array leeren
+            }
+	    # wenn Nachricht 'ENDOFMESSAGES' enthält wurde der letzte Datensatz empfangen
+            elsif ($data eq "ENDOFMESSAGES") {
+	    }
+	    else {
+		# aktuelle empfangen daten an alle nachrichten anhängen
+	        @messages=(@messages,$data);
+	    }
+	}
+	
+	# die letzte empfangen nachricht wird global zur verfügung gestellt
+	# [-1] ist ENDOFMESAGE, [-2] also die letzte 'echte' nachricht
+	$pub_lastmessage=$sentdata[-2];
+	# wenn die letzte gerade empfangene nachricht $pub_lastmessage nicht die letzte davor erhaltene nachricht $oldlastmessage ist
+	# dann ist die letzte nachricht eine neue
+	if ($oldlastmessage ne $pub_lastmessage) {
+	    # global bekannt geben das eine neue nachricht erhalten wurde
+	    $new_message=1;
+	}
+	# die letzte erhalten nachricht wird zur letzt erhaltenen nachricht des neuen durchlaufs
+	$oldlastmessage = $sentdata[-2];
+    }
+}
+
+# Wird aufgerufen bei Fehlerhaftem Programmstart
+sub wrong_start {
+    # Fehlernachricht anzeigen
+    print
+         "\n\nclient_tk MCASTIP:MPort\n\n",
+         "    MCASTIP  Multicast Adresse an die Nachrichten gesendet werden\n",
+         "        Bsp 239.1.1.1\n\n",
+         "    MPort  Port der für die Multicast Nachrichten verwendet wird\n",
+         "        Bsp 64000\n\n",
+         "    Beispielaufruf\n",
+         "        client_tk 239.1.1.1:64000\n\n",
+         "    Falsche IPs und/oder Ports werden nicht! abgefangen\n\n";
+
+    # Programm beenden
+    exit;
+}

Perl Nachrichtenticker Chat/client_tk_w7.perlapp

@@ -0,0 +1,33 @@
+#!C:\Program Files\ActiveState Perl Dev Kit 8.2.1\bin\perlapp-gui.exe
+PAP-Version: 1.0
+Packer: C:\Program Files\ActiveState Perl Dev Kit 8.2.1\bin\perlapp.exe
+Script: client_tk.pl
+Cwd: G:\My Documents\Diverse Skripts\Ticker
+Clean: 1
+Date: 2010-08-09 08:32:37
+Debug: 
+Dependent: 0
+Dyndll: 0
+Exe: client_tk.exe
+Force: 1
+Gui: 1
+Hostname: LAZAREUS
+Manifest: 
+No-Compress: 0
+No-Logo: 0
+Runlib: 
+Shared: none
+Tmpdir: 
+Verbose: 0
+Version-Comments: 
+Version-CompanyName: Andre Wisniewski
+Version-FileDescription: 
+Version-FileVersion: 1.3
+Version-InternalName: MCast Ticker
+Version-LegalCopyright: Andre Wisniewski
+Version-LegalTrademarks: 
+Version-OriginalFilename: client_tk
+Version-ProductName: Multicast Ticker Tool
+Version-ProductVersion: 1.3
+Warnings: 0
+Xclude: 0

Perl Nachrichtenticker Chat/messages

@@ -0,0 +1,20 @@
+ss (andre)(Sat May 11 00:08:31 2013)
+12 (andre)(Sat May 11 00:09:13 2013)
+nmn (andre)(Sat May 11 00:11:44 2013)
+aaa (andre)(Sat May 11 00:11:46 2013)
+asv (andre)(Sat May 11 00:11:56 2013)
+sa (andre)(Sat May 11 09:49:52 2013)
+asdf (andre)(Sat May 11 09:50:04 2013)
+asdfg (andre)(Sat May 11 09:50:17 2013)
+hallo ()(Sat Dec 28 16:06:47 2013)
+huhu ()(Sat Dec 28 16:07:30 2013)
+juhu ()(Sat Dec 28 16:07:48 2013)
+lolo ()(Sat Dec 28 16:08:10 2013)
+jjjaas (andre)(Wed Jun 19 15:40:15 2019)
+gffffsd (andre)(Wed Jun 19 15:41:42 2019)
+llll ()(Wed Jun 19 15:48:03 2019)
+ggg ()(Wed Jun 19 15:48:16 2019)
+h ()(Wed Jun 19 15:51:57 2019)
+lll ()(Wed Jun 19 15:52:04 2019)
+juhuheidihoooooooooooooooooooo ()(Wed Jun 19 15:52:30 2019)
+dhnscnalcvasnvcnvdpänaväasvadvfas fsacasdv asvc adsva ()(Wed Jun 19 15:53:14 2019)

Perl Nachrichtenticker Chat/server.perlapp

@@ -0,0 +1,33 @@
+#!C:\Program Files\ActiveState Perl Dev Kit 8.2.1\bin\perlapp-gui.exe
+PAP-Version: 1.0
+Packer: C:\Program Files\ActiveState Perl Dev Kit 8.2.1\bin\perlapp.exe
+Script: server.pl
+Cwd: F:\My Documents\Diverse Skripts\Ticker w JSON
+Clean: 0
+Date: 2010-07-26 23:29:00
+Debug: 
+Dependent: 0
+Dyndll: 0
+Exe: server.exe
+Force: 0
+Gui: 0
+Hostname: Andre-PC
+Manifest: 
+No-Compress: 0
+No-Logo: 0
+Runlib: 
+Shared: none
+Tmpdir: 
+Verbose: 0
+Version-Comments: 
+Version-CompanyName: 
+Version-FileDescription: 
+Version-FileVersion: 
+Version-InternalName: 
+Version-LegalCopyright: 
+Version-LegalTrademarks: 
+Version-OriginalFilename: 
+Version-ProductName: 
+Version-ProductVersion: 
+Warnings: 0
+Xclude: 0

Perl Nachrichtenticker Chat/server.pl

@@ -0,0 +1,119 @@
+#!/usr/bin/perl
+use Thread;
+use IO::Socket::Multicast;
+use JSON::XS;
+
+my @messages :shared;
+
+if ($ARGV[1] eq "") { wrong_start(); }
+
+my $MCASTIP :shared;
+my $MCASTPORT :shared;
+my $TCPIP :shared;
+my $TCPPORT :shared;
+
+($MCASTIP,$MCASTPORT) = split(/:/, $ARGV[0]);
+($TCPIP,$TCPPORT)     = split(/:/, $ARGV[1]);
+
+if ($MCASTIP eq "" or $MCASTPORT eq "" or $TCPIP eq "" or $TCPPORT eq "") { wrong_start(); }
+
+open MSG, "<messages";
+@messages=<MSG>;
+close MSG;
+
+foreach (@messages) {
+   chomp;
+}
+
+$thr = new Thread \&SendMessage;
+$thr = new Thread \&ReceiveMessage;
+
+while(1) { sleep 1; }
+
+sub SendMessage {
+   # my $ThreadID=Thread->self;
+   
+   # multicast socket zum senden von nachrichten öffnen
+   $sock = IO::Socket::Multicast->new(Proto=>'udp',PeerAddr=>"$MCASTIP:$MCASTPORT");
+   $sock->mcast_ttl(8);
+   
+   # ein neues json objekt anlegen
+   my $JSONObject = JSON::XS->new->ascii->pretty->allow_nonref();
+   
+   # array mit zu sendenden daten
+   my @sendarray;
+   
+   # json verpackte daten
+   my $senddata;
+   
+   # daten zum senden zusammenbauen
+   while (1) {
+      # zu sendende daten leeren
+      @sendarray=();
+      
+      # erstes element enthält start signatur und ip und port des tcp servers für autokonfig
+      push @sendarray, "STARTOFMESSAGES#$TCPIP#$TCPPORT";
+      
+      # nachrichten in datei speichern um bei neustart des servers die alten daten zu haben
+      open MSG, ">messages";
+   
+      # letzte 20 nachrichten   
+      for($i=-20;$i<=-1;$i++) {
+         if (exists $messages[$i]) {
+            # in array anfügen um mitzusenden
+            push @sendarray, "$messages[$i]";
+            # in datei speichern
+            printf MSG "$messages[$i]\n";
+         }
+      }
+      # ende signatur anhängen
+      push @sendarray, "ENDOFMESSAGES";
+      
+      # messages datei schließen
+      close MSG;
+      
+      # daten aus array zu json objekt kodieren
+      $senddata=$JSONObject->encode(\@sendarray);
+      
+      # daten per multicast senden
+      $sock->send("$senddata");
+      
+      # eine sekunde warten bis daten erneut gesendet werden
+      sleep (1);
+   }
+}
+
+sub ReceiveMessage {
+   $tcpsock=new IO::Socket::INET(LocalHost=>"$TCPIP", LocalPort=> $TCPPORT, Proto=>'tcp', Listen=>5, Reuse=>1);
+
+   while ($tcp_sock=$tcpsock->accept()) {
+      while (defined ($buf=<$tcp_sock>)) {
+         $time = localtime;
+         $buf = sprintf "%s(%24s)",$buf,$time;
+
+         @messages=(@messages, $buf);
+         print "\e[2J";
+         foreach (@messages) {
+            print "$_\n";
+         }
+      }
+   }
+   close ($sock);
+}
+
+sub wrong_start {
+   print "\n\nserver MCASTIP:MPort TCPIP:TPort\n\n",
+         "    MCASTIP  Multicast Adresse an die Nachrichten gesendet werden\n",
+         "        Bsp 239.1.1.1\n\n",
+         "    MPort  Port der für die Multicast Nachrichten verwendet wird\n",
+         "        Bsp 64000\n\n",
+         "    TCPIP  IP Adresse auf die Server hören soll\n",
+         "        Bsp 0.0.0.0\n\n",
+         "    TPort Port auf den Server hören soll\n",
+         "        Bsp 64001\n\n",
+         "    Beispielaufruf\n",
+         "        server 239.1.1.1:64000 0.0.0.0:64001\n\n",
+         "    Falsche IPs und/oder Ports werden nicht! abgefangen\n\n";
+   
+   exit;
+}

Perl Nachrichtenticker Chat/start client.cmd

@@ -0,0 +1 @@
+start client_tk.exe 239.1.1.1:64000

Perl Nachrichtenticker Chat/start client_pl.cmd

@@ -0,0 +1 @@
+start client_tk.pl 239.1.1.1:64000

Perl Nachrichtenticker Chat/start server.cmd

@@ -0,0 +1 @@
+start server.exe 239.1.1.1:65000 192.168.100.200:65001