' If you use NT/2000 or IIS, please read this page on how
' to set up the Windows Script Host as a CGI service:
' http://support.microsoft.com/support/kb/articles/q221/0/81.asp
' On any generic web server with no security restrictions
' (like Fnord or Tiny), all you need to do is set scripting
' to run with CSCRIPT.EXE and with no logo. Do this with a
' command like this:
' CSCRIPT //H:CSCRIPT //Nologo //S
'
' On NT/2000, you will also need to be sure the IIS user
' account has permission to run the CSCRIPT executable. The
' IIS lockdown tool usually removes that permission.
'
' NOTE: If you use Win95/98 you must modify
' this script! In the "ServerVariables" function, change
' the Windows NT/XP/2000 text
' CreateObject("Wscript.Shell").Environment("PROCESS").Item(strVariable)
' to Win95/98 text:
' CreateObject("Wscript.Shell").Environment.Item(strVariable)
Main
Sub Main
Dim strTemp, strCookieCrumbs 'As String
Dim varArray 'As Variant
Dim Request, Cookies 'As Scripting.Dictionary
'Put query string data in a dictionary for easy access.
strTemp = ServerVariables("QUERY_STRING")
strTemp = Unescape(strTemp)
Set Request = CreateDictionary(strTemp, "=", "&")
'Put cookies in a dictionary for easy access.
strTemp = ServerVariables("HTTP_COOKIE")
Set Cookies = CreateDictionary(strTemp, "=", ";")
'Test to see what action should be taken by the CGI.
If Not Request.Exists("test") Then
SendDefaultPage
Exit Sub
End If
'Create cookies to be sent
strCookieCrumbs = ""
strCookieCrumbs = strCookieCrumbs & "Set-Cookie: "
strCookieCrumbs = strCookieCrumbs & "LastRequestTime=" & Split(Now)(1) & ";" 'typical sample cookie
strCookieCrumbs = strCookieCrumbs & "path=/;"
If Request.Exists("cookiename") And Request.Exists("cookievalue") Then
If Request("cookiename") <> "" And Request("cookievalue") <> "" Then
If strCookieCrumbs <> "" Then
strCookieCrumbs = strCookieCrumbs & vbCrLf
End If
strCookieCrumbs = strCookieCrumbs & "Set-Cookie: "
strCookieCrumbs = strCookieCrumbs & Request("cookiename") & "=" & Request("cookievalue") & ";"
strCookieCrumbs = strCookieCrumbs & "path=/;"
End If
End If
'Send out http headers
Wscript.Echo "HTTP/1.0 200 OK"
Wscript.Echo "Pragma: no-cache"
WScript.Echo "Cache-Control: private"
Wscript.Echo "Content-type: text/html"
If strCookieCrumbs <> "" Then Wscript.Echo "Set-Cookie: " & strCookieCrumbs
WScript.Echo ""
'Send out html headers
Wscript.Echo ""
'Show server variables
WScript.Echo "Server Variables"
Wscript.Echo "
"
For Each strTemp In Split("REMOTE_ADDR HTTP_USER_AGENT QUERY_STRING HTTP_COOKIE HTTP_REFERER PATH_INFO SCRIPT_NAME PATH_TRANSLATED SERVER_NAME SERVER_PORT")
Wscript.Echo "| " & strTemp & " | " & HtmlEncode(ServerVariables(strTemp)) & " |
"
Next
Wscript.Echo "
"
'Show GET request items
WScript.Echo "Request Items"
Wscript.Echo "
"
varArray = Request.Keys
For Each strTemp In varArray
Wscript.Echo "| " & HtmlEncode(strTemp) & " | " & HtmlEncode(Request(strTemp)) & " |
"
Next
Wscript.Echo "
"
'Show Cookies
WScript.Echo "Cookies"
Wscript.Echo "
"
varArray = Cookies.Keys
For Each strTemp In varArray
Wscript.Echo "| " & HtmlEncode(strTemp) & " | " & HtmlEncode(Cookies(strTemp)) & " |
"
Next
Wscript.Echo "
"
'Sample code to test a request item
If Request.Exists("test") Then
WScript.Echo "
You had a request item named "test". "
If InStr(Request("test"), vbTab) = 0 Then
'Common assumption of single value
WScript.Echo "The value was "" & Request("test") & "". "
Else
'Special case of multiple items with same name
For Each strTemp In Split(Request("test"), vbTab)
WScript.Echo "The value was "" & strTemp & "". "
Next
End If
Else
WScript.Echo "
You didn't have a query item named "test". "
End If
'Sample code testing a cookie
If Cookies.Exists("test") Then
WScript.Echo "
You had a cookie named "test". "
WScript.Echo "The value was "" & Cookies("test") & "". "
Else
WScript.Echo "
You didn't have a cookie named "test". "
End If
'Send page closing tags
WScript.Echo ""
End Sub
Function ServerVariables(strVariable)
ServerVariables = CreateObject("Wscript.Shell").Environment("PROCESS").Item(strVariable)
End Function
Function HtmlEncode(strText) 'As String
'Because it is NEVER safe to display raw data that can be influenced by the user.
Dim strBuffer
Dim lngPos
For lngPos = 1 To Len(strText)
strBuffer = strBuffer & "&#" & Asc(Mid(strText, lngPos, 1)) & ";"
Next
HtmlEncode = strBuffer
End Function
Function Unescape(strEncodedText) 'As String
'This accepts a url-encoded string and returns the decoded value
'For example "counts=9%2E3&name=Eric+Phelps" becomes "counts=9.3&name=Eric Phelps"
Dim strBuffer, strUnescape 'As String
Dim lPos 'As Long
strUnescape = strEncodedText
'Convert plusses to spaces
Do While Instr(strUnescape, "+") <> 0
strUnescape = Replace(strUnescape, "+", " ")
Loop
'Convert escaped hex values to normal (%61 = a)
strBuffer = ""
lPos = 1
Do
If Mid(strUnescape, lPos, 1) = "%" Then
strBuffer = strBuffer + Chr(Cint("&H" + Mid(strUnescape, lPos + 1, 2)))
lPos = lPos + 3
Else
strBuffer = strBuffer + Mid(strUnescape, lPos, 1)
lPos = lPos + 1
End If
Loop Until lPos > Len(strUnescape)
Unescape = strBuffer
End Function
Function CreateDictionary(strMultiplyDelimitedString, strItemSeparator, strEntrySeparator) 'As Scripting.Dictionary
'Accepts a multiply-delimited string and returns a dictionary. For example
'Set dict=CreateDictionary("counts=9.3&name=Eric Phelps", "=", "&") becomes available like this...
'dict.Item("counts") will return "9.3", and dict.Item("name") returns "Eric Phelps".
'Likewise dict.Exists("counts") is True and dict.Exists("xyftc") is False.
Dim strQuery 'As String
Dim strName 'As String
Dim strValue 'As String
Dim dict 'As Object
Set dict = CreateObject("Scripting.Dictionary")
strQuery = strMultiplyDelimitedString
Do While strQuery <> ""
strName = Left(strQuery, InStr(strQuery, strItemSeparator) - 1)
strQuery = Mid(strQuery, InStr(strQuery, strItemSeparator) + Len(strItemSeparator))
If InStr(strQuery, strEntrySeparator) = 0 Then
strValue = strQuery
strQuery = ""
Else
strValue = Left(strQuery, InStr(strQuery, strEntrySeparator) - 1)
strQuery = Mid(strQuery, InStr(strQuery, strEntrySeparator) + Len(strEntrySeparator))
End If
'Allow for multiple items by tab-delimiting them
If dict.Exists(strName) Then
dict.Item(strName) = dict.Item(strName) & vbTab & strValue
Else
dict.Add strName, strValue
End If
Loop
Set CreateDictionary = dict
Set dict = Nothing
End Function
Sub SendDefaultPage
'Sends a page whose name is the same as the script
'(but with htm extension). If page doesn't exist,
'it will be created.
Dim fs, ts, strFileName, strWebContent
Const ForReading = 1
Const ForWriting = 2
Set fs = CreateObject("Scripting.FileSystemObject")
strFileName = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & "htm"
If Not fs.FileExists(strFileName) Then
strWebContent = ""
Set ts = fs.OpenTextFile(strFileName, ForWriting, True)
ts.Write strWebContent
ts.Close
End If
Wscript.Echo "HTTP/1.0 200 OK"
Wscript.Echo "Content-type: text/html" & vbCrLf
Set ts = fs.OpenTextFile(strFileName, ForReading, True)
strWebContent = ts.ReadAll
ts.Close
Wscript.Echo strWebContent
End Sub