TS2 Viewer

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Antworten
Andreas21
Beiträge: 390
Registriert: 30.08.2004 09:05
Computerausstattung: Desktop
Windows 10 Pro x64
CPU: AMD Ryzen 5 2600 3.40 GHz
Ram: 16GB RAM
Grafik: NVIDA Geforce 1060
PB: 5.72 X86/X64
Wohnort: Heidelberg

TS2 Viewer

Beitrag von Andreas21 »

Hier mal ein sehr alter Code von mir.
Glaube so vor 3 Jahren ist der entstanden.

Damit kann man auf TS2 Server schauen und sehn wer Online ist.
Davür muss man den QPort kennen, den Server Port und die IP adresse.

Leider hat der Code noch ein paar macken bei einiegen TS Server.
Ich weis das er schlecht Programiert ist ;)
Ist ein anfangs versuch gewesen mit PB.

Bild

Code: Alles auswählen

InitNetwork()
UsePNGImageDecoder()

;{ Global
Global id.l, EOL.s = Chr(13)+Chr(10)
Global TAB.s = Chr(9)+Chr(10), UserName.l, qport.l = 51234
Global HauptRaum.l, NebenRaum.l, host.s, port.l,lastr.l
;}

;{ Declare
Declare.s send(Daten.s)
Declare.s ServerWahl()
Declare.s OpenConnection()
Declare CloseConnection()
Declare UserScann()
Declare.s Info(wert.l)
Declare.s Filter(typ.l, Daten.s, such.l,teil.l)
Declare.s Bereiniegen(Daten.s,typ.l=0)
Declare.s RaumRechte(Flag.s)
Declare  RaumScann()
Declare.s PlayerRechte(userstatus.s,privileg.s,attribute.s)
Declare  Usersadd(id.s,typ.l)
Declare ServerAuswahl()
Declare.l PlayerDisplayImage(attribute.s)
Declare TSFenster()
Declare UserList()
;}

;{ Server Verbindungs Daten
Structure ServerStruc
  id.s
  port.l
  host.s
  pw.s
EndStructure
;}

;{ User Infos
#user_playerid = 1
#user_channelid = 2
#user_receivedpackets = 3
#user_receivedbytes = 4
#user_sentpackets = 5
#user_sentbytes = 6
#user_paketlost = 7
#user_pingtime = 8
#user_totaltime = 9
#user_idletime = 10
#user_privileg = 11
#user_userstatus = 12
#user_attribute = 13
#user_ip = 14
#user_playername = 15
#user_loginname = 16

Structure UserStruc
  playerid.s
	channelid.s
	receivedpackets.s
	receivedbytes.s
	sentpackets.s
	sentbytes.s
	paketlost.s
	pingtime.s
	totaltime.s
	idletime.s
	privileg.s
	userstatus.s
	attribute.s
	ip.s
	playername.s
	loginname.s
EndStructure
;}

;{ Raum Infos
#raum_id=1
#raum_codec=2
#raum_parent=3
#raum_order=4
#raum_maxusers=5
#raum_name=6
#raum_flags=7
#raum_password=8
#raum_topic=9

Structure RaumStruc
  raum_id.s
  raum_codec.s
  raum_parent.s
  raum_order.s
  raum_maxusers.s
  raum_name.s
  raum_flags.s
  raum_password.s
  raum_topic.s
  raum_zahl.s
EndStructure
;}

;{ Server Info
#server_id=1
#server_name=2
#server_platform=3
#server_welcomemessage=4
#server_webpost_linkurl=5
#server_webpost_posturl=6
#server_password=7
#server_clan_server=8
#server_udpport=9
#server_maxusers=10
#server_allow_codec_celp51=11
#server_allow_codec_celp63=12
#server_allow_codec_gsm148=13
#server_allow_codec_gsm164=14
#server_allow_codec_windowscelp52=15
#server_allow_codec_speex2150=16
#server_allow_codec_speex3950=17
#server_allow_codec_speex5950=18
#server_allow_codec_speex8000=19
#server_allow_codec_speex11000=20
#server_allow_codec_speex15000=21
#server_allow_codec_speex18200=22
#server_allow_codec_speex24600=23
#server_packetssend=24
#server_bytessend=25
#server_packetsreceived=26
#server_bytesreceived=27
#server_uptime=28
#server_currentusers=29
#server_currentchannels=30
#server_bwinlastsec=31
#server_bwoutlastsec=32
#server_bwinlastmin=33
#server_bwoutlastmin=34
;}

