PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

TS2 Viewer

https://www.purebasic.fr/german/viewtopic.php?t=21879

Seite 1 von 1

TS2 Viewer

Verfasst: 14.02.2010 15:40
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

Re: TS2 Viewer

Verfasst: 16.02.2010 16:19
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

Re: TS2 Viewer

Verfasst: 16.02.2010 17:09
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.

Re: TS2 Viewer

Verfasst: 18.02.2010 18:47
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

Re: TS2 Viewer

Verfasst: 19.02.2010 06:44
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.

Re: TS2 Viewer

Verfasst: 21.02.2010 22:33
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

Re: TS2 Viewer

Verfasst: 22.02.2010 05:02
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...

Re: TS2 Viewer

Verfasst: 26.02.2010 15:46
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

Re: TS2 Viewer

Verfasst: 26.02.2010 23:33
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^^

Re: TS2 Viewer

Verfasst: 26.02.2010 23:34
von Bisonte
Ich glaube, der Begriff BETA VERSION ist ihm nicht geläufig...

Egal.
Gruss Jens
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de