PureBasic Forums - English

Code: Select all

If (Not InitNetwork()) : 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.l = EventClient()
      Select SEvent
        Case 1  ; When a new client has been connected...
        Case 4  ; When a client has closed the connection...
        Default
          RequestLength.l = 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.l, ContentType$)
  Length = PokeS(*Buffer, "HTTP/1.1 200 OK"+EOL$)                     : *Buffer+Length
  Length = PokeS(*Buffer, "Date: Wed, 07 Aug 1996 11:15:43 GMT"+EOL$) : *Buffer+Length
  Length = PokeS(*Buffer, "Server: Web Server 0.2b"+EOL$)             : *Buffer+Length
  Length = PokeS(*Buffer, "Content-Length: "+Str(DataLength)+EOL$)    : *Buffer+Length
  Length = PokeS(*Buffer, "Content-Type: "+ContentType$+EOL$)         : *Buffer+Length
  Length = PokeS(*Buffer, EOL$)                                       : *Buffer+Length
  ProcedureReturn *Buffer
EndProcedure
; --------------------------------------------
ProcessRequest:
  a$ = PeekS(*Buffer)
  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
    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
    ContentType$ = "text/plain"
    If (Not ReadFile(0, BaseDirectory$+RequestedFile$))
      If (Not ReadFile(0, BaseDirectory$+"AtomicWebServer_Error.html"))
        Return
      EndIf
    EndIf
    FileLength = Lof(0)
    *FileBuffer   = AllocateMemory(FileLength+200)
    *BufferOffset = BuildRequestHeader(*FileBuffer, FileLength, ContentType$)
    ReadData(0, *BufferOffset, FileLength)
    CloseFile(0)
    SendNetworkData(ClientID, *FileBuffer, *BufferOffset-*FileBuffer+FileLength)
    FreeMemory(*FileBuffer)
  EndIf
Return

Code: Select all

AllocateMemory(10000)