4KWebServer
An HTTP Web Server in less than 4Ko !
| You can run it to host a web server, but don't try to have tons of multiple connexions, it fits only in 4k ! Your website shouldn't have too many pics. Just modify the constant at the beginning of the script to tell where are your local webpages. Have fun ! |
File Name : 4KWebServer.vbs
Requirement : Winsock 2 (MSWinsck.ocx >v 6.xxx) with a valid licence (i.e. Visual Studio installed)
Author : Jean-Luc Antoine
Submitted : 17/08/2001
Updated : 19/03/2002
Category : 4K
Preview : Click here !
Option Explicit
'Virtual directory, must have index.htm to start
Const RootDir="E:\quake3\Extras\Help"
K False
Dim Z,oSck,fso
Set oSck=I()
Set fso=createobject("Scripting.FileSystemObject")
Z=M(Wscript.ScriptFullName)
L "PixyWebServer (c) JL, running on " & oSck.LocalHostName & " (" & oSck.LocalIP & ")"
oSck.LocalPort=80
oSck.Listen
L "Listening on port " & oSck.LocalPort
Do
wscript.sleep 999
If M(Wscript.ScriptFullName)<>Z Then
L "New server version detected"
K True
End If
Loop
Function G(ByRef C)
Dim x,k
C=Trim(C)
x=instr(C," ")
k=instr(C,chr(13))
If k<x Then x=k
k=instr(C,chr(10))
If k<x Then x=k
If x>1 Then
G=Left(C,x-1)
C=Mid(C,x+1)
Else
G=C
C=""
End If
End Function
Function I()
On Error Resume Next
Err.Number=0
Set I=WScript.CreateObject("MSWinsock.Winsock","s_")
Select Case Err.Number
Case 0
case &H80040112
L "No licence found. Install Visual Studio"
case &H80020009
L "ActiveX Winsock not in the registry, check if installed or use regsvr32"
Case else
L "Error " & Err.Number & " - &H" & Hex(Err.Number) & " - " & Err.Description
End Select
End Function
Function J(D)
J=Array("","Sun","Mon","Tue","Wed","Thu","Fri","Sat")(WeekDay(D)) & ", " & Day(D) & " " & Array("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")(Month(D)-1) & " " & Year(D) & " " & FormatDateTime(D,3) & " GMT"
End Function
Sub K(b)
Dim S
If (right(Ucase(WScript.FullName),11)="WSCRIPT.EXE") Or b Then
Set S=CreateObject("WScript.Shell")
S.Run S.ExpandEnvironmentStrings("%COMSPEC%") & " /C cscript.exe """ & WScript.ScriptFullName & """",1,False
Set S=Nothing
WScript.Quit
End If
End Sub
Sub L(S)
WScript.Echo Now & " " & S
End Sub
Function M(f)
M=fso.Getfile(f).DateLastModified
End Function
Sub s_ConnectionRequest(Byval requestID)
oSck.Close
L oSck.RemoteHostIP & " - Connection request n°" & requestID
oSck.Accept requestID
End Sub
Sub s_Close
oSck.Close
L "closed - re-listening"
oSck.Listen
End Sub
Sub s_SendComplete
oSck.close
oSck.Listen
End Sub
Sub s_Error(ByVal N, D, ByVal C, ByVal S, ByVal F, ByVal H, Y)
L "Error" & N & " - " & D
oSck.Close
oSck.Listen
End Sub
Sub s_DataArrival(Byval b)
Dim S,F
S=""
oSck.GetData S
F=G(S)
Select Case Ucase(F)
Case "GET"
H G(S),G(S),S
Case Else
L "can't handle : " & S
End Select
End Sub
Sub H(URI,Proto,Reste)
Dim s,a,x,k,d,f
URI=unescape(URI)
x=Instr(URI,"?")
If x>0 Then URI=Left(URI,x-1)
Uri=Replace(Uri,"/","\")
x=Instr(URI,"\..")
While x>0
k=InstrRev(Left(Uri,x-1),"\")
if k>0 Then
Uri=Left(Uri,k-1) & Mid(Uri,x+3)
Else
Uri=Mid(Uri,x+3)
End If
x=Instr(URI,"\..")
Wend
d="Date: " & J(Now) & vbCrLf & "Server: PixyWebServer/0.02" & vbCrLf & "Connection: close" & vbCrLf
If Right(Uri,1)="\" Then Uri=Uri & "index.htm"
a=fso.BuildPath(RootDir,URI)
If fso.FileExists(a) Then
s="HTTP/1.0 200 OK" & vbCrLf & d
Select Case UCase(right(a,4))
Case ".JPG","JPEG"
s=s & "Content-Type: image/jpeg"
Case ".GIF"
s=s & "Content-Type: image/gif"
Case Else
s=s & "Content-Type: text/html"
End Select
Set f=fso.OpenTextFile(a,1)
x=fso.GetFile(a).size
s=s & vbCrLf & "Last-Modified: " & J(Now) & vbCrLf & "Content-Length: " & x & vbCrLf & vbCrLf & f.Read(x) & vbCrLf & vbCrLf
f.close
Set f=Nothing
L "Page " & a & " (" & Proto & ") sent"
Else
If UCase(URI)="\DEFAULT.IDA" Then
s="HTTP/1.0 200 OK" & vbCrLf & d & "Content-Type: text/html" & vbCrLf & vbCrLf & "<HTML>CodeRed</HTML>"
L oSck.RemoteHostIP & " - CodeRed"
Else
s="HTTP/1.0 404 Not Found" & vbCrLf & d & "Content-Type: text/html" & vbCrLf & vbCrLF & "<HTML><BODY>PixyWebSerevr (c) JLA<br>Server Time: " & Now
s=s & "<br>URL <font color=red><b>not found</b></font> : " & URI & " (" & Proto & ")" & "<br>from IP : " & oSck.RemoteHostIP & " - " & oSck.RemoteHost
s=s & "<p>with header :<br>" & Replace(reste,chr(13),"<br>") & "</BODY></HTML>" & vbCrLf & vbCrLf
L "Page " & URI & " (" & Proto & ") not found"
End If
End If
oSck.SendData s
End Sub
| .:: Tools |
|
Server Info Remote Info Compress |
| .:: Articles-fr |
|
Batchs BootSector Droit Accessoire GFA On Now Ecran plasma Système d'exploitation Son Unités Scripting Multilingue Site Web Bruit et son Architecture Google |