PureBoard

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

Server <-> Client

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

Seite 2 von 3

Verfasst: 07.06.2006 21:24
von cofter
Ich poste mal meinen ganzen Code in der Hoffnung mir kann jemand helfen.

Code: Alles auswählen

;- Window Constants
;
Enumeration
  #MainWindow
EndEnumeration

;- MenuBar Constants
;
Enumeration
  #MenuBar_0
EndEnumeration

Enumeration
  #Menu_Exit
  #MENU_Hilfe
  #MENU_Ueber
EndEnumeration

;- Gadget Constants
;
Enumeration
  #ServerFrame
  #ListPlayer
  #ConsoleStringGadged
  #ConsoleEditorGadged
  #CommandGadget
  #SendConsole
EndEnumeration

;- StatusBar Constants
;
Enumeration
  #StatusBar_0
EndEnumeration

;- Structure 
;
Structure PlayerStruct
  PlayerRace.s
  PlayerClass.s
  PlayerID.f
  PlayerName.s
  PlayerX.l
  PlayerY.l
  PlayerZ.l
  PlayerLevel.w
  PlayerExp.l
  PlayerHealth.w
  PlayerPower.w
  PlayerSpeed.w
  
  PlayerStr.w
  PlayerWis.w
  PlayerSta.w
  
  PlayerResHeat.w
  PlayerResPoison.w
  PlayerResCold.w
  PlayerResDivine.w
EndStructure


