Harbour Project - Samples -> testcgi
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- Harbour Test of a CGI/HTML-Generator class
-
-
- This example shows how to work with Web pages using a custom class to manipulate data coming from a file and returns it to web browser.
-
-
-
-
-
-
-
-
-
-
- Files:
-
-
-
-
-
-
-
-
-
- Screenshot:
-
-
-
-
-
-
-
-
-
-
-
-
-
- How to compile:
-
-
-
-
- To learn how to compile/link this example see our specific section on this link .
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/harbour/website/samples/testcgi.prg.html b/harbour/website/samples/testcgi.prg.html
deleted file mode 100644
index 0721b81b52..0000000000
--- a/harbour/website/samples/testcgi.prg.html
+++ /dev/null
@@ -1,494 +0,0 @@
-
-testcgi.prg
-#define CGI_SERVER_SOFTWARE 01
- #define CGI_SERVER_NAME 02
- #define CGI_GATEWAY_INTERFACE 03
- #define CGI_SERVER_PROTOCOL 04
- #define CGI_SERVER_PORT 05
- #define CGI_REQUEST_METHOD 06
- #define CGI_HTTP_ACCEPT 07
- #define CGI_HTTP_USER_AGENT 08
- #define CGI_HTTP_REFERER 09
- #define CGI_PATH_INFO 10
- #define CGI_PATH_TRANSLATED 11
- #define CGI_SCRIPT_NAME 12
- #define CGI_QUERY_STRING 13
- #define CGI_REMOTE_HOST 14
- #define CGI_REMOTE_ADDR 15
- #define CGI_REMOTE_USER 16
- #define CGI_AUTH_TYPE 17
- #define CGI_CONTENT_TYPE 18
- #define CGI_CONTENT_LENGTH 19
- #define CGI_ANNOTATION_SERVER 20
-
- #define IF_BUFFER 65535
-
- FUNCTION Main ()
-
- LOCAL oHTML := THTML (): New ()
- LOCAL hFile, nPos, cString, cBuf, i, cTable, cLine
-
- oHTML: SetHTMLFile ( "function.cfm" )
-
- hFile := fOpen ( "list.txt" , 0 )
-
- cString := space ( IF_BUFFER )
- cBuf := ""
- cTable := ""
-
- WHILE hFile != - 1 .AND. (nPos := fRead ( hFile, @cString, IF_BUFFER )) > 0
- i := 1
- DO WHILE i <= nPos
-
- IF substr ( cString, i, 1 ) = chr ( 13 )
- i := i + 1
- cLine := cBuf
- cBuf := ""
-
- IF left ( cLine, 1 ) <> ';'
- cTable += '<TR>' + chr ( 10 )+ chr ( 13 ) + ;
- '<TD WIDTH="50%"><FONT SIZE="2" FACE="Tahoma">' + ;
- ParseString ( cLine, ';' , 1 ) + '</FONT></TD>' + chr ( 10 )+ chr ( 13 ) + ;
- '<TD WIDTH="16%">' + ;
- if ( ParseString ( cLine, ';' , 2 ) = 'R' , ;
- '<CENTER><IMG SRC="images/purple-m.gif">' , ;
- ' ' ) + ;
- '</TD>' + chr ( 10 )+ chr ( 13 ) + ;
- '<TD WIDTH="16%">' + ;
- if ( ParseString ( cLine, ';' , 2 ) = 'S' , ;
- '<CENTER><IMG SRC="images/purple-m.gif">' , ;
- ' ' ) + ;
- '</TD>' + chr ( 10 )+ chr ( 13 ) + ;
- '<TD WIDTH="16%">' + ;
- if ( ParseString ( cLine, ';' , 2 ) = 'N' , ;
- '<CENTER><IMG SRC="images/purple-m.gif">' , ;
- ' ' ) + ;
- '</TD>' + chr ( 10 )+ chr ( 13 ) + ;
- '</TR>'
- ENDIF
- ELSE
- cBuf := cBuf + substr ( cString, i, 1 )
- ENDIF
-
- i++
- ENDDO
- ENDDO
-
- fClose ( hFile )
-
- oHTML: AddReplaceTag ( "Functions" , cTable )
- oHTML: Generate ()
-
- oHTML: ShowResult ()
-
- RETURN ( NIL )
-
- FUNCTION ParseString ( cString, cDelim, nRet )
-
- LOCAL cBuf, aElem, nPosFim, nSize, i
-
- nSize := len ( cString ) - len ( StrTran ( cString, cDelim, '' ) ) + 1
- aElem := array ( nSize )
-
- cBuf := cString
- i := 1
- FOR i := 1 TO nSize
- nPosFim := at ( cDelim, cBuf )
-
- IF nPosFim > 0
- aElem[i] := substr ( cBuf, 1 , nPosFim - 1 )
- ELSE
- aElem[i] := cBuf
- ENDIF
-
- cBuf := substr ( cBuf, nPosFim + 1 , len ( cBuf ) )
-
- NEXT i
-
- RETURN ( aElem[ nRet ] )
-
- FUNCTION Hex2Dec ( cHex )
-
- LOCAL aHex := { { "0" , 00 }, ;
- { "1" , 01 }, ;
- { "2" , 02 }, ;
- { "3" , 03 }, ;
- { "4" , 04 }, ;
- { "5" , 05 }, ;
- { "6" , 06 }, ;
- { "7" , 07 }, ;
- { "8" , 08 }, ;
- { "9" , 09 }, ;
- { "A" , 10 }, ;
- { "B" , 11 }, ;
- { "C" , 12 }, ;
- { "D" , 13 }, ;
- { "E" , 14 }, ;
- { "F" , 15 } }
- LOCAL nRet
- LOCAL nRes
-
- nRet := ascan ( aHex, {| x | upper ( x[ 1 ] ) = upper ( left ( cHex, 1 ) ) } )
- nRes := aHex[nRet, 2 ] * 16
- nRet := ascan ( aHex, {| x | upper ( x[ 1 ] ) = upper ( right ( cHex, 1 ) ) } )
- nRes += aHex[nRet, 2 ]
-
- RETURN ( nRes )
-
- FUNCTION THTML
-
- STATIC oClass
-
- IF oClass == NIL
- oClass = HBClass (): New ( "THTML" )
-
- oClass: AddData ( "cTitle" ) oClass: AddData ( "cBody" ) oClass: AddData ( "cBGColor" ) oClass: AddData ( "cLinkColor" ) oClass: AddData ( "cvLinkColor" ) oClass: AddData ( "cContent" ) oClass: AddData ( "aCGIContents" )
- oClass: AddData ( "aQueryFields" )
- oClass: AddData ( "cHTMLFile" )
- oClass: AddData ( "aReplaceTags" )
-
- oClass: AddMethod ( "New" , @ New () ) oClass: AddMethod ( "SetTitle" , @ SetTitle () ) oClass: AddMethod ( "AddHead" , @ AddHead () ) oClass: AddMethod ( "AddLink" , @ AddLink () ) oClass: AddMethod ( "AddPara" , @ AddPara () ) oClass: AddMethod ( "SaveToFile" , @ SaveToFile () ) oClass: AddMethod ( "ShowResult" , @ ShowResult () ) oClass: AddMethod ( "Generate" , @ Generate () ) oClass: AddMethod ( "SetHTMLFile" ,@ SetHTMLFile () ) oClass: AddMethod ( "ProcessCGI" , @ ProcessCGI () )
- oClass: AddMethod ( "GetCGIParam" , @ GetCGIParam () )
- oClass: AddMethod ( "QueryFields" , @ QueryFields () )
- oClass: AddMethod ( "AddReplaceTag" , @ AddReplaceTag () )
-
- oClass: Create ()
-
- ENDIF
-
- RETURN ( oClass: Instance () )
-
- STATIC FUNCTION New ()
-
- LOCAL Self := QSelf ()
-
- ::cTitle := "Untitled"
- ::cBGColor := "#FFFFFF"
- ::cLinkColor := "#0000FF"
- ::cvLinkColor := "#FF0000"
- ::cContent := ""
- ::cBody := ""
- ::aCGIContents := {}
- ::aQueryFields := {}
- ::aReplaceTags := {}
- ::cHTMLFile := ""
-
- RETURN ( Self )
-
- STATIC FUNCTION SetTitle ( cTitle )
-
- LOCAL Self := QSelf ()
-
- ::cTitle := cTitle
-
- RETURN ( Self )
-
- STATIC FUNCTION AddLink ( cLinkTo, cLinkName )
-
- LOCAL Self := QSelf ()
-
- ::cBody := ::cBody + ;
- "<A HREF='" + cLinkTo + "'>" + cLinkName + "</A>"
-
- RETURN ( Self )
-
- STATIC FUNCTION AddHead ( cDescr )
-
- LOCAL Self := QSelf ()
-
- ::cBody := ::cBody + ;
- "<H1>" + cDescr + "</H1>"
-
- RETURN ( NIL )
-
- STATIC FUNCTION AddPara ( cPara, cAlign )
-
- LOCAL Self := QSelf ()
-
- ::cBody := ::cBody + ;
- "<P ALIGN='" + cAlign + "'>" + hb_eol () + ;
- cPara + hb_eol () + ;
- "</P>"
-
- RETURN ( Self )
-
- STATIC FUNCTION Generate ()
-
- LOCAL Self := QSelf ()
- LOCAL cFile, i, hFile, nPos, cRes := ""
- LOCAL lFlag := .f.
-
- IF empty ( ::cHTMLFile )
- ::cContent := ;
- "<HTML><HEAD>" + hb_eol () + ;
- "<TITLE>" + ::cTitle + "</TITLE>" + hb_eol () + ;
- "<BODY link='" + ::cLinkColor + "' " + ;
- "vlink='" + ::cvLinkColor + "'>" + + hb_eol () + ;
- ::cBody + hb_eol () + ;
- "</BODY></HTML>"
- ELSE
- ::cContent := ""
-
- IF ! File ( ::cHTMLFile )
- ::cContent := "<H1>Server Error</H1><P><I>No such file: " + ;
- ::cHTMLFile
- ELSE
- hFile := fOpen ( ::cHTMLFile, 0 )
- cFile := space ( IF_BUFFER )
- DO WHILE (nPos := fRead ( hFile, @cFile, IF_BUFFER )) > 0
-
- cFile := left ( cFile, nPos )
- cRes += cFile
- cFile := space ( IF_BUFFER )
-
- ENDDO
-
- fClose ( hFile )
-
- i := 1
- ::cContent := cRes
- DO WHILE i <= len ( ::aReplaceTags )
- ::cContent := strtran ( ::cContent, ;
- "<#" + ::aReplaceTags[i, 1 ] + ">" , ::aReplaceTags[i, 2 ] )
- i++
- ENDDO
-
- ENDIF
- ENDIF
-
- RETURN ( Self )
-
- STATIC FUNCTION ShowResult ()
-
- LOCAL Self := QSelf ()
-
- OutStd ( ;
- "HTTP/1.0 200 OK" + hb_eol () + ;
- "CONTENT-TYPE: TEXT/HTML" + hb_eol () + hb_eol () + ;
- ::cContent )
-
- RETURN ( Self )
-
- STATIC FUNCTION SaveToFile ( cFile )
-
- LOCAL Self := QSelf ()
- LOCAL hFile := fCreate ( cFile )
-
- fWrite ( hFile, ::cContent )
- fClose ( hFile )
-
- RETURN ( Self )
-
- STATIC FUNCTION ProcessCGI ()
-
- LOCAL Self := QSelf ()
- LOCAL cQuery := ""
- LOCAL cBuff := ""
- LOCAL nBuff := 0
- LOCAL i
-
- IF empty ( ::aCGIContents )
- ::aCGIContents := { ;
- GetEnv ( "SERVER_SOFTWARE" ), ;
- GetEnv ( "SERVER_NAME" ), ;
- GetEnv ( "GATEWAY_INTERFACE" ), ;
- GetEnv ( "SERVER_PROTOCOL" ), ;
- GetEnv ( "SERVER_PORT" ), ;
- GetEnv ( "REQUEST_METHOD" ), ;
- GetEnv ( "HTTP_ACCEPT" ), ;
- GetEnv ( "HTTP_USER_AGENT" ), ;
- GetEnv ( "HTTP_REFERER" ), ;
- GetEnv ( "PATH_INFO" ), ;
- GetEnv ( "PATH_TRANSLATED" ), ;
- GetEnv ( "SCRIPT_NAME" ), ;
- GetEnv ( "QUERY_STRING" ), ;
- GetEnv ( "REMOTE_HOST" ), ;
- GetEnv ( "REMOTE_ADDR" ), ;
- GetEnv ( "REMOTE_USER" ), ;
- GetEnv ( "AUTH_TYPE" ), ;
- GetEnv ( "CONTENT_TYPE" ), ;
- GetEnv ( "CONTENT_LENGTH" ), ;
- GetEnv ( "ANNOTATION_SERVER" ) ;
- }
-
- cQuery := :: GetCGIParam ( CGI_QUERY_STRING )
-
- IF ! empty ( cQuery )
-
- ::aQueryFields := {}
-
- FOR i := 1 TO len ( cQuery ) + 1
-
- IF i > len ( cQuery ) .OR. substr ( cQuery, i, 1 ) == "&"
-
- aadd ( ::aQueryFields, ;
- { substr ( cBuff, 1 , at ( "=" , cBuff ) - 1 ), ;
- strtran ( substr ( cBuff, at ( "=" , cBuff ) + 1 , ;
- len ( cBuff ) - at ( "=" , cBuff ) + 1 ), "+" , " " ) } )
- cBuff := ""
- ELSE
- IF substr ( cQuery, i, 1 ) = "%"
- cBuff += chr ( Hex2Dec ( substr ( cQuery, i + 1 , 2 ) ) )
- nBuff := 3
- ENDIF
-
- IF nBuff = 0
- cBuff += substr ( cQuery, i, 1 )
- ELSE
- nBuff--
- ENDIF
- ENDIF
-
- NEXT
-
- ENDIF
-
- ENDIF
-
- RETURN ( Self )
-
- STATIC FUNCTION GetCGIParam ( nParam )
-
- LOCAL Self := QSelf ()
-
- :: ProcessCGI ()
-
- IF nParam > 20 .OR. nParam < 1
- outerr ( "Invalid CGI parameter" )
- RETURN ( NIL )
- ENDIF
-
- RETURN ( ::aCGIContents[nParam] )
-
- STATIC FUNCTION QueryFields ( cQueryName )
-
- LOCAL Self := QSelf ()
- LOCAL cRet := ""
- LOCAL nRet
-
- :: ProcessCGI ()
-
- nRet := aScan ( ::aQueryFields, ;
- {| x | upper ( x[ 1 ] ) = upper ( cQueryName ) } )
-
- IF nRet > 0
- cRet := ::aQueryFields[nRet, 2 ]
- ENDIF
-
- RETURN ( cRet )
-
- STATIC FUNCTION SetHTMLFile ( cFile )
-
- LOCAL Self := QSelf ()
-
- ::cHTMLFile := cFile
-
- RETURN ( Self )
-
- STATIC FUNCTION AddReplaceTag ( cTag, cReplaceText )
-
- LOCAL Self := QSelf ()
-
- aAdd ( ::aReplaceTags, { cTag, cReplaceText } )
-
- RETURN ( Self )
- 