;{ TS2 Server Adreasse & Port
; Test Server XCORE
;qport = Query Port, fals er nicht standart 51234 ist.
port = 8767
host = "81.169.152.93"
;}

Procedure.s send(Daten.s)
  SendNetworkString(ID, Daten)
  Buffer = AllocateMemory(4096)
  send2 = ReceiveNetworkData(ID, Buffer, 4096)
  Daten = PeekS(Buffer,send2-2)
  FreeMemory(Buffer)
  ProcedureReturn Daten
EndProcedure

Procedure.s ServerWahl()
  Daten.s = send("sel "+Str(port)+EOL)
  ProcedureReturn Daten
EndProcedure

Procedure.s OpenConnection()
  ID.l = OpenNetworkConnection(host, qport)
  If id 
    Buffer = AllocateMemory(4096)
    send2.l = ReceiveNetworkData(id, Buffer, 4096)
    temp2.s = PeekS(Buffer,send2-2)
    FreeMemory(Buffer)
  EndIf
ProcedureReturn temp2
EndProcedure

Procedure CloseConnection()
  If id
    SendNetworkString(ID, "quit"+EOL)
    CloseNetworkConnection(ID)
  EndIf
EndProcedure

Procedure.s Info(wert.l)
  Daten.s = send("si"+EOL)
  Daten.s = StringField(Daten, wert, EOL)
  Daten.s = StringField(Daten, 2, "=")
  ProcedureReturn Daten
EndProcedure

Procedure.s Filter(typ.l, Daten.s, such.l,teil.l)
  Daten.s = StringField(Daten, teil, EOL)
  If typ = 0
    Daten = StringField(Daten, such, TAB)
  Else
    Daten = StringField(Daten, such, EOL)
  EndIf
  ProcedureReturn Daten
EndProcedure

Procedure.s Bereiniegen(Daten.s,typ.l=0)
  If typ = 0
    Daten = StringField(Daten, 2, Chr(34))
  ElseIf typ = 1
    Daten = StringField(Daten, 2, Chr(10))
  EndIf
  ProcedureReturn Daten
EndProcedure

Procedure.s RaumRechte(Flag.s)
  Flags = Val(Flag)
  If (Flags & 1)  = 1 : Daten.s = "U" : Else : Daten = "R" : EndIf
  If (Flags & 2)  = 2 : Daten = Daten + "M" : EndIf
  If (Flags & 4)  = 4 : Daten = Daten + "P" : EndIf
  If (Flags & 8)  = 8 : Daten = Daten + "S" : EndIf
  If (Flags & 16) = 16 : Daten = Daten + "D" : EndIf
  ProcedureReturn "("+Daten+")"
EndProcedure

Procedure.s PlayerRechte(userstatus.s,privileg.s,attribute.s)
  If UserName > -1
    userstatus2 = Val(userstatus) : privilegs = Val(privileg) : attributes = Val(attribute)
    If (userstatus2 & 4) = 4 : Daten.s = "R" : Else : Daten = "U" : EndIf
    If (userstatus2 & 1) = 1 : Daten = Daten + " SA" : EndIf
    If (privilegs & 1) = 1 : Daten = Daten + " CA" : EndIf
    If (privilegs & 8) = 8 : Daten = Daten + " AO" : EndIf
    If (privilegs & 16) = 16 : Daten = Daten + " AV" : EndIf
    If (privilegs & 2) = 2 : Daten = Daten + " O" : EndIf
    If (privilegs & 4) = 4 : Daten = Daten + " V" : EndIf
    If (attributes & 64) = 64 : Daten = Daten + " REC" : EndIf
    Daten = "("+Daten+")"
  Else 
    Daten = ""
  EndIf
  ProcedureReturn Daten
EndProcedure

