posted January 10, 2001 12:42 PM            

There are 3 files below:
1. dd_isapi.inc - the ISAPI declarations largely borrowed from PB's isapi header file
2. istest32.bas - the source for istest32.dll ISAPI dll
3. istest.htm - a sample HTML page - you'll have to change the directory reference to match your web server.

BEGIN file 1 - dd_isapi.inc

'==============================================================================
'
'  ISAPI Header for PB/DLL
'  Copyright (c) 1999 PowerBASIC, Inc.
'
'  Modified by Don Dickinson Jan, 2001
'  ddickinson@usinternet.com
'
'  Removed the global variable gECB as this is not a safe practice
'  as this is a pointer passed to each call to 
'  and because of the multi-threaded nature of ISAPI, this will not
'  necessarily be the same variable on each call. The ConnID parameter
'  might be different, for instance. Bottom line is that ECB must be
'  passed to each call in the functions below.
'
'==============================================================================

'************************************************************
'*   Manifest Constants
'************************************************************
%HSE_VERSION_MAJOR        =   4      ' major version of this spec
%HSE_VERSION_MINOR        =   0      ' minor version of this spec
%HSE_LOG_BUFFER_LEN       =  80
%HSE_MAX_EXT_DLL_NAME_LEN = 256
%MAXPATH                  = 128
'
' the following are the status codes returned by the Extension DLL
'
%HSE_STATUS_SUCCESS                      = 1
%HSE_STATUS_SUCCESS_AND_KEEP_CONN        = 2
%HSE_STATUS_PENDING                      = 3
%HSE_STATUS_ERROR                        = 4
'
' The following are the values to request services with the ServerSupportFunction().
' Values from 0 to 1000 are reserved for future versions of the interface
%HSE_REQ_BASE                            = 0
%HSE_REQ_SEND_URL_REDIRECT_RESP          = %HSE_REQ_BASE + 1
%HSE_REQ_SEND_URL                        = %HSE_REQ_BASE + 2
%HSE_REQ_SEND_RESPONSE_HEADER            = %HSE_REQ_BASE + 3
%HSE_REQ_DONE_WITH_SESSION               = %HSE_REQ_BASE + 4
%HSE_REQ_END_RESERVED                    = 1000
'
'  These are Microsoft specific extensions
'
%HSE_REQ_MAP_URL_TO_PATH                 = %HSE_REQ_END_RESERVED+1
%HSE_REQ_GET_SSPI_INFO                   = %HSE_REQ_END_RESERVED+2
%HSE_APPEND_LOG_PARAMETER                = %HSE_REQ_END_RESERVED+3
%HSE_REQ_IO_COMPLETION                   = %HSE_REQ_END_RESERVED+5
%HSE_REQ_TRANSMIT_FILE                   = %HSE_REQ_END_RESERVED+6
%HSE_REQ_REFRESH_ISAPI_ACL               = %HSE_REQ_END_RESERVED+7
%HSE_REQ_IS_KEEP_CONN                    = %HSE_REQ_END_RESERVED+8
%HSE_REQ_ASYNC_READ_CLIENT               = %HSE_REQ_END_RESERVED+10
%HSE_REQ_GET_IMPERSONATION_TOKEN         = %HSE_REQ_END_RESERVED+11
%HSE_REQ_MAP_URL_TO_PATH_EX              = %HSE_REQ_END_RESERVED+12
%HSE_REQ_ABORTIVE_CLOSE                  = %HSE_REQ_END_RESERVED+14
%HSE_REQ_GET_CERT_INFO_EX                = %HSE_REQ_END_RESERVED+15
%HSE_REQ_SEND_RESPONSE_HEADER_EX         = %HSE_REQ_END_RESERVED+16
'
'  Bit Flags for TerminateExtension
'
'    HSE_TERM_ADVISORY_UNLOAD - Server wants to unload the extension,
'          extension can return TRUE if OK, FALSE if the server should not
'          unload the extension
'
'    HSE_TERM_MUST_UNLOAD - Server indicating the extension is about to be
'          unloaded, the extension cannot refuse.
'
%HSE_TERM_ADVISORY_UNLOAD                 =  &H00000001&
%HSE_TERM_MUST_UNLOAD                     =  &H00000002&
'
' Flags for IO Functions, supported for IO Funcs.
' TF means ServerSupportFunction( %HSE_REQ_TRANSMIT_FILE)
'
%HSE_IO_SYNC                     = &H00000001&  ' for WriteClient
%HSE_IO_ASYNC                    = &H00000002&  ' for WriteClient/TF
%HSE_IO_DISCONNECT_AFTER_SEND    = &H00000004&  ' for TF
%HSE_IO_SEND_HEADERS             = &H00000008&  ' for TF
'************************************************************
'*   Type Definitions
'************************************************************
'
' structure passed to GetExtensionVersion()
'
Type HSE_VERSION_INFO
  dwExtensionVersion As Dword
  lpszExtensionDesc As Asciiz * %HSE_MAX_EXT_DLL_NAME_LEN
