Verfasst: 08.08.2005 17:12
Ich hab das jetzt mal Probiert und irgendwas mache ich falsch da ich anfänger bin weiß ich nicht was 
Hab den grade nomma geupdated
Code: Alles auswählen
; ------------------------------------------------------------
;
; Atomic Web Server in PureBasic by AlphaSND
;
; (c) 2001 - Fantaisie Software
;
; ------------------------------------------------------------
;
; 19/05/2005
; Corrections for PB 3.93 (Hroudtwolf)
;
; 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.
;
;Aufruf über : IP:Port/Index.html
If InitNetwork() = 0
MessageRequester("Error", "Can't initialize the network !", 0)
End
EndIf
DefType.l
Port = 81
;BaseDirectory$ = "C:\Meine Projekte\Source\Webserver\"
DefaultPage$ = "index"
AtomicTitle$ = "Atomic Web Server v1.0"
Global EOL$
EOL$ = Chr(13)+Chr(10)
*Buffer = GlobalAlloc_(#GMEM_FIXED | #GMEM_ZEROINIT, 10000)
If CreateNetworkServer(Port)
OpenWindow(0, 300, 300, 230, 0, #PB_Window_SystemMenu, "Atomic Web Server (Port "+Str(Port)+")")
Repeat
WEvent.l = WindowEvent()
SEvent.l = NetworkServerEvent()
If WEvent = #PB_EventCloseWindow
Quit = 1
EndIf
If SEvent
ClientID.l = NetworkClientID()
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
Sleep_(20) ; Don't stole the whole CPU !
EndIf
Until Quit = 1
CloseNetworkServer()
Else
MessageRequester(AtomicTitle$, "Error: can't create the server (port in use ?).", #MB_ICONERROR)
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, EOL$) : *Buffer+Length
; Length = PokeS(*Buffer, "Last-modified: Thu, 27 Jun 1996 16:40:50 GMT"+Chr(13)+Chr(10) , *Buffer) : *Buffer+Length
; Length = PokeS(*Buffer, "Accept-Ranges: bytes"+EOL$ , *Buffer) : *Buffer+Length
; Length = PokeS(*Buffer, "Connection: close"+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$ = Trim(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
If(RequestedFile$ = "index")
html_output.s = "Hallo User!"
*BufferOffset = BuildRequestHeader(*FileBuffer, Len(html_output), ContentType$)
EndIf
; Test if the file exists, and if not display the error message
;
;If ReadFile(0, BaseDirectory$+RequestedFile$) : CloseFile(0) : Else : RequestedFile$ = "AtomicWebServer_Error.html" : EndIf
;If ReadFile(0, BaseDirectory$+RequestedFile$)
; FileLength = Lof()
; 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 = GlobalAlloc_(#GMEM_FIXED|#GMEM_ZEROINIT, FileLength+200)
; *BufferOffset = BuildRequestHeader(*FileBuffer, FileLength, ContentType$)
; ReadData(*BufferOffset, FileLength)
; CloseFile(0)
SendNetworkData(ClientID, html_output, *BufferOffset-*BufferOffset+Len(html_output))
GlobalFree_(*FileBuffer)
;Else
; MessageRequester(AtomicTitle$, "Error: Can't open the file "+BaseDirectory$+RequestedFile$, #MB_ICONERROR)
EndIf
Return 
.