PureBoard

Code: Alles auswählen

; -:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-
;
; PMVs ConsoleChat
;
; {|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}
;
; © 2006 by PMV
; 
; {|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}-{|}

Global Input$         ;irgend welche Texteingaben
Global InputText$     ;aktuelle Texteingabe
Global Nick$          ;eigener Nickname
Global URL$           ;URL des Servers (bei Client)
Global Title.s        ;aktueller Title
Global ConID.l        ;ConnectionID zum Server
Global *MemoryBuffer  ;Speicheradresse
Global InputTime.l    ;Zeit der letzten Eingabe
Global Port.l         ;benutzter Port
Global PrintDot.l     ;ThreadID wenn der Thread aktiv ist
Global Away.l         ;Wenn Weg, dann = Zeitpunkt des Entfernens, sonnst #False
Global EndChat.b      ;#Ture = Beendet Programm

Structure StructureUser
  Name.s
  ID.l
EndStructure
NewList User.StructureUser()
NewList Text.s()

#CharacterPerLine = 72 ;maximal mögliche Zeichen pro Zeile
#BufferLength = #CharacterPerLine ;maximale empfangbare Datenmenge
#MaxLine = 22
#AwayTimer=0
#NoInputTime = 120000 ;Millisekunden

#DefaultURL = "localhost"
#DefaultPort = 1111
#DefaultNick = "Noname"

Enumeration
  #Command_Nick = 1
  #Command_Away
  #Command_Back
  #Command_WhoIs
  #Command_EndLine
EndEnumeration

#Input_Away = "/away"
#Input_Help = "/?"
#Input_End = "/quit"
#Input_WhoIs = "/whois"
#Input_IP = "/ip"

#Key_NickFalse = 10
#Key_NickAkzept = 15

;ändert den aktuellen Title der Console
Procedure SetConsoleTitle(Titletext$)
  ConsoleTitle(Titletext$)
  Title = Titletext$
EndProcedure

;gibt den aktuellen Title der Console zurück
Procedure.s GetConsoleTitle()
  ProcedureReturn Title
EndProcedure

