PureBoard

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

Einfaches Chatsystem (Multiuser)

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

Seite 1 von 1

Einfaches Chatsystem (Multiuser)

Verfasst: 14.12.2008 00:27
von Criss
Hi zusammen,

hier ist ein kleines Beispiel eines einfachen Chat's. Es benötigt kein weiteres Programm, denn es ist Server und Client in einem.

Sowas habe ich überall gesucht, doch in einfacher Version mit Server & Client in einem, habe ich nicht gefunden.

Ist jetzt nicht komplett fertig, man müsste noch einiges machen, aber als Demonstration reicht es allemal.

Viel Spass damit!

Code: Alles auswählen

Enumeration
  #File_0
  #Ftp_0
  #Listview_0
  #Listview_1
  #Listview_2
  #String_0
  #Win_0
EndEnumeration


Structure main
  prgname.s
  prgvers.f
  server.l
  ip.s
  port.l
  name.s
EndStructure
Global main.main
main\prgname = "Chat"
main\prgvers = 1.0


Structure server
  connection.l
  *buffer.l
  message.s
EndStructure
Global server.server
server\buffer = AllocateMemory(1024)


Structure client
  id.l
  name.s
EndStructure
Global NewList client.client()


If InitNetwork() = #False
  MessageRequester("Info", "Kann das Netzwerk nicht initialisieren!", #MB_ICONERROR)
  End
EndIf


Procedure Win_0()
  If OpenWindow(#Win_0, 0, 0, 320, 236, main\prgname + " v" + StrF(main\prgvers, 1), #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget | #PB_Window_Invisible)
    ListViewGadget(#Listview_0, 4, 4, 228, 80)
    SetGadgetColor(#Listview_0, #PB_Gadget_BackColor, RGB(0, 0, 0))
    SetGadgetColor(#Listview_0, #PB_Gadget_FrontColor, RGB(0, 240, 0))
    ListViewGadget(#Listview_1, 236, 4, 80, 228)
    ListViewGadget(#Listview_2, 4, 88, 228, 120)
    SetGadgetColor(#Listview_2, #PB_Gadget_BackColor, RGB(120, 120, 120))
    SetGadgetColor(#Listview_2, #PB_Gadget_FrontColor, RGB(255, 255, 255))
    StringGadget(#String_0, 4, 212, 228, 20, "")
  EndIf
EndProcedure


Procedure ServerInit(port.l, type.l)
  ProcedureReturn CreateNetworkServer(#PB_Any, port, type)
EndProcedure


Procedure ClientConnect(ip.s, port.l, type)
  server\connection = OpenNetworkConnection(ip, port, type)
  ProcedureReturn server\connection
EndProcedure


Procedure ServerCheck()
  Select NetworkServerEvent()

    Case #PB_NetworkEvent_Data
      PokeS(server\buffer, Space(1048), 1048)
      length.l  = ReceiveNetworkData(EventClient(), server\buffer, 1024)
      message.s = PeekS(server\buffer, length)
      AddGadgetItem(#Listview_0, -1, "Client " + Str(EventClient()) + " sendet Daten")
      SetGadgetState(#Listview_0, CountGadgetItems(#Listview_0) - 1) : SetGadgetState(#Listview_0, -1)

      If FindString(message, "@", 1) <> 0
        ; Neuer Client. Name an alle Clienten schicken
        AddElement(client())
        client()\id   = EventClient()
        client()\name = StringField(message, 2, "|")
        AddGadgetItem(#Listview_0, -1, "Client " + Str(client()\id) + " hat sich verbunden")
        SetGadgetState(#Listview_0, CountGadgetItems(#Listview_0) - 1) : SetGadgetState(#Listview_0, -1)
        ; Liste aktualisieren
        names.s = ""
        ForEach client()
          names + "|" + Str(client()\id) + "/" + client()\name
        Next
        ForEach client()
          SendNetworkString(client()\id, "#" + names)
        Next
      Else
        ; Nachricht an alle Clienten schicken
        ForEach client()
          SendNetworkString(client()\id, Str(EventClient()) + "|" + message)
        Next
      EndIf

    Case #PB_NetworkEvent_Disconnect
      AddGadgetItem(#Listview_0, -1, "Client " + Str(EventClient()) + " hat Verbindung getrennt")
      SetGadgetState(#Listview_0, CountGadgetItems(#Listview_0) - 1) : SetGadgetState(#Listview_0, -1)
      ; Client löschen
      ForEach client()
        If client()\id = EventClient()
          DeleteElement(client(), 1)
          Break
        EndIf
      Next
      ; Liste aktualisieren
      names.s = ""
      ForEach client()
        names + "|" + Str(client()\id) + "/" + client()\name
      Next
      ForEach client()
        SendNetworkString(client()\id, "#" + names)
      Next

  EndSelect
EndProcedure


Procedure ClientCheck()
  Select NetworkClientEvent(server\connection)

    Case #PB_NetworkEvent_Data
      PokeS(server\buffer, Space(1048), 1048)
      length.l  = ReceiveNetworkData(server\connection, server\buffer, 1024)
      message.s = PeekS(server\buffer, length)
      If FindString(message, "#", 1) <> 0
        ; Neuer Client. Listen aktualisieren
        ClearList(client())
        ClearGadgetItems(#Listview_1)
        For z0.l = 1 To CountString(message, "|") + 1
          client.s = StringField(message, z0, "|")
          If client <> "#"
            id.l    = Val(StringField(client, 1, "/"))
            name.s  = StringField(client, 2, "/")
            AddElement(client())
            client()\id   = id
            client()\name = name
            AddGadgetItem(#Listview_1, -1, client()\name)
          EndIf
        Next z0
      Else
        ; Nachricht
        ForEach client()
          If client()\id = Val(StringField(message, 1, "|"))
            Break
          EndIf
        Next
        AddGadgetItem(#Listview_2, -1, client()\name + ">" + StringField(message, 2, "|"))
        SetGadgetState(#Listview_2, CountGadgetItems(#Listview_2) - 1) : SetGadgetState(#Listview_2, -1)
      EndIf

  EndSelect
EndProcedure


Procedure SendString(string.s)
  SendNetworkString(server\connection, string)
EndProcedure


Win_0()
ExamineIPAddresses()
main\ip   = IPString(NextIPAddress()) ; Eventuell anpassen
main\port = 8000


Select MessageRequester("Info", "Als Server & Client starten?", #PB_MessageRequester_YesNo | #MB_ICONQUESTION)

  Case 6 ; Server & Client
    ; Server
    If ServerInit(main\port, #PB_Network_TCP)
      AddGadgetItem(#Listview_0, -1, "Server initialisieren...OK")
      AddGadgetItem(#Listview_0, -1, "IP: " + main\ip)
      main\server = #True
    Else
      AddGadgetItem(#Listview_0, -1, "Server initialisieren...Fehlgeschlagen")
      main\server = -1
    EndIf
    ; Client
    If ClientConnect(main\ip, main\port, #PB_Network_TCP)
      main\name = InputRequester("Info", "Dein Nickname:", "")
      If main\name = ""
        main\name = "Nobody" + RSet(Str(Random(99)), 2, "0")
      EndIf
      SendString("@|" + main\name)
    Else
      MessageRequester("Info", "Konnte keine Verbindung zum Server herstellen!", #MB_ICONINFORMATION)
      main\server = -1
    EndIf

  Case 7 ; Client
    main\server = #False
    If ClientConnect(main\ip, main\port, #PB_Network_TCP)
      main\name = InputRequester("Info", "Dein Nickname:", "")
      If main\name = ""
        main\name = "Nobody" + RSet(Str(Random(99)), 2, "0")
      EndIf
      SendString("@|" + main\name)
    Else
      MessageRequester("Info", "Konnte keine Verbindung zum Server herstellen!", #MB_ICONINFORMATION)
      main\server = -1
    EndIf
    HideGadget(#Listview_0, #True)
    ResizeGadget(#Listview_2, 4, 4, #PB_Ignore, 204)
EndSelect


HideWindow(#Win_0, #False)
SetActiveGadget(#String_0)


;- MAINLOOP
Repeat

  Repeat
    EventID = WindowEvent()
    Select EventID
      Case #PB_Event_CloseWindow
        End

    EndSelect
  Until EventID = 0

  ; Text senden
  If GetAsyncKeyState_(#VK_RETURN) And GetGadgetText(#String_0) <> "" And main\server <> -1
    SendString(GetGadgetText(#String_0))
    SetGadgetText(#String_0, "")
  EndIf

  If main\server = #True
    ServerCheck()
  EndIf
  If main\server <> -1
    ClientCheck()
  EndIf

ForEver
End

Verfasst: 14.12.2008 02:15
von KatSeiko
Sieht sehr vielversprechend aus. Hast Du das schon mit PB 4.3 x84 und 4.3 x64 getestet?

Verfasst: 14.12.2008 09:18
von Criss
Nein, bisher habe ich es nur mit PB 4.3 x86 (32Bit) getestet.

Verfasst: 14.12.2008 13:25
von Deluxe0321
sieht gut aus, ist auch schön schlank..
stürzt aber gerne ab bei eingabe von:

Code: Alles auswählen

#irgendwas
nichtvorhandeneruser|blablabla
mach noch ein paar abfragen rein

Verfasst: 14.12.2008 13:42
von Criss
Ja, das # und das @ werden vom Programm verwendet.
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de