End Type
Type EXTENSION_CONTROL_BLOCK
  cbSize As Dword                                 ' size of structure
  dwVersion As Dword                              ' version information
  ConnId As Dword                                 ' context number (read-only)
  dwHttpStatusCode As Dword                       ' HTTP status code
  lpszLogData As Asciiz * %HSE_LOG_BUFFER_LEN     ' log information specific to DLL
  lpszMethod As Asciiz Ptr                        ' REQUEST_METHOD
  lpszQueryString As Asciiz Ptr                   ' QUERY_STRING
  lpszPathInfo As Asciiz Ptr                      ' PATH_INFO
  lpszPathTranslated As Asciiz Ptr                ' PATH_TRANSLATED
  cbTotalBytes As Dword                           ' Total bytes from client
  cbAvailable As Dword                            ' Available bytes
  lpbData As Byte Ptr                             ' Pointer to available bytes
  lpszContentType As Asciiz Ptr                   ' Content type of client data
  lpGetServerVariable As Dword                    ' GetServerVariable() function pointer
  lpWriteClient As Dword                          ' WriteClient() function pointer
  lpReadClient As Dword                           ' ReadClient() function pointer
  lpServerSupportFunction As Dword                ' ServerSupportFunction() function pointer
End Type

'
'  Bit field of flags that can be on a virtual directory
'
%HSE_URL_FLAGS_READ         = &H00000001&    ' Allow for Read
%HSE_URL_FLAGS_WRITE        = &H00000002&    ' Allow for Write
%HSE_URL_FLAGS_EXECUTE      = &H00000004&    ' Allow for Execute
%HSE_URL_FLAGS_SSL          = &H00000008&    ' Require SSL
%HSE_URL_FLAGS_DONT_CACHE   = &H00000010&    ' Don't cache (vroot only)
%HSE_URL_FLAGS_NEGO_CERT    = &H00000020&    ' Allow client SSL certs
%HSE_URL_FLAGS_REQUIRE_CERT = &H00000040&    ' Require client SSL certs
%HSE_URL_FLAGS_MAP_CERT     = &H00000080&    ' Map SSL cert to NT account
%HSE_URL_FLAGS_SSL128       = &H00000100&    ' Require 128 bit SSL
%HSE_URL_FLAGS_SCRIPT       = &H00000200&    ' Allow for Script execution
%HSE_URL_FLAGS_MASK         = &H000003ff&
'
'  Structure for extended information on a URL mapping
'
Type HSE_URL_MAPEX_INFO
  lpszPath As Asciiz * %MAXPATH ' Physical path root mapped to
  dwFlags As Dword              ' Flags associated with this URL path
  cchMatchingPath As Dword      ' Number of matching characters in physical path
  cchMatchingURL As Dword       ' Number of matching characters in URL
  dwReserved1 As Dword
  dwReserved2 As Dword
