SeedRnd(MilliSecs())

;Eine Datei die per HTTP (POST) hochgeladen wird
Type HttpPostFile
   Field name$
   Field filename$
   Field contentType$
   Field size
End Type

;Ein Feld das per HTTP (POST) übermittelt wird
Type HttpPostField
   Field name$
   Field value$
   Field contentType$
End Type

;Wird von HttpPostSplit verwendet um die einzelnen Zeilen zwischen zu speichern
Type HttpPostLine
   Field l$
End Type

;Fügt eine Datei zum Hochladen hinzu
Function AddHttpPostFile(name$, filename$, contentType$ = "application/octet-stream")
   If FileType(filename) = 1 Then
      Local f.HttpPostFile = New HttpPostFile
      f\name = name
      f\filename = filename
      f\contentType = contentType
      f\size = FileSize(filename)
   EndIf
End Function

;Fügt ein Feld zum Übermitteln hinzu
Function AddHttpPostField(name$, value$, contentType$ = "text/plain")
   Local f.HttpPostField = New HttpPostField
   f\name = name
   f\value = value
   f\contentType = contentType
End Function


;Generiert ein zufälliges Boundary das als Trennzeichen für Inhalte
;mit Content-Type multipart/form-Data verwendet wird
Function GenerateMultipartBoundary$()
   Local chars$ = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
   Local boundary$ = ""
   For i = 1 To 10
      Local index = Rand(1, Len(chars))
      boundary = boundary + Mid(chars, index, 1)
   Next
   Return "----------------" + boundary
End Function


;Generiert den gesamten Inhalt für den HTTP-Upload (POST), jedoch noch ohne Dateiinhalte
;Stattdessen werden Platzhalter eingefügt
Function GenerateMultipartTemplate$(boundary$)
   Local br$ = Chr(13) + Chr(10)
   Local template$ = ""
   
   For file.HttpPostFile = Each HttpPostFile
      template = template + "--" + boundary + br
      template = template + "Content-Disposition: form-data; name=" + Chr(34) + file\name + Chr(34) + "; filename=" + Chr(34) + HttpPostFileName(file\filename) + Chr(34) + br
      template = template + "Content-Type: " + file\contentType + br
      template = template + br
      template = template + "--[FILE " + file\name + "]--" + br
   Next
   
   For feld.HttpPostField = Each HttpPostField
      template = template + "--" + boundary + br
      template = template + "Content-Disposition: form-data; name=" + Chr(34) + feld\name + Chr(34) + br
      template = template + "Content-Type: " + feld\contentType + br
      template = template + br
      template = template + feld\value + br
   Next
   
   template = template + "--" + boundary + "--" + br
   
   Return template
End Function


