Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
HTTP_server.bas
| Uploader: |  ThePuppetMaster |
| Datum/Zeit: | 30.01.2009 14:10:42 |
'##############################################################################################################
Dim Shared HTTP_PathSeperation as UByte
#If defined(__fb_linux__)
HTTP_PathSeperation = 47
#elseIf defined(__fb_win32__)
HTTP_PathSeperation = 92
#elseIf defined(__fb_dos__)
HTTP_PathSeperation = 92
#Else
#Error "Platform not supported!"
#EndIf
'##############################################################################################################
#Define TSNE_DEF_REUSER
#include once "../TSNE_V3/TSNE_V3.bi"
#include once "vbcompat.bi"
#include once "file.bi"
'##############################################################################################################
Private Const Base64_String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim Shared Base64_Rev64() As UByte
'###############################################################################################################
Private Sub Base64_ReverseCode(V_Code() As UByte, B_Rev() As UByte)
Dim X As UInteger
ReDim B_Rev(255) as UByte
For X = 0 To UBound(V_Code)-1
B_Rev(V_Code(X)) = X
Next
End Sub
'---------------------------------------------------------------------------------------------------------------
Function Base64_Decode(V_Source As String) As String
Dim X as ULong
Dim D as String = V_Source
Dim B64() As Byte
ReDim B64(63) As Byte
For X = 1 to Len(Base64_String)
B64(X-1) = Asc(Mid(Base64_String, X, 1))
Next
Base64_ReverseCode(B64(), Base64_Rev64())
Dim Code() As Byte
ReDim Code(255) As Byte
For X = 0 to 255
Code(X) = Base64_Rev64(X)
Next
Dim XCNT As ULong
Dim XRest As ULong
Dim XL As ULong
Dim w1 As Integer
Dim w2 As Integer
Dim w3 As Integer
Dim w4 As Integer
Dim SourceB() As UByte
Dim Result() As UByte
XL = Len(D)
If XL = 0 Then Exit Function
XRest = XL Mod 4
If XRest > 0 Then
D = D + String$(4 - XRest, 0)
XL = Len(D)
End If
Redim SourceB(XL) as UByte
For X = 1 to XL
SourceB(X-1) = Asc(Mid(D, X, 1))
Next
ReDim Result(XL)
For X = 0 To UBound(sourceB) Step 4
w1 = Code(SourceB(X))
w2 = Code(SourceB(X + 1))
w3 = Code(SourceB(X + 2))
w4 = Code(SourceB(X + 3))
Result(XCNT) = ((w1 * 4 + Int(w2 / 16)) And 255)
XCNT += 1
Result(XCNT) = ((w2 * 16 + Int(w3 / 4)) And 255)
XCNT += 1
Result(XCNT) = ((w3 * 64 + w4) And 255)
XCNT += 1
Next
ReDim Preserve Result(XCNT - 1) as UByte
D = ""
For X = 0 to UBound(Result)
If Result(X) = 0 Then Exit For
D += Chr(Result(X))
Next
Return D
End Function
'##############################################################################################################
Dim Shared G_Server as UInteger
Dim Shared FbCrLf as String: FbCrLf = Chr(13, 10)
Dim Shared G_FileMutex as Any Ptr
Dim Shared G_ConfFileTime as Double
'##############################################################################################################
Dim Shared G_Port as UShort
Dim Shared G_TimeOut as UInteger
Dim Shared G_NoDirList as UByte
Dim Shared G_RobotLock as UByte
Dim Shared G_MimeFileC as UInteger
'##############################################################################################################
Dim Shared G_BaseFileD() as String
Dim Shared G_BaseFileC as UInteger
'##############################################################################################################
Type Host_Type
V_Host as String
V_BasePath as String
V_Username as String
V_Password as String
End Type
Dim Shared G_HostD() as Host_Type
Dim Shared G_HostC as UInteger
'##############################################################################################################
Type Mime_Type
V_FileType as String
V_Command as String
End Type
Dim Shared G_MimeD() as Mime_Type
Dim Shared G_MimeC as UInteger
'##############################################################################################################
Type Client_Type
V_InUse as UByte
V_TSNEID as UInteger
V_IPA as String
V_ConTime as Double
V_Data as String
V_MimePathIn as String
V_MimePathOut as String
End Type
Dim Shared ClientD() as Client_Type
Dim Shared ClientC as UShort
Dim Shared ClientDC as Client_Type
Dim Shared ClientMutex as Any Ptr
'##############################################################################################################
Declare Sub TSNE_Disconnected (ByVal V_TSNEID as UInteger)
Declare Sub TSNE_Connected (ByVal V_TSNEID as UInteger)
Declare Sub TSNE_NewData (ByVal V_TSNEID as UInteger, ByRef V_Data as String)
Declare Sub TSNE_NewConnection (ByVal V_TSNEID as UInteger, ByVal V_RequestID as Socket, ByVal V_IPA as String)
'##############################################################################################################
Declare Function Signal cdecl lib "c" alias "signal" (byval sig as Integer, func as Any Ptr) as Integer
Declare Sub F_SignalRX cdecl()
'##############################################################################################################
Sub DoLog(V_Text As String)
MutexLock(G_FileMutex)
Dim XFN as Integer = FreeFile
Open "log/" & Format(Now(), "yyyy_mm_dd") & ".log" for Append as #XFN
Print #XFN, "[" & Format(Now(), "yyyy.mm.dd-hh:mm:ss") & "] " & V_Text
Close #XFN
MutexUnLock(G_FileMutex)
Print "[" & Format(Now(), "yyyy.mm.dd-hh:mm:ss") & "] " & V_Text
End Sub
'##############################################################################################################
Function HTTP_Get_Code_Desc(V_Code As UInteger) As String
Select Case V_Code
Case 100: Return "Continue"
Case 101: Return "Switching Protocols"
Case 200: Return "OK"
Case 201: Return "Created"
Case 202: Return "Accepted"
Case 203: Return "Non Authoritative Information"
Case 204: Return "No Contend"
Case 205: Return "Reset Contend"
Case 206: Return "Partial Content"
Case 300: Return "Multiple Choise"
Case 301: Return "Moved Permanently"
Case 302: Return "Found"
Case 303: Return "See Other"
Case 304: Return "Not Modified"
Case 305: Return "Use Proxy"
Case 307: Return "Temporary Redirect"
Case 400: Return "Bad Request"
Case 401: Return "Unauthorized"
Case 402: Return "Payment Required"
Case 403: Return "Forbidden"
Case 404: Return "Not Found"
Case 405: Return "Method Not Allowed"
Case 406: Return "Not Acceptable"
Case 407: Return "Proxy Authentcation Required"
Case 408: Return "Request Time-out"
Case 409: Return "Conflict"
Case 410: Return "Gone"
Case 411: Return "Length Required"
Case 412: Return "Precondition Faild"
Case 413: Return "Request Entry Too Large"
Case 414: Return "Request URI Too Large"
Case 415: Return "Unsupportet Media Type"
Case 416: Return "Requested range not satisfiable"
Case 417: Return "Exeption Faild"
Case 490: Return "IP Banned"
Case 491: Return "Hacking Attack Blocked"
Case 500: Return "Internal Server Error"
Case 501: Return "Not Implemented"
Case 502: Return "Bad Gateway"
Case 503: Return "Service Unavailable"
Case 504: Return "Gateway Time-out"
Case 505: Return "HTTP Version not supported"
Case Else: Return "Internal Server Error"
End Select
End Function
'##############################################################################################################
Function MIME_Get_Type_Desc(V_FileType As String) As String
Select Case LCase(V_FileType)
case "html", "htm", "fs", "c4s": return "text/html"
case "txt": return "text/plain"
case "css": return "text/css"
case "tar", "zip", "rar": return "application/" & LCase(v_fileType)
case "gtar": return "application/x-" & LCase(v_fileType)
case "gz": return "application/gzip"
case "doc": return "application/msword"
case "bin", "exe", "com", "dll": return "application/octet-stream"
case "swf": return "application/x-shockwave-flash"
case "mid", "midi": return "audio/x-midi"
case "mp2": return "audio/x-mpeg"
case "mp3", "wav", "ogg": return "audio/x-" & LCase(v_fileType)
case "jpg", "jpeg", "jpe": return "image/jpeg"
case "bmp", "gif", "png": return "image/" & LCase(v_fileType)
case "avi": return "video/x-msvideo"
case "qt", "mov": return "image/quicktime"
case else: Return "*/" & lcase(V_FileType)
end Select
End Function
'##############################################################################################################
Function HTML_HTTPCode_CreatePage(ByRef V_HTTPCode as UInteger) as String
Dim T as String
T = "<!DOCTYPE html PUBLIC ""-//W3C//DTD HTML 4.01 Transistional//EN"">" & FbCrLf
T += "<html>" & FbCrLf
T += " <head>" & FbCrLf
T += " <Title>" & Str(V_HTTPCode) & " - " & HTTP_Get_Code_Desc(V_HTTPCode) & "</Title>" & FbCrLf
T += " </head>" & FbCrLf
T += " <body text=""#000000"" bgcolor=""#FFFFFF"">" & FbCrLf
T += " <h1>" & Str(V_HTTPCode) & "</h1>" & FbCrLf
T += " <hr>" & FbCrLf
T += " <h3>" & HTTP_Get_Code_Desc(V_HTTPCode) & "</h3><hr>" & FbCrLf
T += " <pre>" & FbCrLf & FbCrLf
Select Case V_HTTPCode
Case 300': Return "Multiple Choise"
Case 301
T += " [DE] Diese Datei wurde dauerhaft verschoben." & FbCrLf & FbCrLf
T += " [EN] This file was moved permanently." & FbCrLf
Case 302
T += " [DE] Die Datei wurde gefunden." & FbCrLf & FbCrLf
T += " [EN] The file was found." & FbCrLf
Case 303': Return "See Other"
Case 304
T += " [DE] Diese Datei wurde nicht geändert." & FbCrLf & FbCrLf
T += " [EN] This file was not modified." & FbCrLf
Case 305': Return "Use Proxy"
Case 307
T += " [DE] Diese Datei wurde kurzfristig umgelenkt." & FbCrLf & FbCrLf
T += " [EN] This file was redirected temporary" & FbCrLf
Case 400
T += " [DE] Das Anfrage-Format von Ihrer Anwendung wurde nicht verstanden." & FbCrLf & FbCrLf
T += " [EN] The request format wasn't understood by your application." & FbCrLf
Case 401
T += " [DE] Sie sind nicht Berechtigt diese Datei / dieses Verzeichniss zu betrachten." & FbCrLf & FbCrLf
T += " [EN] You are not allowed to view this file / directory." & FbCrLf
Case 402
T += " [DE] Sie müssen bezahlen, um diese Datei herunterladen zu dürfen." & FbCrLf & FbCrLf
T += " [EN] You need to pay to download this file." & FbCrLf
Case 403
T += " [DE] Der Zugriff auf diese Datei / Verzeichniss ist ihnen nicht gestattet." & FbCrLf & FbCrLf
T += " [EN] The access to this file / folder is not permitted." & FbCrLf
Case 404
T += " [DE] Diese Datei wurde nicht gefunden. Wurde die Anfrage richtig geschrieben?" & FbCrLf
T += " Sollte ein Verzeichniss geoeffnet werden, muss ein '[komm]LycgYW0gZW5kZSBkZXIgVVJMIHN0ZWhlbiEiICZhbXA7IEZiQ3JMZiAmYW1wOyBGYkNyTGYKICAgICAgICBUICs9ICIgJiN4NUI7RU4mI3g1RDsgVGhlIGZpbGUgd2FzIG5vdCBmb3VuZC4gRGlkIHlvdSB0eXBlIGNvcnJlY3RseSB0aGUgcmVxdWVzdD8iICZhbXA7IEZiQ3JMZgogICAgICAgIFQgKz0gIiAgICAgIElmIHlvdSB3YW50IHRvIGFjY2VzcyBhIGRpcmVjdG9yeSB5b3UgbXVzdCB0YWtlIGEgJy8ß[/komm]' at the end of the URL!" & FbCrLf
Case 405
T += " [DE] Die Methode, wie sie diese Seite aufrufen, ist nicht gestattet." & FbCrLf & FbCrLf
T += " [EN] The method you're using to access this page isn't permitted." & FbCrLf
Case 406': Return "Not Acceptable"
Case 407': Return "Proxy Authentcation Required"
Case 408
T += " [DE] Die Anfrage hat ein Zeitlimit ueberschritten." & FbCrLf & FbCrLf
T += " [EN] The request exceeded a timelimit." & FbCrLf
Case 409
T += " [DE] Ein Konflikt ist aufgetreten." & FbCrLf & FbCrLf
T += " [EN] A conflict was raised." & FbCrLf
Case 410': Return "Gone"
Case 411
T += " [DE] Um die Anfrage bearbeiten zu koennen, muss die Laenge der angehaengten Daten mitgesandt werden." & FbCrLf & FbCrLf
T += " [EN] To process your request it's need to send the length of data in the request." & FbCrLf
Case 412': Return "Precondition Faild"
Case 413': Return "Request Entry Too Large"
Case 414
T += " [DE] Die übertragene URL ist zu lang." & FbCrLf & FbCrLf
T += " [EN] The send URL was too UInteger." & FbCrLf
Case 415
T += " [DE] Den von ihnen gewuenschten Media Typ kann dieser Server nicht unterstuetzen." & FbCrLf & FbCrLf
T += " [EN] The media type you wish to access isn't support by this server." & FbCrLf
Case 416': Return "Requested range not satisfiable"
Case 417': Return "Exeption Faild"
Case 490': -!- KEIN OFFIZIELLER RETURN-CODE -!-
T += " [DE] Sie haben einen boeswilligen Angriff auf dieses System durchgefuehrt. Ihre IP-Adresse wurde gespert!" & FbCrLf & FbCrLf
T += " [EN] You did an evil attack on this Server. Your IP-Address has been banned!" & FbCrLf
Case 491': -!- KEIN OFFIZIELLER RETURN-CODE -!-
T += " [DE] Das System hat Sie als potenziellen Hacker identifiziert." & FbCrLf
T += " Ihre IP-Adresse wurde gespeichert und fuer die Zukunft blockiert." & FbCrLf
T += " Sollten Sie erneut versuchen sich auf diesem System Illegal zu betaetien" & FbCrLf
T += " werden automatisch Passive und Aktive Verteidigungsmassnahmen ergriffen!" & FbCrLf & FbCrLf
T += " [EN] The system classified you as a possible hacker!" & FbCrLf
T += " Your IP-Address has been saved and blocked for future." & FbCrLf
T += " In case you try apain to harm the system the system will defend itselfs" & FbCrLf
T += " with passive and active strategies of defence!" & FbCrLf
Case 500
T += " [DE] Ein Interner Server-Fehler ist aufgetreten." & FbCrLf & FbCrLf
T += " [EN] A internal servererror has ocurred." & FbCrLf
Case 501
T += " [DE] Diese Aktion ist im Server nicht vorhanden." & FbCrLf & FbCrLf
T += " [EN] This action is not implemented in this server." & FbCrLf
Case 502
T += " [DE] Der Server konnte keine Verbindung mit einer Datenquelle herstellen." & FbCrLf & FbCrLf
T += " [EN] The server couldn't connect to a source of data." & FbCrLf
Case 503
T += " [DE] Dieser Server ist zur Zeit nicht verfuegbar." & FbCrLf & FbCrLf
T += " [EN] This server is temporary not available." & FbCrLf
Case 504
T += " [DE] Bei der Kommunikation mit der Datenquelle wurde ein Zeitlimit ueberschritten." & FbCrLf & FbCrLf
T += " [EN] By the communication with our source of data occured an timelimit." & FbCrLf
Case 505
T += " [DE] Die von Ihrer Anwendung benutzte Version des Kommunikations-Formats wird von diesem Server nicht unterstuezt." & FbCrLf & FbCrLf
T += " [EN] The communication-format version of your application was not supportet by this server." & FbCrLf
Case Else
T += " [DE] Es ist ein interner Server-Fehler aufgetreten, dessen Ursprung nicht bekannt ist." & FbCrLf & FbCrLf
T += " [EN] An internal server error has occured. The source of this error is unknown." & FbCrLf
End Select
T += " </pre>" & FbCrLf
T += " <hr><h6>ASIX4 - FileServer [HTTP] - (C) 2009 By.: Martin Wiemann - Admin [at] MLN [dot] ath [dot] cx</h6>" & FbCrLf
T += " </body>" & FbCrLf
T += "</html>" & FbCrLf
Return T
End Function
'##############################################################################################################
Function HTML_HTTPCode_ReadFolder(V_Path as String, V_Folder as String) as String
Dim DD() as String
Dim DC as UInteger
Dim FD() as String
Dim FC as UInteger
Dim N as String
Dim XAtr as Integer
MutexLock(G_FileMutex)
N = Dir(V_Path & "*", -1, @XAtr)
Do until N = ""
If N <> "." and N <> ".." Then
If (XAtr and &H10) = &H10 Then
DC += 1: Redim Preserve DD(DC) as String: DD(DC) = N & "/"
Else: FC += 1: Redim Preserve FD(FC) as String: FD(FC) = N
End If
End If
N = Dir("", -1, @XAtr)
Loop
MutexUnLock(G_FileMutex)
Dim T as String
T = "<!DOCTYPE html PUBLIC ""-//W3C//DTD HTML 4.01 Transistional//EN"">" & FbCrLf
T += "<html>" & FbCrLf
T += " <head>" & FbCrLf
T += " <Title>Folder: " & V_Folder & "</Title>" & FbCrLf
T += " </head>" & FbCrLf
T += " <body text=""#000000"" bgcolor=""#FFFFFF"", link=""#0000FF"", vlink=""#0000FF"", alink=""#0000FF"">" & FbCrLf
T += " <pre><h3>Folder: <a href=""" & V_Folder & """>" & V_Folder & "</a></h3>" & FBCRLF
T += " <a href=""../"">[Go one folder back]</a> - <a href=""" & V_Folder & """>[Refresh page]</a>" & FBCRLF & FBCRLF
T += "<hr>" & FBCRLF
T += " Folder(s): " & Str(DC) & " - File(s): " & Str(FC) & FBCRLF & FBCRLF
T += "<hr>" & FBCRLF
If DC > 0 Then
For X as UInteger = 1 to DC
T += " [Folder] <a href=""" & V_Folder & DD(X) & """>" & DD(X) & "</a>" & FBCRLF
Next
If FC > 0 Then T += FBCRLF & "<hr>" & FBCRLF
End If
Dim D as String
Dim XFN as UInteger
Dim Y as UByte
For X as UInteger = 1 to FC
MutexLock(G_FileMutex)
XFN = FreeFile
Open V_Path & FD(X) for binary as XFN
D = Format(Lof(XFN), "###,###,###,##0")
Close #XFN
MutexUnLock(G_FileMutex)
For Y = 1 to Len(D)
If D[Y - 1] = 44 then D[Y - 1] = 46
Next
T += " [" & Space(13 - Len(D)) & D & " Byte's] <a href=""" & V_Folder & FD(X) & """>" & FD(X) & "</a>" & FBCRLF
Next
If (FC = 0) and (DC = 0) Then T += " <b>= Folder is empty! =</b>" & FBCRLF
T += " </pre>" & FbCrLf
T += " <hr><h6>ASIX4 - HTTP FileServer - (C) 2009 By.: Martin Wiemann - Admin [at] MLN [dot] ath [dot] cx</h6>" & FbCrLf
T += " </body>" & FbCrLf
T += "</html>" & FbCrLf
Return T
End Function
'##############################################################################################################
Function HTTP_Create_Answer(V_ReturnCode as UInteger, V_ContentType as String = "", V_ContentLen as UInteger = 0, V_RangeStart as UInteger = 0, V_RangeStop as UInteger = 0, V_Auth as UByte = 0) as String
Dim D as String
Dim T as String
If V_ReturnCode = 200 Then
If V_RangeStart > 0 Then
D += "HTTP/1.1 206 " & HTTP_Get_Code_Desc(206) & FbCrLf
Else: D += "HTTP/1.1 " & Str(V_ReturnCode) & " " & HTTP_Get_Code_Desc(V_ReturnCode) & FbCrLf
End If
Else: D += "HTTP/1.1 " & Str(V_ReturnCode) & " " & HTTP_Get_Code_Desc(V_ReturnCode) & FbCrLf
End If
D += "Server: ASIX4 - FileServer [HTTP]" & FbCrLf
D += "Accept-Ranges: bytes" & FbCrLf
If V_ReturnCode = 200 Then
If V_RangeStart > 0 Then
D += "Content-Length: " & Str(V_RangeStop - V_RangeStart) & FbCrLf
D += "Content-Range: bytes " & Str(V_RangeStart) & "-" & Str(V_RangeStop - 1) & "/" & Str(V_ContentLen) & FbCrLf
Else: D += "Content-Length: " & Str(V_ContentLen) & FbCrLf
End If
D += "Content-Type: " & V_ContentType & FbCrLf
Else
T = HTML_HTTPCode_CreatePage(V_ReturnCode)
D += "Content-Length: " & Str(Len(T)) & FbCrLf
D += "Content-Type: " & MIME_Get_Type_Desc("html") & FbCrLf
End If
If V_Auth = 1 Then D += "WWW-Authenticate: Basic realm=""Authenticate""" & FbCrLf
D += "Connection: Close" & FbCrLf
D += FbCrLf & T
Return D
End Function
'##############################################################################################################
Sub Term()
DoLog "[HTTP] Disconnecting..."
Dim RV as Integer = TSNE_Disconnect(G_Server)
If RV <> TSNE_Const_NoError Then DoLog "[HTTP] [FEHLER] " & TSNE_GetGURUCode(RV)
DoLog "[HTTP] Wait disconnected..."
TSNE_WaitClose(G_Server)
DoLog "[HTTP] Disconnected!"
MutexLock(ClientMutex)
Dim TID as UInteger
For X as UInteger = 1 to ClientC
If ClientD(X).V_InUse = 1 Then
TID = ClientD(X).V_TSNEID
MutexUnLock(ClientMutex)
TSNE_Disconnect(TID)
MutexLock(ClientMutex)
End IF
Next
MutexUnLock(ClientMutex)
MutexDestroy(ClientMutex)
DoLog "[HTTP] Shutdown"
MutexDestroy(G_FileMutex)
End Sub
'##############################################################################################################
Sub F_Signal_RX cdecl
Term()
End 0
end sub
'##############################################################################################################
Sub ConfigReload()
G_HostC = 0
G_MimeC = 0
G_BaseFileC = 0
Dim D as String
Dim T1 as String
Dim T2 as String
Dim T3 as String
Dim T4 as String
Dim T5 as String
Dim O as String
Dim XPos as UInteger
Dim XFN as Integer = FreeFile
Open "config.c4n" for input as #XFN
Do Until Eof(XFN)
Line Input #XFN, D
O = ""
For X as UInteger = 1 to Len(D)
Select Case D[X - 1]
Case 9
Case Else: O += Chr(D[X - 1])
End Select
Next
If (O <> "") and Left(O, 1) <> "'" Then
XPos = InStr(1, O, "=")
If XPos > 0 Then
T1 = LCase(Mid(O, 1, XPos - 1))
T2 = Mid(O, XPos + 1)
Select Case LCase(T1)
Case "host"
XPos = InStr(1, T2, "=")
If XPos = 0 Then DoLog "[HTTP] [config.c4n] Syntaxfehler in: '" & O & "'": Goto HTTP_Main_Conf_NextLine
T3 = Mid(T2, XPos + 1)
T2 = Mid(T2, 1, XPos - 1)
T4 = "": T5 = ""
XPos = InStr(1, T2, "@")
If XPos > 0 Then
T4 = Left(T2, XPos - 1)
T2 = Mid(T2, XPos + 1)
XPos = InStr(1, T4, ":")
If XPos > 0 Then
T5 = Mid(T4, XPos + 1)
T4 = Left(T4, XPos - 1)
End If
End If
If (T2 = "") or (T3 = "") Then DoLog "[HTTP] [config.c4n] Syntaxfehler in: '" & O & "'": Goto HTTP_Main_Conf_NextLine
If Dir(T3 & "/*", -1) = "" Then
DoLog "[HTTP] [config.c4n] Pfad '" & T3 & "' not found for Host '" & T2 & "'!"
Else: DoLog "[HTTP] [config.c4n] Set host: '" & T2 & "' to BasePath: '" & T3 & "'"
End If
G_HostC += 1
Redim Preserve G_HostD(G_HostC) as Host_Type
With G_HostD(G_HostC)
.V_Host = T2
.V_BasePath = T3
.V_Username = LCase(T4)
.V_Password = T5
End With
Case "mime"
XPos = InStr(1, T2, "=")
If XPos = 0 Then DoLog "[HTTP] [config.c4n] Syntaxfehler in: '" & O & "'": Goto HTTP_Main_Conf_NextLine
T3 = Mid(T2, XPos + 1)
T2 = Mid(T2, 1, XPos - 1)
If (T2 = "") or (T3 = "") Then DoLog "[HTTP] [config.c4n] Syntaxfehler in: '" & O & "'": Goto HTTP_Main_Conf_NextLine
G_MimeC += 1
Redim Preserve G_MimeD(G_MimeC) as Mime_Type
With G_MimeD(G_MimeC)
.V_FileType = T2
.V_Command = T3
End With
Case "basefile"
If T2 = "" Then DoLog "[HTTP] [config.c4n] Syntaxfehler in: '" & O & "'": Goto HTTP_Main_Conf_NextLine
G_BaseFileC += 1
Redim Preserve G_BaseFileD(G_BaseFileC) as String
G_BaseFileD(G_BaseFileC) = T2
Case "port"
If T2 = "" Then DoLog "[HTTP] [config.c4n] Syntaxfehler in: '" & O & "'": Goto HTTP_Main_Conf_NextLine
If (ValInt(T2) < 1) or (ValInt(T2) > 65535) Then DoLog "[HTTP] [config.c4n] 'Port'-Wert auserhalb des gueltigen Bereichs! '" & O & "'": End -1
G_Port = CSng(ValUInt(T2))
Case "timeout"
If T2 = "" Then DoLog "[HTTP] [config.c4n] Syntaxfehler in: '" & O & "'": Goto HTTP_Main_Conf_NextLine
If (ValInt(T2) < 1) or (ValInt(T2) > 900) Then DoLog "[HTTP] [config.c4n] 'Port'-Wert auserhalb des gueltigen Bereichs! '" & O & "'": End -1
G_Timeout = ValUInt(T2)
Case Else: DoLog "[HTTP] [config.c4n] Unbekannter Parameter! '" & O & "'"
End Select
Else
Select Case LCase(O)
Case "nodirlist": G_NoDirList = 1
Case "robotlock": G_RobotLock = 1
Case Else: DoLog "[HTTP] [config.c4n] Unbekannter Parameter! '" & O & "'"
End Select
End If
End If
HTTP_Main_Conf_NextLine:
Loop
Close #XFN
If G_HostC = 0 Then DoLog "[HTTP] Keine 'Host' Werte in 'config.c4n' vorhanden!" & Chr(13, 10) & "Es ist ein folgender Eintrag noetig: Host=<Hostname>[:<Port>]=<BasisPfad> ... z.B. Host=localhost=C:\www": End -1
end sub
'##############################################################################################################
Sub Main()
DoLog ""
DoLog String(100, 35)
DoLog "[HTTP] Setup..."
MKDir "mime"
MKDir "log"
MKDir "cache"
G_FileMutex = MutexCreate()
ClientMutex = MutexCreate()
G_ConfFileTime = FileDateTime("config.c4n")
MutexLock(ClientMutex)
ConfigReload()
MutexUnLock(ClientMutex)
Dim RV as Integer
DoLog "[HTTP] Init Socket..."
Do
RV = TSNE_Create_Server(G_Server, G_Port, 10, @TSNE_NewConnection)
If RV = TSNE_Const_NoError Then Exit Do
Sleep 1000, 1
Loop
DoLog "[HTTP] OK!"
DoLog "[HTTP] Registering signals..."
For X as Integer = 1 to 9
Signal(X, @F_Signal_RX)
Next
DoLog "[HTTP] Running!"
Dim TTime as Double
Dim TCFTime as Double = Timer + 10
Do
If TCFTime < Timer Then
TTime = FileDateTime("config.c4n")
If G_ConfFileTime <> TTime Then
DoLog "[HTTP] +++ RELOAD CONFIGURATION +++"
G_ConfFileTime = TTime
MutexLock(ClientMutex)
ConfigReload()
MutexUnLock(ClientMutex)
End If
TCFTime = Timer + 10
End If
MutexLock(ClientMutex)
Dim TID as UInteger
For X as UInteger = 1 to ClientC
If ClientD(X).V_InUse = 1 Then
If ClientD(X).V_ConTime < Timer Then
TID = ClientD(X).V_TSNEID
DoLog "[HTTP] [" & Space(3 - Len(Str(X))) & Str(X) & "][" & Space(15 - Len(ClientD(X).V_IPA)) & ClientD(X).V_IPA & "][408]"
MutexUnLock(ClientMutex)
TSNE_Data_Send(TID, HTTP_Create_Answer(408))
TSNE_Disconnect(TID)
MutexLock(ClientMutex)
End If
End IF
Next
MutexUnLock(ClientMutex)
Sleep 100, 1
Loop until InKey() = Chr(27)
End Sub
'##############################################################################################################
Sub TSNE_Disconnected(ByVal V_TSNEID as UInteger)
MutexLock(ClientMutex)
For X as UInteger = 1 to ClientC
If ClientD(X).V_InUse = 1 Then
If ClientD(X).V_TSNEID = V_TSNEID Then
With ClientD(X)
.V_InUse = 0
.V_Data = ""
If .V_MimePathIn <> "" Then Kill .V_MimePathIn: .V_MimePathIn = ""
If .V_MimePathOut <> "" Then Kill .V_MimePathOut: .V_MimePathOut = ""
End WIth
MutexUnLock(ClientMutex): Exit Sub
End If
End If
Next
MutexUnLock(ClientMutex)
Print "[HTTP] [ERROR] TSNEID Not found in Client-Array"
End Sub
'##############################################################################################################
Sub TSNE_Connected(ByVal V_TSNEID as UInteger)
MutexLock(ClientMutex)
For X as UInteger = 1 to ClientC
If ClientD(X).V_InUse = 1 Then
If ClientD(X).V_TSNEID = V_TSNEID Then
ClientD(X).V_ConTime = Timer() + G_TimeOut
MutexUnLock(ClientMutex): Exit Sub
End If
End If
Next
MutexUnLock(ClientMutex)
Print "[HTTP] [ERROR] TSNEID Not found in Client-Array"
End Sub
'##############################################################################################################
Sub TSNE_NewConnection(ByVal V_TSNEID as UInteger, ByVal V_RequestID as Socket, ByVal V_IPA as String)
Dim TNewTSNEID as UInteger
Dim TReturnIPA as String
Dim CIndex as UInteger
Dim RV as Integer
MutexLock(ClientMutex)
For X as UInteger = 1 to ClientC
If ClientD(X).V_InUse = 0 Then
CIndex = X
Exit For
End If
Next
If CIndex = 0 Then
If ClientC >= 100 Then
DoLog "[HTTP] FULL!!! IPA:" & V_IPA
RV = TSNE_Create_Accept(V_RequestID, TNewTSNEID, TReturnIPA, 0, 0, 0)
If RV <> TSNE_Const_NoError Then DoLog "[HTTP] [FEHLER] " & TSNE_GetGURUCode(RV): MutexUnLock(ClientMutex): Exit Sub
RV = TSNE_Data_Send(TNewTSNEID, HTTP_Create_Answer(503))
If RV <> TSNE_Const_NoError Then DoLog "[HTTP] [FEHLER] " & TSNE_GetGURUCode(RV)
MutexUnLock(ClientMutex)
TSNE_Disconnect(TNewTSNEID)
Exit Sub
End If
ClientC += 1
Redim Preserve ClientD(ClientC) as Client_Type
CIndex = ClientC
End If
RV = TSNE_Create_Accept(V_RequestID, TNewTSNEID, TReturnIPA, @TSNE_Disconnected, @TSNE_Connected, @TSNE_NewData)
If RV <> TSNE_Const_NoError Then DoLog "[HTTP] [FEHLER] " & TSNE_GetGURUCode(RV): MutexUnLock(ClientMutex): Exit Sub
ClientD(CIndex) = ClientDC
With ClientD(CIndex)
.V_InUse = 1
.V_TSNEID = TNewTSNEID
.V_IPA = V_IPA
.V_ConTime = Timer() + G_TimeOut
.V_Data = ""
End With
'Print "[HTTP] New Connect >" & CIndex & "< IPA:" & V_IPA
MutexUnLock(ClientMutex)
End Sub
'##############################################################################################################
Function Replace(ByVal V_Data As String, ByVal V_Expression As String, ByVal V_ReplaceBy As String) As String
Dim D as String = V_Data
Dim SL As UInteger = Len(V_Expression)
Dim X As UInteger = 0
Do
X += 1
If X > Len(D) - SL + 1 Then Exit Do
If Mid(D, X, SL) = V_Expression Then
D = Mid(D, 1, X - 1) & V_ReplaceBy & Mid(D, X + SL)
X -= (SL - 1)
If X < 0 then X = 0
End If
Loop
Return D
End Function
'##############################################################################################################
Sub TSNE_NewData(ByVal V_TSNEID as UInteger, ByRef V_Data as String)
Dim CIndex as UInteger
Dim RV as Long
MutexLock(ClientMutex)
For X as UInteger = 1 to ClientC
If ClientD(X).V_InUse = 1 Then
If ClientD(X).V_TSNEID = V_TSNEID Then CIndex = X: Exit For
End If
Next
If CIndex = 0 Then MutexUnLock(ClientMutex): Print "[HTTP] [ERROR] TSNEID Not found in Client-Array": Exit Sub
Dim TData as String = ClientD(CIndex).V_Data & V_Data
ClientD(CIndex).V_Data = ""
MutexUnLock(ClientMutex)
'Hier können wir jetzt unsere Daten verarbeiten welche in TData stehen
Dim XPos as UInteger = InStr(1, TData, FBCRLF & FBCRLF)
Dim XIPA as String = ClientD(CIndex).V_IPA
If XPos = 0 Then
MutexLock(ClientMutex)
ClientD(CIndex).V_Data = TData & ClientD(CIndex).V_Data
MutexUnLock(ClientMutex)
If Len(TData) > 100000 Then
DoLog "[HTTP] [" & Space(3 - Len(Str(CIndex))) & Str(CIndex) & "][" & Space(15 - Len(XIPA)) & XIPA & "][414]"
TSNE_Data_Send(V_TSNEID, HTTP_Create_Answer(414)): TSNE_Disconnect(V_TSNEID)
End if
Exit Sub
End If
Dim XHeader as String = Mid(TData, 1, XPos + 1)
TData = Mid(TData, XPos + 4)
'Print "Header:>" & XHeader & "<"
XPos = InStr(1, XHeader, FbCrLf)
If XPos = 0 Then
DoLog "[HTTP] [" & Space(3 - Len(Str(CIndex))) & Str(CIndex) & "][" & Space(15 - Len(XIPA)) & XIPA & "][400]"
TSNE_Data_Send(V_TSNEID, HTTP_Create_Answer(400)): TSNE_Disconnect(V_TSNEID): Exit Sub
End If
Dim XRequest as String = Mid(XHeader, 1, XPos - 1)
XHeader = Mid(XHeader, XPos + 2)
Dim DD() as String
Dim DT() as String
Dim DC as UInteger
Dim T as String
Dim D as String
Dim XStart as UInteger
Dim XStop as UInteger
Dim XHost as String
Dim XAuthDo as UByte = 0
Dim XAuthUser as String
Dim XAuthPass as String
For X as UInteger = 1 to Len(XHeader)
XPos = InStr(1, XHeader, FbCrLf)
If XPos <= 0 Then Exit For
D = Left(XHeader, XPos - 1)
XHeader = Mid(XHeader, XPos + 2)
If D <> "" Then
XPos = InStr(1, D, ":")
If XPos > 0 Then
DC += 1
Redim Preserve DD(DC) as String
Redim Preserve DT(DC) as String
DD(DC) = LCase(Trim(Mid(D, 1, XPos - 1)))
DT(DC) = Trim(Mid(D, XPos + 1))
T = DT(DC)
Select Case DD(DC)
Case "host": XHost = T
Case "range"
XPos = InStr(1, T, "=")
If XPos > 0 Then
T = Mid(T, XPos + 1)
XPos = InStr(1, T, "-")
If XPos > 0 Then
XStart = Val(Left(T, XPos - 1))
XStop = Val(Mid(T, XPos + 1))
End If
End If
Case "authorization"
T = Trim(T)
XPos = InStr(1, T, " ")
If XPos > 0 Then
If LCase(Trim(Left(T, XPos - 1))) = "basic" Then
T = Base64_Decode(Mid(T, XPos + 1))
XPos = InStr(1, T, ":")
If XPos > 0 Then
XAuthUser = LCase(Left(T, XPos - 1))
XAuthPass = Mid(T, XPos + 1)
End If
End If
End If
End Select
End If
End If
Next
XPos = InStr(1, XRequest, " ")
If XPos = 0 Then
DoLog "[HTTP] [" & Space(3 - Len(Str(CIndex))) & Str(CIndex) & "][" & Space(15 - Len(XIPA)) & XIPA & "][400]"
TSNE_Data_Send(V_TSNEID, HTTP_Create_Answer(400)): TSNE_Disconnect(V_TSNEID): Exit Sub
End If
Dim XType as String = Mid(XRequest, 1, XPos - 1)
XRequest = Mid(XRequest, XPos + 1)
Select Case UCase(XType)
Case "HEAD", "GET"', "POST", "PUT"
Case Else
DoLog "[HTTP] [" & Space(3 - Len(Str(CIndex))) & Str(CIndex) & "][" & Space(15 - Len(XIPA)) & XIPA & "][501]"
TSNE_Data_Send(V_TSNEID, HTTP_Create_Answer(501)): TSNE_Disconnect(V_TSNEID): Exit Sub
End Select
XPos = InStr(1, XRequest, " ")
If XPos = 0 Then
DoLog "[HTTP] [" & Space(3 - Len(Str(CIndex))) & Str(CIndex) & "][" & Space(15 - Len(XIPA)) & XIPA & "][400]"
TSNE_Data_Send(V_TSNEID, HTTP_Create_Answer(400)): TSNE_Disconnect(V_TSNEID): Exit Sub
End if
Dim XGet as String = Mid(XRequest, 1, XPos - 1)
If XGet = "" Then
DoLog "[HTTP] [" & Space(3 - Len(Str(CIndex))) & Str(CIndex) & "][" & Space(15 - Len(XIPA)) & XIPA & "][400]"
TSNE_Data_Send(V_TSNEID, HTTP_Create_Answer(400)): TSNE_Disconnect(V_TSNEID): Exit Sub
End If
D = ""
For X as UInteger = 1 to Len(XGet)
If Mid(XGet, X, 1) = "%" Then
If X + 2 <= Len(XGet) Then
D += Chr(CUInt("&H" & Mid(XGet, X + 1, 2)))
X += 2
End If
Else: D += Mid(XGet, X, 1)
End If
Next
XGet = D
If Left(XGet, 1) <> "/" Then
DoLog "[HTTP] [" & Space(3 - Len(Str(CIndex))) & Str(CIndex) & "][" & Space(15 - Len(XIPA)) & XIPA & "][400] " & XGet
TSNE_Data_Send(V_TSNEID, HTTP_Create_Answer(400)): TSNE_Disconnect(V_TSNEID): Exit Sub
End If
Dim XGetData as String
XPos = InStr(1, XGet, "?")
If XPos > 0 Then XGetData = Mid(XGet, XPos + 1): XGet = Left(XGet, XPos - 1)
For X as UInteger = 1 to Len(XGet)
Select Case XGet[X - 1]
Case 46 to 57, 65 to 91, 93, 95, 97 to 122, 126
Case Else
DoLog "[HTTP] [" & Space(3 - Len(Str(CIndex))) & Str(CIndex) & "][" & Space(15 - Len(XIPA)) & XIPA & "][400] " & XGet
TSNE_Data_Send(V_TSNEID, HTTP_Create_Answer(400)): TSNE_Disconnect(V_TSNEID): Exit Sub
End Select
Next
If Len(XGet) > 2 Then
For X as UInteger = 1 to Len(XGet) - 2
If (XGet[X - 1] = 47) and (XGet[X] = 46) Then
Select Case XGet[X + 1]
Case 46, 47
DoLog "[HTTP] [" & Space(3 - Len(Str(CIndex))) & Str(CIndex) & "][" & Space(15 - Len(XIPA)) & XIPA & "][400] " & XGet
TSNE_Data_Send(V_TSNEID, HTTP_Create_Answer(400)): TSNE_Disconnect(V_TSNEID): Exit Sub
End Select
End If
Next
End if
Dim TBasePath as String = ""
Dim XAuthOK as UByte
MutexLock(G_FileMutex)
For X as UInteger = 1 to G_HostC
If (G_HostD(X).V_Host = XHost) or (G_HostD(X).V_Host = "*") Then
If G_HostD(X).V_Username <> "" Then
XAuthDo = 1
If (XAuthUser = G_HostD(X).V_Username) and (XAuthPass = G_HostD(X).V_Password) Then
XAuthOK = 1
TBasePath = G_HostD(X).V_BasePath
End If
Else: TBasePath = G_HostD(X).V_BasePath
End If
Exit For
End If
Next
MutexUnLock(G_FileMutex)
If XAuthDo = 1 Then
If XAuthOK = 0 Then
' If XAuthUser <> "" Then
' DoLog "[HTTP] [" & Space(3 - Len(Str(CIndex))) & Str(CIndex) & "][" & Space(15 - Len(XIPA)) & XIPA & "][403] [" & XHost & "] " & XAuthUser & " " & XGet
' TSNE_Data_Send(V_TSNEID, HTTP_Create_Answer(403, , , , , 1)): TSNE_Disconnect(V_TSNEID): Exit Sub
' Else
DoLog "[HTTP] [" & Space(3 - Len(Str(CIndex))) & Str(CIndex) & "][" & Space(15 - Len(XIPA)) & XIPA & "][401] [" & XHost & "] " & XGet
TSNE_Data_Send(V_TSNEID, HTTP_Create_Answer(401, , , , , 1)): TSNE_Disconnect(V_TSNEID): Exit Sub
' End If
Else: XAuthUser = " [" & XAuthUser & "] "
End If
End If
If TBasePath = "" Then
DoLog "[HTTP] [" & Space(3 - Len(Str(CIndex))) & Str(CIndex) & "][" & Space(15 - Len(XIPA)) & XIPA & "][502] [" & XHost & "] " & XAuthUser & " " & XGet
TSNE_Data_Send(V_TSNEID, HTTP_Create_Answer(502)): TSNE_Disconnect(V_TSNEID): Exit Sub
End If
Dim TGet as String = XGet
For X as UInteger = 1 to Len(TGet)
If TGet[X - 1] = 47 Then TGet[X - 1] = HTTP_PathSeperation
Next
If Right(XGet, 1) = "/" Then
If Dir(TBasePath & TGet & "*", -1) <> "" Then
MutexLock(ClientMutex)
For X as UInteger = 1 to G_BaseFileC
If Dir(TBasePath & TGet & G_BaseFileD(X), -1) <> "" Then TGet += G_BaseFileD(X): MutexUnLock(ClientMutex): Goto HTTP_Request_OK
Next
MutexUnLock(ClientMutex)
If G_NoDirList = 1 Then
DoLog "[HTTP] [" & Space(3 - Len(Str(CIndex))) & Str(CIndex) & "][" & Space(15 - Len(XIPA)) & XIPA & "][404] [" & XHost & "] " & XAuthUser & " " & XGet
TSNE_Data_Send(V_TSNEID, HTTP_Create_Answer(403)): TSNE_Disconnect(V_TSNEID): Exit Sub
End If
Else
DoLog "[HTTP] [" & Space(3 - Len(Str(CIndex))) & Str(CIndex) & "][" & Space(15 - Len(XIPA)) & XIPA & "][404] [" & XHost & "] " & XAuthUser & " " & XGet
TSNE_Data_Send(V_TSNEID, HTTP_Create_Answer(404)): TSNE_Disconnect(V_TSNEID): Exit Sub
End If
Else
If LCase(xget) = "/robots.txt" Then
MutexLock(ClientMutex)
If G_RobotLock = 1 Then
MutexUnLock(ClientMutex)
DoLog "[HTTP] [" & Space(3 - Len(Str(CIndex))) & Str(CIndex) & "][" & Space(15 - Len(XIPA)) & XIPA & "][490] [" & XHost & "] " & XAuthUser & " " & XGet
TSNE_Data_Send(V_TSNEID, HTTP_Create_Answer(490))
'BlockList
TSNE_Disconnect(V_TSNEID)
Exit Sub
Else: MutexUnLock(ClientMutex)
End If
End If
Dim XAtr as Integer
If Dir(TBasePath & TGet, -1, @XAtr) = "" Then
DoLog "[HTTP] [" & Space(3 - Len(Str(CIndex))) & Str(CIndex) & "][" & Space(15 - Len(XIPA)) & XIPA & "][404] [" & XHost & "] " & XAuthUser & " " & XGet
TSNE_Data_Send(V_TSNEID, HTTP_Create_Answer(404)): TSNE_Disconnect(V_TSNEID): Exit Sub
Else
If (XAtr and &H10) = &H10 Then
DoLog "[HTTP] [" & Space(3 - Len(Str(CIndex))) & Str(CIndex) & "][" & Space(15 - Len(XIPA)) & XIPA & "][404] [" & XHost & "] " & XAuthUser & " " & XGet
TSNE_Data_Send(V_TSNEID, HTTP_Create_Answer(404)): TSNE_Disconnect(V_TSNEID): Exit Sub
End If
End If
End If
HTTP_Request_OK:
DoLog "[HTTP] [" & Space(3 - Len(Str(CIndex))) & Str(CIndex) & "][" & Space(15 - Len(XIPA)) & XIPA & "] [" & XHost & "] " & XAuthUser & " " & XGet
Sleep 1, 1
Dim XTot as Double
TData = ""
XPos = InStrRev(TGet, ".")
Dim XFileType as String = ""
Dim XHTimeOut as UInteger = G_TimeOut / 2
Dim TTO as Double
If XPos > 0 Then XFileType = LCase(Mid(TGet, XPos + 1))
Select Case UCase(XType)
Case "HEAD"
T = HTML_HTTPCode_ReadFolder(TBasePath & TGet, XGet)
TData = HTTP_Create_Answer(200, MIME_Get_Type_Desc("html"), Len(T))
RV = TSNE_Data_Send(V_TSNEID, TData)
If RV <> TSNE_Const_NoError Then Exit Select
Case "GET"
If Right(TGet, 1) = Chr(HTTP_PathSeperation) Then
T = HTML_HTTPCode_ReadFolder(TBasePath & TGet, XGet)
TData = HTTP_Create_Answer(200, MIME_Get_Type_Desc("html"), Len(T))
RV = TSNE_Data_Send(V_TSNEID, TData)
If RV <> TSNE_Const_NoError Then Exit Select
For X as UInteger = 1 to Len(T) Step 6000
RV = TSNE_Data_Send(V_TSNEID, Mid(T, X, 6000))
If RV <> TSNE_Const_NoError Then Exit For
If XTot < Timer Then Sleep 1, 1: XTot = Timer + 0.001
If TTO < Timer() Then
MutexLock(ClientMutex)
ClientD(CIndex).V_ConTime = Timer() + G_TimeOut
MutexUnLock(ClientMutex)
TTO = Timer() + XHTimeOut
End If
Next
Else
Dim XFN as Integer
Dim XCInFile as String
Dim XCOutFile as String
Dim XFC as UByte
MutexLock(ClientMutex)
For X as UInteger = 1 to G_MimeC
If G_MimeD(X).V_FileType = XFileType Then
XFC = 1
Dim XCMD as String = G_MimeD(X).V_Command
MutexUnLock(ClientMutex)
If XCMD = "" Then TSNE_Data_Send(V_TSNEID, HTTP_Create_Answer(500)): TSNE_Disconnect(V_TSNEID): Exit Sub
MutexLock(G_FileMutex)
Do
G_MimeFileC += 1
XCOutFile = "cache" & Chr(HTTP_PathSeperation) & Str(G_MimeFileC)
If Dir(XCOutFile & "_out.dat") = "" Then Exit Do
Loop
MutexUnLock(G_FileMutex)
XCMD = Replace(XCMD, "$type", XType)
XCMD = Replace(XCMD, "$request", XGet)
XCMD = Replace(XCMD, "$ipa", XIPA)
XCMD = Replace(XCMD, "$port", Str(G_Port))
XCMD = Replace(XCMD, "$outpath", Exepath & Chr(HTTP_PathSeperation) & XCOutFile & "_out.dat")
XCMD = Replace(XCMD, "$inpath", TBasePath & TGet)
XCMD = Replace(XCMD, "$rootpath", TBasePath)
XCMD = Replace(XCMD, "$headerpath", Exepath & Chr(HTTP_PathSeperation) & XCOutFile & "_outh.dat")
MutexLock(G_FileMutex)
Dim XPFID as Integer = FreeFile
Open Pipe XCMD For Input as #XPFID
MutexUnLock(G_FileMutex)
Do until eof(XPFID)
Line input #XPFID, T
Loop
Close #XPFID
MutexLock(ClientMutex)
ClientD(CIndex).V_MimePathOut = XCOutFile
MutexUnLock(ClientMutex)
MutexLock(G_FileMutex)
XFN = FreeFile
Open Exepath & Chr(HTTP_PathSeperation) & XCOutFile & "_out.dat" For Binary as #XFN
MutexUnLock(G_FileMutex)
Goto HTTP_FileResume
End If
Next
If XFC = 0 Then MutexUnLock(ClientMutex)
MutexLock(G_FileMutex)
XFN = FreeFile
Open TBasePath & TGet For Binary as #XFN
MutexUnLock(G_FileMutex)
HTTP_FileResume:
Dim MX as UInteger = Lof(XFN)
If XStop > MX Then XStop = MX
If ((XStart > XStop) and (XStop > 0)) Then XStart = XStop
If XStart > 0 Then
If XStop = 0 Then XStop = MX
TData = HTTP_Create_Answer(200, MIME_Get_Type_Desc(XFileType), MX, XStart, XStop)
Else: TData = HTTP_Create_Answer(200, MIME_Get_Type_Desc(XFileType), MX)
End if
RV = TSNE_Data_Send(V_TSNEID, TData)
Dim XStep as UInteger = 6000
If RV = TSNE_Const_NoError Then
If XStop = 0 Then XStop = MX
For X as UInteger = XStart + 1 to XStop Step XStep
T = Space(XStep)
If X + XStep > MX Then T = Space(MX - X + 1)
Get #XFN, X, T
RV = TSNE_Data_Send(V_TSNEID, T)
If RV <> TSNE_Const_NoError Then Exit For
If XTot < Timer Then Sleep 1, 1: XTot = Timer + 0.001
If TTO < Timer() Then
MutexLock(ClientMutex)
ClientD(CIndex).V_ConTime = Timer() + G_TimeOut
MutexUnLock(ClientMutex)
TTO = Timer() + XHTimeOut
End If
Next
End If
Close #XFN
MutexLock(ClientMutex)
If XCOutFile <> "" Then Kill Exepath & Chr(HTTP_PathSeperation) & XCOutFile & "_out.dat"
If XCOutFile <> "" Then Kill Exepath & Chr(HTTP_PathSeperation) & XCOutFile & "_outh.dat"
MutexUnLock(ClientMutex)
End If
Case "POST"
Case "PUT"
End Select
TSNE_Disconnect(V_TSNEID)
End Sub
'##############################################################################################################
Main()
Term()
End 0