home *** CD-ROM | disk | FTP | other *** search
/ Microsoft Internet Business Development Kit / PRODUCT_CD.iso / ftpage / disk7 / cgitest.ba_ / cgitest.ba
Encoding:
Text File  |  1995-09-07  |  6.5 KB  |  175 lines
  1. '----------------------------------------------------------------------
  2. '       ***************
  3. '       * CGITEST.BAS *
  4. '       ***************
  5. '
  6. ' Test CGI back-end for NCSA httpd for Windows. Generates HTML report
  7. ' detailing the stuff it got from the server via the interface.
  8. '
  9. ' Requires procedures in CGI.BAS. Set the VB project options to use
  10. ' Sub Main as the startup form.
  11. '
  12. ' Author:   Robert B. Denny <rdenny@netcom.com>
  13. '           June 7, 1994
  14. '----------------------------------------------------------------------
  15. Option Explicit
  16.  
  17. '
  18. '   Sample CGI script
  19. '
  20. ' Returns a report in HTML of the CGI data, depending on the "extra
  21. ' path info" on the URL (Logical Path), which is used here as an
  22. ' "opcode". Yeah, there are better ways to do this, but I designed
  23. ' this to be used from a command-driven linemode browser as well as
  24. ' interactively. So the tail end of the URL selects the type of
  25. ' report. See comments for more...
  26. '
  27. ' CGI.BAS contains the "Sub Main()" entry point. That code initializes
  28. ' the CGI environment, then calls CGI_Main(), here. At this point, the
  29. ' output file is open, the input file (if any) is NOT. Use the Send()
  30. ' function to isolate yourself from the output file number, and as
  31. ' a convenient shortcut.
  32. '
  33. ' NOTE: ALWAYS use FreeFile() to get file numbers if you need to open
  34. '       files in your code!
  35. '
  36. Sub CGI_Main ()
  37.     Dim sel As String
  38.     Dim buf As String
  39.     Dim i As Integer
  40.  
  41.     sel = LCase$(Mid$(CGI_LogicalPath, 2)) ' Skip leading "/"
  42.     Select Case sel
  43.     '
  44.     ' If no selector, return the usage document
  45.     '
  46.     Case ""
  47.         Send ("Location: /winhttpd/htdocs/cgitest.htm")
  48.         Send ("")
  49.         Exit Sub        ' Finished: BACK TO CGI DRIVER/MAIN!!!
  50.     '
  51.     ' Logical Path "Transparent" means generate the full HTTP/1.0
  52.     ' header, testing the server's ability to detect this and pass
  53.     ' it to the client without interpretation. Then it makes a
  54.     ' 'normal' report.
  55.     '
  56.     Case "transparent"
  57.         Send ("HTTP/1.0 200 OK")
  58.         Send ("Server: " & CGI_ServerSoftware)
  59.         Send ("MIME-Version: 1.0")
  60.         StartDocument (sel)
  61.         Send ("This was returned transparently.")
  62.     '
  63.     ' CGI means send back the CGI variables
  64.     '
  65.     Case "cgi"
  66.         StartDocument (sel)
  67.         Send ("<H2>CGI Variables (some may be blank):</H2>")
  68.         Send ("<UL>")
  69.         Send ("<LI><I>CGI Version: </I>" & CGI_Version)
  70.         Send ("<LI><I>Request Protocol: </I>" & CGI_RequestProtocol)
  71.         Send ("<LI><I>Request Method: </I>" & CGI_RequestMethod)
  72.         Send ("<LI><I>Executable Path: </I>" & CGI_ExecutablePath)
  73.         Send ("<LI><I>Logical Path: </I>" & CGI_LogicalPath)
  74.         Send ("<LI><I>Physical Path: </I>" & CGI_PhysicalPath)
  75.         Send ("<LI><I>Query String: </I>" & CGI_QueryString)
  76.         Send ("<LI><I>Content Type: </I>" & CGI_ContentType)
  77.         Send ("<LI><I>Content Length: </I>" & CGI_ContentLength)
  78.         Send ("<LI><I>Server Software: </I>" & CGI_ServerSoftware)
  79.         Send ("<LI><I>Server Name: </I>" & CGI_ServerName)
  80.         Send ("<LI><I>Server Port: </I>" & CGI_ServerPort)
  81.         Send ("<LI><I>Server Admin: </I>" & CGI_ServerAdmin)
  82.         Send ("<LI><I>Remote Host: </I>" & CGI_RemoteHost)
  83.         Send ("<LI><I>Remote Address: </I>" & CGI_RemoteAddr)
  84.         Send ("<LI><I>Authentication Method: </I>" & CGI_AuthType)
  85.         Send ("<LI><I>Authenticated Username: </I>" & CGI_AuthUser)
  86.         Send ("<LI><I>RFC-931 Identity: </I>" & CGI_TAPUser)
  87.         Send ("</UL>")
  88.         Send ("<H2>System Variables</H2>")
  89.         Send ("<UL>")
  90.         Send ("<LI><I>Output File: </I>" & UCase$(CGI_OutputFile))
  91.         Send ("<LI><I>Content File: </I>" & UCase$(CGI_ContentFile))
  92.         If CGI_DebugMode Then buf = "Yes" Else buf = "no"
  93.         Send ("<LI><I>Debug Mode: </I>" & buf)
  94.         Send ("</UL>")
  95.     '
  96.     ' "Headers" means show the Accept: and Extra headers
  97.     '
  98.     Case "headers"
  99.         StartDocument (sel)
  100.         Send ("<H2>MIME Accept Types:</H2>")
  101.         If CGI_NumAcceptTypes > 0 Then
  102.             Send ("<UL>")
  103.             For i = 0 To CGI_NumAcceptTypes - 1
  104.                 ' Don't display the "Yes"
  105.                 If CGI_AcceptTypes(i).value = "Yes" Then
  106.                     Send ("<LI>" & CGI_AcceptTypes(i).key)
  107.                 Else
  108.                     Send ("<LI>" & CGI_AcceptTypes(i).key & " (" & CGI_AcceptTypes(i).value & ")")
  109.                 End If
  110.             Next i
  111.             Send ("</UL>")
  112.         Else
  113.             Send ("(none)")
  114.         End If
  115.         Send ("<H2>Extra Headers:</H2>")
  116.         If CGI_NumExtraHeaders > 0 Then
  117.             Send ("<UL>")
  118.             For i = 0 To CGI_NumExtraHeaders - 1
  119.                 Send ("<LI><I>" & CGI_ExtraHeaders(i).key & ": </I>" & CGI_ExtraHeaders(i).value)
  120.             Next i
  121.             Send ("</UL>")
  122.         Else
  123.             Send ("(none)")
  124.         End If
  125.     '
  126.     ' "Form" means show the form stuff decoded
  127.     '
  128.     Case "form"
  129.         StartDocument (sel)
  130.         Send ("<H2>Form fields:</H2>")
  131.         If CGI_NumFormTuples > 0 Then
  132.             Send ("<UL>")
  133.             For i = 0 To CGI_NumFormTuples - 1
  134.                 Send ("<LI><I>" & CGI_FormTuples(i).key & ": </I>" & CGI_FormTuples(i).value)
  135.             Next i
  136.             Send ("</UL>")
  137.         Else
  138.             Send ("(none)")
  139.         End If
  140.         If CGI_NumHugeTuples > 0 Then
  141.             Send ("<H2>Form Fields > 64KB:</H2>")
  142.             Send ("<UL>")
  143.             For i = 0 To CGI_NumHugeTuples - 1
  144.                 Send ("<LI><I>" & CGI_HugeTuples(i).key & ": </I>Offset=" & CStr(CGI_HugeTuples(i).offset) & ", Length=" & CStr(CGI_HugeTuples(i).length))
  145.             Next i
  146.             Send ("</UL>")
  147.         End If
  148.         
  149.     End Select
  150.  
  151.     '
  152.     ' Finish up with server admin's address. Return to complete HTTP.
  153.     '
  154.     Send ("<HR>")
  155.     Send ("<A HREF=""mailto:" & CGI_ServerAdmin & """>")
  156.     Send ("<address><" & CGI_ServerAdmin & "></address>")
  157.     Send ("</A></BODY></HTML>")
  158.  
  159.     '****** RETURN, DON'T STOP! ******
  160. End Sub
  161.  
  162. Sub StartDocument (sel As String)
  163.     Send ("Content-type: text/html")
  164.     Send ("X-Script-name: Visual Basic CGI Test 1.1")
  165.     Send ("")
  166.     Send ("<HTML><HEAD><TITLE>CGI Test Results</TITLE></HEAD>")
  167.     Send ("<BODY><H1>CGI Test Results</H1>")
  168.     Send ("Program version: 1.1 (12-Nov-94)<BR>")
  169.     Send ("Server: <B>" & CGI_ServerSoftware & "</B><BR>")
  170.     Send ("Selector: <B>" & sel & "</B><P>")
  171.     Send ("<A HREF=""/winhttpd/htdocs/cgitest.htm"">Return to usage document</A>")
  172.     Send ("<HR>")
  173. End Sub
  174.  
  175.