;Führt den HTTP-Upload (POST) durch
;Vorher müssen Dateien oder Felder hinzugefügt werden
;(Siehe AddHttpPostFile und AddHttpPostField)
Function HttpPost(host$, path$, port, expect = True)
   ;Es gibt nichts zum Hochladen, false zurückgeben
   If First HttpPostFile = Null And First HttpPostField = Null Then Return False

   ;Inhalt generieren (mit Platzhalter für Dateien)
   Local boundary$ = GenerateMultipartBoundary()
   Local template$ = GenerateMultipartTemplate(boundary)
   
   ;ContentLength berechnen
   Local contentLength = Len(template)
   For file.HttpPostFile = Each HttpPostFile
      ;Platzhalterlänge von der contentLength abziehen und Dateigrösse hinzu addieren
      contentLength = contentLength + file\size
      contentLength = contentLength - Len("--[FILE " + file\name + "]--")
   Next
   
   ;Verbindung herstellen
   Local stream = OpenTCPStream(host, port)
   If stream = 0 Then Return False
   
   ;HTTP-Header schreiben
   WriteLine(stream, "POST " + path + " HTTP/1.1")
   WriteLine(stream, "Host: " + host + ":" + port)
   WriteLine(stream, "Content-Type: multipart/form-data; boundary=" + boundary)
   WriteLine(stream, "Content-Length: " + contentLength)
   WriteLine(stream, "Connection: close")
   If expect Then
      WriteLine(stream, "Expect: 100-continue")
   EndIf
   WriteLine(stream, "")
   
   If expect Then
      ;Prüfen ob der Server den Upload annehmen möchte (Meldung 100 Continue)
      Local response$ = ReadLine(stream)
      ReadLine(stream)
      If Upper(Left(response, 12)) <> "HTTP/1.1 100" Then
         ;Wenn die Antwort nicht 100 Continue ist, möchte der Server den Upload nicht

         CloseTCPStream(stream)
         Return False
      EndIf
   EndIf

   
   ;Multipart-Inhalt Zeile für Zeile schreiben
   HttpPostSplit(template)
   file.HttpPostFile = First HttpPostFile
   For l.HttpPostLine = Each HttpPostLine
      If file <> Null Then
         Local placeholder$ = "--[FILE " + file\name + "]--"
         If Left(l\l, Len(placeholder)) = placeholder Then
            ;Es wurde ein Datei-Platzhalter gefunden (statt dem Platzhalter wird nun der Dateiinhalt geschrieben)
            Local fstream = ReadFile(file\filename)
            Local bank = CreateBank(8192)
            Local totalRead = 0
            While totalRead < file\size
               Local r = ReadBytes(bank, fstream, 0, 8192)
               If r <= 0 Then Exit
               WriteBytes(bank, stream, 0, r)
               totalRead = totalRead + r
            Wend
            CloseFile(fstream)
            FreeBank(bank)

            ;Nach der Datei noch einen Zeilenumbruch einfügen (damit das nächste Boundary auf einer neuen Zeile beginnt)
            WriteLine(stream, "")
         
            ;Auf Platzhalter für die nächste Datei prüfen
            file = After file
         Else
            ;Ansonsten nur die Zeile schreiben
            WriteLine(stream, l\l)
         EndIf
      Else
         ;Ansonsten nur die Zeile schreiben
         WriteLine(stream, l\l)
      EndIf
   Next
   

   
   ;Antwort auslesen
   Local upload_ok = False
   response$ = ReadLine(stream)
   If Upper(Left(response, 12)) = "HTTP/1.1 200" Then upload_ok = True
   
   ;Response-Header lesen
   contentLength = 0
   While (Not Eof(stream)) And (response <> "")
      response = ReadLine(stream)
   Wend
   
   ;Wenn die Antwort einen Inhalt enthält, diesen überlesen
   bank = CreateBank(8192)
   While Not Eof(stream)
      r = ReadBytes(bank, stream, 0, 8192)
      If r <= 0 Then Exit
   Wend
   FreeBank(bank)

   ;Die Type-Instanzen werden nicht mehr verwendet (löschen)
   Delete Each HttpPostLine
   Delete Each HttpPostFile
   Delete Each HttpPostField


   CloseTCPStream(stream)

   Return upload_ok
End Function


;Hilfsfunktion zum Splitten des Templates in einzelne Zeilen
Function HttpPostSplit(template$)
   Local br$ = Chr(13) + Chr(10)
   Local pos = Instr(template$, br)

   While pos > 0
      l.HttpPostLine = New HttpPostLine
      l\l = Mid(template, 1, pos - 1)
      template = Mid(template, pos + 2)
      pos = Instr(template, br)
   Wend
   
   l.HttpPostLine = New HttpPostLine
   l\l = template
End Function


;Gibt von einem Datei-Pfad nur den letzten Teil zurück (Dateiname)
Function HttpPostFileName$(path$)
   path = Replace(path, "/", "\")
   Local pos = Instr(path, "\")
   Local lastpos = 1
   While pos > 0
      lastpos = pos
      pos = Instr(path, "\", lastpos + 1)
   Wend
   
   If Mid(path, lastpos, 1) = "\" Then
      Return Mid(path, lastpos + 1)
   Else
      Return Mid(path, lastpos)
   EndIf
End Function

Include "HttpPost.bb"


AddHttpPostFile("file", "documents/Offerte.doc", "application/msword")
AddHttpPostField("pfad", "uploads")

If HttpPost("test.zehr.de", "/test.php", 80) Then
   Print "Der Upload war erfolgreich."
Else
   Print "Die Datei konnte nicht hochgeladen werden."
EndIf

WaitKey
End

<?php

if ($_FILES['file']) {
   $tempname = $_FILES['file']['tmp_name'];
   $name = $_FILES['file']['name'];

   @move_uploaded_file($tempname, $_POST['pfad'] . "/$name");
}

?>