'==============================================================================
'
'
'  ISAPI Header for PB/DLL
'  Modified from PB's distribution by Don Dickinson Jan, 2001
'  ddickinson@usinternet.com
'  dickinson.basicguru.com
'
'     Removed the global variable gECB as this is not a safe practice
'     as this is a pointer passed to each call 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.
'
'     Also added some of my own wrapper functions (see the bottom)
'
'     --Don
'
'==============================================================================
#if not %def(%DD_ISAPI_INC) 

%DD_ISAPI_INC = 1

'************************************************************
'*   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

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  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

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  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

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  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

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  isapiRedirect
'     This tells the server to get a different page. Use this instead of 
'     isaipWrite/isapiWriteHeader
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function isapiRedirect(ECB as EXTENSION_CONTROL_BLOCK, ByVal sURL as String) as Long
   
   Dim RetVal As Long
   Dim dwSize as dword
   Dim dwNotUsed as dword
   Dim zRedir as Asciiz * 1000   
   
   zRedir = Trim$(sUrl)
   dwSize = len(sURL)

   Call Dword ECB.lpServerSupportFunction _
      Using ssf(ECB.ConnID, %HSE_REQ_SEND_URL_REDIRECT_RESP, zRedir, dwSize, dwNotUsed) _
      To RetVal

   Function = RetVal   

End Function

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  isapiWriteHeader
'     Uses the server support function %HSE_REQ_SEND_RESPONSE_HEADER_EX
'     to return the header. Some web servers will want the header returned
'     with the HTML (like CGI) and some use this function.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function isapiWriteHeader(ECB as EXTENSION_CONTROL_BLOCK, _
      ByVal sStatus as String, ByVal sHeader as String) as Long

   Dim zStatus as Asciiz * 100
   Dim zHeader as Asciiz * 2000
   Dim hei  As HSE_SEND_HEADER_EX_INFO
   
   '- Default headers if not specified
   if Trim$(sStatus) = "" then
      sStatus = "200 OK" + $CRLF
   end if
   
   if sHeader = "" then
      sHeader = "Content-type: text/html" + $CRLF + $CRLF
   end if
   
   zStatus = sStatus
   
   '- Make sure the user didn't omit the 2 $CRLF at
   '  the end of the line as this is required.
   '
   if right$(sHeader, 2) <> $CRLF + $CRLF then
      sHeader = sHeader + $CRLF + $CRLF
   end if
   zHeader = sHeader
   
   '- Build the structure and send the header
   hei.pszStatus = VarPtr(zStatus)
   hei.pszHeader = VarPtr(zHeader)
   hei.cchStatus = Len(sStatus)
   hei.cchHeader = Len(sHeader)
   hei.fKeepConn = 0

   Function = isapiServerSupportFunction(ECB, %HSE_REQ_SEND_RESPONSE_HEADER_EX, _
         varptr(hei), len(hei), 0)

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

#endif