End Type
'
' PFN_HSE_IO_COMPLETION - callback function for the Async I/O Completion.
'
'FUNCTION PFN_HSE_IO_COMPLETION(ECB AS AS EXTENSION_CONTROL_BLOCK,
'                               BYVAL pContext AS DWORD,
'                               BYVAL cbIO AS DWORD,
'                               BYVAL dwError AS DWORD) AS LONG
'
'
' HSE_TF_INFO defines the type for HTTP SERVER EXTENSION support for
' ISAPI applications to send files using TransmitFile.
' A pointer to this object should be used with ServerSupportFunction()
' for %HSE_REQ_TRANSMIT_FILE.
'
Type HSE_TF_INFO
  '
  ' callback and context information
  ' the callback function will be called when IO is completed.
  ' the context specified will be used during such callback.
  '
  ' These values (if non-NULL) will override the one set by calling
  '  ServerSupportFunction() with HSE_REQ_IO_COMPLETION
  '
  pfnHseIO As Dword 'PFN_HSE_IO_COMPLETION pointer
  pContext As Dword
  ' file should have been opened with FILE_FLAG_SEQUENTIAL_SCAN
  hFile As Long
  '
  ' HTTP header and status code
  ' These fields are used only if HSE_IO_SEND_HEADERS is present in dwFlags
  '
  pszStatusCode As Asciiz Ptr ' HTTP Status Code  eg: "200 OK"
  BytesToWrite As Dword   ' special value of "0" means write entire file.
  Offset As Dword         ' offset value within the file to start from
  pHead As Dword          ' Head buffer to be sent before file data
  HeadLength As Dword     ' header length
  pTail As Dword          ' Tail buffer to be sent after file data
  TailLength As Dword     ' tail length
  dwFlags As Dword        ' includes HSE_IO_DISCONNECT_AFTER_SEND, ...
End Type
'
'  HSE_SEND_HEADER_EX_INFO allows an ISAPI application to send headers
'  and specify keep-alive behavior in the same call.
'
Type HSE_SEND_HEADER_EX_INFO
  '
  ' HTTP status code and header
  '
  pszStatus As Asciiz Ptr  ' HTTP status code  eg: "200 OK"
  pszHeader As Asciiz Ptr  ' HTTP header
  cchStatus As Dword  ' number of characters in status code
  cchHeader As Dword  ' number of characters in header
  fKeepConn As Long   ' keep client connection alive?
End Type
$If 0
' Certification stuff not ported
Type CERT_CONTEXT
  dwCertEncodingType As Dword
  pbCertEncoded As Byte Ptr
  cbCertEncoded As Dword
  pCertInfo As PCERT_INFO
  hCertStore As Long
End Type

'
'  CERT_CONTEXT_EX is passed as an an argument to
'  ServerSupportFunction( HSE_REQ_GET_CERT_INFO_EX )
'
Type CERT_CONTEXT_EX
  CertContext As CERT_CONTEXT
  cbAllocated As Dword
  dwCertificateFlags As Dword
End Type
$EndIf
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Function DWORD call templates
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Declare Function gsv(ByVal hConn As Long, VariableName As Asciiz, Buffer As Any, cbBuffer As Dword) As Long
Declare Function rc(ByVal hConn As Long, Buffer As Any, lpdwSize As Dword) As Long
Declare Function wc(ByVal hConn As Long, Buffer As Any, lpdwBytes As Dword, ByVal dwReserved As Dword) As Long
Declare Function ssf (ByVal hConn As Long, ByVal dwHSERRequest As Dword, Buffer As Any, lpdwSize As Dword, lpswDataType As Dword) As Long
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  Function Prototypes
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Declare Function DecodeCGI(ByVal t As String) As String
Declare Function ParseParams(ByVal params As String, Param() As String) As Long
Declare Sub ParseCGI (Param() As String, names() As String, values() As String)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  isapiGetVariable
'     Returns an environment variable set by the server. Things like 
'     HTTP_COOKIE, etc. are environment variables in regular CGI, but have 
'     to be obtained directly from the server with ISAPI.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function isapiGetVariable(ECB As EXTENSION_CONTROL_BLOCK, _
                          ByVal sVar as String, sReturn as String) As Long
                          
   %ISAPI_MAX_VARIABLE_LENGTH = 66000
   Dim RetVal As Long
   Dim zReturn as Asciiz * %ISAPI_MAX_VARIABLE_LENGTH
   Dim lenReturn as Dword
   
   lenReturn = %ISAPI_MAX_VARIABLE_LENGTH
   Call Dword ECB.lpGetServerVariable _
         Using gsv(ECB.ConnID, ByCopy(sVar+$NUL), zReturn, lenReturn) _
         To RetVal
   sReturn = zReturn
   Function = RetVal
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  isapiWrite
'     Writes data back to the server. This is usually the last call
'     you make in your ISAPI routine - send the HTML back to the server.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function isapiWrite(ECB As EXTENSION_CONTROL_BLOCK, ByVal buffer as String) as Long
   Dim dwReserved as Dword
   Dim dwBytes as Dword
   Dim RetVal as Long
   
   dwBytes = len(buffer)
   Call Dword ECB.lpWriteClient _
         Using wc(ECB.ConnID, ByVal StrPtr(Buffer), dwBytes, dwReserved) _
         To RetVal
  Function = RetVal
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  isapiRead
'     Reads data from the server. I have never used this, so I'm not sure
'     what it will be used for.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function isapiRead(ECB As EXTENSION_CONTROL_BLOCK) As String
   Dim RetVal   As Long
   Dim Buffer   As String
   Dim lpdwSize As Dword
      
   Buffer = String$(65536, 0)  '64k
   lpdwSize = Len(Buffer)
   
   Call Dword ECB.lpReadClient Using rc(ECB.ConnID, ByVal StrPtr(Buffer), lpdwSize) To RetVal
   
   If RetVal Then
    Function = Left$(Buffer, lpdwSize)
   End If
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  isapiPostData
'     Retrieves the data passed to your DLL by the POST method. This
'     replaces the StdIn Line call needed at the beginning of a 
'     regular CGI application.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function isapiPostData(ECB as EXTENSION_CONTROL_BLOCK) as String
   Dim pzData as Asciiz Ptr
   
   pzData = ECB.lpbData
   if pzData then
      Function = @pzData
   else
      Function = ""
   end if
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  isapiGetData
'     Retrieves the data passed to your DLL on the command line. This may
'     be HTML coded command lines or GET data. This replaces the Command$
'     or Environ$("QUERY_STRING") calls necessary in regular CGI programs.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function isapiGetData(ECB as EXTENSION_CONTROL_BLOCK) as String
   if ECB.lpszQueryString then
      Function = ECB.@lpszQueryString
   else
      Function = ""
   end if
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  isapiServerSupportFunction
'     Encapsulation of the ServerSupportFunction. There are various
'     uses for this function - keep-alives, etc. I will not go into them
'     right here.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function isapiServerSupportFunction(ECB as EXTENSION_CONTROL_BLOCK, _
                               ByVal dwHSERRequest As Dword, _
                               ByVal lpBuffer As Dword, lpdwSize As Dword, _
                               lpdwDataType As Dword) As Long
   Dim RetVal As Long
   
   Call Dword ECB.lpServerSupportFunction _
      Using ssf(ECB.ConnID, dwHSERRequest, ByVal lpBuffer, lpdwSize, lpdwDataType) _
      To RetVal
   Function = RetVal
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  GetValueFromName
'     Returns the value corresponding to the passed name from the Name/Value
'     pair array.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function GetValueFromName(sName As String, sNames() As String, sValues() As String) As String
   Dim i As Long
   Dim iFound As Long
   iFound = 0
   For i = 1 To UBound(sNames)
       If Trim$(UCase$(sNames(i))) = Trim$(UCase$(sName)) Then
          iFound = i
          Exit For
       End If
   Next i
   If iFound = 0 Then
      Function = ""
   Else
      Function = sValues(iFound)
   End If
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  isapiGetPostVariables
'     Retrieves the POST variables and puts them in a name/value pair array.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function isapiGetPostVariables(ECB as EXTENSION_CONTROL_BLOCK, _
                               names() as String, values() as String) as Long
   Dim rawData as String
   Dim rawParams() as String
   
   Redim rawParams(0 to 0) as String
   rawData = isapiPostData(ECB)
   ParseParams rawData, rawParams()
   ParseCGI rawParams(), names(), values()
   
   Function = ubound(names())
   
End Function
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  isapiGetGetVariables
'     Retrievs the GET variables and puts them in a name/value pair array.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function isapiGetGetVariables(ECB as EXTENSION_CONTROL_BLOCK, _
                              names() as String, values() as String) as Long
   Dim rawData as String
   Dim rawParams() as String
   
   Redim rawParams(0 to 0) as String
   rawData = isapiGetData(ECB)
   ParseParams rawData, rawParams()
   ParseCGI rawParams(), names(), values()
   
   Function = ubound(names())
   
End Function
                               
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  isapiGetCookies
'  Fills the Name/Value arrays with the cookies 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function isapiGetCookies(ECB As EXTENSION_CONTROL_BLOCK, _
                         cookieN() As String, cookieV() As String) As Long
   Dim i As Long
   Dim iCount As Long
   Dim sCookies as String
   Dim sC As String
   isapiGetVariable ECB, "HTTP_COOKIE", sCookies
   iCount = ParseCount(sCookies, ";")
   ReDim cookieN(0 To iCount) As String
   ReDim cookieV(0 To iCount) As String
   If iCount > 0 Then
      For i = 1 To iCount
         sC = Parse$(sCookies, ";", i)
         cookieN(i) = Parse$(sC, "=", 1)
         cookieV(i) = Parse$(sC, "=", 2)
      Next i
   End If
   Function = iCount
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  Decode all of the special characters in a CGI string
'  This is copied directly from PB's cgi include file that comes with PBCC
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function DecodeCGI(ByVal t As String) As String
  Dim b_in  As Byte Ptr
  Dim b_out As Byte Ptr
  Dim h     As String Ptr * 2
  Dim a     As Asciiz Ptr
  If Len(t) = 0 Then
    Exit Function
  End If
  b_in  = StrPtr(t)
  b_out = b_in
  Do
    If @b_in = 43 Then          'convert plus to space
      @b_out = 32
    ElseIf @b_in = 37 Then      'process special chars
      h = b_in + 1
      @b_out = Val("&H" + @h)
      b_in = b_in + 2
    Else
      @b_out = @b_in
    End If
    Incr b_in
    Incr b_out
  Loop Until @b_in = 0
  @b_out = 0
  a = StrPtr(t)
  Function = @a
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  ParseCGI
'     Breaks an array of "Name=Value" into Name/Value pair arrays
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub ParseCGI (Param() As String, names() As String, values() As String)
   Local i As Long
   Local iLoop As Long
   i = UBound(Param())
   ReDim names(0 To i) As String
   ReDim values(0 To i) As String
   For iLoop = 1 To i
      names(iLoop) = Parse$(Param(iLoop), "=", 1)
      values(iLoop) = Parse$(Param(iLoop), "=", 2)
      names(iLoop) = DecodeCGI$(names(iLoop))
      values(iLoop) = DecodeCGI$(values(iLoop))
   Next i
End Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  ParseParams
'  Parses a command line of names and values into an array formatted like:
'     "Name=Value"
'  This is copied directly from PB's cgi include file that comes with PBCC
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function ParseParams(ByVal params As String, Param() As String) As Long
  Local c As Long
  Local x As Long
  c = ParseCount(params, "&")
  ReDim Param(0 To c) As String
  For x = 1 To c
    Param(x) = Parse$(params, "&", x)
  Next x
  Function = c
End Function

BEGIN file 2 - istest32.bas

'
'  istest32.bas
'
'  By Don Dickinson
'  ddickinson@usinternet.com
'  Jan, 2001
'
'  Use as you see fit. Parts of this code and its include file
'  are copyrighted by PowerBasic.
'
'  compile with pbdll6 to create istest32.dll - an ISAPI test dll.
'  The purpose of this DLL is to demonstrate how to get POST, GET, and
'  Cookie from your ISAPI dll. It requires my re-write of pb's cgi include
'  file that comes with PBCC. This re-write is named dd_isapi.inc and
'  should be posted with this code.
'
#Dim All
#Compile Dll "e:\omni\isapi\istest32.dll"
#Include "dd_isapi.inc"
#Include "win32api.inc"

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  Lib Main
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function LibMain(BYVAL hInstance   AS LONG, _
                 BYVAL fwdReason   AS LONG, _
                 BYVAL lpvReserved AS LONG) EXPORT AS LONG
   Select Case fwdReason
   
      '- The DLL is loaded into memory
      Case %DLL_PROCESS_ATTACH      
         Function = 1
      
      '- The DLL is coming out of memory
      Case %DLL_PROCESS_DETACH         
         Function = 1
      
      '- The thread is coming into memory
      Case %DLL_THREAD_ATTACH
         LibMain = 1
      
      '- The thread is coming out of memory
      Case %DLL_THREAD_DETACH
         LibMain = 1 
   
   End Select
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  GetExtensionVersion
'  Initialization - called once when dll is loaded into memory
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function GetExtensionVersion Alias "GetExtensionVersion" _
                             (pVer As HSE_VERSION_INFO) Export As Long
   pVer.dwExtensionVersion = MakLng( %HSE_VERSION_MINOR, %HSE_VERSION_MAJOR )
   pVer.lpszExtensionDesc = "PB-DLL ISAPI Test DLL"
   Function = 1
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  TerminateExtension
'  Termination - called once when the dll is unloaded
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function TerminateExtension Alias "TerminateExtension" (ByVal dwFlags As Dword) Export As Long
   Function = 1
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  HttpExtensionProc
'  The isapi function. This is called when the dll is requested as
'  an action in a web page.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function HttpExtensionProc Alias "HttpExtensionProc" _
                           (ECB As EXTENSION_CONTROL_BLOCK) Export As Long
   Dim i as Long
   Dim pData as Asciiz Ptr
   Dim msg As String
   Dim sCookies as String
   Dim cookieN() as String
   Dim cookieV() as String
   
   Redim cookieN(0 to 0) as String
   Redim cookieV(0 to 0) as String
   Redim postN(0 to 0) as String
   Redim postV(0 to 0) as String
   
   isapiGetCookies ECB, cookieN(), cookieV()
   isapiGetPostVariables ECB, postN(), postV()
   
   msg = "Content-type: text/html" + $CRLF + _
         "Set-Cookie: cook1=DON" + $CRLF + _
         "Set-Cookie: cook2=2ndCookie" + $CRLF + $CRLF
   msg = msg + "<HTML>" + _
         "<HEAD><TITLE>ISAPI Extension DLL Test Results</TITLE>" + _
         "</HEAD>"+ $CRLF + "<B>Cookies</B><BR>" + _
         "<BODY>CookieCount: " + Format$(ubound(cookieN())) + "<BR>"         
   
   '- List the cookies
   For i = 1 to ubound(cookieN())
      msg = msg + "Cookie " + cookieN(i) + "=" + cookieV(i) + "<BR>"
   Next i
   msg = msg + "<P>"
   
   '- Here's the command line passed to the DLL
   '  This could also be parseable fields if you're
   '  using the GET method, BUT I never use the GET
   '  method, so I don't parse it (I use the command
   '  line to pass instructions to the DLL).
   '
   msg = msg + "<B>Get</B><BR>" + isapiGetData(ECB) + "<P>"
   '- Add in any posted variables
   msg = msg + "<B>Post</B><BR>"
   For i = 1 to ubound(postN())
      msg = msg + "Post Var " + postN(i) + "=" + postV(i) + "<BR>"
   Next i
   msg = msg + "<P>"
   msg = msg + "</BODY></HTML>" + $CRLF
   
   '- Send the data back to the web server
   isapiWrite ECB, msg
   Function = %HSE_STATUS_SUCCESS
End Function

BEGIN file 3 - istest.htm

<HTML>
<HEAD><title>ISAPI Test Page</title></HEAD>
<BODY>
<CENTER><H2>ISAPI Test Page</H2></CENTER><BR><HR>
<P>
This tests the POST method of the isapi interface. It tries to
call the function in istest32.dll. Currently, this dll must be
in the /docs directory if you're running the <A href="http://www.sambar.com">
Sambar Server</A>. I can't seem to make it work if it's anywhere
else. I don't use IIS, so I don't know where the dll needs to bin
with that system. If you're using omnihttpd, the DLL goes in the httpd\ISAPI
directory. There is a configuration option to specify directories where ISAPI
dlls may be. I have tested this on Sambar and OmniHTTPd.
The dll was written in pb-dll6 and based on a sample from
Dave Navarro of Power Basic. 
<P>
<FORM method="POST" action="/ISAPI/istest32.dll">
<PRE>
Company Name <INPUT type=text name=company>
Your Name    <INPUT type=text name=contact>
             <INPUT type=submit>
</PRE>
</FORM>
</BODY></HTML>