Aktuelle Zeit: 31.03.2020 16:57

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 36 Beiträge ]  Gehe zu Seite Vorherige  1, 2, 3, 4
Autor Nachricht
 Betreff des Beitrags: Re: Webserver bzw. Problem mit SendNetworkData()
BeitragVerfasst: 14.02.2020 13:07 
Offline
Ein Admin
Benutzeravatar

Registriert: 29.08.2004 20:20
Wohnort: Saarbrücken
Atomic -Webserver? Wo gibt's den? War das nicht mal ein Beispiel-Code von Purebasic? In meinem examples-Ordner ist er leider nicht drin.

_________________
Ubuntu Gnome 19.04 LTS x64, PureBasic 5.71 x64 (außerdem 4.41, 4.50, 4.61, 5.00, 5.10, 5.11, 5.21, 5.22, 5.30, 5.31, 5.40, 5.50, 5.60)
"Die deutsche Rechtschreibung ist Freeware, du darfst sie kostenlos nutzen – Aber sie ist nicht Open Source, d. h. du darfst sie nicht verändern oder in veränderter Form veröffentlichen."


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Webserver bzw. Problem mit SendNetworkData()
BeitragVerfasst: 14.02.2020 14:12 
Offline

Registriert: 28.12.2005 14:26
Wohnort: NRW
/Examples/Sources - Advanced/Atomic Web Server/Atomic Web Server.pb

Hier die Windows-Variante. Hab momentan (im Büro) keinen Zugriff auf mein Linux.

Port auf 8080 geändert.

Code:
;
; ------------------------------------------------------------
;
;       Atomic Web Server in PureBasic
;
;          (c) Fantaisie Software
;
; ------------------------------------------------------------
;

If InitNetwork() = 0
  MessageRequester("Error", "Can't initialize the network !", 0)
  End
EndIf

Port = 80
BaseDirectory$ = "www/"
DefaultPage$   = "Index.html"
AtomicTitle$   = "Atomic Web Server v1.0"

Global EOL$

EOL$ = Chr(13)+Chr(10)

*Buffer = AllocateMemory(10000)

If CreateNetworkServer(0, Port)

  OpenWindow(0, 100, 200, 230, 0, "Atomic Web Server (Port "+Str(Port)+")")
 
  Repeat
   
    Repeat
      WEvent = WindowEvent()

      If WEvent = #PB_Event_CloseWindow : Quit = 1 : EndIf
    Until WEvent = 0
   
    SEvent = NetworkServerEvent()
 
    If SEvent
      ClientID = EventClient()
 
      Select SEvent
     
        Case 1  ; When a new client has been connected...
         
        Case 4  ; When a client has closed the connection...
 
        Default
          RequestLength = ReceiveNetworkData(ClientID, *Buffer, 2000)
          Gosub ProcessRequest
         
      EndSelect

    Else
      Delay(20)  ; Don't stole the whole CPU !
    EndIf
   
  Until Quit = 1
   
  CloseNetworkServer(0)
Else
  MessageRequester(AtomicTitle$, "Error: can't create the server (port in use ?).", 0)
EndIf
 
End



