This sample should demonstrate the FORM part; I don't have a good answer to forcing a shutdown of all ISAPI processes.... wait! Yes I do: Just load this url and they will all reset:
* Make this into a PRG, and make it part of a project
* and build the project into a DLL, then RegSvr32 the DLL on the server
* Finally, call up:
#DEFINE NEWLINE [<BR>]+CHR(13)+CHR(10)
#DEFINE CRLF CHR(13)+CHR(10)
#DEFINE HKEY_LOCAL_MACHINE BITSET(0,31)+2 && -2147483646 && BITSET(0,31)+2
#DEFINE COMPNAME_KEY "SYSTEM\CurrentcontrolSet\control\ComputerName\Computername"
#DEFINE HTTPHEAD [HTTP/1.0 200 OK]+CRLF+[Content-Type: text/html]+CRLF+[Expires: Sunday 15-May-94 14:00:01 GMT]+CRLF+CRLF+[<HTML>]+CRLF
PROCEDURE Test
LOCAL loTest
loTest = CREATEOBJECT('foxweb.customclass.formresponder')
lcTest = loTest.FormResponder()
StrToFile(lcTest,'test.htm')
=ShellExec('test.htm','','OPEN','')
ENDPROC
DEFINE CLASS foxweb_base AS CUSTOM
* Server Property Declarations
cError = HTTPHEAD
Title = []
HeadStr = []
BodyTag = [<BODY>]
BodyStr = []
iniFile = []
QryStr = .null.
DIMENSION aQry[2,2]
nQry = 0
ShowDebug = .F.
PROCEDURE Init
* GetPrivateProfileString function is used to read INI file passed by
* FOXISAPI.DLL to the automation server as 2nd parameter.
SET REPROCESS TO 3 SECONDS && v10.00 wgcs
SET PROCEDURE TO UTIL ADDITIVE
DECLARE INTEGER GetPrivateProfileString IN win32api String,String,String,;
String @, integer,string
set exclusive off
set deleted on
ENDPROC
PROCEDURE ReInit
SET REPROCESS TO 3 SECONDS && v10.00 wgcs
THIS.cError = ''
THIS.HeadStr = ''
THIS.Title = ''
THIS.BodyStr = ''
THIS.BodyTag = [<BODY>]
if NOT IsNull(m.P1) and NOT Empty(m.P1)
* Got Form fields from a POST
* THIS.BodyStr=[ Getting form fields from P1 (POST)]+NewLine
THIS.QryStr = m.P1
THIS.ShowDebug = upper(alltrim(THIS.FormField('ShowDebug')))='ON'
else
if THIS.ShowDebug
* Any form fields (from a GET) are in INI file (m.P2)
THIS.BodyStr=[ No Form Fields in P1 (GET)]+NewLine
endif
THIS.QryStr = .null.
endif
THIS.nQry = .NULL.
THIS.aQry = .NULL.
* nPersistInstance = 0 && signal the client to not release this instance
nPersistInstance = 1 && For debugging, don't lockup the DLL until a server restart
IF !EMPTY(m.p2) AND FILE(m.p2)
THIS.IniFile = m.p2
THIS.ShowDebug = upper(alltrim(THIS.FormField('ShowDebug')))='ON'
ELSE
THIS.cError = THIS.cError + [<P>INI file not found on remote server.</P>] + CRLF
ENDIF
if THIS.ShowDebug and not IsNull(THIS.QryStr)
THIS.BodyStr=[QryStr=]+THIS.QryStr +NewLine
endif
ENDPROC
PROCEDURE Hello
* ex.
*
PARAMETERS p1,p2,nPersistInstance
LOCAL retval,buf,nlen
retval = [<HTML><BODY>Hello World!</BODY></HTML>]
return retval + THIS.cError
ENDPROC
********************************
PROCEDURE Error
* Your FOXISAPI automation servers should always have an error
* routine which returns HTML information regarding the nature of error.
*
LPARAMETERS nError, cMethod, nLine
LOCAL Retval, src
retval = [<P>Error #]+alltrim(str(nError))+[: "] + alltrim(MESSAGE()) + ["] ;
+ [ in ] + m.cMethod + [ on line ] + alltrim(STR(m.nLine)) ;
+ [<BR>] + CRLF
src = Message(1)
if !empty(src)
retval = m.retval + [Source="] + alltrim(src) + [" <BR>] + CRLF
endif
retval = m.retval + [</P>] + CRLF
THIS.cError = THIS.cError + m.RetVal
RETURN HTTPHEAD + THIS.cError + [</HTML>]
ENDPROC
********************************
PROCEDURE RetStr
LOCAL RetVal
RetVal = HTTPHEAD + [<HTML><HEAD>]
if not isNull( THIS.HeadStr )
RetVal = RetVal + THIS.HeadStr
else
RetVal = RetVal + 'HeadStr = NULL'
endif
RetVal = RetVal + [</HEAD>]
if not isNull( THIS.BodyTag )
RetVal = RetVal + THIS.BodyTag
else
RetVal = RetVal + 'BodyTag = NULL'
endif
if not isNull( THIS.BodyStr )
RetVal = RetVal + THIS.BodyStr
else
RetVal = RetVal + 'BodyStr = NULL'
endif
if not isNull( THIS.cError )
RetVal = RetVal + THIS.cError
else
RetVal = RetVal + 'cError = NULL'
endif
RetVal = RetVal + crlf + [</BODY></HTML>]
RETURN RetVal
ENDPROC
********************************
PROCEDURE Title_Assign
LPARAMETERS lcValue
THIS.HeadStr = StrTran( THIS.HeadStr, [<TITLE>]+THIS.Title+[</TITLE>], '' )
THIS.HeadStr = THIS.HeadStr + [<TITLE>]+lcValue+[</TITLE>]
THIS.Title = lcValue
ENDPROC
********************************
PROCEDURE BodyStr_Assign
LPARAMETERS lcValue
do case
case empty(lcValue)
THIS.BodyStr = ''
case varType(lcValue)='C'
THIS.BodyStr = THIS.BodyStr + lcValue
endcase
ENDPROC
********************************
PROCEDURE Write
LPARAMETERS pcValue
if VarType(pcValue)='C'
LOCAL lcValue
lcValue = StrTran( pcValue, '\\', chr(255) )
lcValue = StrTran( lcValue, '\n', chr(13)+chr(10) )
lcValue = StrTran( lcValue, '\t', chr(9) )
lcValue = StrTran( lcValue, chr(255), '\' )
THIS.BodyStr = lcValue
endif
ENDPROC
********************************
PROCEDURE WriteLn
LPARAMETERS pcValue
if VarType(pcValue)='C'
LOCAL lcValue
lcValue = StrTran( pcValue, '\\', chr(255) )
lcValue = StrTran( lcValue, '\n', crlf )
lcValue = StrTran( lcValue, '\t', chr(9) )
lcValue = StrTran( lcValue, chr(255), '\' )
THIS.BodyStr = lcValue + '<BR>' + crlf
endif
ENDPROC
********************************
PROCEDURE GetCompName
* This routine returns the computer name
*
LOCAL oreg,cValue,nErr
cValue = ""
oreg = NewObject('registry','registry.prg')
nErr=oReg.GetRegKey("ComputerName", @cValue, COMPNAME_KEY, HKEY_LOCAL_MACHINE)
RETURN IIF(nErr = 0, m.cValue, ""
ENDPROC
********************************
FUNCTION UnEncode
LPARAMETERS UrlEncoded
LOCAL RetVal, lnI
RetVal = UrlEncoded
* Translate pluses to spaces first so encoded pluses aren't affected.
RetVal = StrTran( RetVal, '+', ' ' )
* Translate symbol for % (%25) into "_percent_"
RetVal = StrTran( RetVal, '%25', '_percent_' )
RetVal = StrTran( RetVal, '%0D0A', '<BR>' )
do While '%' $ RetVal
lnI = at('%', RetVal)
if NOT InList( upper( substr( RetVal, lnI+1 ) ), ;
'0','1','2','3','4','5','6','7','8','9','0', ;
'A','B','C','D','E','F' )
* Delete bad "%"
RetVal = Stuff( RetVal, lnI, 1, '' )
else
if NOT InList( upper( substr( RetVal, lnI+2 ) ), ;
'0','1','2','3','4','5','6','7','8','9','0', ;
'A','B','C','D','E','F' )
* Delete double bad char
RetVal = Stuff( RetVal, lnI, 2, '' )
else
* GOOD!
RetVal = Stuff( RetVal, lnI, 3, chr( UnHex(SubStr(RetVal,lnI,3)) ) )
endif
endif
enddo
RetVal = StrTran( RetVal, '_percent_', '%' )
RETURN RetVal
ENDFUNC
********************************
FUNCTION FormField
LPARAMETERS pcFieldName
LOCAL aPairs,nPairs, buf, nLen, lnI, QryVals[2]
if THIS.ShowDebug
THIS.BodyStr='FormField Looking for ' + pcFieldName + NewLine
endif
if isNull(THIS.QryStr) or empty(THIS.QryStr) or THIS.QryStr='EMPTY'
* Haven't yet gotten QryStr out of the INI file
buf = SPACE(10000)
nlen = GetPrivateProfileString("FOXISAPI","Query String","default7",@buf,LEN(buf),THIS.IniFile)
THIS.QryStr = StrTran(Alltrim(Buf),chr(0),'')
if THIS.ShowDebug
THIS.BodyStr=[QryStr=]+THIS.QryStr +NewLine
endif
endif
if isNull(THIS.nQry) or isNull(THIS.aQry)
THIS.nQry = ALINES( QryVals, StrTran(THIS.QryStr,'&',chr(13)) )
if THIS.ShowDebug
THIS.BodyStr=alltrim(Str(THIS.NQry))+[ Values Found!] +NewLine
endif
DIMENSION THIS.aQry[THIS.nQry,2]
for lnI = 1 to THIS.nQry
lnPos = at('=',QryVals[lnI])
THIS.aQry[lnI,1] = THIS.UnEncode( left(QryVals[lnI],lnPos-1) )
THIS.aQry[lnI,2] = iif( lnPos>=Len(QryVals[lnI]) or (lnPos=0), '', ;
THIS.UnEncode( SubStr(QryVals[lnI],lnPos+1)) )
if THIS.ShowDebug
THIS.BodyStr= THIS.aQry[lnI,1] +[ == ]+THIS.aQry[lnI,2] +NewLine
endif
endfor
endif
for lnI = 1 to THIS.nQry
if upper(alltrim(pcFieldName))==upper(Alltrim(THIS.aQry[lnI,1]))
if THIS.ShowDebug
THIS.BodyStr= 'FormField Found '+ pcFieldName +'! ('+THIS.aQry[lnI,2]+')' +NewLine
endif
RETURN THIS.aQry[lnI,2]
endif
endfor
if THIS.ShowDebug
THIS.BodyStr= '...'+pcFieldName + ' Not Found!' +NewLine
endif
RETURN .NULL.
ENDFUNC
ENDDEFINE
DEFINE CLASS CustomClass AS FoxWeb_Base OLEPUBLIC
FUNCTION MakeForm
PARAMETERS p1,p2,nPersistInstance
THIS.BodyStr=[<FORM METHOD="GET" ACTION="/cgi-bin/foxisapi.dll/Foxweb.CustomClass.FormResponder">]+crlf
THIS.BodyStr=[<INPUT NAME=SayHi TYPE="Submit">]+crlf
THIS.BodyStr=[</FORM>]+crlf
RETURN THIS.RetStr
ENDFUNC
FUNCTION FormResponder
PARAMETERS p1,p2,nPersistInstance
LOCAL lcHi
THIS.ReInit()
lcHi = THIS.FormField('SayHi')
if not isnull(lcHi)
THIS.BodyStr=[<h1>Hi!</H1>]
else
THIS.BodyStr=[<h1>No field on form called "SayHi"!</H1>]
endif
RETURN THIS.RetStr
ENDFUNC
ENDDEFINE
