fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2009-01-19 23:39 UTC+0100 Francesco Saverio Giudice (info/at/fsgiudice.com)

Browse Source 
+ harbour/contrib/examples/uhttpd
  + harbour/contrib/examples/socket.c
  + harbour/contrib/examples/uhttpd.prg
  + harbour/contrib/examples/hbmk_b32.bat
  + harbour/contrib/examples/readme.txt
  + harbour/contrib/examples/home
  + harbour/contrib/examples/home/cgi-bin
  + harbour/contrib/examples/home/counter.html
  + harbour/contrib/examples/home/css
  + harbour/contrib/examples/home/css/base.css
  + harbour/contrib/examples/home/favicon.ico
  + harbour/contrib/examples/home/images
  + harbour/contrib/examples/home/images/ajax-loader.gif
  + harbour/contrib/examples/home/index.html
  + harbour/contrib/examples/home/js
  + harbour/contrib/examples/home/js/ajax.js
  + harbour/contrib/examples/home/testajax.html
  + harbour/contrib/examples/home/testxmldb.html
  + harbour/contrib/examples/home/xsl
  + harbour/contrib/examples/home/xsl/based.xsl
  + harbour/contrib/examples/home/xsl/basep.xsl
  + harbour/contrib/examples/logs
  + harbour/contrib/examples/modules
  + harbour/contrib/examples/modules/bldhrb.bat
  + harbour/contrib/examples/modules/showcounter.prg
  + harbour/contrib/examples/modules/tableservletdb.prg
  + harbour/contrib/examples/modules/testajax.prg
    + Uploaded first version of uHTTPD server.
    ; NOTE:
      This is first version of uHTTPD (micro HTTPD server) based
      on a sample shared from Mindaugas (thanks!).
      Actually is only for windows and BCC32.
      To build use hbmk_b32.bat
      Please read readme.txt before start to use.
This commit is contained in:
Francesco Saverio Giudice
2009-01-19 22:40:07 +00:00
parent 603ad8a1fd
commit 8f7a4429ae
19 changed files with 3555 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

36
harbour/ChangeLog
View File

@@ -8,6 +8,42 @@
2008-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org)
*/
2009-01-19 23:39 UTC+0100 Francesco Saverio Giudice (info/at/fsgiudice.com)
+ harbour/contrib/examples/uhttpd
+ harbour/contrib/examples/socket.c
+ harbour/contrib/examples/uhttpd.prg
+ harbour/contrib/examples/hbmk_b32.bat
+ harbour/contrib/examples/readme.txt
+ harbour/contrib/examples/home
+ harbour/contrib/examples/home/cgi-bin
+ harbour/contrib/examples/home/counter.html
+ harbour/contrib/examples/home/css
+ harbour/contrib/examples/home/css/base.css
+ harbour/contrib/examples/home/favicon.ico
+ harbour/contrib/examples/home/images
+ harbour/contrib/examples/home/images/ajax-loader.gif
+ harbour/contrib/examples/home/index.html
+ harbour/contrib/examples/home/js
+ harbour/contrib/examples/home/js/ajax.js
+ harbour/contrib/examples/home/testajax.html
+ harbour/contrib/examples/home/testxmldb.html
+ harbour/contrib/examples/home/xsl
+ harbour/contrib/examples/home/xsl/based.xsl
+ harbour/contrib/examples/home/xsl/basep.xsl
+ harbour/contrib/examples/logs
+ harbour/contrib/examples/modules
+ harbour/contrib/examples/modules/bldhrb.bat
+ harbour/contrib/examples/modules/showcounter.prg
+ harbour/contrib/examples/modules/tableservletdb.prg
+ harbour/contrib/examples/modules/testajax.prg
+ Uploaded first version of uHTTPD server.
; NOTE:
This is first version of uHTTPD (micro HTTPD server) based
on a sample shared from Mindaugas (thanks!).
Actually is only for windows and BCC32.
To build use hbmk_b32.bat
Please read readme.txt before start to use.
2009-01-19 22:17 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/source/vm/hvm.c
* clone arrays and hash tables instead of coping when thread static

19
harbour/contrib/examples/uhttpd/hbmk_b32.bat Normal file
View File

@@ -0,0 +1,19 @@
@echo off
rem
rem $Id: hbmk_b32.bat 9884 2008-11-09 19:37:16Z vszakats $
rem
rem NOTE: This sample program needs hbgd.lib from contrib/hbgd
..\..\..\bin\harbour uhttpd /n /i..\..\..\include
bcc32 -O2 -tW -d -a8 -I..\..\..\include -L..\..\..\lib uhttpd.c socket.c hbdebug.lib hbvmmt.lib hbrtl.lib gtwvt.lib gtwin.lib gtgui.lib hblang.lib hbrdd.lib hbmacro.lib hbpp.lib rddntx.lib rddcdx.lib rddfpt.lib hbcpage.lib hbsix.lib hbcommon.lib hbpcre.lib hbhsx.lib hbzlib.lib hbgd.lib bgd.lib xhb.lib hbct.lib cw32mt.lib
:CLEAN
del *.obj
del *.tds
del uhttpd.c
if not exist uhttpd.exe goto :EXIT
if not exist bgd.dll echo.ATTENTION! This program needs bgd.dll
echo.Build complete.
:EXIT

89
harbour/contrib/examples/uhttpd/home/counter.html Normal file
View File

@@ -0,0 +1,89 @@
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html>
<head>
<title>Show Graphic Counter</title>
<meta http-equiv="Pragma" content="no-cache">
<link rel="stylesheet" type="text/css" href="/css/base.css" />
<script type="text/javascript" src="/js/ajax.js"></script>
<script type="text/javascript">
// <![CDATA[
var divpart;
/**
* Requests table data for a specific page.
*
* @param pageNum the page number to request data for
*/
function sendData( force )
{
var qstr = getquerystring();
if ( force || qstr.length > 4 )
{
//qstr = 'w1=' + escape(qstr); // NOTE: no '?' before querystring
//xmlPost('/cgi-bin/showcounter.hrb', qstr + "&sid=" + Math.random(), tableResponseHandler);
divpart = 'result';
updatepage( escape( qstr ) );
}
return false;
}
function getquerystring()
{
var form = document.forms[ 'f1' ];
var word = form.word.value;
//alert( 'qstr: ' + qstr );
return word;
}
function updatepage( str )
{
//document.getElementById( divpart ).innerHTML = str; /* "<img src='/counter/" + str + "' />"; */
document.getElementById( divpart ).innerHTML = "<img src='/cgi-bin/showcounter.hrb?w=" + str + "' />";
}
/**
* Handler for server's response to table requests.
* Table content is pulled from response XML and a HTML
* table is built. The table is then inserted into the
* 'tableSection' DIV.
*/
function tableResponseHandler()
{
// Make sure the request is loaded (readyState = 4)
if (req.readyState == 4)
{
// Make sure the status is "OK"
if (req.status == 200)
{
// shutdown Ajax loading progress
EndProgress();
// transform
//document.write( xsldoc );
updatepage( req.responseText );
}
else
{
EndProgress();
alert("There was a problem retrieving the XML data:\n" +
req.statusText);
}
}
}
// ]]>
</script>
</head>
<body>
This is a simple ajax test. Please type a number (at least 4 digits).
<form name="f1" onsubmit='JavaScript:sendData(true);return false'>
<p>word: <input name="word" type="text" onkeyup='JavaScript:sendData(false);return false'>
<input value="Go" type="button" onclick='JavaScript:sendData(true)'></p>
<div id="result"></div>
</form>
Return to <a href="/">Main Page</a>
</body>
</html>