Procedure.l BuildRequestHeader(*Buffer, DataLength, ContentType$)

  Length = PokeS(*Buffer, "HTTP/1.1 200 OK"+EOL$, -1, #PB_UTF8)                     : *Buffer+Length
  Length = PokeS(*Buffer, "Date: Wed, 11 Fec 2017 11:15:43 GMT"+EOL$, -1, #PB_UTF8) : *Buffer+Length
  Length = PokeS(*Buffer, "Server: Atomic Web Server 0.2b"+EOL$, -1, #PB_UTF8)      : *Buffer+Length
  Length = PokeS(*Buffer, "Content-Length: "+Str(DataLength)+EOL$, -1, #PB_UTF8)    : *Buffer+Length
  Length = PokeS(*Buffer, "Content-Type: "+ContentType$+EOL$, -1, #PB_UTF8)         : *Buffer+Length
  Length = PokeS(*Buffer, #CRLF$, -1, #PB_UTF8)                                     : *Buffer+Length

  ; Length = PokeS(*Buffer, "Last-modified: Thu, 27 Jun 1996 16:40:50 GMT"+Chr(13)+Chr(10), -1, #PB_UTF8) : *Buffer+Length
  ; Length = PokeS(*Buffer, "Accept-Ranges: bytes"+EOL$, -1, #PB_UTF8) : *Buffer+Length
  ; Length = PokeS(*Buffer, "Connection: close"+EOL$, -1, #PB_UTF8) : *Buffer+Length

  ProcedureReturn *Buffer
EndProcedure


ProcessRequest:

  a$ = PeekS(*Buffer, -1, #PB_UTF8)
 
  If Left(a$, 3) = "GET"

    MaxPosition = FindString(a$, Chr(13), 5)
    Position = FindString(a$, " ", 5)
    If Position < MaxPosition
      RequestedFile$ = Mid(a$, 6, Position-5)      ; Automatically remove the leading '/'
      RequestedFile$ = RTrim(RequestedFile$)
    Else
      RequestedFile$ = Mid(a$, 6, MaxPosition-5)   ; When a command like 'GET /' is sent..
    EndIf

      ; The following routine transforme all '/' in '\' (Windows format)
      ;
      Structure tmp
        a.b
      EndStructure

      If RequestedFile$ = ""
        RequestedFile$ = DefaultPage$
      Else
        *t.tmp = @RequestedFile$
        While *t\a <> 0
          If *t\a = '/' : *t\a = '\' : EndIf
          *t+1
        Wend
      EndIf

      ; Test if the file exists, and if not display the error message
      ;   

      If ReadFile(0, BaseDirectory$+RequestedFile$, #PB_UTF8)
     
        FileLength = Lof(0)

        Select Right(RequestedFile$,4)
          Case ".gif"
            ContentType$ = "image/gif"

          Case ".jpg"
            ContentType$ = "image/jpeg"

          Case ".txt"
            ContentType$ = "text/plain"

          Case ".zip"
            ContentType$ = "application/zip"

          Default
            ContentType$ = "text/html"

        EndSelect
       
        *FileBuffer   = AllocateMemory(FileLength+200)
        *BufferOffset = BuildRequestHeader(*FileBuffer, FileLength, ContentType$)

        ReadData(0, *BufferOffset, FileLength)

        CloseFile(0)
 
        SendNetworkData(ClientID, *FileBuffer, *BufferOffset-*FileBuffer+FileLength)
       
        FreeMemory(*FileBuffer)
      Else
        If ReadFile(0, BaseDirectory$+"AtomicWebServer_Error.html")
          FileLength = Lof(0)
          ContentType$ = "text/html"

          *FileBuffer   = AllocateMemory(FileLength+200)
          *BufferOffset = BuildRequestHeader(*FileBuffer, FileLength, ContentType$)

          ReadData(0, *BufferOffset, FileLength)
          CloseFile(0)
   
          SendNetworkData(ClientID, *FileBuffer, *BufferOffset-*FileBuffer+FileLength)
          FreeMemory(*FileBuffer)
        EndIf
      EndIf
  EndIf

Return

_________________
Gruß
Markus


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Webserver bzw. Problem mit SendNetworkData()
BeitragVerfasst: 14.02.2020 14:52 
Offline
Ein Admin
Benutzeravatar

Registriert: 29.08.2004 20:20
Wohnort: Saarbrücken
Den Code gibt es in meiner Installation nicht. Gibt es das vielleicht nur in der Windows-Installation? Komisch.

Hast du den Code auch auf #PB_Any umgeschrieben oder hast du CreateNetworkServer(0, ...) weiterhin benutzt? Denn damit geht es ja nicht.
Bei mir funktioniert der Code übrigens überhaupt nicht. Abgesehen davon, dass ich die notwendigen Dateien auch nicht besitze, kommt nicht mal eine Fehlermeldung oder vergleichbares.

Vielleicht schaue ich nochmal genauer, wenn ich mehr Zeit habe. Momentan bin ich ja auf der Arbeit.

_________________
Ubuntu Gnome 19.04 LTS x64, PureBasic 5.71 x64 (außerdem 4.41, 4.50, 4.61, 5.00, 5.10, 5.11, 5.21, 5.22, 5.30, 5.31, 5.40, 5.50, 5.60)
"Die deutsche Rechtschreibung ist Freeware, du darfst sie kostenlos nutzen – Aber sie ist nicht Open Source, d. h. du darfst sie nicht verändern oder in veränderter Form veröffentlichen."


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Webserver bzw. Problem mit SendNetworkData()
BeitragVerfasst: 14.02.2020 15:54 
Offline

Registriert: 28.12.2005 14:26
Wohnort: NRW
Ja, CreateNetworkServer(#PB_Any, Port)

Wenn ich zu Hause bin, schick ich mal den Code, den ich unter Linux ausführe.

_________________
Gruß
Markus


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Webserver bzw. Problem mit SendNetworkData()
BeitragVerfasst: 14.02.2020 18:52 
Offline

Registriert: 28.12.2005 14:26
Wohnort: NRW
Tatsächlich, der "Atomic Web Server" ist nur bei der PB-Windows-Version enthalten.
Hatte ihn für Linux etwas angepasst; ganz vergessen.

Code:
;
;
; ------------------------------------------------------------
;
;       Atomic Web Server in PureBasic
;
;          (c) Fantaisie Software
;
;         (modifiziert v. Gimbly mit Hilfe v. NicTheQuick)
; ------------------------------------------------------------
;

CompilerIf #PB_Compiler_OS = #PB_OS_Linux
   #SOL_SOCKET = 1
   #SO_REUSEADDR = 2
   #SO_REUSEPORT = 15
   
   Procedure CreateNetworkServerEx(ServerID.i, Port.i, Modus, BindedIP$)
      Protected handle.i
      If ServerID.i = #PB_Any
         handle.i = CreateNetworkServer(#PB_Any, Port, Modus, BindedIP$)
         If Not handle
            ProcedureReturn handle
         EndIf
         Protected hSocket.l = PeekL(handle), enable.l = 1
         If setsockopt_(hSocket, #SOL_SOCKET, #SO_REUSEADDR, @enable, SizeOf(enable)) < 0
            Debug "Error setting SO_REUSEADDR"
            End
         EndIf
         If setsockopt_(hSocket, #SOL_SOCKET, #SO_REUSEPORT, @enable, SizeOf(enable)) < 0
            Debug "Error setting SO_REUSEPORT"
            End
         EndIf
         ProcedureReturn handle
      Else
         ProcedureReturn CreateNetworkServer(ServerID, Port, Modus, BindedIP$)
      EndIf
   EndProcedure
   Macro CreateNetworkServer(a, b, c = #PB_Network_TCP | #PB_Network_IPv4, d = "0.0.0.0")
      CreateNetworkServerEx(a, b, c, d)
   EndMacro
CompilerEndIf

CompilerIf #PB_Compiler_OS=#PB_OS_Linux
  Procedure mitStrgCbeendet(signal.i) :  CloseNetworkServer(0) : PrintN("Server beendet!") : PrintN("Drücke Return zum Schließen.") : Input() : CloseConsole() : End : EndProcedure
CompilerEndIf


#EOL=Chr(10)

Port = 8080
BaseDirectory$ = "www/"
DefaultPage$   = "Index.html"
ServerTitle$   = "Atomic Web Server v1.0"

If OpenConsole(ServerTitle$+" (Port "+Str(Port)+")") = 0 : End : EndIf

If InitNetwork() = 0
  PrintN("Can't initialize the network !")
  End
EndIf

Global *FileBuffer

*Buffer = AllocateMemory(100000)

If CreateNetworkServer(#PB_Any, Port)
  CompilerIf #PB_Compiler_OS=#PB_OS_Linux : signal_(2,@mitStrgCbeendet()) ;SIGINT (STRG+C)
    signal_(15,@mitStrgCbeendet()) ;SIGTERM
  CompilerEndIf

  PrintN("Server gestartet auf Port "+Str(Port))

  Repeat
   
    SEvent = NetworkServerEvent()
 
    If SEvent
      ClientID = EventClient()
 
      Select SEvent
     
        Case 1  ; When a new client has been connected...
         
        Case 4  ; When a client has closed the connection...
 
        Default
          RequestLength = ReceiveNetworkData(ClientID, *Buffer, 2000)
          Gosub ProcessRequest
         
      EndSelect

    Else
      Delay(20)  ; Don't stole the whole CPU !
    EndIf
   
  ForEver
   
  CloseNetworkServer(0)
Else
  PrintN("Error: can't create the server (port in use ?).") : PrintN("Drücke Return zum Schließen.") : Input()
EndIf 
End



Procedure BuildRequestHeader(*Buffer, DataLength, ContentType$)

  Length = PokeS(*Buffer, "HTTP/1.1 200 OK"+#EOL, -1, #PB_Ascii|#PB_String_NoZero)                     : *Buffer+Length
  Length = PokeS(*Buffer, "Date: Wed, 11 Fec 2017 11:15:43 GMT"+#EOL, -1, #PB_Ascii|#PB_String_NoZero) : *Buffer+Length
  Length = PokeS(*Buffer, "Server: Atomic Web Server 0.2b"+#EOL, -1, #PB_Ascii|#PB_String_NoZero)      : *Buffer+Length
  Length = PokeS(*Buffer, "Content-Length: "+Str(DataLength)+#EOL, -1, #PB_Ascii|#PB_String_NoZero)    : *Buffer+Length
  Length = PokeS(*Buffer, "Content-Type: "+ContentType$+#EOL, -1, #PB_Ascii|#PB_String_NoZero)         : *Buffer+Length
  Length = PokeS(*Buffer, #CRLF$, -1, #PB_Ascii)                                                       : *Buffer+Length

  ProcedureReturn *Buffer
EndProcedure

ProcessRequest:

  a$ = PeekS(*Buffer, -1, #PB_Ascii)
 
  If Left(a$, 3) = "GET"

    MaxPosition = FindString(a$, Chr(13), 5)
    Position = FindString(a$, " ", 5)
    If Position < MaxPosition
      RequestedFile$ = Mid(a$, 6, Position-5)      ; Automatically remove the leading '/'
      RequestedFile$ = RTrim(RequestedFile$)
    Else
      RequestedFile$ = Mid(a$, 6, MaxPosition-5)   ; When a command like 'GET /' is sent..
    EndIf

      ; The following routine transforme all '/' in '\' (Windows format)
      ;
      Structure tmp
        a.b
      EndStructure

      If RequestedFile$ = ""
        RequestedFile$ = DefaultPage$
      Else
        *t.tmp = @RequestedFile$
        While *t\a <> 0
          If *t\a = '/' : *t\a = '\' : EndIf
          *t+1
        Wend
      EndIf

      ; Test if the file exists, and if not display the error message
      ;   

      If ReadFile(0, BaseDirectory$+RequestedFile$, #PB_Ascii)
     
        FileLength = Lof(0)

        Select Right(RequestedFile$,4)
          Case ".gif"
            ContentType$ = "image/gif"

          Case ".jpg"
            ContentType$ = "image/jpeg"

          Case ".txt"
            ContentType$ = "text/plain"

          Case ".zip"
            ContentType$ = "application/zip"

          Default
            ContentType$ = "text/html"

        EndSelect
       
        *FileBuffer   = AllocateMemory(FileLength+200)
        *BufferOffset = BuildRequestHeader(*FileBuffer, FileLength, ContentType$)

        ReadData(0, *BufferOffset, FileLength)

        CloseFile(0)
 
        SendNetworkData(ClientID, *FileBuffer, *BufferOffset-*FileBuffer+FileLength)
       
        FreeMemory(*FileBuffer)
      Else
        If ReadFile(0, BaseDirectory$+"AtomicWebServer_Error.html")
          FileLength = Lof(0)
          ContentType$ = "text/html"

          *FileBuffer   = AllocateMemory(FileLength+200)
          *BufferOffset = BuildRequestHeader(*FileBuffer, FileLength, ContentType$)

          ReadData(0, *BufferOffset, FileLength)
          CloseFile(0)
   
          SendNetworkData(ClientID, *FileBuffer, *BufferOffset-*FileBuffer+FileLength)
          FreeMemory(*FileBuffer)
        EndIf
      EndIf
  EndIf

Return

_________________
Gruß
Markus


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Webserver bzw. Problem mit SendNetworkData()
BeitragVerfasst: 02.03.2020 18:58 
Offline

Registriert: 28.12.2005 14:26
Wohnort: NRW
Hallo, ist da jemand?

_________________
Gruß
Markus


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 36 Beiträge ]  Gehe zu Seite Vorherige  1, 2, 3, 4

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 1 Gast


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye