PureBasic Forums - English

Code: Select all

AddEncoding x-gzip .gz
RewriteEngine On
RewriteCond %{REQUEST_FILENAME}.gz -f
RewriteCond %{REQUEST_FILENAME} \.css$ [OR] 
RewriteCond %{REQUEST_FILENAME} \.js$
RewriteRule (.*)$ $1.gz
<FilesMatch "\\.css.gz$">
ForceType text/css
Header set Content-Encoding: gzip
</FilesMatch>

<FilesMatch "\\.js.gz$">
ForceType text/js
Header set Content-Encoding: gzip
</FilesMatch>

Code: Select all

Import "ZlibStat.lib" 
  gzclose(a.l) As "_gzclose@4" 
  gzopen(a.l,b.l) As "_gzopen@8" 
  gzread(a.l,b.l,c.l) As "_gzread@12" 
EndImport 

Code: Select all

gzwrite(a.l,b.l,c.l) As "_gzwrite@12" 

Code: Select all

;
; ------------------------------------------------------------
;
;       Atomic Web Server in PureBasic by AlphaSND
;
;           (c) 2001 - Fantaisie Software
;
; ------------------------------------------------------------
;
; 25/03/2001
;   Added path relative feature. It can be started everywhere
;   Added the window to kill it easely
;
; 19/03/2001
;   Added some new features (clients closed automatically)
;
; 17/03/2001
;   First version.
;
CompilerIf #PB_Compiler_OS = #PB_OS_Windows 
  
  ImportC "zlib.lib"
    compress2(*dest,*destlen,*source,sourcelen,level)
    uncompress(*dest,*destlen,*source,sourcelen)
  EndImport 
CompilerElse 
  
  ImportC "-lz"   
     compress(*dest,*destlen,*source,Srclen)
     compress2(*dest,*destlen,*source,sourcelen,level)
     uncompress(*dest,*destlen,*source,sourcelen)
 EndImport 
  
CompilerEndIf 



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

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

Global EOL$

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

*Buffer = AllocateMemory(10000)

If CreateNetworkServer(1,Port)

  OpenWindow(0, 0, 0, 300, 0, "Atomic Web Server (Port "+Str(Port)+")",#PB_Window_SystemMenu | #PB_Window_ScreenCentered)

  Repeat

    Repeat
      WEvent = WindowEvent()

      If WEvent = #PB_Event_CloseWindow : Quit = 1 : EndIf
    Until WEvent = 0

    SEvent = NetworkServerEvent()

    If SEvent

      ClientID.l = EventClient();NetworkClientID()

      Select SEvent

        Case 1  ; When a new client has been connected...
          Debug "New connection"

        Case 4  ; When a client has closed the connection...
          Debug "Deconnection"

        Default
          Debug "Raw data"
          RequestLength.l = ReceiveNetworkData(ClientID, *Buffer, 2000)
         ; Debug PeekS(*buffer,RequestLength) 
          
          Gosub ProcessRequest

      EndSelect

    Else
      Delay(20)  ; Don't stole the whole CPU !
    EndIf

  Until Quit = 1

  CloseNetworkServer(1)
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: Atomic 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, "Content-Encoding: deflate" + 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

      ; 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$)

        FileLength = Lof(0)

        Select LCase(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
     
        
        *src = AllocateMemory(FileLength) 
        ReadData(0,*src,FileLength)
        *dest = AllocateMemory(FileLength*1.5) 
        destlen = FileLength*1.5 
        compress2(*dest,@destlen,*src,FileLength,9) 
               
        *FileBuffer = AllocateMemory(destlen+500)
        *BufferOffset = BuildRequestHeader(*FileBuffer, destlen, ContentType$)
        
        Debug PeekS(*FileBuffer,*BufferOffset-*FileBuffer)
        headerlen = *BufferOffset-*FileBuffer 
        
        CopyMemory(*dest,*FileBuffer+headerlen,destlen)
        FileLength = destlen + headerlen       
        Debug "header len " + headerlen
        Debug "compressed page  " + FileLength 
                
        CloseFile(0)

        SendNetworkData(ClientID, *FileBuffer, FileLength)
        FreeMemory(*FileBuffer)
        FreeMemory(*src)
        FreeMemory(*dest)
        
      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

Code: Select all

Select Right(RequestedFile$,4)

Code: Select all

Select LCase(Right(RequestedFile$,4))

Code: Select all

#windowBits 15
#GZIP_ENCODING 16
#Z_DEFAULT_COMPRESSION  -1
#Z_DEFAULT_STRATEGY    0
#Z_DEFLATED   8
deflateInit2 (strm, #Z_DEFAULT_COMPRESSION, #Z_DEFLATED,
                             #windowBits | #GZIP_ENCODING, 8,
                             #Z_DEFAULT_STRATEGY)