66
harbour/contrib/examples/uhttpd/home/css/base.css Normal file
View File

@@ -0,0 +1,66 @@
body {font-family:Tahoma,Helvetica, Arial;font-size:10pt;color:black;}
a.pageSection:link {color: #ff0000}
a.pageSection:visited {color: #0000ff}
a.pageSection:hover {background: #66ff66}
/*
a:link {color: #ff0000}
a:visited {color: #0000ff}
a:hover {background: #66ff66}
*/
A {
color: #0000FF;
text-decoration: none;
}
A:hover { color: #6699cc; text-decoration: underline; }
A.urls { color: #0A68B6; text-decoration: none; }
A.urls:hover { color: #6699cc; text-decoration: underline; }
A.tags { color: #008080; text-decoration: none; }
A.tags:hover { color: #6699cc; text-decoration: underline; }
table.pagetable td
{
padding: 3px;
}
table.datatable
{
width: 100%;
font-family: Verdana;
font-size: 12px;
}
table.datatable tr th
{
border-bottom:1px solid black;
padding: 2px;
text-align: left;
}
table.datatable tr td
{
vertical-align: top;
padding: 2px;
border-bottom: 1px solid white;
}
table.datatable tr.odd
{
background-color: #7FFFD4;
}
table.datatable tr.even
{
background-color: #F0F0F0;
}
table.datatable tr.blank
{
background-color: #FFFFFF;
}

BIN
harbour/contrib/examples/uhttpd/home/favicon.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 8.9 KiB

BIN
harbour/contrib/examples/uhttpd/home/images/ajax-loader.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.6 KiB

20
harbour/contrib/examples/uhttpd/home/index.html Normal file
View File

@@ -0,0 +1,20 @@
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<title>Harbour uHTTPD Server example</title>
<link rel="shortcut icon" href="favicon.ico" type="image/x-icon" />
</head>
<body>
Simple uHTTPD server demo.
<br />
<br />
Examples:
<br />
<a href="testajax.html">Test Ajax</a>
<br>
<a href="testxmldb.html">Test Ajax XML Database</a>
<br>
<a href="counter.html">Test Ajax Counter</a>
</body>
</html>

257
harbour/contrib/examples/uhttpd/home/js/ajax.js Normal file
View File

@@ -0,0 +1,257 @@
/*
Global data var declaration
*/
/**
* Open a connection to the specified URL, which is
* intended to provide an XML message. The specified data
* is sent to the server as parameters. This is the same as
* calling xmlOpen("POST", url, toSend, responseHandler).
*
* @param string url The URL to connect to.
* @param string toSend The data to send to the server; must be URL encoded.
* @param function responseHandler The Javascript function handling server response.
*/
function xmlPost(url, toSend, responseHandler)
{
StartProgress();
xmlOpen("POST", url, toSend, responseHandler);
}
/**
* Open a connection to the specified URL, which is
* intended to provide an XML message. No other data is
* sent to the server. This is the same as calling
* xmlOpen("GET", url, null, responseHandler).
*
* @param string url The URL to connect to.
* @param function responseHandler The Javascript function handling server response.
*/
function xmlGet(url, responseHandler)
{
StartProgress();
xmlOpen("GET", url, null, responseHandler);
}
/**
* Open a connection to the specified URL, which is
* intended to respond with an XML message.
*
* @param string method The connection method; either "GET" or "POST".
* @param string url The URL to connect to.
* @param string toSend The data to send to the server; must be URL encoded.
* @param function responseHandler The Javascript function handling server response.
*/
function xmlOpen(method, url, toSend, responseHandler)
{
req = null;
if (window.XMLHttpRequest)
{
// browser has native support for XMLHttpRequest object
req = new XMLHttpRequest();
}
else if (window.ActiveXObject)
{
// try XMLHTTP ActiveX (Internet Explorer) version
req = new ActiveXObject("Microsoft.XMLHTTP");
}
if(req)
{
req.onreadystatechange = responseHandler;
req.open(method, url, true);
req.setRequestHeader("content-type","application/x-www-form-urlencoded");
req.send(toSend);
}
else
{
alert('Your browser does not seem to support XMLHttpRequest.');
}
}
/**
* Gets the first child node of <code>parent</code> with the
* specified tag name.
*
* @param parent the parent XML DOM node to search
* @param tagName the tag name of the child node to search for
*/
function getNode(parent, tagName)
{
var i;
var max = parent.childNodes.length;
// Check each child node
for(i = 0; i < max; i++)
{
if(parent.childNodes[i].tagName)
{
if(parent.childNodes[i].tagName.toUpperCase() == tagName.toUpperCase())
{
// We found a matching child node; return it.
return parent.childNodes[i];
}
}
}
// One was not found; return null
return null;
}
/**
* Gets the first child node of <code>parent</code> with the
* specified tag name and whose value of the 'key' attribute
* is <code>key</code>.
*
* @param parent the parent XML DOM node to search
* @param tagName the tag name of the child nodes to search in
* @param key the value of the 'key' attribute to search on
*/
function getNodesWithKey(parent, tagName, key)
{
var i;
var cellNodes = parent.getElementsByTagName(tagName);
var max = cellNodes.length;
// Check each cell node for the specified value for
// the 'key' attribute
for(i = 0; i < max; i++)
{
if(cellNodes[i].getAttribute('key') == key)
{
// We found a matching cell node; return it.
return cellNodes[i];
}
}
// One was not found; return null
return null;
}
// ----- xslT functions --------------------------------------------------------------------
// Immediately try to load the xsl file asynchronously
var xsldocloaded = false;
var xsldoc;
function xslGet( xslfile )
{
if (window.XSLTProcessor)
{
// support Mozilla/Gecko based browsers
xsldoc = document.implementation.createDocument("", "", null);
xsldoc.addEventListener("load", onXslLoad, false);
xsldoc.load( xslfile );
}
else if(window.ActiveXObject)
{
// support Windows / ActiveX
xsldoc = new ActiveXObject("Microsoft.XMLDOM");
xsldoc.ondataavailable = onXslLoad;
xsldoc.load( xslfile );
}
}
function onXslLoad()
{
// flag that the xsl is loaded
xsldocloaded = true;
//alert( "xsl loaded: " + xsldocloaded )
}
// ----- xslT to HTML functions -----------
function combine_XLM_XSLT_HTML( xlm, xsl, html, html_id )
{
var swappableSection = html.getElementById( html_id );
if (window.XSLTProcessor)
{
// support Mozilla/Gecko based browsers
var xsltProcessor = new XSLTProcessor();
xsltProcessor.importStylesheet( xsl );
var outputXHTML = xsltProcessor.transformToFragment( xlm.responseXML, html );
//alert( outputXHTML );
swappableSection.innerHTML = "";
swappableSection.appendChild( outputXHTML );
}
else if(window.ActiveXObject)
{
// support Windows/ActiveX enabled browsers
var outputXHTML = xlm.responseXML.transformNode( xsl );
//alert( outputXHTML );
swappableSection.innerHTML = outputXHTML;
}
}
// ----- show or hide a progress indicator -----
var progress = false;
var progressTimer = null;
// show a progress indicator if it takes longer...
function StartProgress()
{
//alert( "progress = " + progress );
progress = true;
if (progressTimer != null)
window.clearTimeout(progressTimer);
progressTimer = window.setTimeout(ShowProgress, 220);
} // StartProgress
// hide any progress indicator soon.
function EndProgress()
{
progress = false;
if (progressTimer != null)
window.clearTimeout(progressTimer);
progressTimer = window.setTimeout(ShowProgress, 20);
} // EndProgress
// this function is called by a timer to show or hide a progress indicator
function ShowProgress()
{
//alert( "Showprogress = " + progress );
progressTimer = null;
var a = document.getElementById("AjaxProgressIndicator");
if (progress && (a != null)) {
// just display the existing object
a.style.top = document.documentElement.scrollTop + 2 + "px";
a.style.display = "";
} else if (progress) {
// find a relative link to the ajaxcore folder containing ajax.js
var path = "/images/"
//for (var n in document.scripts) {
// s = document.scripts[n].src;
// if ((s != null) && (s.length >= 7) && (s.substr(s.length -7).toLowerCase() == "ajax.js"))
// path = s.substr(0,s.length -7);
//} // for
// create new standard progress object
a = document.createElement("div");
a.id = "AjaxProgressIndicator";
a.style.position = "absolute";
a.style.right = "2px";
a.style.top = document.documentElement.scrollTop + 2 + "px";
a.style.width = "130px";
a.style.height = "16px"
a.style.padding = "2px";
a.style.verticalAlign = "bottom";
a.style.backgroundColor="#9FCDFF";
a.innerHTML = "<img style='vertical-align:bottom' src='" + path + "ajax-loader.gif?a'>&nbsp;please wait...";
document.body.appendChild(a);
} else if (a) {
a.style.display="none";
} // if
} // ShowProgress

56
harbour/contrib/examples/uhttpd/home/testajax.html Normal file
View File

@@ -0,0 +1,56 @@
<html>
<head>
<title>Simple Ajax Example</title>
<script language="Javascript">
function xmlhttpPost(strURL)
{
var xmlHttpReq = false;
var self = this;
// Mozilla/Safari
if ( window.XMLHttpRequest )
{
self.xmlHttpReq = new XMLHttpRequest();
}
// IE
else if ( window.ActiveXObject )
{
self.xmlHttpReq = new ActiveXObject("Microsoft.XMLHTTP");
}
self.xmlHttpReq.open('POST', strURL, true);
self.xmlHttpReq.setRequestHeader('Content-Type', 'application/x-www-form-urlencoded');
self.xmlHttpReq.onreadystatechange = function()
{
if ( self.xmlHttpReq.readyState == 4 )
{
updatepage( self.xmlHttpReq.responseText );
}
}
self.xmlHttpReq.send( getquerystring() );
}
function getquerystring()
{
var form = document.forms[ 'f1' ];
var word = form.word.value;
qstr = 'w=' + escape(word); // NOTE: no '?' before querystring
return qstr;
}
function updatepage( str )
{
document.getElementById( "result" ).innerHTML = str;
}
</script>
</head>
<body>
This is a simple ajax test. Please type a string in input field and press GO button.
<form name="f1">
<p>word: <input name="word" type="text">
<input value="Go" type="button" onclick='JavaScript:xmlhttpPost("/cgi-bin/testajax.hrb")'></p>
<div id="result"></div>
</form>
Return to <a href="/">Main Page</a>
</body>
</html>

85
harbour/contrib/examples/uhttpd/home/testxmldb.html Normal file
View File

@@ -0,0 +1,85 @@
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html>
<head>
<title>Part 4 Example</title>
<meta http-equiv="Pragma" content="no-cache">
<link rel="stylesheet" type="text/css" href="/css/base.css" />
<script type="text/javascript" src="/js/ajax.js"></script>
<script type="text/javascript">
// <![CDATA[
var divpart;
/**
* Requests table data for a specific page.
*
* @param pageNum the page number to request data for
*/
function getTableData(pageNum)
{
xslGet( "/xsl/based.xsl" );
xmlGet('/cgi-bin/tableservletdb.hrb?page=' + pageNum + "&sid=" + Math.random(), tableResponseHandler);
divpart = 'tableSection';
}
function getTablePages()
{
xslGet( "/xsl/basep.xsl" );
xmlGet('/cgi-bin/tableservletdb.hrb?count=true' + "&sid=" + Math.random(), tableResponseHandler);
divpart = 'pageSection';
}
/**
* Handler for server's response to table requests.
* Table content is pulled from response XML and a HTML
* table is built. The table is then inserted into the
* 'tableSection' DIV.
*/
function tableResponseHandler()
{
// Make sure the request is loaded (readyState = 4)
if (req.readyState == 4)
{
// Make sure the status is "OK"
if (req.status == 200)
{
// shutdown Ajax loading progress
EndProgress();
// Make sure the XSL document is loaded
if (!xsldocloaded)
{
alert('Unable to transform data. XSL is not yet loaded.');
// break out of the function
return;
}
// transform
//document.write( xsldoc );
combine_XLM_XSLT_HTML( req, xsldoc, document, divpart );
xsldocloaded = null;
xsldoc = null;
}
else
{
alert("There was a problem retrieving the XML data:\n" +
req.statusText);
}
}
}
// ]]>
</script>
</head>
<body onload="getTablePages()">
Sample XML servlet. Tested with IE6+ and Firefox 2+
<br>Return to <a href="/">Main Page</a>
<br>Page&nbsp;
<div style="border: 1px solid black; padding: 10px;" id="pageSection">&nbsp;</div>
<br />
<div style="border: 1px solid black; padding: 10px;" id="tableSection">&nbsp;</div>
</body>
</html>

74
harbour/contrib/examples/uhttpd/home/xsl/based.xsl Normal file
View File

@@ -0,0 +1,74 @@
<?xml version="1.0" encoding="ISO-8859-1"?>
<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
<xsl:output method="html" omit-xml-declaration="yes" indent="no"/>
<xsl:variable name="numCols" select="count(table/header/cell)" />
<xsl:variable name="numToPad" select="23 - count(table/row)" />
<xsl:template match="/">
<!-- start Data Section table -->
<table cellspacing="0" cellpadding="0" class="datatable">
<tr>
<xsl:for-each select="table/header/cell">
<th><xsl:value-of select="." /></th>
</xsl:for-each>
</tr>
<xsl:if test="count(table/row) = 0">
<tr class="blank">
<td width="100%" colspan="{$numCols}" align="center" style="font-style: italic; padding:10px;">No Records Found</td>
</tr>
</xsl:if>
<xsl:for-each select="table/row">
<xsl:variable name="rowClass">
<xsl:choose>
<xsl:when test="position() mod 2">even</xsl:when>
<xsl:otherwise>odd</xsl:otherwise>
</xsl:choose>
</xsl:variable>
<tr class="{$rowClass}">
<xsl:call-template name="buildCell">
<xsl:with-param name="rowNode" select="." />
</xsl:call-template>
</tr>
</xsl:for-each>
<xsl:call-template name="padding">
<xsl:with-param name="max_count" select="$numToPad"/>
<xsl:with-param name="counter" select="'0'"/>
</xsl:call-template>
</table>
<!-- end Data Section table -->
</xsl:template>
<xsl:template name="buildCell">
<xsl:param name="rowNode"/>
<xsl:for-each select="/table/header/cell">
<xsl:variable name="colName" select="@key" />
<td><xsl:value-of select="$rowNode/*[@key=$colName]" disable-output-escaping="yes"/>&#160;</td>
</xsl:for-each>
</xsl:template>
<xsl:template name="padding">
<xsl:param name="max_count"/>
<xsl:param name="counter"/>
<xsl:if test="$counter &lt; $max_count">
<tr class="blank">
<td colspan="{$numCols + 1}">&#160;</td>
</tr>
<xsl:call-template name="padding">
<xsl:with-param name="max_count" select="$max_count"/>
<xsl:with-param name="counter" select="$counter + 1"/>
</xsl:call-template>
</xsl:if>
</xsl:template>
</xsl:stylesheet>

24
harbour/contrib/examples/uhttpd/home/xsl/basep.xsl Normal file
View File

@@ -0,0 +1,24 @@
<?xml version="1.0" encoding="ISO-8859-1"?>
<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
<xsl:output method="html" omit-xml-declaration="yes" indent="no"/>
<xsl:template match="/">
<!-- start Data Section table -->
<table cellspacing="0" cellpadding="0" class="pagetable">
<tr>
<xsl:for-each select="pages/page">
<td>
<xsl:variable name="pagenumber"><xsl:value-of select="." /></xsl:variable>
<a class="pageSection" href="javascript: getTableData({$pagenumber});"><xsl:value-of select="$pagenumber" />
</a>
</td>
</xsl:for-each>
</tr>
</table>
</xsl:template>
</xsl:stylesheet>

63
harbour/contrib/examples/uhttpd/modules/bldhrb.bat Normal file
View File

@@ -0,0 +1,63 @@
@echo off
rem Saving current HB_MT state
set OLDENVMT=%HB_MT%
set OLDENVGT=%HB_GT_LIB%
set OLDENVC=%CFLAGS%
set OLDENVHB=%HARBOURFLAGS%
set OLD_HB_ARCHITECTURE=%HB_ARCHITECTURE%
set OLD_HB_COMPILER=%HB_COMPILER%
set OLD_HB_USER_LIBS=%HB_USER_LIBS%
set HB_INSTALL=..\..\..\..
if %HB_ARCHITECTURE%.==. set HB_ARCHITECTURE=w32
if %HB_COMPILER%.==. set HB_COMPILER=bcc32
SET HB_BIN_INSTALL=%HB_INSTALL%\bin
set HB_INC_INSTALL=include;%HB_INSTALL%\include
set HB_LIB_INSTALL=%HB_INSTALL%\lib
%HB_BIN_INSTALL%\harbour %1.prg -n -q0 -w -es2 -gh -i%HB_INC_INSTALL% %2 %3 %HARBOURFLAGS% > bldtest.log
IF ERRORLEVEL 1 GOTO SHOWERROR
GOTO COMPILEOK
:SHOWERROR
echo.
echo.Error on compiling ...
echo.
echo.Running notepad, please close to end this batch file ...
echo.
notepad bldtest.log
echo.
echo.Notepad closed, exiting ...
echo.
GOTO ENDSET
:COMPILEOK
echo.
echo.Compiled successfully
echo.
if exist bldtest.log del bldtest.log
if exist %1.hrb copy %1.hrb ..\home\cgi-bin /y
if exist %1.hrb del %1.hrb
GOTO ENDSET
:ENDSET
rem Restore Old Settings
set HB_MT=%OLDENVMT%
set HB_GT_LIB=%OLDENVGT%
set CFLAGS=%OLDENVC%
set HARBOURFLAGS=%OLDENVHB%
set HB_ARCHITECTURE=%OLD_HB_ARCHITECTURE%
set HB_COMPILER=%OLD_HB_COMPILER%
set HB_USER_LIBS=%OLD_HB_USER_LIBS%
set OLDENVHB=
set OLDENVGT=
set OLDENVC=
set OLDENVMT=
set BLDDEFAULT=
set OLD_HB_ARCHITECTURE=
set OLD_HB_COMPILER=
set OLD_HB_USER_LIBS=

219
harbour/contrib/examples/uhttpd/modules/showcounter.prg Normal file
View File

@@ -0,0 +1,219 @@
/*
* $Id: rlcdx.prg 9754 2008-10-27 22:40:04Z vszakats $
*/
/*
* Harbour Project source code:
* simple image counter
*
* Copyright 2009 Francesco Saverio Giudice <info / at / fsgiudice.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
MEMVAR _SERVER // defined in uHTTPD
MEMVAR _REQUEST // defined in uHTTPD
#include "common.ch"
//#include "xhb.ch"
#include "gd.ch"
#define IMAGES_IN "..\..\hbgd\tests\digits\"
#define IMAGES_OUT ( _SERVER[ "DOCUMENT_ROOT" ] + "\counter\" )
#define DISPLAY_NUM 10
FUNCTION HRBMAIN()
LOCAL cHtml
LOCAL cBaseImage
IF HB_HHasKey( _REQUEST, "w" )
cHtml := CreateCounter( AllTrim( Str( Val( _REQUEST[ "w" ] ) ) ) )
//hb_ToOutDebug( hb_sprintf( "CreateCounter = %s", cHtml ) )
IF !Empty( cHtml )
uAddHeader( "Content-Type", "image/gif" )
uAddHeader( "Pragma", "no-cache" )
uAddHeader( "Content-Disposition", "inline; filename=counter" + LTrim( Str( hb_randomint( 100 ) ) ) + ".gif" )
uWrite( cHtml )
ELSE
uAddHeader( "Content-Type", "text/html" )
uWrite( "<h1>Error: No image created</h1>" )
ENDIF
ELSE
uAddHeader( "Content-Type", "text/html" )
uWrite( "<h1>Error: no parameters passed</h1>" )
ENDIF
RETURN TRUE
STATIC FUNCTION CreateCounter( cValue, cBaseImage )
LOCAL oI, oIDigits, nWidth, nHeight, nDigits, nNumWidth, oTemp
//LOCAL black, white, blue, red, green, cyan, gray
LOCAL white
LOCAL aNumberImages := {}
LOCAL n, nValue
LOCAL cFile
// A value if not passed
DEFAULT cValue TO Str( hb_RandomInt( 1, 10^DISPLAY_NUM ), DISPLAY_NUM )
DEFAULT cBaseImage TO "57chevy.gif"
IF !File( IMAGES_IN + cBaseImage )
//hb_ToOutDebug( "ERROR: Base Image File '" + IMAGES_IN + cBaseImage + "' not found" )
//THROW( "ERROR: Base Image File '" + IMAGES_IN + cBaseImage + "' not found" )
RETURN NIL
ENDIF
nValue := Val( cValue )
// Fix num lenght
IF nValue > 10^DISPLAY_NUM
nValue := 10^DISPLAY_NUM
ENDIF
cValue := StrZero( nValue, DISPLAY_NUM )
//? "Value = ", cValue
// To set fonts run this command:
// for windows: SET GDFONTPATH=c:\windows\fonts
// per linux : export GDFONTPATH=/usr/share/fonts/default/TrueType
// SET GDFONTPATH=c:\windows\fonts
//IF GetEnv( "GDFONTPATH" ) == ""
// ? "Please set GDFONTPATH"
// ? "On Windows: SET GDFONTPATH=c:\windows\fonts"
// ? "On Linux : export GDFONTPATH=/usr/share/fonts/default/TrueType"
// ?
//ENDIF
// Check output directory
/*
IF !ISDirectory( IMAGES_OUT )
DirMake( IMAGES_OUT )
ENDIF
*/
/* Load a digits image in memory from file */
oIDigits := GDImage():LoadFromGif( IMAGES_IN + cBaseImage )
/* Get single number images */
// Get dimensions
nWidth := oIDigits:Width()
nHeight := oIDigits:Height()
// Check base digits image
DO CASE
CASE nWidth % 10 == 0 // 0..9 digits
nDigits := 10
CASE nWidth % 11 == 0 // 0..9 :
nDigits := 11
CASE nWidth % 13 == 0 // 0..9 : am pm
nDigits := 13
OTHERWISE
uWrite( "Error on digits image" )
ENDCASE
nNumWidth := nWidth / nDigits
//? "nNumWidth, nWidth, nHeight, nDigits = ", nNumWidth, nWidth, nHeight, nDigits
/* extracts single digits */
FOR n := 1 TO nDigits
oTemp := oIDigits:Copy( (n - 1) * nNumWidth, 0, nNumWidth, nHeight )
//oTemp:SaveGif( IMAGES_OUT + StrZero( n-1, 2 ) + ".gif" )
// Here I have to clone the image, otherwise on var destruction I loose
// the image in memory
aAdd( aNumberImages, oTemp:Clone() )
NEXT
/* Create counter image in memory */
oI := GDImage():New( nNumWidth * DISPLAY_NUM, nHeight ) // the counter
//? "Image dimensions: ", oI:Width(), oI:Height()
/* Allocate background */
white := oI:SetColor( 255, 255, 255 )
/* Allocate drawing color */
//black := oI:SetColor( 0, 0, 0 )
//blue := oI:SetColor( 0, 0, 255 )
//red := oI:SetColor( 255, 0, 0 )
//green := oI:SetColor( 0, 255, 0 )
//cyan := oI:SetColor( 0, 255, 255 )
/* Draw rectangle */
//oI:Rectangle( 0, 0, 200, 30, , blue )
/* Draw Digits */
FOR n := 1 TO Len( cValue )
// Retrieve the number from array in memory
oTemp := aNumberImages[ Val( SubStr( cValue, n, 1 ) ) + 1 ]:Clone()
// Save it to show the number for a position
//oTemp:SaveGif( IMAGES_OUT + "Pos_" + StrZero( n, 2 ) + ".gif" )
// Set the digit as tile that I have to use to fill position in counter
oI:SetTile( oTemp )
// Fill the position with the image digit
oI:Rectangle( (n - 1) * nNumWidth, 0, (n - 1) * nNumWidth + nNumWidth, nHeight, TRUE, gdTiled )
NEXT
/* Write Final Counter Image */
cFile := "counter" + StrZero( hb_RandomInt( 1, 99 ), 2 ) + ".gif"
//oI:SaveGif( IMAGES_OUT + cFile )
/* Destroy images in memory */
// Class does it automatically
//?
//? "Look at " + IMAGES_OUT + " folder for output images"
//?
//RETURN cFile
RETURN oI:ToStringGif()

400
harbour/contrib/examples/uhttpd/modules/tableservletdb.prg Normal file
View File

@@ -0,0 +1,400 @@
/*
* $Id: rlcdx.prg 9754 2008-10-27 22:40:04Z vszakats $
*/
/*
* Harbour Project source code:
* xml table servlet
*
* Copyright 2009 Francesco Saverio Giudice <info / at / fsgiudice.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "common.ch"
#include "hbclass.ch"
#define CRLF ( chr(13)+chr(10) )
#define TABLE_NAME_PATH "..\..\..\tests\test.dbf"
#define SIMULATE_SLOW_REPLY
MEMVAR _REQUEST // defined in uHTTPD
FUNCTION HRBMAIN()
LOCAL cXml, cPage, cCount, nCount
LOCAL oTM
LOCAL hGets
hGets := _REQUEST
DEFAULT hGets TO hb_Hash()
IF HB_HHasKey( hGets, "page" )
cPage := hGets[ "page" ]
oTM := TableManager():New()
IF ( oTM:Open() )
oTM:Read()
cXml := oTM:getXmlData( Val( cPage ) )
oTM:Close()
ENDIF
ELSEIF HB_HHasKey( hGets, "count" )
cCount := hGets[ "count" ]
IF cCount == "true"
oTM := TableManager():New()
IF ( oTM:Open() )
nCount := oTM:getLastRec()
cXml := oTM:getXmlCount( nCount )
oTM:Close()
ENDIF
ENDIF
ENDIF
IF !Empty( cXml )
uAddHeader("Content-Type", "text/xml")
// cache control
uAddHeader( "Cache-Control", "no-cache, must-revalidate" )
uAddHeader( "Expires", "Mon, 26 Jul 1997 05:00:00 GMT" )
uWrite( cXml )
ELSE
uAddHeader("Content-Type", "text/xml")
uWrite( '<?xml version="1.0" encoding="ISO-8859-1"?>' )
uWrite( '<pages><page>No Data</page></pages>' )
ENDIF
RETURN TRUE // I Handle HTML Output
/*
TableManager
*/
CLASS TableManager
CLASSVAR ROWS_PER_PAGE INIT 23
VAR aData INIT {}
VAR cTable INIT TABLE_NAME_PATH
VAR lOpened INIT FALSE
METHOD New()
METHOD Open()
METHOD Close() INLINE IIF( ::lOpened, ( table->( dbCloseArea() ), ::lOpened := FALSE ), )
METHOD Read()
METHOD getLastRec() INLINE table->( LastRec() )
METHOD getXmlData()
METHOD getXmlCount()
METHOD xmlEncode( input )
ENDCLASS
METHOD New() CLASS TableManager
RETURN Self
METHOD Open() CLASS TableManager
LOCAL cDBF := ::cTable
IF !::lOpened
CLOSE ALL
USE ( cDBF ) ALIAS table SHARED NEW
::lOpened := USED()
ENDIF
RETURN ::lOpened
METHOD Read() CLASS TableManager
LOCAL hMap, lOk := FALSE
#ifdef SIMULATE_SLOW_REPLY
// force slow connection to simulate long reply
HB_IDLESLEEP(0.5)
#endif
IF ::lOpened
table->( dbGoTop() )
//n := 0
DO WHILE table->( !Eof() ) //.AND. ++n < 50
hMap := hb_Hash()
hMap[ "recno" ] := StrZero( table->( RecNo() ), 4 )
hMap[ "name" ] := RTrim( table->first ) + " " + RTrim( table->last )
hMap[ "address" ] := RTrim( table->street )
hMap[ "city" ] := RTrim( table->city )
hMap[ "state" ] := table->state
hMap[ "zip" ] := table->zip
aAdd( ::aData, hMap )
table->( dbSkip() )
ENDDO
lOk := TRUE
ENDIF
RETURN lOK
/**
* Builds a <code>String</code> of XML representing the aData for the
* request table.
*
* For simplicity, we are using a hard-coded data set. In a production
* system, you may wish to use DAOs to query a database for specific table
* data. This may require additional parameters (e.g., the name of the
* table, which could be used to look up instructions on retrieving the
* necessary data).
*
* The returned XML will be formatted as follows:
* &lt;table&gt;<br />
* &lt;header&gt;<br />
* &lt;cell key="address"&gt;Address&lt;/cell&gt;<br />
* &lt;/header&gt;<br />
* &lt;row&gt;<br />
* &lt;cell key="name"&gt;Hank&lt;/cell&gt;<br />
* &lt;cell key="address"&gt;1B Something Street&lt;/cell&gt;<br />
* &lt;cell key="city"&gt;Marietta&lt;/cell&gt;<br />
* &lt;cell key="state"&gt;GA&lt;/cell&gt;<br />
* &lt;cell key="zip"&gt;30339&lt;/cell&gt;<br />
* &lt;/row&gt;<br />
* ...<br />
* &lt;/table&gt;
*
* @param page
* the page number to retrieve data for
* @return a <code>String</code> of XML representing data for the
* requested table
* @throws IllegalArgumentException
*/
METHOD getXmlData( page ) CLASS TableManager
LOCAL startIndex, stopIndex
LOCAL xml, i, map, key, cString
/*
* For simplicity, we are creating XML as a String. In a production
* system, you should create an XML document (org.w3c.dom.Document) to
* ensure compliance with the DOM Level 2 Core Specification.
*/
// Calculate the start and end indexes of the table data.
startIndex := (page - 1) * ::ROWS_PER_PAGE
stopIndex := startIndex + ::ROWS_PER_PAGE
stopIndex := Min( Len( ::aData ), stopIndex )
// Check the validity of the page index.
IF ( startIndex < 0 .OR. startIndex >= stopIndex )
//throw new IllegalArgumentException("Page index is out of bounds.");
ENDIF
xml := BasicXML():New()
xml:append( '<?xml version="1.0" encoding="ISO-8859-1"?>' )
// Add the opening <table> tag
xml:append( "<table>" )
// Add nodes describing the table columns
xml:append( "<header>" )
xml:append( '<cell key="recno">RecNo</cell>')
xml:append( '<cell key="name">Name</cell>')
xml:append( '<cell key="address">Address</cell>' )
xml:append( '<cell key="city">City</cell>' )
xml:append( '<cell key="state">State</cell>' )
xml:append( '<cell key="zip">Zip</cell>' )
xml:append( "</header>" )
// Add nodes for each row.
FOR i := startIndex + 1 TO stopIndex
map := ::aData[ i ]
// Add the opening <row> tag
xml:append( "<row>" )
// For each entry in the HashMap, add a node
// e.g., <address>123 four street</address>
FOR EACH key IN map:Keys
cString := '<cell key="' + key + '">'
cString += ::xmlEncode( hb_cStr( map[ key ] ) )
cString += "</cell>"
xml:append( cString )
NEXT
// Add the closing </row> tag
xml:append( "</row>" )
NEXT
// Add the closing </table> tag
xml:append( "</table>" )
RETURN xml:toString()
METHOD getXmlCount( nCount ) CLASS TableManager
LOCAL xml, n
LOCAL nPages := nCount / ::ROWS_PER_PAGE
IF Int( nPages ) < nPages
nPages++
ENDIF
xml := BasicXML():New()
xml:append( '<?xml version="1.0" encoding="ISO-8859-1"?>' )
xml:append( "<pages>" )
FOR n := 1 TO nPages
xml:append( "<page>" + LTrim( Str( n ) ) + "</page>" )
NEXT
xml:append( "</pages>" )
RETURN xml:toString()
/**
* Replaces characters commonly used in XML with symbolic representations
* such that they are interpretted correctly by XML parsers.
*
* @param input
* the string to encode.
* @return the encoded version of the specified string
*/
METHOD xmlEncode( input ) CLASS TableManager
LOCAL out, i, c
IF input == NIL
RETURN input
ENDIF
// Go through the input string and replace the following
// characters:
// & &amp;
// ' &apos;
// " &quot;
// < &lt;
// > &gt;
// [any non-ascii character] &#[character code];
out := ""
FOR i := 1 TO Len( input )
c := SubStr( input, i, 1 )
switch ( c )
case '&'
out += "&amp;"
exit
case "'"
out += "&apos;"
exit
case '"'
out += "&quot;"
exit
case '<'
out += "&lt;"
exit
case '>'
out += "&gt;"
exit
//case ' '
// out += "&nbsp;"
// exit
case Chr( 9 ) //E'\t'
case Chr( 13 ) //E'\r'
case Chr( 10 ) //E'\n'
out += c
exit
OTHERWISE
// All non-ascii
if ( Asc( c ) <= 0x1F .OR. Asc( c ) >= 0x80 )
out += "&#x" + hb_NumToHex( Asc( c ) ) + ";"
else
out += c
endif
exit
end
NEXT
RETURN out
CLASS BasicXML
VAR aData INIT {}
METHOD New() CONSTRUCTOR
METHOD Append( cString ) INLINE aAdd( ::aData, cString )
METHOD ToString()
ENDCLASS
METHOD New() CLASS BasicXML
RETURN Self
METHOD ToString() CLASS BasicXML
LOCAL s := ""
aEval( ::aData, {|c| s += c + IIF( Right( c, 1 ) == ">", CRLF, "" ) } )
RETURN s

69
harbour/contrib/examples/uhttpd/modules/testajax.prg Normal file
View File

@@ -0,0 +1,69 @@
/*
* $Id: rlcdx.prg 9754 2008-10-27 22:40:04Z vszakats $
*/
/*
* Harbour Project source code:
* simple ajax responder
*
* Copyright 2009 Francesco Saverio Giudice <info / at / fsgiudice.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "common.ch"
MEMVAR _REQUEST
FUNCTION HRBMAIN()
LOCAL cW
LOCAL cHtml := ""
IF HB_HHasKey( _REQUEST, "w" )
IF !Empty( cW := _REQUEST[ "w" ] )
cHtml += "This is a reply from testajax : " + cW
ENDIF
ENDIF
RETURN cHtml

12
harbour/contrib/examples/uhttpd/readme.txt Normal file
View File

@@ -0,0 +1,12 @@
uHTTPD server
Build it using hbmk*.bat
For parameters run:
uhttpd -?
Before starting please build modules in modules folder using bldhrb.bat
Francesco

416
harbour/contrib/examples/uhttpd/socket.c Normal file
View File

@@ -0,0 +1,416 @@
#include <windows.h>
#include "hbapi.h"
#include "hbapiitm.h"
/*
Function naming:
The intention of this library is to be as close as possible to the original
socket implementation. This supposed to be valid for function names also,
but some of the names are very platform dependent, ex., WSA*() functions.
select() function name is reserved for standard Harbour's function, so,
socket_*() prefix was used:
socket_init() - WSAStartup()
socket_exit() - WSACleanup()
socket_error() - WSALastError()
socket_select() - select()
Finally I renamed all functions to have socket_*() prefix to be more "prefix
compatible" and not to occupy a general function names like send(), bind(),
accept(), listen(), etc.:
socket_create() - socket()
socket_close() - closesocket()
socket_shutdown() - shutdown()
socket_bind() - bind()
socket_listen() - listen()
socket_accept() - accept()
socket_send() - send()
socket_recv() - recv()
socket_recv() - recv()
socket_getsockname() - getsockname()
socket_getpeername() - getpeername()
Types mapping:
SOCKET
UINT_PTR in Windows, let's map it to pointer type, and INVALID_SOCKET value to NIL
struct sockaddr
It is not only IP addresses, also can be IPX, etc. All network-host byte order
conversion should be hidden from Harbour API. So, let's map to:
{ adress_familly, ... }
AF_INET: { AF_INET, cAddr, nPort }
other: { AF_?, cAddressDump }
*/
#ifdef hb_parnidef
#undef hb_parnidef
#endif
static int hb_parnidef( int iParam, int iValue )
{
return ISNUM( iParam ) ? hb_parni( iParam ) : iValue;
}
static SOCKET hb_parsocket( int iParam )
{
return ISPOINTER( iParam ) ? ( SOCKET ) hb_parptr( 1 ) : INVALID_SOCKET;
}
static void hb_retsocket( SOCKET hSocket )
{
if( hSocket == INVALID_SOCKET )
hb_ret();
else
hb_retptr( ( void* ) hSocket );
}
static SOCKET hb_itemGetSocket( PHB_ITEM pItem )
{
return HB_IS_POINTER( pItem ) ? ( SOCKET ) hb_itemGetPtr( pItem ) : INVALID_SOCKET;
}
static PHB_ITEM hb_itemPutSocket( PHB_ITEM pItem, SOCKET hSocket )
{
if( ! pItem )
pItem = hb_itemNew( NULL );
if( hSocket == INVALID_SOCKET )
hb_itemClear( pItem );
else
hb_itemPutPtr( pItem, ( void* ) hSocket );
return pItem;
}
static void hb_itemGetSockaddr( PHB_ITEM pItem, struct sockaddr* sa )
{
memset( sa, 0, sizeof( struct sockaddr ) );
if( HB_IS_ARRAY( pItem ) )
{
sa->sa_family = hb_arrayGetNI( pItem, 1 );
if( sa->sa_family == AF_INET )
{
( ( struct sockaddr_in* ) sa)->sin_addr.S_un.S_addr = inet_addr( hb_arrayGetCPtr( pItem, 2 ) );
( ( struct sockaddr_in* ) sa)->sin_port = htons( hb_arrayGetNI( pItem, 3 ) );
}
else
{
ULONG ulLen = hb_arrayGetCLen( pItem, 2 );
if( ulLen > sizeof( sa->sa_data ) )
ulLen = sizeof( sa->sa_data );
memcpy( sa->sa_data, hb_arrayGetCPtr( pItem, 2 ), ulLen );
}
}
}
static PHB_ITEM hb_itemPutSockaddr( PHB_ITEM pItem, const struct sockaddr* saddr )
{
pItem = hb_itemNew( pItem );
if( saddr->sa_family == AF_INET )
{
hb_arrayNew( pItem, 3 );
hb_arraySetNI( pItem, 1, saddr->sa_family );
hb_arraySetC( pItem, 2, inet_ntoa( ( ( struct sockaddr_in* ) saddr )->sin_addr ) );
hb_arraySetNI( pItem, 3, ntohs( ( ( struct sockaddr_in* ) saddr )->sin_port ) );
}
else
{
hb_arrayNew( pItem, 2 );
hb_arraySetNI( pItem, 1, saddr->sa_family );
hb_arraySetCL( pItem, 2, saddr->sa_data, sizeof( saddr->sa_data ) );
}
return pItem;
}
HB_FUNC ( SOCKET_INIT )
{
WSADATA wsad;
hb_retni( WSAStartup( hb_parnidef( 1, 257 ), &wsad ) );
hb_storclen( (char*) &wsad, sizeof( WSADATA ), 2 );
}
HB_FUNC ( SOCKET_EXIT )
{
hb_retni( WSACleanup() );
}
HB_FUNC ( SOCKET_ERROR )
{
hb_retni( WSAGetLastError() );
}
HB_FUNC ( SOCKET_CREATE )
{
hb_retsocket( socket( hb_parnidef( 1, PF_INET ),
hb_parnidef( 2, SOCK_STREAM ),
hb_parnidef( 3, IPPROTO_TCP ) ) );
}
HB_FUNC ( SOCKET_CLOSE )
{
hb_retni( closesocket( hb_parsocket( 1 ) ) );
}
HB_FUNC ( SOCKET_BIND )
{
struct sockaddr sa;
hb_itemGetSockaddr( hb_param( 2, HB_IT_ANY ), &sa );
hb_retni( bind( hb_parsocket( 1 ), &sa, sizeof( struct sockaddr ) ) );
}
HB_FUNC ( SOCKET_LISTEN )
{
hb_retni( listen( hb_parsocket( 1 ), hb_parnidef( 2, 10 ) ) );
}
HB_FUNC ( SOCKET_ACCEPT )
{
struct sockaddr saddr;
int iSize = sizeof( struct sockaddr );
hb_retsocket( accept( hb_parsocket( 1 ), &saddr, &iSize ) );
if( ISBYREF( 2 ) )
{
hb_itemParamStoreForward( 2, hb_itemPutSockaddr( NULL, &saddr ) );
}
}
HB_FUNC ( SOCKET_SHUTDOWN )
{
hb_retni( shutdown( hb_parsocket( 1 ), hb_parnidef( 2, SD_BOTH ) ) );
}
HB_FUNC ( SOCKET_RECV )
{
int iLen, iRet;
char* pBuf;
iLen = hb_parni( 3 );
if( iLen > 65536 || iLen <= 0 )
iLen = 4096;
pBuf = ( char* ) hb_xgrab( ( ULONG ) iLen );
iRet = recv( hb_parsocket( 1 ), pBuf, iLen, hb_parnidef( 4, 0 ) );
hb_retni( iRet );
hb_storclen( pBuf, iRet > 0 ? iRet : 0, 2 );
hb_xfree( pBuf );
}
HB_FUNC ( SOCKET_SEND )
{
hb_retni( send( hb_parsocket( 1 ), hb_parc( 2 ), hb_parclen( 2 ), hb_parni( 3, 0 ) ) );
}
HB_FUNC ( SOCKET_SELECT )
{
fd_set setread, setwrite, seterror;
BOOL bRead = 0, bWrite = 0, bError = 0;
struct timeval tv;
SOCKET socket, maxsocket;
PHB_ITEM pArray, pItem;
ULONG ulLen, ulIndex, ulCount;
LONG lTimeout;
int iRet;
FD_ZERO( &setread );
FD_ZERO( &setwrite );
FD_ZERO( &seterror );
maxsocket = (SOCKET) 0;
pArray = hb_param( 1, HB_IT_ARRAY );
if( pArray )
{
ulLen = hb_arrayLen( pArray );
for( ulIndex = 1; ulIndex <= ulLen; ulIndex++ )
{
socket = hb_itemGetSocket( hb_arrayGetItemPtr( pArray, ulIndex ) );
if( socket != INVALID_SOCKET )
{
bRead = 1;
FD_SET( socket, &setread );
if( socket > maxsocket )
maxsocket = socket;
}
}
}
pArray = hb_param( 2, HB_IT_ARRAY );
if( pArray )
{
ulLen = hb_arrayLen( pArray );
for( ulIndex = 1; ulIndex <= ulLen; ulIndex++ )
{
socket = hb_itemGetSocket( hb_arrayGetItemPtr( pArray, ulIndex ) );
if( socket != INVALID_SOCKET )
{
bWrite = 1;
FD_SET( socket, &setwrite );
if( socket > maxsocket )
maxsocket = socket;
}
}
}
pArray = hb_param( 3, HB_IT_ARRAY );
if( pArray )
{
ulLen = hb_arrayLen( pArray );
for( ulIndex = 1; ulIndex <= ulLen; ulIndex++ )
{
socket = hb_itemGetSocket( hb_arrayGetItemPtr( pArray, ulIndex ) );
if( socket != INVALID_SOCKET )
{
bError = 1;
FD_SET( socket, &seterror );
if( socket > maxsocket )
maxsocket = socket;
}
}
}
/* Default forever */
lTimeout = ISNUM( 4 ) ? hb_parnl( 4 ) : -1;
if( lTimeout == -1 )
{
iRet = select( maxsocket + 1, bRead ? &setread : NULL, bWrite ? &setwrite: NULL,
bError ? &seterror : NULL, NULL );
}
else
{
tv.tv_sec = lTimeout / 1000;
tv.tv_usec = ( lTimeout % 1000 ) * 1000;
iRet = select( maxsocket + 1, bRead ? &setread : NULL, bWrite ? &setwrite: NULL,
bError ? &seterror : NULL, &tv );
}
pArray = hb_param( 1, HB_IT_ARRAY );
if( pArray && ISBYREF( 1 ) )
{
ulLen = hb_arrayLen( pArray );
pItem = hb_itemNew( NULL );
hb_arrayNew( pItem, ulLen );
ulCount = 0;
for( ulIndex = 1; ulIndex <= ulLen; ulIndex++ )
{
socket = hb_itemGetSocket( hb_arrayGetItemPtr( pArray, ulIndex ) );
if( socket != INVALID_SOCKET )
{
if( FD_ISSET( socket, &setread ) )
{
hb_arraySetForward( pItem, ++ulCount, hb_itemPutSocket( NULL, socket ) );
}
}
}
hb_itemParamStoreForward( 1, pItem );
}
pArray = hb_param( 2, HB_IT_ARRAY );
if( pArray && ISBYREF( 2 ) )
{
ulLen = hb_arrayLen( pArray );
pItem = hb_itemNew( NULL );
hb_arrayNew( pItem, ulLen );
ulCount = 0;
for( ulIndex = 1; ulIndex <= ulLen; ulIndex++ )
{
socket = hb_itemGetSocket( hb_arrayGetItemPtr( pArray, ulIndex ) );
if( socket != INVALID_SOCKET )
{
if( FD_ISSET( socket, &setwrite ) )
{
hb_arraySetForward( pItem, ++ulCount, hb_itemPutSocket( NULL, socket ) );
}
}
}
hb_itemParamStoreForward( 2, pItem );
}
pArray = hb_param( 3, HB_IT_ARRAY );
if( pArray && ISBYREF( 3 ) )
{
ulLen = hb_arrayLen( pArray );
pItem = hb_itemNew( NULL );
hb_arrayNew( pItem, ulLen );
ulCount = 0;
for( ulIndex = 1; ulIndex <= ulLen; ulIndex++ )
{
socket = hb_itemGetSocket( hb_arrayGetItemPtr( pArray, ulIndex ) );
if( socket != INVALID_SOCKET )
{
if( FD_ISSET( socket, &seterror ) )
{
hb_arraySetForward( pItem, ++ulCount, hb_itemPutSocket( NULL, socket ) );
}
}
}
hb_itemParamStoreForward( 3, pItem );
}
hb_retni( iRet );
}
HB_FUNC ( SOCKET_GETSOCKNAME )
{
struct sockaddr saddr;
int iSize = sizeof( struct sockaddr );
hb_retni( getsockname( hb_parsocket( 1 ), &saddr, &iSize ) );
if( ISBYREF( 2 ) )
{
hb_itemParamStoreForward( 2, hb_itemPutSockaddr( NULL, &saddr ) );
}
}
HB_FUNC ( SOCKET_GETPEERNAME )
{
struct sockaddr saddr;
int iSize = sizeof( struct sockaddr );
hb_retni( getpeername( hb_parsocket( 1 ), &saddr, &iSize ) );
if( ISBYREF( 2 ) )
{
hb_itemParamStoreForward( 2, hb_itemPutSockaddr( NULL, &saddr ) );
}
}
HB_FUNC ( CONNECT )
{
struct sockaddr sa;
hb_itemGetSockaddr( hb_param( 2, HB_IT_ANY ), &sa );
hb_retni( connect( hb_parsocket( 1 ), &sa, sizeof( struct sockaddr ) ) );
}

1650
harbour/contrib/examples/uhttpd/uhttpd.prg Normal file
View File

File diff suppressed because it is too large Load Diff