File: n_cst_cgienv.sru
Size: 13987
Date: Sat, 08 Dec 2007 15:38:27 +0100
$PBExportHeader$n_cst_cgienv.sru
$PBExportComments$CGI Environment
forward
global type n_cst_cgienv from nonvisualobject
end type
end forward

global type n_cst_cgienv from nonvisualobject
end type
global n_cst_cgienv n_cst_cgienv

type prototypes
Function ulong GetModuleFileName( ulong hModule, ref string lpFilename, ulong  nSize ) library  "kernel32" Alias for "GetModuleFileNameA"



end prototypes

type variables
// Parsed PATH_INFO
string is_Application
string is_Class
string is_Function

// Yet unused
string is_LastError

// Translated Variables
string is_ParamName[]
long il_ParamValueIndex[] // Start Index for Variable Values (duplicates might be allowed!)
string is_ParamValue[]

// Translated Cookies
string is_CookieName[]
string is_CookieValue[]

// FullPath to PWE.INI Files
string is_INIFileName

// NULL string 
String STRINGNULL

end variables

forward prototypes
public function string of_printcgienv ()
public function string of_getenv (string as_cgivar)
public function string of_invokemethod (string as_method)
private function long of_translatequerystring ()
public function string of_printquerystring ()
private function integer of_translatepathinfo ()
public function string of_printcontent ()
private function long of_translateposteddata ()
public function string of_decode (string as_text)
private function long of_translatehttpcookie ()
public function long of_getcookievalue (string as_cookiename, ref string as_cookievalue)
public function string of_getcookie (string as_cookiename)
public function long of_getlasterror (ref string as_error)
public function long of_getpathinfo (ref string as_application, ref string as_class, ref string as_function)
public function string of_gettempdirectory ()
public function string of_getinifilename ()
public function long of_getvariablenames (ref string as_paramname[])
public function string of_getparam (string as_paramname)
public function long of_getparamvalue (string as_paramname, ref string as_paramvalue)
end prototypes

public function string of_printcgienv ();// of_query_string will return a html page that displays the query arguments passed 
// in the url after the question mark (?).

string ls_html
long  ll_i , ll_ub
string ls_value
environment lenv

string ls_envvar [] = { &
   "CONTENT_TYPE" , "CONTENT_LENGTH" , "DOCUMENT_ROOT" , "HTTP_REFERER" , "HTTP_USER_AGENT" , &
   "PATH_INFO" , "PATH_TRANSLATED" , "REMOTE_ADDR" , "REMOTE_HOST" , "REQUEST_METHOD" , &
   "SCRIPT_NAME" , "SERVER_NAME" , "SERVER_PORT" , "HTTP_COOKIE"}

ls_html = "<html>~n<head>~n<title>PB Web Easy Print CGI Environment</title>~n</head>~n"   & 
      +  "<body>~n<h1>PB Web Easy Print CGI Environment</h1>~n"   &
         +  "<table>"

/* Print Out PB Version */
GetEnvironment ( lenv )
ls_html += "<tr><td>PB VERSION</td><td>"+ &
               String(lenv.pbmajorrevision)+"."+ &
               String(lenv.pbminorrevision)+"."+ & 
               String(lenv.pbfixesrevision)+" "+&
               String(lenv.pbbuildnumber)+ "</td></tr>~n"

ll_ub = UpperBound ( ls_envvar [] )

For ll_i = 1 To ll_ub 
   If Len ( of_getenv ( ls_envvar [ ll_i ] ) ) > 0 then
      ls_html += "<tr><td>" + ls_envvar [ ll_i ] + "</td><td>" + of_getenv ( ls_envvar [ ll_i ] )+ "</td></tr>~n"
   else 
      ls_html += "<tr><td>" + ls_envvar [ ll_i ] + "</td><td>NULL</td></tr>~n"
   End if
Next

ls_html += "<tr><td>" + "QUERY_STRING" +"</td><td>" + of_getenv ("QUERY_STRING") + "</td></tr>~n"  & 
      +   "</table>~n" &
      +   '<table border="1">~n'    &
      +  '<tr><td colspan="2">CGI Variables</td></tr>~n'

ll_ub = UpperBound ( is_ParamName [] )
For ll_i = 1 To ll_ub 
   ls_html += "<tr><td>" + is_ParamName [ ll_i ] + "</td><td>" + is_ParamValue [ ll_i ] + "</td></tr>~n"
Next

ls_html += "</table>~n"+ 'Servertime: ' + String (Today(), "yyyy-mm-dd") + " " + String(Now(),"hh:mm:ss:fff")+"</br></body>~n</html>"

return ls_html

end function

public function string of_getenv (string as_cgivar);
String ls_value[]

ContextKeyword lcx_key

if this.GetContextService ("ContextKeyword", lcx_key) = 1 then 
   if lcx_key.GetContextKeywords (as_cgivar, ls_value) > 0 then 
      return ls_value[1]
   else
      return ""
   end if
end if

return STRINGNULL
end function

public function string of_invokemethod (string as_method);// Some methods for testing purposes
choose case as_method
   case "of_printcgienv"      ; return this.of_printcgienv( ) 
   case "of_printquerystring" ; return this.of_printquerystring( ) 
   case "of_printcontent"     ; return this.of_printcontent( ) 
end choose

return "Method unknown"

end function

private function long of_translatequerystring ();string ls_qs
long ll_p1
long ll_p2
long ll_i=0

ls_qs = of_getenv ("QUERY_STRING")

ll_p2 = 0
ll_p1 = Pos ( ls_qs , '=' )
do while ll_p1 > 0 
   ll_i ++
   ll_p2 ++
   ll_p1 ++
   is_ParamName [ ll_i ] = of_decode ( Mid ( ls_qs , ll_p2 , ll_p1 - ll_p2 - 1) )
   il_ParamValueindex [ ll_i ] = ll_i
   ll_p2 = Pos ( ls_qs , '&' , ll_p1  )
   If ll_p2 > 0 then
      is_ParamValue [ ll_i ] = of_decode ( Mid ( ls_qs , ll_p1 , ll_p2 - ll_p1 ) )
   else
      // this is the end?!
      exit 
   end if
   ll_p1 = Pos ( ls_qs , '=' , ll_p2 )
loop

if ll_p1 > 0 and ll_p2 = 0 then
   is_ParamValue [ ll_i ] = of_decode ( Mid ( ls_qs , ll_p1 ) )
end if

return ll_i 

end function

public function string of_printquerystring ();// of_query_string will return a html page that displays the query arguments passed 
// in the url after the question mark (?).

string ls_html
   
long li_i , ll_ub

ls_html = '<html>~n<head>~n<title>PBCGI QUERY_STRING</title>~n<head>~n' + &
             '<body>~n<h1>PBCGI QUERY_STRING</h1>~n' +&
               '<table border="1">~n' +&
               '<tr><th>Variable</th><th>Value</th></tr>~n' 
 
ll_ub = UpperBound ( is_ParamName [] )
For li_i = 1 To ll_ub 
   ls_html += '<tr><td>' + is_ParamName [ li_i ] + '</td><td>' + is_ParamValue [ li_i ] + '</td></tr>~n'
Next

ls_html += '</table>~n</body>~n</html>'

return ls_html


end function

private function integer of_translatepathinfo ();string ls_pathinfo
long ll_pos , ll_sop

ls_pathinfo = of_getenv ( "PATH_INFO" )

If Pos ( ls_pathinfo , "/" ) = 1 then
   ll_pos = Pos ( ls_pathinfo , "/" , 2 )
   If ll_pos > 0 then
      is_application = Mid ( ls_pathinfo , 2, ll_pos - 2 ) 
      if Len ( is_application ) > 0 then
         ll_pos ++ 
         ll_sop = Pos ( ls_pathinfo , "/" , ll_pos )
         If ll_sop > 0 Then
            is_class = Mid ( ls_pathinfo , ll_pos , ll_sop - ll_pos )
            If Len ( is_class ) > 0 then
               ll_sop ++ 
               is_function = Mid ( ls_pathinfo , ll_sop )
               If Len ( is_function ) > 0 then
                  If Pos ( is_function , "/" ) > 0 then
                     Return -1
                  Else
                     Return 1
                  End If
               End If
            End If
         End If
      End If
   End If
End if            
                  
return -1 
end function

public function string of_printcontent ();
string ls_html
string ls_content 
long li_i , ll_ub
long ll_cl

ls_html = "<html>~n<head>~n<title>PB Web Easy CONTENT</title>~n</head>~n"  &
      +  "<body>~n<h1>PB Web Easy Print Content</h1>~n"

ll_cl = long ( of_getenv ('CONTENT_LENGTH' ) )

if ll_cl  > 0 then 
   ls_html += '<div>Content Lenght: ' + String ( ll_cl ) + '</div>~n'
   ls_content = Space ( ll_cl )
   
   n_cst_stdin lnv_stdin
   lnv_stdin = CREATE n_cst_stdin
   lnv_stdin.getdata ( ls_content , ll_cl )
   DESTROY lnv_stdin

   ls_html += '<div>Content: <br />'+ ls_content + '</div>~n'
else
   ls_html += '<div>Content Lenght: 0 or unset</div>~n'
   
end if
ls_html += '</body>~n</html>~n'
return ls_html 


end function

private function long of_translateposteddata ();/**
  Read and translate x-www-form-urlencoded content from stdin
*/

long ll_cl     // Content Length
string ls_ct   // Content String

string ls_qs   // Like a encode Query String
long ll_p1     // Position of '=' - Sign
long ll_p2     // Position of '&' -Sign
long ll_i=0    // Counter for added Parameter

ll_cl = Long ( of_getenv ("CONTENT_LENGTH"))
// Must be > 0  
IF ll_cl > 0 THEN ; ELSE ; RETURN 0 ; END IF

IF Lower(of_getenv ("CONTENT_TYPE")) = "application/x-www-form-urlencoded" THEN ; ELSE ; RETURN 0 ; END IF

// Read String from stdin
n_cst_stdin lnv_stdin
lnv_stdin = CREATE n_cst_stdin
ls_qs = Space ( ll_cl )
lnv_stdin.getdata ( ls_qs , ll_cl )
DESTROY lnv_stdin

// Append to possible submitted Parameters via URL GET
ll_i = UpperBound ( is_ParamName )

ll_p2 = 0
ll_p1 = Pos ( ls_qs , '=' )
do while ll_p1 > 0 
   ll_i ++
   ll_p2 ++
   ll_p1 ++
   is_ParamName [ ll_i ] = of_decode ( Mid ( ls_qs ,  ll_p2 , ll_p1 -  ll_p2 - 1) )
   il_ParamValueindex [ ll_i ] = ll_i
    ll_p2 = Pos ( ls_qs , '&' , ll_p1  )
   If  ll_p2 > 0 then
      is_ParamValue [ ll_i ] = of_decode ( Mid ( ls_qs , ll_p1 ,  ll_p2 - ll_p1 ) )
   else
      // this is the end?!
      exit 
   end if
   ll_p1 = Pos ( ls_qs , '=' ,  ll_p2 )
loop

// Last pair '=' without a trailing '&'
if ll_p1 > 0 and  ll_p2 = 0 then
   is_ParamValue [ ll_i ] = of_decode ( Mid ( ls_qs , ll_p1 ) )
end if

return ll_i

end function

public function string of_decode (string as_text);/// <function name="of_decode" access="public">
/// <summary>
/// Decodes an URI encoded string to it's ASCII Representation.
///
///
///</summary>
/// <param name="as_text" type="string" passby="value">Text to decode</param>
/// <returns type="string">Decoded Text</returns>
/// </function>

char c[]
long i,j, l
int li_c, li_c_j
c = as_text
l = Upperbound ( c )
for i = 1 to l 
   j ++
   if c[i] = '+' then 
      c[j] = ' '
   else
      if c [i] = "%" then
         if i < l - 1 then
            i++
            li_c = Asc ( Upper ( c [ i ]) )
            choose case true
               case li_c > 47 and li_c < 58
                  li_c_j = ( li_c - 48 ) * 16
               case li_c > 64 and li_c < 71
                  li_c_j = ( li_c - 55 ) * 16
            end choose
            i++
            li_c = Asc ( Upper ( c [ i ]) )
            choose case true
               case li_c > 47 and li_c < 58
                  li_c_j += ( li_c - 48 )
               case li_c > 64 and li_c < 71
                  li_c_j += ( li_c - 55 )
            end choose
            c[j] = Char ( li_c_j )
         else
            c[j] = c [ i ]
         end if
      else
         c[j] = c [ i ]
      end if
   end if
next  

if j <= l then
   j++
   c[j] = Char(0)
end if

return c
end function

private function long of_translatehttpcookie ();
string ls_qs
long ll_p1
long ll_p2
long ll_i=0

ls_qs = of_getenv ("HTTP_COOKIE")

ll_p2 = 0
ll_p1 = Pos ( ls_qs , '=' )
do while ll_p1 > 0 
   ll_i ++
   ll_p2 ++
   ll_p1 ++
   is_cookiename [ ll_i ] =  Mid ( ls_qs , ll_p2 , ll_p1 - ll_p2 - 1) 
   ll_p2 = Pos ( ls_qs , ';' , ll_p1  )
   If ll_p2 > 0 then
      is_cookievalue [ ll_i ] = Mid ( ls_qs , ll_p1 , ll_p2 - ll_p1 ) 
   else
      // this is the end?!
      exit 
   end if
   ll_p1 = Pos ( ls_qs , '=' , ll_p2 )
loop

if ll_p1 > 0 and ll_p2 = 0 then
   is_cookievalue [ ll_i ] = Mid ( ls_qs , ll_p1 ) 
end if

return ll_i

end function

public function long of_getcookievalue (string as_cookiename, ref string as_cookievalue);
long ll_i
long ll_k

ll_k = Upperbound ( is_cookiename [] )

for ll_i = 1 to ll_k 
   if is_cookiename [ ll_i ] = as_cookiename then 
      as_cookievalue = is_cookievalue [ ll_i ]
      return 1
   end if
next

return -1
end function

public function string of_getcookie (string as_cookiename);
long ll_i
long ll_k

ll_k = Upperbound ( is_cookiename [] )

for ll_i = 1 to ll_k 
   if is_cookiename [ ll_i ] = as_cookiename then 
      return is_cookievalue [ ll_i ]
   end if
next

return STRINGNULL


end function

public function long of_getlasterror (ref string as_error);
IF Len ( is_lasterror ) > 0 Then 
   as_error = is_lasterror
   return 1
END IF

return -1
end function

public function long of_getpathinfo (ref string as_application, ref string as_class, ref string as_function);
as_application = is_application
as_class = is_class
as_function = is_function

// Is this a PBF Call? (Experimental for Apache to use smarter URLs)
// Instead of using /cgi-bin/pwe.exe/appname/class/function you can use /appname/class/function.pbf

If Lower(Right ( as_function,4 ))= ".pbf"  Then
   as_function = Left (as_function, Len(as_function) - 4 )
End If

If Len ( as_application ) > 0 and Len ( as_class ) > 0 and Len ( as_function ) > 0 then return 1

return -1

end function

public function string of_gettempdirectory ();// Getting the TEMP Directory!
return ""
end function

public function string of_getinifilename ();// Returns fullpath of pwe.ini filename
IF len ( is_INIFileName ) > 0 then return is_INIFileName

is_INIFileName = space (255)

if GetModuleFilename ( 0 , is_INIFileName , 255 ) > 3 then
   is_INIFileName = Left ( is_INIFileName, Len ( is_INIFileName ) - 3 ) + "ini"
else
   is_INIFileName = "" 
end if

return is_INIFileName

end function

public function long of_getvariablenames (ref string as_paramname[]);as_ParamName = is_ParamName
return Upperbound(is_ParamName) 
end function

public function string of_getparam (string as_paramname);
long ll_i
long ll_k

ll_k = Upperbound ( is_ParamName [] )

for ll_i = 1 to ll_k 
   if is_ParamName [ ll_i ] = as_ParamName then 
      return is_ParamValue [ ll_i ]
   end if
next

return STRINGNULL
end function

public function long of_getparamvalue (string as_paramname, ref string as_paramvalue);long ll_i
long ll_k

ll_k = Upperbound ( is_ParamName [] )

for ll_i = 1 to ll_k 
   if is_ParamName [ ll_i ] = as_ParamName then 
      as_ParamValue = is_ParamValue [ ll_i ]
      return 1
   end if
next

return -1
end function

on n_cst_cgienv.create
call super::create
TriggerEvent( this, "constructor" )
end on

on n_cst_cgienv.destroy
TriggerEvent( this, "destructor" )
call super::destroy
end on

event constructor;
// Parse essential Values the URL
// loads anything need into 
SetNull (STRINGNULL )
of_translatepathinfo ()
of_translatequerystring ()
of_translatehttpcookie()
of_translateposteddata()

end event