Procedure.l PlayerDisplayImage(attribute.s)
  If UserName > -1
    attributes = Val(attribute)
    If (attributes & 8) = 8 : Daten = CatchImage(0, ?away) 
    ElseIf (attributes & 32) = 32 : Daten = CatchImage(0, ?mutespeakers)
    ElseIf (attributes & 16) = 16 : Daten = CatchImage(0, ?mutemicrophone)
    ElseIf (attributes & 1) = 1 : Daten = CatchImage(0, ?channelcommander)
    Else : Daten = CatchImage(0, ?normal) : EndIf
  Else 
    Daten = 0
  EndIf
  ProcedureReturn Daten
EndProcedure

Procedure UserScann()
Daten.s = send("pl"+EOL)
UserName.l = CountString(Daten, EOL) - 2
If UserName > -1
  Global Dim Users.UserStruc(UserName)
  For t = 0 To UserName
    Users(t)\channelid =  Filter(0, Daten, #user_channelid, t+2)
    Users(t)\playername =  Bereiniegen(Filter(0, Daten, #user_playername, t+2))
    Users(t)\privileg =  Filter(0, Daten, #user_privileg, t+2)
    Users(t)\userstatus =  Filter(0, Daten, #user_userstatus, t+2)
    Users(t)\attribute =  Filter(0, Daten, #user_attribute, t+2)
  Next
  SortStructuredArray(Users(), 0, OffsetOf(UserStruc\playername), #PB_Sort_String)
Else
  Global Dim Users.UserStruc(0)
  Users(0)\playername = "Kein User Online"
EndIf
EndProcedure

Procedure Usersadd(id.s,typ.l)
  For t = 0 To UserName
    If Users(t)\channelid = id
      Daten.s = PlayerRechte(Users(t)\userstatus,Users(t)\privileg,Users(t)\attribute)
      AddGadgetItem (0, -1, Users(t)\playername + " " + Daten, PlayerDisplayImage(Users(t)\attribute), typ)
    EndIf
  Next
EndProcedure

Procedure UserList()
  Daten.s = Info(#server_name) + " Ts Server. Es sind "+Info(#server_currentusers)+"/"
  Daten = Daten + Info(#server_maxusers)+" User on."
  SetWindowTitle(0, Daten) 
  SetGadgetItemText(2, -1, Info(#server_currentusers) + " User Online:",0)
  If UserName > -1
    For t = 0 To UserName
      Daten.s = PlayerRechte(Users(t)\userstatus,Users(t)\privileg,Users(t)\attribute)
      AddGadgetItem (2, -1, Users(t)\playername + " " + Daten, PlayerDisplayImage(Users(t)\attribute), 0)
      If FindString(Daten,"SA",1) > 0
        SetGadgetItemColor(2, t, #PB_Gadget_FrontColor, $0000FF)
      ElseIf  FindString(Daten,"U",1) > 0
        SetGadgetItemColor(2, t, #PB_Gadget_FrontColor, $000000)
      Else
        SetGadgetItemColor(2, t, #PB_Gadget_FrontColor, $FF0000)
      EndIf
    Next
  Else
    Daten.s = PlayerRechte(Users(0)\userstatus,Users(0)\privileg,Users(0)\attribute)
    AddGadgetItem (1, -1, Users(0)\playername + " " + Daten, 0, 0)
  EndIf
EndProcedure

Procedure RaumScann()
Daten.s = send("cl"+EOL)
teil.l = CountString(Daten, EOL)
HauptRaum = 0 : NebenRaum = 0 : For t = 2 To teil : If Filter(0, Daten.s, #raum_parent, t) = "-1"
HauptRaum = HauptRaum + 1 : Else : NebenRaum = NebenRaum + 1 : EndIf : Next
NebenRaum = NebenRaum - 1 : hr = 0 : nr = 0 : Global Dim HRaum.RaumStruc(HauptRaum)
If NebenRaum > -1
  Global Dim NRaum.RaumStruc(NebenRaum)
  For t = 2 To teil
    If Filter(0, Daten.s, #raum_parent, t) > "-1"
      NRaum(nr)\raum_id=Bereiniegen(Filter(0, Daten.s, #raum_id, t),1)
      NRaum(nr)\raum_codec=Filter(0, Daten.s, #raum_codec, t)
      NRaum(nr)\raum_parent=Filter(0, Daten.s, #raum_parent, t)
      NRaum(nr)\raum_order=Filter(0, Daten.s, #raum_order, t)
      NRaum(nr)\raum_maxusers=Filter(0, Daten.s, #raum_maxusers, t)
      NRaum(nr)\raum_name=Bereiniegen(Filter(0, Daten.s, #raum_name, t))
      NRaum(nr)\raum_flags=Filter(0, Daten.s, #raum_flags, t)
      NRaum(nr)\raum_password=Filter(0, Daten.s, #raum_password, t)
      NRaum(nr)\raum_topic=Filter(0, Daten.s, #raum_topic, t)
      NRaum(nr)\raum_zahl = "0"
      nr = nr + 1
    EndIf
  Next
EndIf
For t = 2 To teil
  If Filter(0, Daten.s, #raum_parent, t) = "-1"
   HRaum(hr)\raum_id=Bereiniegen(Filter(0, Daten.s, #raum_id, t),1)
   HRaum(hr)\raum_codec=Filter(0, Daten.s, #raum_codec, t)
   HRaum(hr)\raum_parent=Filter(0, Daten.s, #raum_parent, t)
   HRaum(hr)\raum_order=Filter(0, Daten.s, #raum_order, t)
   HRaum(hr)\raum_maxusers=Filter(0, Daten.s, #raum_maxusers, t)
   HRaum(hr)\raum_name=Bereiniegen(Filter(0, Daten.s, #raum_name, t))
   HRaum(hr)\raum_flags=Filter(0, Daten.s, #raum_flags, t)
   HRaum(hr)\raum_password=Filter(0, Daten.s, #raum_password, t)
   HRaum(hr)\raum_topic=Filter(0, Daten.s, #raum_topic, t)
   HRaum(hr)\raum_zahl = Str(hr+1)
   hr = hr + 1
  EndIf
Next  
SortStructuredArray(NRaum(), 0, OffsetOf(RaumStruc\raum_name), #PB_Sort_String)
SortStructuredArray(HRaum(), 0, OffsetOf(RaumStruc\raum_order), #PB_Sort_String)
EndProcedure 

Procedure Usersadd2(raum.s)
  UUser.l = 0
  For t = 0 To HauptRaum
    If HRaum(t)\raum_name + " " + RaumRechte(HRaum(t)\raum_flags) = raum
      raum_id.s = HRaum(t)\raum_id : ok = 1 : Break
    EndIf
  Next
  If ok = 0
    For t = 0 To NebenRaum
      If NRaum(t)\raum_name = raum
        raum_id.s = NRaum(t)\raum_id : ok = 1 : Break
      EndIf
    Next
  EndIf
  If ok = 1 : For t = 0 To UserName
    If Users(t)\channelid = raum_id
      Daten.s = PlayerRechte(Users(t)\userstatus,Users(t)\privileg,Users(t)\attribute)
      AddGadgetItem (1, -1, Users(t)\playername + " " + Daten, PlayerDisplayImage(Users(t)\attribute), typ)
      UUser = UUser + 1
    EndIf
  Next 
    SetGadgetItemText(1, -1, Str(UUser) + " User Online:",0)
  EndIf
EndProcedure

Procedure TSFenster()
  Antwort.s = OpenConnection()
  If Antwort <> "[TS]"
    MessageRequester("Error", "TS Server Offline oder Port "+Str(qport)+" nicht offen!"+Chr(10)+Chr(10)+Antwort)
    CloseConnection()
    End
  EndIf
  Antwort = ServerWahl()
  If Antwort <> "OK"
    MessageRequester("Error", "Es ist ein Fehler bei der Server Wahl aufgetreten!"+Chr(10)+Chr(10)+Antwort)
    CloseConnection()
    End
  EndIf
  UserScann()
  RaumScann()
  
  OpenWindow(0, 0, 0, 690, 485, "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    TreeGadget(0, 10, 10, 250, 460)
    ListIconGadget(1, 270, 10, 200, 420, "0 User im Raum", 195)
    ListIconGadget(2, 480, 10, 200, 420, "", 195)
    ButtonGadget(4, 580, 450, 80, 20, "Ende")
    
  For t = 0 To HauptRaum
    AddGadgetItem (0, -1, HRaum(t)\raum_name + " " + RaumRechte(HRaum(t)\raum_flags), CatchImage(0, ?channel), 0)
    ;Usersadd(HRaum(t)\raum_id,1)
    If NebenRaum > -1
      For y = 0 To NebenRaum    
        If NRaum(y)\raum_parent = HRaum(t)\raum_zahl
          AddGadgetItem (0, -1, NRaum(y)\raum_name, CatchImage(0, ?channel), 1)
          ;Usersadd(NRaum(y)\raum_id,2)
        EndIf
      Next
    EndIf
  Next
  UserList()
EndProcedure

;{ Haupt Schleiffe
TSFenster()
Repeat
  Event = WindowEvent()
  If Event = #PB_Event_Gadget 
    GadgetID = EventGadget()
    If GadgetID = 4
      Break
    ElseIf GadgetID = 0
      ClearGadgetItems(1)
      Usersadd2(GetGadgetText(0))
      lastr = GetGadgetState(0)
    EndIf
  EndIf
  If Timer = 6000
    ClearGadgetItems(1)
    ClearGadgetItems(2)
    UserScann()
    UserList()
    If lastr > -1
      Usersadd2(GetGadgetItemText(0, lastr, 0))
    EndIf
    Timer = 0
  Else 
    Timer+ 1
  EndIf
  Delay(1)
Until Event = #PB_Event_CloseWindow
CloseConnection()
CloseWindow(0)
;}

;{ DataSection
DataSection
  away: 
    IncludeBinary "player_away.png"
  mutespeakers:
    IncludeBinary "player_mutespeakers.png"
  mutemicrophone:
    IncludeBinary "player_mutemicrophone.png"
  channelcommander:
    IncludeBinary "player_channelcommander.png"
  normal:
    IncludeBinary "player_normal.png"
  channel:
    IncludeBinary "channel.png"
EndDataSection
;}
Quelltext und Image Download
Windows 10 x64 Pro - PB 5.61 X64 / x32 - PB 4.6 x32
Nach oben
super_castle
Beiträge: 557
Registriert: 29.11.2005 15:05

Re: TS2 Viewer

Beitrag von super_castle »

Hallo grüss dich.

Leider gibt es jetzt schon TS 3 Beta 15 . Bald kommt die Vollversion von TS3.
Hat eine klasse Oberfläche und ist auch in Deutsch.

Gruss
Nach oben
Andreas21
Beiträge: 390
Registriert: 30.08.2004 09:05
Computerausstattung: Desktop
Windows 10 Pro x64
CPU: AMD Ryzen 5 2600 3.40 GHz
Ram: 16GB RAM
Grafik: NVIDA Geforce 1060
PB: 5.72 X86/X64
Wohnort: Heidelberg

Re: TS2 Viewer

Beitrag von Andreas21 »

Das weis ich.
Ich habe den Code nur beim aufreumen gefunden.
Und es giebt genug Leute die TS2 noch haben und es giebt auch Leute die TS2 besser finden.
Man muss ja nicht unbedingt TS3 benutzen wenn man nicht will ;)

Ist wie mit Windows XP und Windows 7.
Windows 7 ist zwar besser aber nicht jeder muss deswegen von Windows XP auf 7 umsteigen.
Windows 10 x64 Pro - PB 5.61 X64 / x32 - PB 4.6 x32
Nach oben
super_castle
Beiträge: 557
Registriert: 29.11.2005 15:05

Re: TS2 Viewer

Beitrag von super_castle »

TS3 ist wunderbar überarbeitet worden.
Dank der Userforderungen für die Internet-Telefonie und Funkgateways.

Für uns Gateway-Betreiber gibt es auch viele neue schöne Sachen da drin. :D

Gruss
Nach oben
Benutzeravatar
Bisonte
Beiträge: 2470
Registriert: 01.04.2007 20:18

Re: TS2 Viewer

Beitrag von Bisonte »

super_castle hat geschrieben:TS3 ist wunderbar überarbeitet worden.
Dank der Userforderungen für die Internet-Telefonie und Funkgateways.

Für uns Gateway-Betreiber gibt es auch viele neue schöne Sachen da drin. :D

Gruss
Und es ist trotzdem immer noch eine Beta Version.
Wenn mehrere in einem Channel gleichzeitig aufs senden kommen, dann versteht man gar nichts mehr.
Noch ist der Sinn vom "Teamspeak" verfehlt ;)

Ich nutze auch noch lieber die "2"er, weil relativ stabil und man kann alle verstehen, auch wenn sie versuchen
alle gleichzeitig zu sprechen.
PureBasic 6.21 (Windows x86/x64) | Windows11 Pro x64 | AsRock B850 Steel Legend Wifi | R7 9800x3D | 64GB RAM | GeForce RTX 5080 | ThermaltakeView 270 TG ARGB | build by vannicom​​
Nach oben
super_castle
Beiträge: 557
Registriert: 29.11.2005 15:05

Re: TS2 Viewer

Beitrag von super_castle »

Ich nutze auch noch lieber die "2"er, weil relativ stabil und man kann alle verstehen, auch wenn sie versuchen
alle gleichzeitig zu sprechen.
Das ist nicht so gewollt.
Weil über die Gateway auch eine Funkerbindung besteht zu den Funkern "CB", "Freenet", "PMR" usw.
Und da kann nur einer breaken. Diese Funkdiziplin muss eingehalten werden.

Wer Familienfunk betreiben möchte, macht sich einfach einen neuen Raum auf und da stört man keinen anderen.

Gruss
Nach oben
Benutzeravatar
Bisonte
Beiträge: 2470
Registriert: 01.04.2007 20:18

Re: TS2 Viewer

Beitrag von Bisonte »

Auch wenns jetzt OT wird...

Es klappt nicht in der Beta aber in der "alten" Version. Warum dann etwas was funzt austauschen ?
Nur weil da ne Höhere Zahl in der Versionsnummer steht ?

Mir langt persönlich der 2er aber ist halt geschmackssache ...

und wieder Ontopic...
PureBasic 6.21 (Windows x86/x64) | Windows11 Pro x64 | AsRock B850 Steel Legend Wifi | R7 9800x3D | 64GB RAM | GeForce RTX 5080 | ThermaltakeView 270 TG ARGB | build by vannicom​​
Nach oben
super_castle
Beiträge: 557
Registriert: 29.11.2005 15:05

Re: TS2 Viewer

Beitrag von super_castle »

Nur weil da ne Höhere Zahl in der Versionsnummer steht ?
Ja, warum hast du heute nicht Windows 3.11 drauf oder Linux in der ersten Version, welches noch auf eine 3,5' Disk ist, das ganze Betriebsystem.
Es lief doch auch einwandfrei, warum immer eine höhere Versionsnummer nehmen. :D , die nicht fehlerfrei laufen.

Gruss
Nach oben
Andreas21
Beiträge: 390
Registriert: 30.08.2004 09:05
Computerausstattung: Desktop
Windows 10 Pro x64
CPU: AMD Ryzen 5 2600 3.40 GHz
Ram: 16GB RAM
Grafik: NVIDA Geforce 1060
PB: 5.72 X86/X64
Wohnort: Heidelberg

Re: TS2 Viewer

Beitrag von Andreas21 »

Es ist auch reine geschmack sache.
Es giebt einiege die sind halt mit TS2 voll zu frieden.
Für sie gibts keinen zwingenden grund auf TS3 zu weckseln.
Nur weil es neu ist?

Müssen jetzt alle ihr Win xp löschen und Windows 7 drauf machen?

Bei Vista hats ja gezeigt das das nicht so super war... aber es war neu^^
Zuletzt geändert von Andreas21 am 27.02.2010 00:08, insgesamt 2-mal geändert.
Windows 10 x64 Pro - PB 5.61 X64 / x32 - PB 4.6 x32
Nach oben
Benutzeravatar
Bisonte
Beiträge: 2470
Registriert: 01.04.2007 20:18

Re: TS2 Viewer

Beitrag von Bisonte »

Ich glaube, der Begriff BETA VERSION ist ihm nicht geläufig...

Egal.
Gruss Jens
PureBasic 6.21 (Windows x86/x64) | Windows11 Pro x64 | AsRock B850 Steel Legend Wifi | R7 9800x3D | 64GB RAM | GeForce RTX 5080 | ThermaltakeView 270 TG ARGB | build by vannicom​​
Nach oben
Antworten

Zurück zu „Code, Tipps und Tricks“