;sendet einen Text
Procedure SendString(ID.l, String$)
  While Len(String$) > #CharacterPerLine
    SendNetworkString(ID, Left(String$, #CharacterPerLine-1) + Chr(#Command_EndLine))
    String$ = Right(String$, Len(String$) - #CharacterPerLine + 1)
  Wend
  SendNetworkString(ID, String$ + Chr(#Command_EndLine))
EndProcedure

;neuer Chattext
Procedure NewText(Text$)
  ;Wenn zu viel Text, diesen löschen
  If CountList(Text()) > #MaxLine
    FirstElement(Text())
    DeleteElement(Text())
    ClearConsole()
  EndIf
  ; ------------
  
  ;Text einfügen
  LastElement(Text())
  AddElement(Text())
  Text() = Text$
  ; ------------
EndProcedure

;auftretenden Fehler ausgeben
Procedure Error(Text$)
  PrintN(" Error")
  PrintN("")
  If Text$
    PrintN(Text$)
    PrintN("")
  EndIf
  PrintN("programm end")
  Print("------------")
  Repeat
    Delay(100)
  Until Inkey()
  End
EndProcedure

;sucht einen angemeldeten User
Procedure FindUser(ID.l)
  ForEach User()
    If User()\ID = ID
      ProcedureReturn #True
    EndIf
  Next
EndProcedure

;sendet als Server den Text zu allen Clients und zeigt ihn auch selber an
Procedure SendToAll(Text$)
   NewText(Text$)
   
   ForEach User()
     If User()\ID <> -1 And User()\Name
       SendString(User()\ID, Text$)
     EndIf
  Next
EndProcedure

Procedure Server()
  Protected Num.l, Name$, Result.l, DataLength.l, ID.l, Text$
  Select NetworkServerEvent()
    Case 1 ; neuer client
      LastElement(User())
      AddElement(User())
      User()\ID = NetworkClientID()
      User()\Name = ""

      LastElement(Text())
      AddElement(Text())
      Text()="Servermessage >> new client " + Str(User()\ID)
      
    Case 2
      ;Client raussuchen
      FindUser(NetworkClientID())
      ; ----------
      
      ;Daten Empfangen
      DataLength = ReceiveNetworkData(User()\ID, *MemoryBuffer, #BufferLength)

      Select PeekB(*MemoryBuffer) 
        Case #Command_Nick
          Name$ = PeekS(*MemoryBuffer + 1, DataLength - 1 - 1)
          ForEach User()
            If LCase(User()\Name) = LCase(Name$)
              Result = #True
              Break
            EndIf
          Next
          If Result = #True
            SendString(NetworkClientID(), Chr(#Key_NickFalse)) ;Nick schon vergeben
          Else
            SendString(NetworkClientID(), Chr(#Key_NickAkzept)) ;Nick akzeptiert
            FindUser(NetworkClientID())
            User()\Name = Name$
            
            NewText("Servermessage >> Client " + Str(USer()\ID) + " will be named " + User()\Name)
            
            ;Sendet den Text zu allen Usern, außer dem Client, der sich gerade Verbunden hat
            NewText("Message >> " + Name$ + " enters the chat!")
            ForEach User()
              If User()\ID <> -1 And User()\Name And User()\Name <> Name$
                SendString(User()\ID, Text())
              EndIf
            Next
            ; -------------
          EndIf
          
        Case #Command_Away
          SendToAll("Message >> " + User()\Name + " is away!")

        Case #Command_Back
          SendToAll("Message >> " + User()\Name + " comes back!")
        
        Case #Command_WhoIs ;sendet alle Nicknamen der jenigen, die Online sind
          ;ID des Users raussuchen
          ID = User()\ID
          
          ;Nachricht schicken
          Text$ = "Message >> Online is "
          ForEach User()
            If User()\Name
              If Len(Text$ + User()\Name) > #CharacterPerLine
                SendString(ID, Left(Text$, Len(Text$)-2))
                Text$ = "         "
              EndIf
             Text$ + User()\Name + ", "
            EndIf
          Next
          ;Wenn in Text$ noch mehr außer Leerzeichen ist, schicken
          If Trim(Text$)
            SendString(ID, Left(Text$, Len(Text$)-2))
          EndIf
        Default ;normaler Text
          SendToAll(User()\Name + ": " + PeekS(*MemoryBuffer, DataLength-1))        
  
      EndSelect
      ; ----------
      
    Case 3
      
      ; --  nicht benötigt --
      
      
    Case 4 ;Client getrennt
      ;User finden
      FindUser(NetworkClientID())
      Name$ = User()\Name
      DeleteElement(User())
      ; --------

      ;Server Nachricht
      NewText("Servermessage >> client " + Str(NetworkClientID()) + " disconnect")
      ; --------
      
      ;Chatnachricht
      If Name$
        SendToAll("Message >> ''" + Name$ + "'' disconnect")
      EndIf
      ; --------
      
  EndSelect
EndProcedure

;
Procedure Client()
  Protected DataLength.l, Pos.l

  Select NetworkClientEvent(ConID)
    Case 2 ; empfange Daten
      DataLength = ReceiveNetworkData(ConID, *MemoryBuffer, #BufferLength)
 
      Pos = FindString(PeekS(*MemoryBuffer, DataLength-1), Chr(#Command_EndLine), 1)
      While Pos
        NewText(Left(PeekS(*MemoryBuffer, DataLength-1), Pos-1))
        DataLength - Pos
        PokeS(*MemoryBuffer, PeekS(*MemoryBuffer + Pos), DataLength)
        Pos = FindString(PeekS(*MemoryBuffer, DataLength-1), Chr(#Command_EndLine), 1)
      Wend
      NewText(PeekS(*MemoryBuffer, DataLength-1))
        
    
    Case 3 ; empfange Data
    
      ; --  nicht benötigt --
    
  EndSelect
EndProcedure

;Akualisiert die Consolenausgabe
Procedure PrintConsole()
  If Away
    ConsoleLocate(15, 0)
    PrintN(">> You are away since " + Str((ElapsedMilliseconds() - Away)/1000) + " seconds! <<")
  EndIf
  
  ;Texteingabe anzeigen
  ConsoleLocate(0,0)
  PrintN("Input: "+ InputText$)
  ; ----------
  
  ;Text anzeigen
  ForEach Text()
    PrintN(Text())
  Next
  ; ----------
  
  ConsoleLocate(Len("Input: " + InputText$), 0)
EndProcedure

;Benutzter geht in den Awaymodus
Procedure GoAway()
  If Away = #False
    Away = ElapsedMilliseconds()
    If ConID
      SendString(ConID, Chr(#Command_Away))
    Else
      SendToAll("Message >> " + Nick$ + " is away!")
    EndIf
  EndIf
EndProcedure   

;Benutzter kommt aus dem Awaymodus wieder zurück 
Procedure ComeBack()
  If Away
    Away = #False
    
    ConsoleLocate(15, 0)
    Print(Space(40))
    
    If ConID
      SendString(ConID, Chr(#Command_Back))
    Else
      SendToAll("Message >> " + Nick$ + " comes back!")
    EndIf
  EndIf
EndProcedure

;Befehl auswerten
Procedure.b Command()
  Protected Text$, NextIP.l

  If LCase(Left(InputText$, Len(#Input_Away))) = #Input_Away
    GoAway()
    ProcedureReturn #True

  ElseIf LCase(Left(InputText$, Len(#Input_Help))) = #Input_Help
    NewText("Message >> The following commands can you use:")
    NewText("              /?     - show this helplines")
    NewText("              /away  - send a message, that you are away")
    NewText("              /quit  - disconnect and end programm")
    NewText("              /whois - show all chatter where is online")
    NewText("              /ip    - show available ip(s)")

    NewText("")
    ProcedureReturn #True
    
  ElseIf LCase(Left(InputText$, Len(#Input_End))) = #Input_End
    EndChat = #True
    ProcedureReturn #True
    
  ElseIf LCase(Left(InputText$, Len(#Input_WhoIs))) = #Input_WhoIs
    If ConID
      SendString(ConID, Chr(#Command_WhoIs))
    Else
      Text$ = "Message >> Following users are online: "
      ForEach User()
        If User()\Name
          If Len(Text$ + User()\Name) > #CharacterPerLine
            NewText(Left(Text$, Len(Text$) - 2))
            Text$ = "         "
          EndIf
        Text$ + User()\Name + ", "
        EndIf
      Next
      If Trim(Text$)
        NewText(Left(Text$, Len(Text$) - 2))
      EndIf
    EndIf
    ProcedureReturn #True
    
  ElseIf LCase(Left(InputText$, Len(#Input_IP))) = #Input_IP
    ExamineIPAddresses()
    NextIP = NextIPAddress()
    If NextIP
      Text$ = "Message >> Available ips are: "
      Repeat
        If Len(Text$ + IPString(NextIP)) > #CharacterPerLine
          NewText(Left(Text$, Len(Text$) - 2))
          Text$ = "         "
        EndIf
        Text$ + IPString(NextIP) + ", "
        NextIP = NextIPAddress()
      Until NextIP = #False
      If Trim(Text$)
        NewText(Left(Text$, Len(Text$) - 2))
      EndIf
    Else
      NewText("Message >> No IPs found!")
    EndIf
    ProcedureReturn #True

  EndIf
EndProcedure

;Tastatureingabe
Procedure Keyboard()
  Input$ = Inkey()
  
  If Input$
    InputTime = ElapsedMilliseconds() ;Eingabezeitpunkt speichern
    
    ;Wenn Abwesend, isser jetzt wieder da
    If Away
      ComeBack()
    EndIf
    ; --------------
    
    If Asc(Input$) => 32 And Asc(Input$) < 128 And Len(InputText$) < #CharacterPerLine - Len(Nick$) - 2 ;normales Zeichen
      InputText$ + Left(Input$, 1)
    ElseIf Asc(Input$) = 8 ;Löschen
      InputText$ = Left(InputText$, Len(InputText$) - 1)
      ConsoleLocate(Len(InputText$) + Len("Input: "), 0)
      Print(" ")
    ElseIf Asc(Input$) = 27 ; ESC
      EndChat = #True
    ElseIf Asc(Input$) = 13 ;Return
      InputText$ = Trim(InputText$)
      If InputText$ And Command() = #False
        If ConID=0
          SendToAll(Nick$ + ": " + InputText$)
        Else
          SendString(ConID, InputText$)
        EndIf
      EndIf
      ConsoleLocate(Len("Input: "),0):Print(Space(Len(InputText$)))
      InputText$=""
    EndIf
  EndIf
EndProcedure

;Porteingabe
Procedure InputPort()
  Protected Input$
  Print("Please input a port between 1 and 10.000 (default: " + Str(#DefaultPort) + "): ")
  Input$ = Input()
  If Input$ = ""
    Input$ = Str(#DefaultPort)
    Print(Input$)
  EndIf
  PrintN("")
  PrintN("")

  If Val(Input$) < 1 Or Val(Input$) > 10000
    PrintN("Port is not alowed!")
    PrintN("Please input again.")
    PrintN("")
    ProcedureReturn InputPort()
  EndIf
  ProcedureReturn Val(Input$)
EndProcedure

;Thread zum anzeigen einer Punktlinie beim warten
Procedure PrintDot()
  Repeat
    Print(".")
    Delay(1000)
  Until PrintDot = #False
EndProcedure

;Nickeingabe
Procedure ExamineNick()
  Protected Akzept.b
  Repeat
    ;Nickname eingeben
    Nick$ = ""
    Print("Please insert a nickname (3 till 20 characters): ")
    Nick$ = Input()
    ; ---------

    ;Entfernt alle Leerzeichen am anfang und ende
    Nick$ = Trim(Nick$)
    ; ---------

    PrintN("")
    
    ;Nicknamen überprüfen
    If Len(Nick$) >= 3 And Len(Nick$) <= 20
      If ConID ;<> 0 -> Client    
        ;Nick beim Server anfragen
        Print("examine nick ..")
        PrintDot = CreateThread(@PrintDot(), 0)
        SendString(ConID, Chr(#Command_Nick) + Nick$)
        ; ---------
        
        ;Auf antwort warten
        Repeat
          Delay(100)
        Until NetworkClientEvent(ConID) = 2 ; Daten empfangen
        ; ---------
        
        ;Antworte empfangen
        ReceiveNetworkData(ConID, *MemoryBuffer, 2)
        ; ---------
        
        PrintDot = #False
        
        ;Antwort auswerten
        If PeekB(*MemoryBuffer) = #Key_NickAkzept
          PrintN(" OK")
          Akzept = #True
        Else ; PeekB(*MemoryBuffer) = #Key_NickFalse
          PrintN(" is used")
        EndIf
        ; ---------
      Else
        Akzept = #True
      EndIf
    Else
      PrintN("Nickname not allowed!")
    EndIf
    PrintN("")
  Until Akzept = #True
EndProcedure


;=======================================================================================================

;Startinformationen:
NewText("Message >> to see all commands, input '/?'")

;-Programmstart
If OpenConsole() = #False : End : EndIf
SetConsoleTitle("PMV's Console Chat")

; Starttext
PrintN("This is a little chat with a console!")
PrintN("The server can chat like a client.")
PrintN("")
PrintN("The server must input a port and a nickname, the client must also input")
PrintN("a ip or url from the server, which he want to connect.")
PrintN("")
PrintN("                                         "+Chr(184)+" 2006 by PMV (Michael Verhuelsdonk)")
PrintN(" - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -")
PrintN("")

;Netzwerk initialisierung
Print("initialising network ...")
If InitNetwork() = #False
  Error("No tcp/ip  on your system found!")
EndIf
PrintN(" OK")
; ---------------

;Reservierung des Ramspeichers fürs Programm
Print("allocate memory ...")
*MemoryBuffer = AllocateMemory(#BufferLength)
If *MemoryBuffer = #False
  Error("No memory free!")
EndIf
PrintN(" OK")
; --------------

PrintN("")

;Server oder nur Client
PrintN("Would you create a server or connect to a created server?")
PrintN("Please input 1 for server or 2 for creating a client: ")
Repeat
  ConsoleLocate(54, 13)
  Print(Space(Len(Input$)))
  ConsoleLocate(54, 13)
  Input$ = ""
  Input$ = Input()
Until Input$ = "1" Or LCase(Input$) = "server"Or Input$ = "2" Or LCase(Input$) = "client"

If Input$ = "1" Or LCase(Input$) = "server" ;Taste 1 -> Server
  Input$ = "server"
ElseIf Input$ = "2" Or LCase(Input$) = "client"
  Input$ = "client"
EndIf
ConsoleLocate(54, 13)
PrintN(Input$)
; -------------

PrintN("")

;Title setzten
SetConsoleTitle(GetConsoleTitle()+" | "+ Input$ + " | ")
; ----------

;Einrichten des Servers
If Input$ = "server" ;Taste 1 -> Server
  ;Porteingabe
  Port = InputPort()
  ; ---------
  
  ;Server erstellen
  Print("create server ..")
  PrintDot = CreateThread(@PrintDot(), 0)
  If CreateNetworkServer(Port) = #False
    PrintDot = #False
    Error("Can't create server on port " + Str(Port) + "!")
  EndIf
  PrintDot = #False
  PrintN(" OK")
  ; ---------

  SetConsoleTitle(GetConsoleTitle()+" port: "+ Str(Port) +" |")

Else
  ;Serverdaten eingeben
  Print("Please input a ip or url from a server (default: " + #DefaultURL + "): ")
  URL$ = Input()
  If URL$ = ""
    URL$ = #DefaultURL
    Print(URL$)
  EndIf 
  PrintN("")
  PrintN("")  
  Port = InputPort()
  ; ---------
  
  ;Verbindungsaufbau  
  Print("connecting ..")
  PrintDot = CreateThread(@PrintDot(), 0)
  ConID = OpenNetworkConnection(URL$, Port)
  PrintDot = #False    
  ; ---------
  
  ;Fehlgeschlafen
  If ConID = #False
    Error("Can't find server on url and / or port!")
  EndIf  
  ; --------

  PrintN(" OK")

  SetConsoleTitle(GetConsoleTitle() + URL$ + " | " + Str(Port) + " |")
EndIf

PrintN("")

ExamineNick()
SetConsoleTitle(GetConsoleTitle()+" Name: " + Nick$)

;Wenn Server, gibs keine ConID
If ConID = #False
  AddElement(User())
  User()\Name = Nick$
  User()\ID=-1

  Print("create chatroom ...")
  Delay(1000)
  ClearConsole()
Else
  Print("enter chat ...")
  Delay(2000)
        
  ClearConsole()
EndIf
; ----------

;-Hauptschleife
Repeat
  Delay(10)
  
  If ElapsedMilliseconds() - LastInput < #NoInputTime
    GoAway()
  EndIf
  If ConID = #False
    Server()
  Else
    Client()
  EndIf
  Keyboard()
  PrintConsole()
Until EndChat = #True

;-Programmende
If ConID = #False
  SendToAll("Message >> server closed")
  CloseNetworkServer()
  NewText("Servermessage >> you have closed the server")
Else
  CloseNetworkConnection(ConID)
  NewText("Message >> you have disconnect")
EndIf

NewText("")
NewText("")
NewText("Thank you for using!")
NewText("--------------------")
NewText("")
NewText("Press any key to close")
PrintConsole()
ConsoleLocate(23, CountList(Text()))
PrintDot = CreateThread(@PrintDot(), 0)

Repeat
  Delay(100)
Until Inkey()