;- Procedures
;
  Procedure Open_MainWindow()
  

  If OpenWindow(#MainWindow, 240, 147, 746, 524, "Solania Server v0.2b",  #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered )
    If CreateMenu(#MenuBar_0, WindowID(#MainWindow))
      MenuTitle("File")
      MenuItem(#Menu_Exit, "Exit")
      MenuTitle("Options")
      MenuTitle("Info")
      MenuItem(#MENU_Hilfe, "Hilfe")
      MenuItem(#MENU_Ueber, "Über")
      EndIf

      If CreateStatusBar(#StatusBar_0, WindowID(#MainWindow))
        EndIf

        If CreateGadgetList(WindowID(#MainWindow))
          Frame3DGadget(#ServerFrame, 20, 70, 520, 380, "Console")
          ListViewGadget(#ListPlayer, 560, 80, 170, 370)
          EditorGadget(#ConsoleEditorGadged, 30, 90, 500, 350, #PB_Editor_ReadOnly)
          SendMessage_(GadgetID(#ConsoleEditorGadged), #EM_LIMITTEXT, -1, 0) ;Extentd the editorgadget
          
          StringGadget(#CommandGadget, 20, 460, 520, 30, "Commands")
          ButtonGadget(#SendConsole, 550, 460, 80, 30, "Send Console")
          GadgetToolTip(#SendConsole, "Send Command to Console")
          
        EndIf
      EndIf
EndProcedure

; Send() Wird ind recieve_all() aufgerufen
  Procedure Send(ClientID,pz,px,py)
    
      SendNetworkString(EventClient(), Str(EventClient())+";"+Str(pz)+";"+Str(px)+";"+Str(py))
   
  EndProcedure

  Procedure recieve_all()
  *Buffer = AllocateMemory(3072) 
  Global SEvent = NetworkServerEvent()
  ExamineIPAddresses()
   

  If SEvent
    Global ClientID = EventClient()
    
    Select SEvent    
      Case 1
      NewList PlayerS.PlayerStruct()
      AddElement(PlayerS())
      Shared PlayerS()
      PlayerS()\PlayerID = ClientID   
                
        AddGadgetItem(#ConsoleEditorGadged,a,"Neuer Client Connectet! " +Str(PlayerS()\PlayerID) +Chr(10)+ Chr(13))
        AddGadgetItem(#ListPlayer,0,Str(ClientID))                     
      Case 2
        ReceiveNetworkData(ClientID, *Buffer, 3072)
        neuText.s = PeekS(*Buffer)
        ClientID=Val(StringField(neuText.s, 1, ";"))
        pz=Val(StringField(neuText.s, 2, ";"))
        px=Val(StringField(neuText.s, 3, ";"))
        py=Val(StringField(neuText.s, 4, ";"))
        Send(ClientID,pz,px,py)
        
        
      Case 3
        SetGadgetText(#ConsoleStringGadged,"Client " +Str(PlayerS()\PlayerID)+ " versucht Datei zu schicken!"+ Chr(10))
      Case 4
        
        AddGadgetItem(#ConsoleEditorGadged,a,"Client " +Str(ClientID )+ " verlässt den Server"+ Chr(10))
        RemoveGadgetItem(#ListPLayer, 0)

    EndSelect
  EndIf
  
FreeMemory(*Buffer)
EndProcedure

  Procedure Window_Event()
 
    If WindowEvent()
    Select WindowEvent()
      Case #PB_Event_CloseWindow
        FreeMemory(*Buffer)
        End
      Case #PB_Event_Gadget 
          
    EndSelect
  Else
    Delay(1)
  EndIf
  
  
  EndProcedure

;- InitNetwork
;
If InitNetwork()
    in_db = InitDatabase()
    db_examine = ExamineDatabaseDrivers()
    db_driver = NextDatabaseDriver()
    db_descript$ = DatabaseDriverDescription()
    db_driver_name$ = DatabaseDriverName()

    If CreateNetworkServer(0,7000)

        Open_MainWindow()
    Else
        MessageRequester("Error","Server konnte nicht gestartet werden!")
    EndIf
Else
    MessageRequester("Error","Netzwerk konnte nicht initialisiert werden!")
EndIf

Repeat
  
 Window_Event()

 recieve_all()
 
 Delay(1)
ForEver

Verfasst: 07.06.2006 21:25
von mk-soft
@cofter,
Das Programm Struktuell überdenken. Sehe bei Dir einige Fehler die man im vorfeld verhindern kann.
Ein übersichtliches Programm könnte folgend aus sehen

Code: Alles auswählen

; Kommentar

; Strukturen
Structure xy
 
EndStructure

; Globale Listen
Global NewList Users.l()

; Globale Variablen
Global Exit
Global Info

; Procedureen
Procedure xyz()

  ; Locale Variablen
  Protected dx,dy,dz
  Static ID
  
  ; Programmcode
  
EndProcedure

; Hauptprogrammcode

End

Verfasst: 07.06.2006 21:31
von cofter
Ui schnell geantwortet. :)
Ja stimme dir da zu, der Code ist ziemlich Chaotisch.
Kommt daher das ich soviel herumprobiert habe.
Auf meinem zettel siehts nich so schlimm aus.
Wenn das ganz soweit funktioniert dann werde ich das nochmal sauber schreiben.

Also kann ich...

Code: Alles auswählen

Global NewList Users.l()
...schreiben?
Sind dann die Elemente auch Global?

mfg
Cofter

Verfasst: 08.06.2006 00:53
von mk-soft
komme gerade erst wieder.
Ja, mit Global Newlist sind die LinkedList von allen Proceduren erreichbar.

Ich weiss nicht was du mit

Code: Alles auswählen

    in_db = InitDatabase()
    db_examine = ExamineDatabaseDrivers()
    db_driver = NextDatabaseDriver()
    db_descript$ = DatabaseDriverDescription()
    db_driver_name$ = DatabaseDriverName()
machen möchtes. Vielleicht noch einmal die Hilfe und die beispiel für Database anschauen. Jedenfals funktioniert der code so nicht sinnvoll.

Beispiel:

Code: Alles auswählen

If InitDatabase() = 0
  MessageRequester("Fehler", "InitDatabase")
  End
EndIf

ExamineDatabaseDrivers()
While NextDatabaseDriver()
  Debug "Datenbank Name:    " + DatabaseDriverName()
  Debug "Datenbank Treiber: " + DatabaseDriverDescription()
Wend
Hier eine Spielerrei als Variablenserver:

Code: Alles auswählen

;-TOP
; Kommentar : Variablen Server
; Ersteller : Michael Kastner
; Datei     : VarServer.pb
; Erstellt  : 06.06.2006
; Geändert  : 

; -------------------------------------------------------------------

Structure udtVariablen
  Var.s
  Value.s
EndStructure

; -------------------------------------------------------------------

Global NewList db.udtVariablen()

; -------------------------------------------------------------------
Global Exit = 0
Global LastMessage.s

; -------------------------------------------------------------------

Declare.s Daten(buffer.s)

; -------------------------------------------------------------------

If InitNetwork() = 0
  MessageRequester("FEHLER", "InitNetwork nicht erfolgreich!")
  End
EndIf

; -------------------------------------------------------------------

Procedure ThreadVarServer(id)

  port = 7000
  
  If CreateNetworkServer(0, port) = 0
    MessageRequester("FEHLER","CreateNetworkServer Port: " + Str(port))
    Exit = 2
    ProcedureReturn 0
  EndIf

  *buffer = AllocateMemory($8000)
    
  While Exit = 0
    
    SEvent = NetworkServerEvent()
  
    If SEvent
    
      ClientID = EventClient()
  
      Select SEvent
      
        Case #PB_NetworkEvent_Connect
          
        Case #PB_NetworkEvent_Data
          l = ReceiveNetworkData(ClientID,*buffer, $8000)
          result.s + PeekS(*buffer, l)
          If Right(result, 2) = #CRLF$
            result = Left(result, Len(result) - 2)
            temp.s = Daten(result)
            SendNetworkString(ClientID, temp)
            result = ""
          EndIf
          
        Case #PB_NetworkEvent_File
          
        Case  #PB_NetworkEvent_Disconnect
          
      EndSelect
    Else
      Delay(10)
    EndIf
    
  Wend
  
  CloseNetworkServer(0)
  FreeMemory(*buffer)
  Exit = 2
  
EndProcedure

; -------------------------------------------------------------------

Procedure.s Daten(buffer.s)

  cmd.s = StringField(buffer, 1, " ")
  cmd.s = UCase(cmd)
  temp.s = Right(buffer, Len(buffer) - Len(cmd) - 1)
  var.s = StringField(temp, 1, "=")
  var.s = UCase(var)
  var.s = Trim(var)
  value.s = StringField(temp, 2, "=")
  
  Select cmd
  
    Case "NEW"
      ForEach db()
        If db()\Var = var
          ProcedureReturn "FEHLER: Variable existiert bereit´s" + #CRLF$
        EndIf
      Next
      AddElement(db())
      db()\Var = var
      db()\Value = value
      ProcedureReturn "OK:" + #CRLF$
      
    Case "GET"
      ForEach db()
        If db()\Var = var
          ProcedureReturn "OK:" + db()\Value + #CRLF$
        EndIf
      Next
      ProcedureReturn "FEHLER: Variable nicht gefunden" + #CRLF$
        
    Case "PUT"
      ForEach db()
        If db()\Var = var
          db()\Value = value
          ProcedureReturn "OK:" + #CRLF$
        EndIf
      Next
      ProcedureReturn "FEHLER: Variable nicht gefunden" + #CRLF$
      
    Case "DEL"
      ForEach db()
        If db()\Var = var
          DeleteElement(db())
          ProcedureReturn "OK" + #CRLF$
        EndIf
      Next
      ProcedureReturn "FEHLER: Variable nicht gefunden" + #CRLF$
      
    Default
      ProcedureReturn "FEHLER: Command unbekannt" + #CRLF$
      
  EndSelect
  
EndProcedure
  
; -------------------------------------------------------------------

; -------------------------------------------------------------------

If OpenWindow(0, 20, 20, 200, 60, "Varablen Server v1.0", #PB_Window_SystemMenu)

  hThread = CreateThread(@ThreadVarServer(), 1)
  
  Repeat
  
    Select WaitWindowEvent()
    
      Case #PB_Event_CloseWindow
        Exit = 1
        
    EndSelect
  
  Until Exit = 2
  
EndIf

End
NEW Name -> Variable anlegen
PUT Name=HalloWelt -> Variable schreiben
GET Name -> Variable lesen
DEL Name -> Variable löschen

Programm starten und HyperTerminal auf Port 7000 öffnen.
TIP: In HyperTerminal locales Echo einschalten

FF
:wink:

Verfasst: 08.06.2006 10:02
von cofter
Hui, erstmal vielen Dank für das Beispiel.

Ich habe deinen Server gestartet und konnte mich auch mit Hyperterminal zu diesem verbinden.
Aber wenn ich jetzt mit

NEW name
PUT name=hello world
GET name

passiert nichts, auch wenn ich einfach mal GET foo mache sollte der Server doch eine Fehlermeldung bringen aber anscheinend kommt garnichts bei dem Server an.


mfg
Cofter

Verfasst: 09.06.2006 09:04
von mk-soft
HyperTerminal

ASCII Konfiguration
- Gesendet Zeilen enden mit Zeilenvorschub
- Eingegebens Zeichen Local ausgeben

FF :wink:

Verfasst: 09.06.2006 10:07
von cofter
Danke jetzt funktionierts. :)
Könnte wirklich interessant sein für mein Projekt.

mfg
Cofter

Verfasst: 09.06.2006 19:21
von mk-soft
Variablen Server weiter dran gearbeitet.

- Ladt und Speichert alle Variablen in Daten.Dat
- LIST -> Listet alle Variablen auf
- LIST Name -> Listet alle Variablen die mit Name beginnen
- SEARCH Wert -> Listet alle Variablen die den Wert beinhaltet

Code: Alles auswählen

;-TOP
; Kommentar : Variablen Server
; Version   : v1.01
; Ersteller : Michael Kastner
; Datei     : VarServer.pb
; Erstellt  : 06.05.2006
; Geändert  : 09.06.2006

; -------------------------------------------------------------------

Structure udtVariablen
  Var.s
  Value.s
EndStructure

; -------------------------------------------------------------------

Global NewList db.udtVariablen()

; -------------------------------------------------------------------
Global Exit = 0
Global LastMessage.s

; -------------------------------------------------------------------

Declare.l SendDaten(buffer.s, ClientID.l)

; -------------------------------------------------------------------

If InitNetwork() = 0
  MessageRequester("FEHLER", "InitNetwork nicht erfolgreich!")
  End
EndIf

; -------------------------------------------------------------------

Procedure ThreadVarServer(id)

  port = 7000
  
  If CreateNetworkServer(0, port) = 0
    MessageRequester("FEHLER","CreateNetworkServer Port: " + Str(port))
    Exit = 2
    ProcedureReturn 0
  EndIf

  *buffer = AllocateMemory($8000)
    
  While Exit = 0
    
    SEvent = NetworkServerEvent()
  
    If SEvent
    
      ClientID = EventClient()
  
      Select SEvent
      
        Case #PB_NetworkEvent_Connect
          
        Case #PB_NetworkEvent_Data
          l = ReceiveNetworkData(ClientID,*buffer, $8000)
          result.s + PeekS(*buffer, l)
          If Right(result, 2) = #CRLF$
            result = Left(result, Len(result) - 2)
            SendDaten(result, ClientID)
            result = ""
          EndIf
          
        Case #PB_NetworkEvent_File
          
        Case  #PB_NetworkEvent_Disconnect
          
      EndSelect
    Else
      Delay(10)
    EndIf
    
  Wend
  
  CloseNetworkServer(0)
  FreeMemory(*buffer)
  Exit = 2
  
EndProcedure

; -------------------------------------------------------------------

Procedure SendDaten(buffer.s, ClientID.l)

  cmd.s = StringField(buffer, 1, " ")
  cmd.s = UCase(cmd)
  temp.s = Right(buffer, Len(buffer) - Len(cmd) - 1)
  var.s = StringField(temp, 1, "=")
  var.s = UCase(var)
  var.s = Trim(var)
  value.s = StringField(temp, 2, "=")
  
  Select cmd
  
    Case "NEW"
      ForEach db()
        If db()\Var = var
          temp = "FEHLER: Variable existiert bereits" + #CRLF$
          SendNetworkString(ClientID, temp)
          ProcedureReturn 0
        EndIf
      Next
      AddElement(db())
      db()\Var = var
      db()\Value = value
      temp = "OK:" + #CRLF$
      SendNetworkString(ClientID, temp)
      ProcedureReturn 1
      
    Case "GET"
      ForEach db()
        If db()\Var = var
          temp = "OK:" + db()\Value + #CRLF$
          SendNetworkString(ClientID, temp)
          ProcedureReturn 1
        EndIf
      Next
      temp = "FEHLER: Variable nicht gefunden" + #CRLF$
      SendNetworkString(ClientID, temp)
      ProcedureReturn 0
          
    Case "PUT"
      ForEach db()
        If db()\Var = var
          db()\Value = value
          temp = "OK:" + #CRLF$
          SendNetworkString(ClientID, temp)
          ProcedureReturn 1
        EndIf
      Next
      temp = "FEHLER: Variable nicht gefunden" + #CRLF$
      SendNetworkString(ClientID, temp)
      ProcedureReturn 0
        
    Case "DEL"
      ForEach db()
        If db()\Var = var
          DeleteElement(db())
          temp = "OK:" + #CRLF$
          SendNetworkString(ClientID, temp)
          ProcedureReturn 1
        EndIf
      Next
      temp = "FEHLER: Variable nicht gefunden" + #CRLF$
      SendNetworkString(ClientID, temp)
      ProcedureReturn 0
        
    Case "LIST"
      If var = ""
        ForEach db()
          temp = db()\Var + "=" + db()\Value + #CRLF$
          SendNetworkString(ClientID, temp)
        Next
        temp = "OK:" + #CRLF$
        SendNetworkString(ClientID, temp)
        ProcedureReturn 1
      Else
        len = Len(var)
        ForEach db()
          If Left(db()\var, len) = var
            temp = db()\Var + "=" + db()\Value + #CRLF$
            SendNetworkString(ClientID, temp)
          EndIf
        Next
        temp = "OK:" + #CRLF$
        SendNetworkString(ClientID, temp)
        ProcedureReturn 1
      EndIf
    
    Case "SEARCH"
      If var <> ""
        ForEach db()
          If FindString(UCase(db()\value), var, 1)
            temp = db()\Var + "=" + db()\Value + #CRLF$
            SendNetworkString(ClientID, temp)
          EndIf
        Next
      EndIf
      temp = "OK:" + #CRLF$
      SendNetworkString(ClientID, temp)
      ProcedureReturn 1
          
    Default
      temp = "FEHLER: Command unbekannt" + #CRLF$
      SendNetworkString(ClientID, temp)
      ProcedureReturn 0
        
  EndSelect
  
EndProcedure
  
; -------------------------------------------------------------------

Procedure LoadVariablen()

  Protected temp.s, var.s, value.s
  
  If ReadFile(0, "Daten.dat")
    While Not Eof(0)
      temp = ReadString(0)
      var = StringField(temp, 1, #TAB$)
      value = StringField(temp, 2, #TAB$)
      If var <> ""
        AddElement(db())
        db()\var = var
        db()\value = value
      EndIf
    Wend
    CloseFile(0)
  EndIf
    
EndProcedure
      
; -------------------------------------------------------------------

Procedure SaveVariablen()

  Protected temp.s, var.s, value.s
  
  If CreateFile(0, "Daten.dat")
    ForEach db()
      temp = db()\var + #TAB$ + db()\value
      WriteStringN(0, temp)
    Next
    CloseFile(0)
  EndIf
    
EndProcedure
      
; -------------------------------------------------------------------

If OpenWindow(0, 20, 20, 200, 60, "Variablen Server v1.0", #PB_Window_SystemMenu)

  LoadVariablen()
  hThread = CreateThread(@ThreadVarServer(), 1)
  
  Repeat
  
    Select WaitWindowEvent()
    
      Case #PB_Event_CloseWindow
        Exit = 1
        
    EndSelect
  
  Until Exit = 2
  
  SaveVariablen()
EndIf

End
Viel Spass damit

FF :wink:

Verfasst: 09.06.2006 20:17
von cofter
Was noch klasse wäre und wo ich gerade dran sitze... alle User die gerade Verbunden sind in ein Array zu packen und die Gesendeten Variablen an alle User Senden.

Angenommen es sind 5 Clienten.
Client 1 schickt Hello World an den Server und vom Server wieder an alle 5 Clienten. :)
Irgendwo haperts bei mir gewaltig. Ich hoffe ich schaffe es bald mal den Code so sauber zu schreiben wie du. :oops:

BTW... ich Habe bei mir alle Strings und "Commands" in einer MySQL-Datenbank und es funktioniert. :mrgreen:
Wenn ich soweit fertig bin mit meinem Server werde ich diesen für andere veröffentlichen.
Bis dahin ist es aber leider noch ein weiter Weg. :roll:

mfg
Cofter


Edit:
Ich habe noch ein wenig experimentiert und eine Procedure für ein Login geschrieben das Login funktioniert auch super.
Nun habe ich ein ListViewGadget damit ich am Server sehen kann wer eingeloggt ist. Nur wie mache ich das mit der Position die angegeben werden muss?
Habe mir gedacht ich frage aus der Datenbank die ID mit ab und gebe diese als Position im ListViewGadget an aber dann trägt er mir den nick nicht ein.
Wenn der User mit der jeweiligen ID disconnected dann soll sein Nick auch aus dem ListViewGadget verschwinden.
Leider will er mir das nicht so machen wie ich es mir gedacht habe. :?
Hat jemand einen kleinen Tip für mich parat?
Anbei mal meine Procedure....

Code: Alles auswählen

Procedure SQL_Login(username.s,password.s,ClientID)

  If OpenDatabase(1, "xxx", "xxx", "xxx") 
    If DatabaseQuery(1,"SELECT * FROM accounts WHERE acc_name LIKE '"+username+"'")
   
        Global COUNTcols = DatabaseColumns(1)
        While NextDatabaseRow(1)
          Global sql_id.l = GetDatabaseLong(1, 3)
          Global acc_name.s = GetDatabaseString(1, 1)
          Protected acc_pwd.s = GetDatabaseString(1, 2)
        Wend 
        Debug sql_id
        If username = acc_name And password = acc_pwd
           
          SendNetworkString(ClientID, "Lo1")
          AddGadgetItem(#ListPlayer,sql_id,acc_name)
        Else
          SendNetworkString(ClientID, "Lo2")
          CloseDatabase(1)
        EndIf
        
    Else
      MessageRequester("QUERY","Tabelle nicht gefunden")
      CloseDatabase(1)
    EndIf
  Else
    MessageRequester("DB","Datenbank geschlossen")
    CloseDatabase(1)
  EndIf
EndProcedure

Verfasst: 10.06.2006 21:42
von mk-soft
Das Beispiel mit den VarServer war nicht MultiUser tauglich.
Habe den Code mal überarbeitet. Schickt auch an alle User ein Nachricht wenn der Server beendet wird.

Das Beispiel soll als Vorlage dienen :allright:

Für jeden angemeldeten User wird ein Object angelegt und der Pointer in einer LinkedList gespeichert. Meldet sich der User ab (Trennen) wird das Object gelöscht und aus der LinkedList entfernt. Kommt ein SEvent wird mit Foreach ... Next alle Ojecte durchgegangen bis die richtige ClientID gefunden wurde.

VarServer.pb

Code: Alles auswählen

;-TOP
; Kommentar : Variablen Server
; Version   : v2.01
; Author    : Michael Kastner
; Datei     : VarServer2.pb
; Erstellt  : 10.06.2006
; Geändert  : 

; -------------------------------------------------------------------

Global Exit = 0
Global LastMessage.s

; -------------------------------------------------------------------

IncludeFile "VarServerInterface.pb"

; -------------------------------------------------------------------

; -------------------------------------------------------------------

If InitNetwork() = 0
  MessageRequester("FEHLER", "InitNetwork nicht erfolgreich!")
  End
EndIf

; -------------------------------------------------------------------

Procedure ThreadVarServer(id)

  port = 7000
  
  If CreateNetworkServer(0, port) = 0
    MessageRequester("FEHLER","CreateNetworkServer Port: " + Str(port))
    Exit = 2
    ProcedureReturn 0
  EndIf
  
  StatusBarText(0, 0, "Server läuft ")
  
  *buffer = AllocateMemory($8000)
    
  While Exit = 0
    
    SEvent = NetworkServerEvent()
  
    If SEvent
    
      ClientID = EventClient()
  
      Select SEvent
      
        Case #PB_NetworkEvent_Connect
          ; Alten User entfernen. Sollte nicht passieren
          ForEach *User()
            If *User()\Connect(ClientID)
              FreeMemory(*User())
              DeleteElement(*User())
              Break
            EndIf
          Next
          ; User hinzufügen
          AddElement(*User())
          *User() = New_User(ClientID)
          StatusBarText(0, 0, "Usercount: " + Str(CountList(*User())))
  
        Case #PB_NetworkEvent_Data
          ; Daten empfangen
          ForEach *User()
            If *User()\ReceiveData(ClientID)
              Break
            EndIf
          Next
          
        Case #PB_NetworkEvent_File
          ; File empfangen
          ForEach *User()
            If *User()\ReceiveFile(ClientID)
              Break
            EndIf
          Next
          
        Case  #PB_NetworkEvent_Disconnect
          ; User entfernen
          ForEach *User()
            If *User()\Disconnect(ClientID)
              FreeMemory(*User())
              DeleteElement(*User())
              Break
            EndIf
          Next
          StatusBarText(0, 0, "Usercount: " + Str(CountList(*User())))
  
      EndSelect
    Else
      Delay(10)
    EndIf
    
  Wend
  
  ; Shutdown an alle Senden
  ForEach *User()
    *User()\Shutdown()
  Next
  
  CloseNetworkServer(0)
  FreeMemory(*buffer)
  Exit = 2
  
EndProcedure

; -------------------------------------------------------------------

; -------------------------------------------------------------------

Procedure LoadVariablen()

  Protected temp.s, var.s, value.s
  
  If ReadFile(0, "Daten.dat")
    While Not Eof(0)
      temp = ReadString(0)
      var = StringField(temp, 1, #TAB$)
      value = StringField(temp, 2, #TAB$)
      If var <> ""
        AddElement(db())
        db()\var = var
        db()\value = value
      EndIf
    Wend
    CloseFile(0)
  EndIf
    
EndProcedure
      
; -------------------------------------------------------------------

Procedure SaveVariablen()

  Protected temp.s, var.s, value.s
  
  If CreateFile(0, "Daten.dat")
    ForEach db()
      temp = db()\var + #TAB$ + db()\value
      WriteStringN(0, temp)
    Next
    CloseFile(0)
  EndIf
    
EndProcedure
      
; -------------------------------------------------------------------

If OpenWindow(0, 20, 20, 300, 40, "Variablen Server v2.01", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget)

  CreateStatusBar(0, WindowID(0))
  
  StatusBarText(0, 0, "Load Variablen")
  LoadVariablen()
  StatusBarText(0, 0, "Start Server")
  hThread = CreateThread(@ThreadVarServer(), 1)
  
  Repeat
  
    Select WaitWindowEvent()
    
      Case #PB_Event_CloseWindow
        Exit = 1
        
    EndSelect
  
  Until Exit = 2
  StatusBarText(0, 0, "Save Variablen")
  SaveVariablen()
EndIf

End
VarServerInterface.pb

Code: Alles auswählen

;-TOP
; Kommentar : Variablen Server
; Version   : v2.01
; Author    : Michael Kastner
; Datei     : VarServer2Interface.pb
; Erstellt  : 10.06.2006
; Geändert  : 

; -------------------------------------------------------------------

;- Structure
Structure udtManager
  *VTable
  
  ClientID.l
  ClientIP.l
  ClientPort.l
  ClientSocket.l
  
  timeConnect.l
  timeUpdate.l
  
  inData.s
  outData.s
  inFile.s
  outFile.s
  
EndStructure

Structure udtVariablen
  Var.s
  Value.s
EndStructure

; -------------------------------------------------------------------

;- Manager Interface
Interface Manager
  Connect(a)
  Disconnect(a)
  ReceiveData(a)
  ReceiveFile(a)
  Shutdown()
  SendDaten()
  Info(a.s)
  
EndInterface

; -------------------------------------------------------------------

Global NewList db.udtVariablen()
Global NewList *User.Manager()

; -------------------------------------------------------------------

Procedure.l iConnect(*this.udtManager, ClientID)

  If ClientID = *this\ClientID
    ProcedureReturn 1
  EndIf
  
  ProcedureReturn 0
  
EndProcedure

; -------------------------------------------------------------------

Procedure.l iDisconnect(*this.udtManager, ClientID)
  
  If ClientID <> *this\ClientID
    ProcedureReturn 0
  EndIf
  
  ProcedureReturn 1
  
EndProcedure

; -------------------------------------------------------------------

Procedure.l iReceiveData(*this.udtManager, ClientID)
  
  Protected *buffer
  Protected len.l
  
  If ClientID <> *this\ClientID
    ProcedureReturn 0
  EndIf
  
  *buffer = AllocateMemory($4000)
  Repeat
    len = ReceiveNetworkData(ClientID,*buffer, $4000)
    *this\inData + PeekS(*buffer)
  Until len <> $4000  
  
  *this\timeUpdate = Date()
  
  ; Datenende auswerten
  If Right(*this\inData, 2) = #CRLF$
    *self.Manager = *this
    *self\SendDaten()
    *this\inData = ""
  EndIf
  
  FreeMemory(*buffer)
  ProcedureReturn 1
  
EndProcedure

; -------------------------------------------------------------------

Procedure.l iReceiveFile(*this.udtManager, ClientID)
  
  Protected *buffer
  Protected len.l
  
  If id <> *this\ClientID
    ProcedureReturn 0
  EndIf
  
  *this\timeUpdate = Date()
  
  ; Datei Speichern
  ReceiveNetworkFile(ClientID, *this\inFile)
  
  ProcedureReturn 1
  
EndProcedure

; -------------------------------------------------------------------

Procedure iShutdown(*this.udtManager)

  Protected temp.s
  
  temp = "Shutdown VarServer" + #CRLF$
  SendNetworkString(*this\ClientID, temp)
  Delay(10)
  CloseNetworkConnection(*this\ClientID)
  
EndProcedure
; -------------------------------------------------------------------

Procedure iSendDaten(*this.udtManager)

  Protected buffer.s, cmd.s, temp.s, var.s, value.s

  buffer = Left(*this\inData, Len(*this\inData) - 2)
  cmd = StringField(buffer, 1, " ")
  cmd = UCase(cmd)
  temp = Right(buffer, Len(buffer) - Len(cmd) - 1)
  var = StringField(temp, 1, "=")
  var = UCase(var)
  var = Trim(var)
  value = StringField(temp, 2, "=")
  
  Select cmd
  
    Case "NEW"
      ForEach db()
        If db()\Var = var
          temp = "FEHLER: Variable existiert bereits" + #CRLF$
          SendNetworkString(*this\ClientID, temp)
          ProcedureReturn 0
        EndIf
      Next
      AddElement(db())
      db()\Var = var
      db()\Value = value
      temp = "OK:" + #CRLF$
      SendNetworkString(*this\ClientID, temp)
      ProcedureReturn 1
      
    Case "GET"
      ForEach db()
        If db()\Var = var
          temp = "OK:" + db()\Value + #CRLF$
          SendNetworkString(*this\ClientID, temp)
          ProcedureReturn 1
        EndIf
      Next
      temp = "FEHLER: Variable nicht gefunden" + #CRLF$
      SendNetworkString(*this\ClientID, temp)
      ProcedureReturn 0
          
    Case "PUT"
      ForEach db()
        If db()\Var = var
          db()\Value = value
          temp = "OK:" + #CRLF$
          SendNetworkString(*this\ClientID, temp)
          ProcedureReturn 1
        EndIf
      Next
      temp = "FEHLER: Variable nicht gefunden" + #CRLF$
      SendNetworkString(*this\ClientID, temp)
      ProcedureReturn 0
        
    Case "DEL"
      ForEach db()
        If db()\Var = var
          DeleteElement(db())
          temp = "OK:" + #CRLF$
          SendNetworkString(*this\ClientID, temp)
          ProcedureReturn 1
        EndIf
      Next
      temp = "FEHLER: Variable nicht gefunden" + #CRLF$
      SendNetworkString(*this\ClientID, temp)
      ProcedureReturn 0
        
    Case "LIST"
      If var = ""
        ForEach db()
          temp = db()\Var + "=" + db()\Value + #CRLF$
          SendNetworkString(*this\ClientID, temp)
        Next
        temp = "OK:" + #CRLF$
        SendNetworkString(*this\ClientID, temp)
        ProcedureReturn 1
      Else
        len = Len(var)
        ForEach db()
          If Left(db()\var, len) = var
            temp = db()\Var + "=" + db()\Value + #CRLF$
            SendNetworkString(*this\ClientID, temp)
          EndIf
        Next
        temp = "OK:" + #CRLF$
        SendNetworkString(*this\ClientID, temp)
        ProcedureReturn 1
      EndIf
    
    Case "SEARCH"
      If var <> ""
        ForEach db()
          If FindString(UCase(db()\value), var, 1)
            temp = db()\Var + "=" + db()\Value + #CRLF$
            SendNetworkString(*this\ClientID, temp)
          EndIf
        Next
      EndIf
      temp = "OK:" + #CRLF$
      SendNetworkString(*this\ClientID, temp)
      ProcedureReturn 1
          
    Default
      temp = "FEHLER: Command unbekannt" + #CRLF$
      SendNetworkString(*this\ClientID, temp)
      ProcedureReturn 0
        
  EndSelect
  
EndProcedure
  
; -------------------------------------------------------------------

Procedure iInfo(*this.udtManager, Text.s)

  Protected temp.s
  
  temp = text + #TAB$
  temp + "IP " + IPString(*this\ClientIP) + #TAB$
  temp + "Port " + Str(*this\ClientPort) +#TAB$
  temp + "Connected " + FormatDate("%tt.%mm.%yyyy %hh:%ii:%ss", *this\timeConnect)
  
  Debug temp
  
EndProcedure

; -------------------------------------------------------------------

Procedure.l New_User(ClientID)
  
  Protected *v.udtManager
  
  *v = AllocateMemory(SizeOf(udtManager))
  *v\VTable = ?vtManager
  
  *v\ClientID = ClientID
  *v\ClientIP = GetClientIP(ClientID)
  *v\ClientPort = GetClientPort(ClientID)
  *v\ClientSocket = ConnectionID(ClientID)
  
  *v\timeConnect = Date()
  
  *v\inData = ""
  *v\outData = ""
  *v\inFile = "DUMMY.DAT"
  *v\outFile = ""
  
  ProcedureReturn *v

EndProcedure

; -------------------------------------------------------------------

; -------------------------------------------------------------------

;- DataSection Manager Interface
DataSection
  vtManager:
  Data.l @iConnect()
  Data.l @iDisconnect()
  Data.l @iReceiveData()
  Data.l @iReceiveFile()
  Data.l @iShutdown()
  Data.l @iSendDaten()
  Data.l @iInfo()
  
EndDataSection
FF :wink:
Alle Zeiten sind UTC+02:00
Seite 2 von 3

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de