Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

ISAPI code

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • ISAPI code

    I have written a small ISAPI sample dll. It is based on a re-write of PowerBasic's isapi include file and borrows some funtions from pbcgi.inc. The DLL itself (i think) is based on works by Dave Navarro.
    There is a flaw in the isapi header from power basic. It is based on a global variable to track the control block. This can lead to very bad things happening as ISAPI dlls are multi-threaded and the values of the members of this structure (specifically ConnID) can be different with each call. I have simplified and renamed most of the isapi functions and pass ECB as a parameter. Also there is code to obtain GET, POST, and Cookie data.
    I have tested the code, but not extensively, so be sure to run it through its paces if you plan on using it in a production environment. This code is free for all with no credit or blame to be assigned to me.

    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
    Code:
    '==============================================================================
    '
    '  ISAPI Header for PB/DLL
    '  Copyright (c) 1999 PowerBASIC, Inc.
    '
    '  Modified by Don Dickinson Jan, 2001
    '  [email protected]
    '
    '  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 = [email protected]
       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
    Code:
    '
    '  istest32.bas
    '
    '  By Don Dickinson
    '  [email protected]
    '  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
    Code:
    <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>


    ------------------
    www.basicguru.com/dickinson
    Don Dickinson
    www.greatwebdivide.com
Working...
X