Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
HTTP_Server [2]
| Uploader: |  ThePuppetMaster |
| Datum/Zeit: | 23.11.2007 18:05:34 |
'======================================================================
'(c) 2007 By.: /_\ DeltaLab's - Deutschland
'Autor: Martin Wiemann
'======================================================================
Declare Function HTML_HTTPCode_CreatePage(ByRef V_HTTPCode as Long, ByVal V_HTTPDesc as String) as String
Declare Function HTML_HTTP_CreateDirList(ByRef V_WWWRootDir as String, ByRef V_Path As String, ByRef V_Request as String) as String
Function HTML_HTTPCode_CreatePage(ByRef V_HTTPCode as Long, ByVal V_HTTPDesc as String) as String
Dim T as String
Dim FBCRLF as String
FBCRLF = Chr(13) & Chr(10)
T = T & "<!DOCTYPE html PUBLIC ""-//W3C//DTD HTML 4.01 Transistional//EN"">" & FBCRLF
T = T & "<html>" & FBCRLF
T = T & " <head>" & FBCRLF
T = T & " <Title>" & Str(V_HTTPCode) & " - " & V_HTTPDesc & "</Title>" & FBCRLF
T = T & " </head>" & FBCRLF
T = T & " <body>" & FBCRLF
T = T & " <h1>" & Str(V_HTTPCode) & "</h1>" & FBCRLF
T = T & " <hr>" & FBCRLF
T = T & " <h3>" & V_HTTPDesc & "</h3><hr>" & FBCRLF
T = T & " <pre>" & FBCRLF
Select Case V_HTTPCode
Case 300': Return "Multiple Choise"
Case 301
T = T & " [DE] Diese Datei wurde dauerhaft verschoben." & FBCRLF & FBCRLF
T = T & " [EN] This file was moved permanently." & FBCRLF
Case 302
T = T & " [DE] Die Datei wurde gefunden." & FBCRLF & FBCRLF
T = T & " [EN] The file was found." & FBCRLF
Case 303': Return "See Other"
Case 304
T = T & " [DE] Diese Datei wurde nicht geändert." & FBCRLF & FBCRLF
T = T & " [EN] This file was not modified." & FBCRLF
Case 305': Return "Use Proxy"
Case 307
T = T & " [DE] Diese Datei wurde kurzfristig umgelenkt." & FBCRLF & FBCRLF
T = T & " [EN] This file was redirect temporary" & FBCRLF
Case 400
T = T & " [DE] Das Anfrage-Format von Ihrer Anwendung wurde nicht verstanden." & FBCRLF & FBCRLF
T = T & " [EN] The Request format from your application was not understood." & FBCRLF
Case 401
T = T & " [DE] Sie sind nicht Berechtigt diese Datei / dieses Verzeichniss zu betrachten." & FBCRLF & FBCRLF
T = T & " [EN] You are not allowed to view this file / directory." & FBCRLF
Case 402
T = T & " [DE] Sie müssen bezahlen, um diese Datei herunterladen zu dürfen." & FBCRLF & FBCRLF
T = T & " [EN] You need to pay to download this file." & FBCRLF
Case 403
T = T & " [DE] Der zugriff auf diese Datei ist ihnen nicht gestattet." & FBCRLF & FBCRLF
T = T & " [EN] The Acces to this file is not permitted." & FBCRLF
Case 404
T = T & " [DE] Diese Datei wurde nicht gefunden. Wurde die Anfrage richtig geschrieben?" & FBCRLF
T = T & " Sollte ein verzeichniss geoeffnet werden, muss ein '[komm]LycgYW0gZW5kZSBkZXIgVVJMIHNlaW4hIiAmYW1wOyBGQkNSTEYgJmFtcDsgRkJDUkxGCiAgICAgICAgVCA9IFQgJmFtcDsgIiAmI3g1QjtFTiYjeDVEOyBUaGUgZmlsZSB3YXMgbm90IGZvdW5kLiBEaWQgeW91IHR5cGUgdGhlIHJlcXVlc3QgY29ycmVjdGx5PyIgJmFtcDsgRkJDUkxGCiAgICAgICAgVCA9IFQgJmFtcDsgIiAgICAgIElmIHlvdSB3YW50IHRvIGFjY2VzcyBhIGRpcmVjdG9yeSB5b3UgbXVzdCB0YWtlIGEgJy8ß[/komm]' at the end of the URL!" & FBCRLF
Case 405
T = T & " [DE] Die Methode, wie sie diese Seite aufrufen, ist nicht gestattet." & FBCRLF & FBCRLF
T = T & " [EN] The methode you do to access this side is not allowed." & FBCRLF
Case 406': Return "Not Acceptable"
Case 407': Return "Proxy Authentcation Required"
Case 408
T = T & " [DE] Die anfrage hat ein zeitlimit ueberschritten." & FBCRLF & FBCRLF
T = T & " [EN] The request has exceeded a timelimit." & FBCRLF
Case 409
T = T & " [DE] Ein Konflikt ist aufgetreten." & FBCRLF & FBCRLF
T = T & " [EN] A conflict was raised." & FBCRLF
Case 410': Return "Gone"
Case 411
T = T & " [DE] Um die Anfrage bearbeiten zu koennen, muss die Laenge der angehaengten Daten mitgesand werden." & FBCRLF & FBCRLF
T = T & " [EN] To process your request it's need to send the datalen in the request." & FBCRLF
Case 412': Return "Precondition Faild"
Case 413': Return "Request Entry Too Large"
Case 414
T = T & " [DE] Die übertragene URL ist zu lang." & FBCRLF & FBCRLF
T = T & " [EN] The send URL was to long." & FBCRLF
Case 415
T = T & " [DE] Den von ihnen gewuenschten Media Typ kann dieser Server nicht unterstuezen." & FBCRLF & FBCRLF
T = T & " [EN] The media type you wish cant support this server." & FBCRLF
Case 416': Return "Requested range not satisfiable"
Case 417': Return "Exeption Faild"
Case 490
T = T & " [DE] Sie haben einen boesswilligen Angriff auf dieses System durchgeführt. Ihre IP-Adresse wurde gespert!" & FBCRLF & FBCRLF
T = T & " [EN] You got a evil attack on this Server. Your IP-Address was banned!" & FBCRLF
Case 491
T = T & " [DE] Das System hat Sie als potenziellen Hacker identifiziert." & FBCRLF
T = T & " Ihre IP-Adresse wurde gespeichert und fuer die Zukunft blockiert." & FBCRLF
T = T & " Sollten Sie erneut versuchen sich auf diesem System Illegal zu betaetien" & FBCRLF
T = T & " werden automatisch Passive und Aktive Verteidigungsmassnahmen ergriffen!" & FBCRLF & FBCRLF
T = T & " [EN] The system classified you as a possible hacker!" & FBCRLF
T = T & " Your IP-Address has been saves and blocked for future." & FBCRLF
T = T & " In case you try apain to harm the system the system will defend itself" & FBCRLF
T = T & " with passive and active strategies of defence!" & FBCRLF
Case 500
T = T & " [DE] Ein Interner Server Fehler ist aufgetreten." & FBCRLF & FBCRLF
T = T & " [EN] A internal servererror has ocurred." & FBCRLF
Case 501
T = T & " [DE] Diese Aktion ist im Server nicht vorhanden." & FBCRLF & FBCRLF
T = T & " [EN] This action is not implemented in this server." & FBCRLF
Case 502
T = T & " [DE] Der Server konnte keine Verbingug mit einer Daten-Quelle herstellen." & FBCRLF & FBCRLF
T = T & " [EN] The server cant connect to a data-source." & FBCRLF
Case 503
T = T & " [DE] Dieser Server ist zur zeit nicht verfuegbar." & FBCRLF & FBCRLF
T = T & " [EN] This server is temporary not available." & FBCRLF
Case 504
T = T & " [DE] Bei der Kommunikation mit der Daten-Quelle wurde ein Zeitlimit ueberschritten." & FBCRLF & FBCRLF
T = T & " [EN] By the communication whis the data-source has a timeout exceeded." & FBCRLF
Case 505
T = T & " [DE] Die von Ihrer Anwendung benutzte Version des Kommunikations-Formats wird von diesem Server nicht unterstuezt." & FBCRLF & FBCRLF
T = T & " [EN] The communication-format version of your application was not supportet by this server." & FBCRLF
Case Else
T = T & " [DE] Es ist ein interner Server-Fehler aufgetreten, dessen Ursprung nicht bekannt ist." & FBCRLF & FBCRLF
T = T & " [EN] A internal server error has occured. The source of this error is not know." & FBCRLF
End Select
T = T & " </pre>" & FBCRLF
T = T & " <hr><h6>CIC4U - FileServer [HTTP]</h6>" & FBCRLF
T = T & " </body>" & FBCRLF
T = T & "</html>" & FBCRLF
Return T
End Function
Function HTML_HTTP_CreateDirList(ByRef V_WWWRootDir as String, ByRef V_Path As String, ByRef V_Request as String) as String
Dim T as String
Dim FBCRLF as String
FBCRLF = Chr(13) & Chr(10)
T = T & "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.01//EN"">" & FBCRLF
T = T & "<html>" & FBCRLF
T = T & " <head>" & FBCRLF
T = T & " <Title>" & V_Request & "</Title>" & FBCRLF
T = T & " </head>" & FBCRLF
T = T & " <body>" & FBCRLF
T = T & " <h3>" & V_Request & "</h3>" & FBCRLF
T = T & " <pre>"
Dim N as String
Dim XATR as Integer
If len(V_Path) > len(V_WWWRootDir ) then
Dim XPos as Long
For XPos = Len(V_Request) -1 to 1 step -1
If mid(V_Request,XPos,1) = "/" then
T = T & " <a href=""" & mid(V_Request,1, XPos) & """>[Go one directory back]</a>" & FBCRLF
T = T & " </pre><hr><pre>" & FBCRLF
Exit for
endif
Next
End If
N = dir(V_Path & "*", fbdirectory, @XATR)
Do
If N = "" then exit do
If (N <> ".") and (N <> "..") then
T = T & " <a href=""" & V_Request & N & "/"">" & N & "/</a>" & FBCRLF
End If
N = Dir("",fbdirectory)
Loop
if Right(T,6) = "<br>" & FBCRLF then T = Left(t, len(t) - 6) & FBCRLF
T = T & " </pre><hr><pre>" & FBCRLF
N = dir(V_Path & "*", XAttrFiles, @XATR)
Do
If N = "" then exit do
If (N <> ".") and (N <> "..") then
if (XATR and fbdirectory) <> fbdirectory then T = T & " <a href=""" & V_Request & N & """>" & N & "</a>" & FBCRLF
End If
N = Dir("",XAttrFiles)
Loop
if Right(T,6) = "<br>" & FBCRLF then T = Left(t, len(t) - 6) & FBCRLF
T = T & " </pre><hr>" & FBCRLF
T = T & " <h6>CIC4U - FileServer [HTTP]</h6>" & FBCRLF
T = T & " </body>" & FBCRLF
T = T & "</html>" & FBCRLF
Return T
End Function