Type open
 Field dir$
End Type

pw$ = "Passwort"

Global filestring$ = "[tabs]<img src=img/[img]><a href="+chr$(34)+"[url]"+chr$(34)+">[name]</a><br>"
Global lblpos$
svr = CreateTCPServer(80)
Repeat
   Stream = AcceptTCPStream(svr)
   If Stream
  Repeat
   z$ = ReadLine(Stream)
         If Left(Upper(z$),4)="GET "
        z$ = Replace(z$,"+","%20")
            Pos = Instr(z$, " ", 5)
            req$ = urlencode(Mid$(z$, 6, pos-6))
            sc = 0
            If Left(req$,5) = "?cmd=" Then req=mid$(req,6)
            If Left(req$,6) = "?auth=" Then req="auth/"+mid$(req,7)
         End If
  Until z$ = ""
   If req = "" 
      sendtcpheader(stream)
      WriteLine stream, "<a href=clall>close all</a> | <a href=clsvr>close server</a> | <a href=opall>open all</a> <br>"
      If auth=tcpstreamip(stream)
         WriteLine stream, "Send Command: <form method=GET><input type=text name=cmd><input type=submit value=send></form>"
      Else
         WriteLine stream, "Auth: <form method=GET><input type=password name=auth><input type=submit value=send></form>"
      End If
      
      WriteLine stream, "<hr>"

      If auth=tcpstreamip(stream)
         For byte = 66 To 90
            If FileType(chr$(byte)+":\")
               Select diropen(chr$(byte)+":")
                  Case 0
                     WriteLine Stream, "<img src=/img/drive.gif>"
                     WriteLine Stream, "<a href="+chr$(34)+"open/"+chr$(byte)+":"+chr$(34)+">" + chr$(byte)+":" + "</a><br>"
                  Case 1
                     WriteLine Stream, "<img src=/img/drive.gif>"
                     WriteLine Stream, "<a href="+chr$(34)+"close/"+chr$(byte)+":"+chr$(34)+">" + chr$(byte)+":" + "</a><br>"
                     Writedir(Stream,chr$(byte)+":" , tabs+1, "<br>")
               End select
            End if
         Next
      Else
         WriteLine Stream, "Pleas Auth!"
      End if

   ElseIf Left(req,5) = "open/"
      opendir Mid$(req$,6)
      Sendtcploc(stream,"#lbl")
      lblpos$ = Mid$(req$,6)
      WriteLine stream, ""

   ElseIf Left(req,6) = "close/"
      close Mid$(req$,7)
      Sendtcploc(stream,"#lbl")
      lblpos$ = Mid$(req$,7)
      WriteLine stream, ""

  ElseIf Left(req,4) = "img/"
      sendtcpheader(stream, "image\gif")
      sendfile(stream, req)

   ElseIf Left(req,4) = "get/"
      WriteLine stream, "HTTP/1.0 200 OK"
      name$ = req
      Repeat
         name$ = Mid$(name$,Instr(name$,"\")+1)
      Until Not Instr(name$,"\")
      WriteLine stream, "Content-Disposition: attachment; filename="+chr$(34)+name$+chr$(34)
      WriteLine stream, "Content-Length: " + FileSize(mid$(req,5))
      WriteLine stream, ""
      sendfile(stream, Mid$(req,5))

   ElseIf req = "opall"
      For byte = 66 To 90
         If FileType(chr$(byte)+":\")
            opentree(chr$(byte) + ":")
         End if
      Next
      Sendtcploc(stream)
      
   ElseIf req = "clall"
      Delete Each open
      Sendtcploc(stream)            
   ElseIf req = "clsvr"
      Sendtcpheader(stream)
      WriteLine stream, "OK... bye"
      CloseTCPStream(stream)
      end

   ElseIf Left(req,7) = "notify/"
      Notify Mid$(req,8)
      sendtcploc(stream)
      
   ElseIf Left(req,5) = "exec/"
      ExecFile(Mid$(req,6))
      sendtcploc(stream)

   ElseIf Left(req,5) = "auth/"
      Sendtcploc(stream)
      userpw$ = Mid$(req,6)
      If pw$ = userpw$ Then auth = TCPStreamIP(stream)

   Else
      WriteLine stream, "Unknown Request: " + req

   End if
   CloseTCPStream Stream
   End If
Until KeyHit(1)


Function tree(dir$, file$)
 Fileout = WriteFile(file$)
  Writedir fileout, dir$
 CloseFile fileout
End Function

Function writedir(Fileout, dir$, tabs=0, break$="")
 d = ReadDir(dir$)
 Repeat
  file$ = NextFile(d)
  If Not (file$ = "." Or file$ = ".." Or file$ = "")
   If lblpos$ = dir$+"\"+file$ Then WriteLine fileout, "<a NAME=lbl>"
         Select FileType(dir$+"\"+file$)
          Case 1:
     imgurl$ = "dat.gif"
     url$ = "get/"+dir$+"\"+file$
          Case 2:
             Select diropen(dir$+"\"+file$)
            Case 0
       imgurl$ = "folder.gif"
       url$ = "open/"+dir$+"\"+file$
                Case 1
           imgurl$ = "opnfolder.gif"
       url$ = "close/"+dir$+"\"+file$
     End select
         End select
   ret$ = filestring$
   ret$ = Replace(ret$,"[tabs]",String("&nbsp;",tabs*4))
   ret$ = Replace(ret$,"[img]",imgurl$)
   ret$ = Replace(ret$,"[url]",url$)
   ret$ = Replace(ret$,"[name]",file$)   
   If FileType(dir$+"\"+file$) WriteLine fileout, ret$
   If diropen(dir$+"\"+file$) writedir(fileout, dir$+"\"+file$, tabs+1)
         If FileType(dir$+"\"+file) = 2 And diropen(dir$+file$) Then Writedir(fileout, dir$+"\"+file$, tabs+1, break$)
  EndIf
 Until file$ = ""
 CloseDir d
End Function

Function Sendtcpheader(stream, Typ$ = "Text/html", extra$="")
   WriteLine stream, "HTTP/1.1 200 OK" 
   WriteLine stream, "Cache-Control: private" 
   WriteLine stream, "Content-Type: " + typ$
   WriteLine Stream, "Server: Filesrv"
 If extra$ <> "" writeline Stream, extra$
   WriteLine stream, "" 
End Function

Function Sendtcploc(stream,extra$="")
   WriteLine stream, "HTTP/1.0 302 Moved Temporarily"
   WriteLine stream, "Location: .."+extra$
   WriteLine stream, "" 
End Function

Function diropen(dir$)
 For open.open = Each open
  If Lower(open\dir$) = Lower(dir$) Return 1
 Next
 Return 0
End Function

Function opendir(dir$)
 If dir$ = CurrentDir$() Then
 else
  open.open = New open
  open\dir$ = dir$
 End if
End function

Function close(dir$)
 For open.open = Each open
  If open\dir$ = dir$ Then Delete open.open
 next
End function

Function Sendfile(Stream, file$)
 file$ = Replace(file$,"/","\")
   Filein = ReadFile(file$)
   If Not filein WriteLine stream, "404":writeline stream, CurrentDir() +"\" + file$ + " Not found": return

   size = FileSize(file$)
   bank = CreateBank(size)
 ReadBytes(bank,filein,0,size)
 WriteBytes(bank,stream,0,size)

 CloseFile filein
End Function

Function urlencode$(s$)
 For x = 1 To Len(s$)
  b$ = Mid$(s$,x,1)
  If b$ = "%"
   ret$ = ret$ + Chr$(hzd(mid$(s$,x+1,2)))
   x = x + 2
  Else
   ret$ = ret$ + b$
  End if
 Next
 Return ret$
End Function

Function hzd(h$)
 For q=1 To Len(h)
  zwischenwert=Asc(Upper(Mid(h,q,1)))-48
  If zwischenwert>9 zwischenwert=zwischenwert-7
  wert=wert*16+zwischenwert
 Next

 Return wert
End Function

Function opentree(dir$)
 opendir(dir$)
 d = ReadDir(dir$)
 Repeat
  file$ = NextFile(d)
  If Not (file$ = "." Or file$ = ".." Or file$ = "")
   If FileType(dir$+"\"+file$) = 2 Then opentree(dir$+"\"+file$)
  End if
 Until file$ = ""
 CloseDir d
End function