From 76c73907707492a57dc507416becffd1e661cda0 Mon Sep 17 00:00:00 2001 From: Luiz Rafael Culik Date: Sat, 22 Apr 2000 11:10:53 +0000 Subject: [PATCH] see changelog 20000422 08:20 gmt-3 --- harbour/contrib/libnf/n2color.c | 165 +++ harbour/contrib/libnf/netpv.prg | 86 ++ harbour/contrib/libnf/nooccur.prg | 76 ++ harbour/contrib/libnf/ntow.prg | 134 ++ harbour/contrib/libnf/numlock.c | 96 ++ harbour/contrib/libnf/nwlstat.prg | 79 ++ harbour/contrib/libnf/nwsem.prg | 567 ++++++++ harbour/contrib/libnf/nwuid.prg | 125 ++ harbour/contrib/libnf/ontick.c | 139 ++ harbour/contrib/libnf/origin.c | 77 ++ harbour/contrib/libnf/page.prg | 110 ++ harbour/contrib/libnf/pchr.prg | 224 ++++ harbour/contrib/libnf/peek.c | 90 ++ harbour/contrib/libnf/pegs.prg | 234 ++++ harbour/contrib/libnf/pending.prg | 127 ++ harbour/contrib/libnf/pickday.prg | 67 + harbour/contrib/libnf/poke.c | 95 ++ harbour/contrib/libnf/popadder.prg | 1960 ++++++++++++++++++++++++++++ harbour/contrib/libnf/proper.c | 148 +++ harbour/contrib/libnf/prtesc.prg | 102 ++ harbour/contrib/libnf/prtscr.c | 85 ++ harbour/contrib/libnf/pvid.prg | 127 ++ harbour/contrib/libnf/qtr.prg | 110 ++ harbour/contrib/libnf/rand1.prg | 77 ++ harbour/contrib/libnf/restsets.prg | 68 + harbour/contrib/libnf/rmdir.c | 104 ++ harbour/contrib/libnf/round.prg | 185 +++ harbour/contrib/libnf/savearr.prg | 279 ++++ harbour/contrib/libnf/savesets.prg | 79 ++ harbour/contrib/libnf/scancode.prg | 103 ++ harbour/contrib/libnf/scregion.prg | 225 ++++ harbour/contrib/libnf/setdate.prg | 96 ++ harbour/contrib/libnf/settime.prg | 97 ++ harbour/contrib/libnf/shift.c | 74 ++ harbour/contrib/libnf/sinkey.prg | 90 ++ harbour/contrib/libnf/sleep.prg | 108 ++ harbour/contrib/libnf/sqzn.prg | 134 ++ harbour/contrib/libnf/stod.c | 64 + harbour/contrib/libnf/sysmem.prg | 72 + harbour/contrib/libnf/tbwhile.prg | 496 +++++++ harbour/contrib/libnf/tempfile.prg | 139 ++ harbour/contrib/libnf/test.prg | 27 + harbour/contrib/libnf/vertmenu.prg | 180 +++ harbour/contrib/libnf/vidcur.prg | 136 ++ harbour/contrib/libnf/vidmode.prg | 126 ++ harbour/contrib/libnf/wda.prg | 81 ++ harbour/contrib/libnf/week.prg | 112 ++ harbour/contrib/libnf/workdays.prg | 101 ++ harbour/contrib/libnf/woy.prg | 223 ++++ harbour/contrib/libnf/xbox.prg | 224 ++++ harbour/contrib/libnf/year.prg | 92 ++ 51 files changed, 8815 insertions(+) create mode 100644 harbour/contrib/libnf/n2color.c create mode 100644 harbour/contrib/libnf/netpv.prg create mode 100644 harbour/contrib/libnf/nooccur.prg create mode 100644 harbour/contrib/libnf/ntow.prg create mode 100644 harbour/contrib/libnf/numlock.c create mode 100644 harbour/contrib/libnf/nwlstat.prg create mode 100644 harbour/contrib/libnf/nwsem.prg create mode 100644 harbour/contrib/libnf/nwuid.prg create mode 100644 harbour/contrib/libnf/ontick.c create mode 100644 harbour/contrib/libnf/origin.c create mode 100644 harbour/contrib/libnf/page.prg create mode 100644 harbour/contrib/libnf/pchr.prg create mode 100644 harbour/contrib/libnf/peek.c create mode 100644 harbour/contrib/libnf/pegs.prg create mode 100644 harbour/contrib/libnf/pending.prg create mode 100644 harbour/contrib/libnf/pickday.prg create mode 100644 harbour/contrib/libnf/poke.c create mode 100644 harbour/contrib/libnf/popadder.prg create mode 100644 harbour/contrib/libnf/proper.c create mode 100644 harbour/contrib/libnf/prtesc.prg create mode 100644 harbour/contrib/libnf/prtscr.c create mode 100644 harbour/contrib/libnf/pvid.prg create mode 100644 harbour/contrib/libnf/qtr.prg create mode 100644 harbour/contrib/libnf/rand1.prg create mode 100644 harbour/contrib/libnf/restsets.prg create mode 100644 harbour/contrib/libnf/rmdir.c create mode 100644 harbour/contrib/libnf/round.prg create mode 100644 harbour/contrib/libnf/savearr.prg create mode 100644 harbour/contrib/libnf/savesets.prg create mode 100644 harbour/contrib/libnf/scancode.prg create mode 100644 harbour/contrib/libnf/scregion.prg create mode 100644 harbour/contrib/libnf/setdate.prg create mode 100644 harbour/contrib/libnf/settime.prg create mode 100644 harbour/contrib/libnf/shift.c create mode 100644 harbour/contrib/libnf/sinkey.prg create mode 100644 harbour/contrib/libnf/sleep.prg create mode 100644 harbour/contrib/libnf/sqzn.prg create mode 100644 harbour/contrib/libnf/stod.c create mode 100644 harbour/contrib/libnf/sysmem.prg create mode 100644 harbour/contrib/libnf/tbwhile.prg create mode 100644 harbour/contrib/libnf/tempfile.prg create mode 100644 harbour/contrib/libnf/test.prg create mode 100644 harbour/contrib/libnf/vertmenu.prg create mode 100644 harbour/contrib/libnf/vidcur.prg create mode 100644 harbour/contrib/libnf/vidmode.prg create mode 100644 harbour/contrib/libnf/wda.prg create mode 100644 harbour/contrib/libnf/week.prg create mode 100644 harbour/contrib/libnf/workdays.prg create mode 100644 harbour/contrib/libnf/woy.prg create mode 100644 harbour/contrib/libnf/xbox.prg create mode 100644 harbour/contrib/libnf/year.prg diff --git a/harbour/contrib/libnf/n2color.c b/harbour/contrib/libnf/n2color.c new file mode 100644 index 0000000000..2fc3e34671 --- /dev/null +++ b/harbour/contrib/libnf/n2color.c @@ -0,0 +1,165 @@ +/* + * $Id$ + */ + +/* + * File......: N2COLOR.C + * Author....: David Richardson + * CIS ID....: 72271,53 + * + * This function is an original work by David Richardson and is placed in the + * public domain. + * + * Modification history: + * --------------------- + * + * Rev 2.0 03 Mar 1997 03:05:01 JO / Phil Barnett + * commented out : if ( iColor > 15 ) in _ftI2Color() + * Rev 1.0 01 Jan 1995 03:01:00 TED + * Initial release + * + */ + + +/* $DOC$ + * $FUNCNAME$ + * FT_N2COLOR() + * $CATEGORY$ + * String + * $ONELINER$ + * Returns the string complement of a Clipper color number + * $SYNTAX$ + * FT_COLOR2N( ) -> cColor + * $ARGUMENTS$ + * a number representing a Clipper color + * $RETURNS$ + * The string complement of a number representing a Clipper or a + * null string if the parameter is invalid + * $DESCRIPTION$ + * This function is useful for converting a number to a Clipper color + * string. + * $EXAMPLES$ + * cColor := FT_COLOR2N( 239 ) // returns "*+w/gr" + * $SEEALSO$ + * FT_N2COLOR() + * $END$ + */ + +#include "hbapi.h" + +static void _ftI2Color( int iColor, char * cColor ); +static int _ftGetColorStr( int iColor, char * cColor ); + +HB_FUNC(FT_N2COLOR ) +{ +#if defined(HB_OS_DOS) + { + + char * cColor = " "; + + // make sure parameter is a numeric type + + if ( ISNUM(1)) + _ftI2Color( hb_parni( 1 ), cColor ); + else + cColor = NULL; + + hb_retc( cColor ); + + return; + } +#endif +} + + + +// 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +// Function : _ftI2Color +// Purpose : Converts a color int to an Xbase color string +// Parameters: iColor - the color number +// *cColor - pointer to the color string +// Returns : void (string is modified directly) +// 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 + +void _ftI2Color( int iColor, char * cColor ) +{ + unsigned int iBack = 0, iFore = 0, i = 0; + + // check for blink attribute + + if ( iColor > 127 ) + { + cColor[ i++ ] = '*'; + + iColor %= 128; + } + + // check for background and foreground colors + +// if ( iColor > 15 ) +// { + iFore = iColor % 16; + + iBack = ( iColor - iFore ) / 16; +// } + + // check for intensity attrib + + if ( iFore > 7 ) + { + cColor[ i++ ] = '+'; + + iFore %= 8; + } + + // get forground color + + i += _ftGetColorStr( iFore, ( cColor + i ) ); + + // add the seperator + + cColor[ i++ ] = '/'; + + // get background color + + i += _ftGetColorStr( iBack, ( cColor + i ) ); + + // null terminate the color string + + cColor[ i ] = 0; + + return ; +} + + + +// 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 +// Function : _ftGetColorStr +// Purpose : Returns the corresponding Xbase color for passed number +// Parameters: iColor - a color number +// *cColor - pointer to the color string +// Returns : length of added color string +// 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴 + +int _ftGetColorStr( int iColor, char * cColor ) +{ + int iLen = 0; + + switch ( iColor ) + { + case 0 : cColor[iLen++] = 'n'; break; + case 1 : cColor[iLen++] = 'b'; break; + case 2 : cColor[iLen++] = 'g'; break; + case 3 : cColor[iLen++] = 'b'; + cColor[iLen++] = 'g'; break; + case 4 : cColor[iLen++] = 'r'; break; + case 5 : cColor[iLen++] = 'r'; + cColor[iLen++] = 'b'; break; + case 6 : cColor[iLen++] = 'g'; + cColor[iLen++] = 'r'; break; + case 7 : cColor[iLen++] = 'w'; + } + + return iLen; + +} diff --git a/harbour/contrib/libnf/netpv.prg b/harbour/contrib/libnf/netpv.prg new file mode 100644 index 0000000000..1ebc53c0e4 --- /dev/null +++ b/harbour/contrib/libnf/netpv.prg @@ -0,0 +1,86 @@ +/* + * File......: NETPV.PRG + * Author....: David Husnian + * CIS ID....: ? + * + * This is an original work by David Husnian and is placed in the + * public domain. + * + * Modification history: + * --------------------- + * + * Rev 1.2 15 Aug 1991 23:04:06 GLENN + * Forest Belt proofread/edited/cleaned up doc + * + * Rev 1.1 14 Jun 1991 19:52:30 GLENN + * Minor edit to file header + * + * Rev 1.0 01 Apr 1991 01:01:50 GLENN + * Nanforum Toolkit + * + */ + + +/* $DOC$ + * $FUNCNAME$ + * FT_NETPV() + * $CATEGORY$ + * Math + * $ONELINER$ + * Calculate net present value + * $SYNTAX$ + * FT_NETPV( , , ; + * [, ] ) -> nNetPV + * $ARGUMENTS$ + * is the amount of cash invested for purposes + * of generating the cash flows. + * + * is the annual interest rate used to discount + * expected cash flows (10.5% = 10.5, not .105). + * + * is an array of the expected cash receipts each year. + * + * is the number of years cash flows are expected + * (optional, Len( aCashFlow ) ). + * $RETURNS$ + * The difference between the initial investment and the discounted + * cash flow in dollars. + * $DESCRIPTION$ + * This function calculates the net present value, the difference + * between the cost of an initial investment and the present value + * of the expected cash flow(s) from the investment. The present + * value of the expected cashflow(s) is calculated at the specified + * interest rate, which is often referred to as the "cost of capital". + * + * This function can be used to evaluate alternative investments. + * The larger the NPV, the more profitable the investment. See + * also the FutureValue and PresentValue for further explanations. + * The formula to calculate the net present value is: + * + * NetPresentValue = SUM(CashFlow[i] / ((1 + InterestRate) ** i)) + * FOR i = 1 TO NoOfCashFlows + * $EXAMPLES$ + * nNetPresentValue := FT_NETPV(10000, 10, { 10000,15000,16000,17000 } ) + * $END$ + */ + +#ifdef FT_TEST + FUNCTION MAIN() + ? FT_NETPV( 10000, 10, { 10000,15000,16000,17000 } ) + RETURN ( nil ) +#endif + + +FUNCTION FT_NETPV(nInitialInvestment, nInterestRate, aCashFlow, nNoOfCashFlows) + + LOCAL nNetPresentValue := 0 + + nNoOfCashFlows := iif( nNoOfCashFlows == nil, len( aCashFlow ), nNoOfCashFlows ) + + AEVAL(aCashFlow, ; + { | nElement, nElementNo | ; + nNetPresentValue += nElement / ; + ((1 + (nInterestRate / 100)) ** nElementNo) }, ; + 1, nNoOfCashFlows) + + RETURN (nNetPresentValue -= nInitialInvestment) diff --git a/harbour/contrib/libnf/nooccur.prg b/harbour/contrib/libnf/nooccur.prg new file mode 100644 index 0000000000..8bb909c3a7 --- /dev/null +++ b/harbour/contrib/libnf/nooccur.prg @@ -0,0 +1,76 @@ +/* + * File......: NoOccur.Prg + * Author....: David Husnian + * CIS ID....: ? + * + * This is an original work by David Husnian and is placed in the + * public domain. + * + * Modification history: + * --------------------- + * + * Rev 1.2 15 Aug 1991 23:04:08 GLENN + * Forest Belt proofread/edited/cleaned up doc + * + * Rev 1.1 14 Jun 1991 19:52:32 GLENN + * Minor edit to file header + * + * Rev 1.0 01 Apr 1991 01:01:52 GLENN + * Nanforum Toolkit + * + */ + + +/* $DOC$ + * $FUNCNAME$ + * FT_NOOCCUR() + * $CATEGORY$ + * String + * $ONELINER$ + * Find the number of times one string occurs in another + * $SYNTAX$ + * FT_NOOCCUR( , ; + * [, ] ) -> + * $ARGUMENTS$ + * is the string to search for + * + * is the string to search + * + * is a boolean variable to force case sensitivity + * (optional, defaults to .F.). + * $RETURNS$ + * The number of times appears in + * $DESCRIPTION$ + * This function finds the number of times a string occurs in a + * second string. + * $EXAMPLES$ + * // Find the number of times "the" appears in cMemoString, case + * // insensitive + * + * nNoOfOccurrences := FT_NOOCCUR( "the", cMemoString ) + * + * // Find the number of times "the" appears in cMemoString, case + * // sensitive + * + * nNoOfOccurrences := FT_NOOCCUR( "the", cMemoString, TRUE ) + * $END$ + */ + +#define IS_NOT_LOGICAL(x) (VALTYPE(x) != "L") +#define MAKE_UPPER(x) (x := UPPER(x)) + +FUNCTION FT_NOOCCUR(cCheckFor, cCheckIn, lIgnoreCase) + + // Is Case Important?? + IF (IS_NOT_LOGICAL(lIgnoreCase) .OR. lIgnoreCase) + + MAKE_UPPER(cCheckFor) // No, Force Everything to Uppercase + MAKE_UPPER(cCheckIn) + + ENDIF // IS_NOT_LOGICAL(lIgnoreCase) or ; + // lIgnoreCase + + RETURN (IF(LEN(cCheckFor) == 0 .OR. LEN(cCheckIn) == 0, ; + 0, ; + INT((LEN(cCheckIn) - LEN(STRTRAN(cCheckIn, cCheckFor))) / ; + LEN(cCheckFor)))) diff --git a/harbour/contrib/libnf/ntow.prg b/harbour/contrib/libnf/ntow.prg new file mode 100644 index 0000000000..848eb211a0 --- /dev/null +++ b/harbour/contrib/libnf/ntow.prg @@ -0,0 +1,134 @@ +/* + * File......: NTOW.PRG + * Author....: Gary Baren + * CIS ID....: 75470,1027 + * + * This is an original work by Gary Baren and is hereby placed in the + * public domain. + * + * Modification history: + * --------------------- + * + * Rev 1.1 15 Aug 1991 23:05:54 GLENN + * Forest Belt proofread/edited/cleaned up doc + * + * Rev 1.0 09 Jun 1991 00:26:56 GLENN + * Initial revision. + * + */ + + + + +/* $DOC$ + * $FUNCNAME$ + * FT_NTOW() + * $CATEGORY$ + * Conversion + * $ONELINER$ + * Translate numeric value to words + * $SYNTAX$ + * FT_NTOW( ) -> cWords + * $ARGUMENTS$ + * An integer to translate + * $RETURNS$ + * A text string representing + * $DESCRIPTION$ + * Translates numeric input to a text string. + * + * FT_NTOW is intended to be used with integers only. Since I don't + * know what your application will be, I can't assume the type of + * fraction you want returned (ninety nine cents, 99/100, .99, etc). + * If you want the fraction in words, just pass it as an integer. + * + * Do not pass a negative number! Handle negative numbers any way + * you need to in your code. (ie: CR, DB, Negative, Minus, etc.) + * + * Also, numeric 0 is returned as a null string. You will need to + * make a decision how to output it (zero dollars, no dollars, etc). + * $EXAMPLES$ + * ? FT_NTOW( 999 ) -> Nine Hundred Ninety Nine + * + * ? FT_NTOW( 1000 ) -> One Thousand + * + * ? FT_NTOW( 23 ) + " Dollars and " + FT_NTOW( 99 ) + " Cents" + * -> Twenty Three Dollars and Ninety Nine Cents + * + * ? FT_NTOW( 23 ) + " Dollars and " + "99/100" + * -> Twenty Three Dollars and 99/100 + * + * x := -23.99 + * cents := str( (x - int( x )) * 100, 2, 0 ) + "/100" + * x := int( x ) + * string := iif( x < 0, "Credit of ", "Debit of " ) + * ? string + FT_NTOW( abs(x) ) + " Dollars and " + "99/100" + * -> Credit of Twenty Three Dollars and 99/100 + * $END$ + */ + + + +static ones := { "", " One", " Two", " Three", " Four", " Five", ; + " Six", " Seven", " Eight", " Nine" ; + } + +static teens := { " Ten", " Eleven", " Twelve", ; + " Thirteen", " Fourteen", " Fifteen", ; + " Sixteen", " Seventeen", " Eighteen", ; + " Nineteen" ; + } + +static tens := { "", "", " Twenty", " Thirty", " Forty", " Fifty", ; + " Sixty", " Seventy", " Eighty", " Ninety" } + +static qualifiers := { "", " Thousand", " Million", " Billion", " Trillion" } + + +#ifdef FT_TEST + function main( cNum ) + return qout( ft_ntow( val( cNum ) ) ) +#endif + + + +function ft_ntow(nAmount) + local nTemp, sResult := " ", nQualNo + local nDiv := 10 ^ ( int( sol10(nAmount) / 3 ) * 3 ) + + nTemp := int(nAmount % nDiv) + nAmount := int(nAmount / nDiv) + nQualNo := int( sol10( nDiv ) / 3 ) + 1 + sResult += grp_to_words(nAmount, qualifiers[ nQualNo ] ) + + if nTemp > (nDiv /= 1000) .and. (nDiv > 1) + sResult += ft_ntow( nTemp, nDiv ) + else + sResult += grp_to_words(nTemp, "") + endif + return( ltrim(sResult) ) + + +static function grp_to_words(nGrp, sQual) + local sResult := "", nTemp + + nTemp := int(nGrp % 100) + nGrp := int(nGrp / 100) + sResult += ones[ nGrp + 1 ] + iif( nGrp > 0, " Hundred", "") + + do case + case nTemp > 19 + sResult += tens[ int( nTemp / 10 ) + 1 ] + sResult += ones[ int( nTemp % 10 ) + 1 ] + case nTemp < 20 .and. nTemp > 9 + sResult += teens[ int( nTemp % 10 ) + 1 ] + case nTemp < 10 .and. nTemp > 0 + sResult += ones[ int( nTemp) + 1 ] + endcase + return(sResult + sQual) + + +static function sol10( nNumber ) + local sTemp + + sTemp := ltrim( str( int(nNumber), 0) ) + return( len(sTemp) - 1 ) diff --git a/harbour/contrib/libnf/numlock.c b/harbour/contrib/libnf/numlock.c new file mode 100644 index 0000000000..fc01b6f042 --- /dev/null +++ b/harbour/contrib/libnf/numlock.c @@ -0,0 +1,96 @@ +/* + * $Id$ + */ + +/* + * File......: NUMLOCK.C + * Author....: Ted Means + * CIS ID....: 73067,3332 + * + * This function is an original work by Ted Means and is placed in the + * public domain. + * + * Modification history: + * --------------------- + * + * Rev 1.3 15 Jul 1993 00:08:46 GLENN + * Changed reference to status_byte in order to make this work in + * protected mode. + * + * Rev 1.2 15 Aug 1991 23:08:12 GLENN + * Forest Belt proofread/edited/cleaned up doc + * + * Rev 1.1 27 May 1991 14:43:20 GLENN + * Ted added a parameter to toggle the Numlock on or off. + * + * Rev 1.0 01 Apr 1991 01:02:50 GLENN + * Nanforum Toolkit + * + * + */ + + + + +/* $DOC$ + * $FUNCNAME$ + * FT_NUMLOCK() + * $CATEGORY$ + * Keyboard/Mouse + * $ONELINER$ + * Return status of NumLock key + * $SYNTAX$ + * FT_NUMLOCK( [ ] ) -> lCurrentSetting + * $ARGUMENTS$ + * is optional and if supplied is the new setting + * for the CapLock key. Specify .T. to turn CapLock on, or .F. to + * turn it off. + * $RETURNS$ + * lValue is .T. if NumLock is set, .F. if it isn't set. The value + * returned represents the setting in effect prior to any changes that + * might by made by . + * $DESCRIPTION$ + * This function is useful if you need to know or set the status of the + * NumLock key for some reason. + * $EXAMPLES$ + * IF FT_NUMLOCK() + * Qout( "NumLock is active" ) + * ENDIF + * + * Another one, slightly strange, courtesy of Glenn Scott: + * + * + * function numBlink() + * local lOldNum := ft_numlock() + * + * while inkey( .5 ) != 27 + * ft_numlock( !ft_numlock() ) + * end + * + * return ft_numlock( lOldNum ) + * $SEEALSO$ + * FT_CAPLOCK() FT_CTRL() FT_PRTSCR() FT_SHIFT() FT_ALT() + * $END$ + */ + +#include + +#define status_byte ( *( char * ) ( 0x00400017 ) ) + +HB_FUNC(FT_NUMLOCK) +{ +#if defined(HB_OS_DOS) + { + + hb_retl( ( int ) ( status_byte & 0x20 ) ); + + if ( PCOUNT ) + if ( ISLOG(1) ) + status_byte = ( status_byte | 0x20 ); + else + status_byte = ( status_byte & 0xDF ); + + return; + } +#endif +} diff --git a/harbour/contrib/libnf/nwlstat.prg b/harbour/contrib/libnf/nwlstat.prg new file mode 100644 index 0000000000..1a999372e0 --- /dev/null +++ b/harbour/contrib/libnf/nwlstat.prg @@ -0,0 +1,79 @@ +/* + * File......: NWLSTAT.PRG + * Author....: Glenn Scott + * CIS ID....: ? + * + * This is an original work by Glenn Scott and is placed in the + * public domain. + * + * Modification history: + * --------------------- + * + * Rev 1.2 15 Aug 1991 23:06:04 GLENN + * Forest Belt proofread/edited/cleaned up doc + * + * Rev 1.1 12 Jun 1991 02:19:46 GLENN + * Documentation correction and check for compatibility with new return + * value for ft_int86(). + * + * Rev 1.0 01 Apr 1991 01:01:54 GLENN + * Nanforum Toolkit + * + */ + + +/* $DOC$ + * $FUNCNAME$ + * FT_NWLSTAT() + * $CATEGORY$ + * NetWare + * $ONELINER$ + * Return the current Novell NetWare logical station number + * $SYNTAX$ + * FT_NWLSTAT() -> nStatNum + * $ARGUMENTS$ + * None + * $RETURNS$ + * A numeric corresponding to the current logical station number + * assigned by NetWare. + * $DESCRIPTION$ + * In order to find out information about a particular node logged + * in to a NetWare server, you will need the logical + * station number, also known as a "connection number." This + * function will return that number. This will be a number from 1 to 100 + * under NetWare 286, or from 1 to 250 under NetWare 386. This is *not* + * the same as a physical station number. + * + * This function requires FT_INT86(). + * + * This function does NOT test for the existence of the NetWare shell. + * The behavior is undefined if no shell is loaded. + * $EXAMPLES$ + * QOut( "Logical station: " + str( FT_NWLSTAT() ) ) + * $END$ + */ + +#include "FTINT86.CH" + +#define DOS 33 +#define STATNUM 220 + +#ifdef FT_TEST + FUNCTION MAIN() + QOut( "Logical station: " + str( FT_NWLSTAT() ) ) + return ( nil ) +#endif + +FUNCTION FT_NWLSTAT() +/* LOCAL aRegs[ INT86_MAX_REGS ] */ + LOCAL nStation +/* + aRegs[ AX ] = MAKEHI( STATNUM ) + FT_INT86( DOS, aRegs ) + */ + nStation := _ft_nwkstat() /* LOWBYTE( aRegs[ AX ] ) */ + if nStation < 0 + nStation += 256 + endif + + RETURN nStation diff --git a/harbour/contrib/libnf/nwsem.prg b/harbour/contrib/libnf/nwsem.prg new file mode 100644 index 0000000000..65c03c8f40 --- /dev/null +++ b/harbour/contrib/libnf/nwsem.prg @@ -0,0 +1,567 @@ +/* + * File......: NWSEM.PRG + * Author....: Glenn Scott + * CIS ID....: 71620,1521 + * + * This is an original work by Glenn Scott and is placed in the + * public domain. + * + * Modification history: + * --------------------- + * + * Rev 1.4 17 Oct 1992 16:28:22 GLENN + * Leo cleaned up documentation blocks. + * + * Rev 1.3 08 Oct 1992 01:37:34 GLENN + * Added ft_nwsemUnlock() to complement ft_nwsemlock(). Modified + * the calling procedure for ft_nwsemlock() but it shouldn't break any + * existing code, although I doubt anyone's using it. + * + * + * Rev 1.2 17 Aug 1991 16:11:46 GLENN + * Oops, I forgot to comment out some test code. + * + * Rev 1.1 15 Aug 1991 23:05:34 GLENN + * Forest Belt proofread/edited/cleaned up doc + * + * Rev 1.0 28 Jun 1991 00:44:14 GLENN + * Initial revision. + * + */ + + +// -------------------------------------------------------------- +// Semaphore Package for Novell NetWare +// -------------------------------------------------------------- + + +#include "ftint86.ch" + +#define INT21 33 + +#xcommand DEFAULT TO [, TO ]; + => IIF(()=NIL,:=,NIL) [; IF(()=NIL,:=,NIL)] + +#define WAIT_SEMAPHORE 2 +#define SIGNAL_SEMAPHORE 3 +#define CLOSE_SEMAPHORE 4 + +// Sorry this test routine is pretty lame but it sort of gets +// the point across + +#ifdef FT_TEST + + #define INITIAL_SEMAPHORE_VALUE 2 + #define WAIT_SECONDS 1 + + function main() + local nInitVal, nRc, nHandle, nValue, nOpenCnt + + cls + + nInitVal := INITIAL_SEMAPHORE_VALUE + FT_NWSEMOPEN( "TEST", nInitVal, @nHandle, @nOpenCnt ) + + qout( "Waiting ten seconds..." ) + nRc := ft_nwSemWait( nHandle, 180 ) + qout( "Final nRc value = " + STR( nRc ) ) + inkey(0) + if nRc == 254 + qout("Couldn't get the semaphore. Try again.") + quit + end + + cls + + @ 24, 0 say "Any key to exit" + @ 0, 0 say "Handle: " + str( nHandle ) + + ft_nwSemEx( nHandle, @nValue, @nOpenCnt ) + while .t. + @ 23, 0 say "Semaphore test -> Open at [" + ; + alltrim(str(nOpenCnt)) + ; + "] stations, value is [" + ; + alltrim(str(nValue)) + "]" + + if inkey( WAIT_SECONDS ) != 0 + exit + endif + + tone( nHandle,.5 ) + ft_nwSemEx( nHandle, @nValue, @nOpenCnt ) + end + + qout( "Signal returns: " + str( ft_nwsemSig( nHandle ) ) ) + qout( "Close returns: " + str( ft_nwsemClose( nHandle ) ) ) + + return nil + +#endif + + +/* $DOC$ + * $FUNCNAME$ + * FT_NWSEMOPEN() + * $CATEGORY$ + * NetWare + * $ONELINER$ + * Open or create a NetWare semaphore + * $SYNTAX$ + * FT_NWSEMOPEN( , , <@nHandle>, <@nOpenCnt> ) -> nRc + * $ARGUMENTS$ + * is the semaphore name, maximum length is 127 characters. + * + * is the initial value for the semaphore. It must start + * as a positive number, to a maximum of 127. + * + * <@nHandle> is the semaphore handle. THIS MUST BE PASSED BY + * REFERENCE! On exit, will contain a numeric value that + * refers to the opened semaphore. You will need it to pass to + * other semaphore functions! PASS IT BY REFERENCE! + * + * <@nOpenCnt> is the number of stations that have opened the + * semaphore. THIS MUST BE PASSED BY REFERENCE! On exit, + * will contain a numeric value. + * $RETURNS$ + * nRc, a numeric result code, as follows: + * + * 0 - success + * 254 - Invalid semaphore name length + * 255 - Invalid semaphore value + * + * will contain the semaphore handle, and + * will contain the number of stations that have opened + * the semaphore. + * $DESCRIPTION$ + * A semaphore is simply a label that indirectly controls network + * activity. There is a semaphore name, which can be up to 127 + * characters, and an associated value, which can range from 0 to + * 127. + * + * A semaphore can be used for many things, but is most often used + * to limit the number of users in an application, and to control + * access to a network resource. + * + * A semaphore essentially allows you to place locks on resources + * other than files. + * + * An application begins the process by calling FT_NWSEMOPEN(). + * If the semaphore doesn't exist, NetWare will create it. + * FT_NWSEMOPEN() returns a handle that is used in other semaphore + * calls. + * + * Applications use FT_NWSEMWAIT() to wait for a semaphore to + * become available. FT_NWSEMWAIT() decrements the semaphore's + * value by 1. If the value > 0, then the application should + * be allowed to access the semaphore's resource. If the value + * goes negative, then the application is placed in a queue. + * How long your app is in the queue is determined by how you + * set the timeout parameter. If you can't get the resource in + * the time you allot, you're let out of the queue and the + * value increments by 1 again. + * + * When an application finishes with a semaphore, it should + * call FT_NWSEMSIG() to increment the value, and then + * FT_NWSEMCLOSE() to close the semaphore. When the semaphore's + * open count goes to 0, NetWare deletes it. + * + * FT_NWSEMEX() can be used to examine the value and open count + * without affecting them. + * + * For an interesting discussion on the operating system aspects + * of semaphores, check "Operating Systems Design and Implementation" + * by A. Tanenbaum, page 60. For more details on NetWare's + * semaphore facilities, refer to Charles Rose's "Programmer's + * Guide to NetWare". The "Programmer's Guide" will make an + * excellent companion guide to the source code for all NetWare + * functions in the Nanforum Toolkit. + * $EXAMPLES$ + * LOCAL nInitVal, nRc, nHandle, nOpenCnt + * + * nInitVal := 2 + * nRc := FT_NWSEMOPEN( "Semaphore Test", nInitVal, ; + * @nHandle, @nOpenCnt ) + * + * IF nRc != 0 + * QOUT =: "Error: " + STR( nRc ) ) + * QUIT + * ENDIF + * $SEEALSO$ + * FT_NWSEMEX() FT_NWSEMWAIT() FT_NWSEMSIG() FT_NWSEMCLOSE() FT_NWSEMLOCK() + * $END$ + */ + +function ft_nwSemOpen( cName, nInitVal, nHandle, nOpenCnt ) + local aRegs[ INT86_MAX_REGS ], cRequest, nRet + + default cName to "", ; + nInitVal to 0, ; + nHandle to 0, ; + nOpenCnt to 0 + + + cName := iif( len( cName ) > 127, substr( cName, 1, 127 ), cName ) + cRequest := chr( len( cName ) ) + cName + + aRegs[ AX ] := makehi( 197 ) // C5h + aRegs[ DS ] := cRequest + aRegs[ DX ] := REG_DS + aRegs[ CX ] := nInitVal + + ft_int86( INT21, aRegs ) + + nHandle := bin2l( i2bin( aRegs[CX] ) + i2bin( aRegs[DX] ) ) + nOpenCnt := lowbyte( aRegs[ BX ] ) + + nRet := lowbyte( aRegs[AX] ) + + return iif( nRet < 0, nRet + 256, nRet ) + + + + +/* $DOC$ + * $FUNCNAME$ + * FT_NWSEMEX() + * $CATEGORY$ + * NetWare + * $ONELINER$ + * Examine a NetWare semaphore's value and open count + * $SYNTAX$ + * FT_NWSEMEX( , <@nValue>, <@nOpenCnt> ) -> nRc + * $ARGUMENTS$ + * is the semaphore handle, returned from a previous call + * to FT_NWSEMOPEN(). + * + * <@nValue> will get the current semaphore value. THIS NUMERIC + * ARGUMENT MUST BE PASSED BY REFERENCE! + * + * <@nOpenCnt> will get the current number of workstations + * that have opened the semaphore. THIS NUMERIC ARGUMENT MUST BE + * PASSED BY REFERENCE! + * $RETURNS$ + * nRc, a numeric, as follows: + * + * 0 - success + * 255 - invalid semaphore handle + * + * In addition, nValue will be set to the semaphore's current value, + * and nOpenCnt will be set to the number of stations that have + * opened the semaphore. + * $DESCRIPTION$ + * See the description for FT_NWSEMOPEN(). + * $EXAMPLES$ + * nInitVal := 2 + * nHandle := 0 + * nOpenCnt := 0 + * + * FT_NWSEMOPEN( "Semaphore Test", nInitVal, @nHandle, @nOpenCnt ) + * + * nRc := FT_NWSEMWAIT( nHandle ) + * IF nRc == 254 + * QOUT( "All slots for this resource are currently in use" ) + * QUIT + * ENDIF + * + * FT_NWSEMEX( nHandle, @nValue, @nOpenCnt ) + * QOUT( "Semaphore test -> Open at [" + ; + * ALLTRIM(STR(nOpenCnt)) + ; + * "] stations, value is [" + ; + * ALLTRIM(STR(nValue)) + "]" ) + * $SEEALSO$ + * FT_NWSEMOPEN() FT_NWSEMWAIT() FT_NWSEMSIG() FT_NWSEMCLOSE() FT_NWSEMLOCK() + * $END$ + */ + + +function ft_nwSemEx( nHandle, nValue, nOpenCnt ) + local aRegs[ INT86_MAX_REGS ], nRet + + default nHandle to 0, ; + nValue to 0, ; + nOpenCnt to 0 + + aRegs[ AX ] := makehi( 197 ) + 1 // C5h, 01h + aRegs[ CX ] := bin2i( substr( l2bin( nHandle ), 1, 2 ) ) + aRegs[ DX ] := bin2i( substr( l2bin( nHandle ), 3, 2 ) ) + + ft_int86( INT21, aRegs ) + + #ifdef FT_TEST + + @ 5, 1 say highbyte( aregs[CX] ) + @ 6, 1 say lowbyte( aregs[CX ] ) + + #endif + + nValue := aRegs[ CX ] + nOpenCnt := lowbyte( aRegs[ DX ] ) + nRet := lowbyte( aRegs[ AX ] ) + + return iif( nRet < 0, nRet + 256, nRet ) + + +/* $DOC$ + * $FUNCNAME$ + * FT_NWSEMWAIT() + * $CATEGORY$ + * NetWare + * $ONELINER$ + * Wait on a NetWare semaphore (decrement) + * $SYNTAX$ + * FT_NWSEMWAIT( [, nTimeout ] ) -> nRc + * $ARGUMENTS$ + * is the semaphore handle, returned from a previous call + * to FT_NWSEMOPEN(). + * + * is an optional parameter telling how long you wish to + * wait on this semaphore. This is a numeric indicating the number + * of clock ticks (approx 1/18 sec ) to wait. A zero (the default) + * means "don't wait." + * $RETURNS$ + * nRc, a numeric, as follows: + * + * 0 - success + * 254 - timeout failure + * 255 - invalid semaphore handle + * $DESCRIPTION$ + * See the description for the FT_NWSEMOPEN() function. + * $EXAMPLES$ + * FT_NWSEMOPEN( "Semaphore Test", nInitVal, @nHandle, @nOpenCnt ) + * + * nRc := FT_NWSEMWAIT( nHandle ) + * IF nRc == 254 + * QOUT( "All slots for this resource are currently in use" ) + * QUIT + * ENDIF + * $SEEALSO$ + * FT_NWSEMOPEN() FT_NWSEMEX() FT_NWSEMSIG() FT_NWSEMCLOSE() FT_NWSEMLOCK() + * $END$ + */ + + + +function ft_nwSemWait( nHandle, nTimeout ) + return _ftnwsem( WAIT_SEMAPHORE, nHandle, nTimeout ) + + + +/* $DOC$ + * $FUNCNAME$ + * FT_NWSEMSIG() + * $CATEGORY$ + * NetWare + * $ONELINER$ + * Signal a NetWare semaphore (increment) + * $SYNTAX$ + * FT_NWSEMSIG( nHandle ) -> nRc + * $ARGUMENTS$ + * is the semaphore handle, returned from a previous call + * to FT_NWSEMOPEN(). + * $RETURNS$ + * nRc, a numeric, as follows + * + * 0 - success + * 1 - semaphore overflow ( value > 127 ) + * 255 - invalid semaphore handle + * $DESCRIPTION$ + * Use FT_NWSEMSIG() when your app has finished with the resource + * locked by a semaphore. This will increase the value (thus + * making a slot available to another app). + * + * For more information, see the description under FT_NWSEMOPEN(). + * $EXAMPLES$ + * QOUT( "Signal returns: " + STR( FT_NWSEMSIG( nHandle ) ) ) + * $SEEALSO$ + * FT_NWSEMOPEN() FT_NWSEMEX() FT_NWSEMWAIT() FT_NWSEMCLOSE() FT_NWSEMLOCK() + * $END$ + */ + + +function ft_nwSemSig( nHandle ) + return _ftnwsem( SIGNAL_SEMAPHORE, nHandle ) + + +/* $DOC$ + * $FUNCNAME$ + * FT_NWSEMCLOSE() + * $CATEGORY$ + * NetWare + * $ONELINER$ + * Close a NetWare semaphore + * $SYNTAX$ + * FT_NWSEMCLOSE( ) -> nRc + * $ARGUMENTS$ + * is the semaphore handle, returned from a previous call + * to FT_NWSEMOPEN(). + * $RETURNS$ + * nRc, a numeric, as follows: + * + * 0 - success + * 255 - invalid semaphore handle + * $DESCRIPTION$ + * Call FT_NWSEMCLOSE() when the app is finished. This decrements + * the open count for the semaphore. If the open count hits zero, + * the semaphore is deleted by NetWare. + * $EXAMPLES$ + * QOUT( "Close returns: " + STR( FT_NWSEMCLOSE( nHandle ) ) ) + * $SEEALSO$ + * FT_NWSEMOPEN() FT_NWSEMEX() FT_NWSEMWAIT() FT_NWSEMSIG() FT_NWSEMLOCK() + * $END$ + */ + +function ft_nwSemClose( nHandle ) + return _ftnwsem( CLOSE_SEMAPHORE, nHandle ) + + +// --------------------------------------------------------- +// _ftnwsem() - internal for the semaphore package +// --------------------------------------------------------- + +static function _ftnwsem( nOp, nHandle, nTimeout ) + local aRegs[ INT86_MAX_REGS ],; + nRet + + default nOp to SIGNAL_SEMAPHORE, ; + nHandle to 0, ; + nTimeout to 0 + + aRegs[ AX ] := makehi( 197 ) + nOp + aRegs[ CX ] := bin2i( substr( l2bin( nHandle ), 1, 2 ) ) + aRegs[ DX ] := bin2i( substr( l2bin( nHandle ), 3, 2 ) ) + aRegs[ BP ] := nTimeout + + + ft_int86( INT21, aRegs ) + nRet := lowbyte( aRegs[AX] ) + nRet := iif( nRet < 0, nRet + 256, nRet ) + + return nRet + + + +/* $DOC$ + * $FUNCNAME$ + * FT_NWSEMLOCK() + * $CATEGORY$ + * NetWare + * $ONELINER$ + * Perform a semaphore "lock" + * $SYNTAX$ + * FT_NWSEMLOCK ( , <@nHandle> ) -> lRet + * $ARGUMENTS$ + * is the name of a semaphore you want to "lock." + * is the semaphore's handle, if you get the lock. + * THIS MUST BE PASSED BY REFERENCE! + * $RETURNS$ + * lRet == .t. if you get the lock, .f. if you don't. + * If the lock succeeds, will contain the semaphore + * handle. If it fails, the value of is undefined. + * + * $DESCRIPTION$ + * FT_NWSEMLOCK() uses the Nanforum Toolkit's NetWare Semaphore API + * functions in order to provide a general purpose "lock" you can use in + * a NetWare environment. + * + * An interesting byproduct of NetWare's semaphore functions is + * the "open count" which tells you how many connections have this + * semaphore open. This is different from the semaphore's _value_, + * which is set when the semaphore is opened and changed with + * signal() and wait(). + * + * The point of semaphores is that you don't care how many users + * are using the resource; you merely wait on a semaphore until + * the resource becomes available or you give up. When you're done, + * you signal it and off you go. + * + * Back to the open count. FT_NWSEMLOCK() opens the semaphore + * as named in . After it is opened, the open count + * is checked. If it is anything other than 1, that means someone + * else has it (or you failed in your open) so the semaphore is + * closed and the "lock" is refused. If the value is 1, then your + * app is that 1 station so the "lock" is granted. + * + * You can use a semaphore lock to control access to anything + * that Clipper's RLOCK() and FLOCK() can't help you with, such + * as text files written with the low level file i/o functions, + * etc. + * $EXAMPLES$ + * LOCAL nHandle := 0 + * IF FT_NWSEMLOCK( "k:\apps\error.log", @nHandle ) + * // Note, you aren't actually LOCKING this file, you are + * // just locking a semaphore by the same name. As long as + * // all apps that might be using this file are cooperating + * // with the same kind of semaphore lock, you can effectively + * // control access to the file. + * ELSE + * QOUT("Couldn't lock file.") + * ENDIF + * * Processing, then: + * FT_NWSEMUNLOCK( nHandle ) + * + * $SEEALSO$ + * FT_NWSEMOPEN() FT_NWSEMEX() FT_NWSEMWAIT() FT_NWSEMSIG() FT_NWSEMUNLOCK() + * $END$ + */ + + + +function ft_nwSemLock( cSemaphore, nHandle ) + local nRc + local nOpenCnt := 0 + + nRc := FT_NWSEMOPEN( cSemaphore, 0, @nHandle, @nOpenCnt ) + + if nRc == 0 + if nOpenCnt != 1 + ft_nwSemClose( nHandle ) + endif + endif + + return ( nOpenCnt == 1 ) + + +/* $DOC$ + * $FUNCNAME$ + * FT_NWSEMUNLOCK() + * $CATEGORY$ + * NetWare + * $ONELINER$ + * "Unlock" a semaphore locked by FT_NWSEMLOCK() + * $SYNTAX$ + * FT_NWSEMUNLOCK( ) -> lRet + * $ARGUMENTS$ + * is the semaphore handle returned from FT_NWSEMLOCK() + * $RETURNS$ + * lRet == .t. if you successfully unlock the semaphore, .f. if + * you don't. If this call fails, it could be that you're passing + * an invalid semaphore handle. + * $DESCRIPTION$ + * + * This call unlocks a semaphore prevsiously locked via FT_NWSEMLOCK(). + * It is important that you get a valid semaphore handle from + * FT_NWSEMLOCK() before you use this call. Make sure when you call + * FT_NWSEMLOCK() that you pass a numeric parameter in for the handle + * BY REFERENCE. + * $EXAMPLES$ + * LOCAL nHandle := 0 + * IF FT_NWSEMLOCK( "k:\apps\error.log", @nHandle ) + * // Note, you aren't actually LOCKING this file, you are + * // just locking a semaphore by the same name. As long as + * // all apps that might be using this file are cooperating + * // with the same kind of semaphore lock, you can effectively + * // control access to the file. + * ELSE + * QOUT("Couldn't lock file.") + * ENDIF + * * Processing, then: + * FT_NWSEMUNLOCK( nHandle ) + * + * $SEEALSO$ + * FT_NWSEMOPEN() FT_NWSEMEX() FT_NWSEMWAIT() FT_NWSEMSIG() FT_NWSEMLOCK() + * $END$ + */ + + +function ft_nwSemUnLock( nHandle ) + return ( ft_nwSemClose( nHandle ) == 0 ) diff --git a/harbour/contrib/libnf/nwuid.prg b/harbour/contrib/libnf/nwuid.prg new file mode 100644 index 0000000000..985b219a4e --- /dev/null +++ b/harbour/contrib/libnf/nwuid.prg @@ -0,0 +1,125 @@ +/* + * File......: NWUID.PRG + * Author....: Glenn Scott + * CIS ID....: 71620,1521 + * + * This is an original work by Glenn Scott and is placed in the + * public domain. + * + * Modification history: + * --------------------- + * + * Rev 1.4 15 Aug 1991 23:04:10 GLENN + * Forest Belt proofread/edited/cleaned up doc + * + * Rev 1.3 14 Jun 1991 19:52:34 GLENN + * Minor edit to file header + * + * Rev 1.2 14 Jun 1991 04:31:30 GLENN + * Return value still needs to have nulls (chr(0)) removed. Put that back + * in. + * + * Rev 1.1 12 Jun 1991 02:25:22 GLENN + * Documentation correction and revision of ft_int86() call to account + * for Ted's new string passing conventions. + * + * Rev 1.0 01 Apr 1991 01:01:56 GLENN + * Nanforum Toolkit + * + */ + + +/* $DOC$ + * $FUNCNAME$ + * FT_NWUID() + * $CATEGORY$ + * NetWare + * $ONELINER$ + * Return the current Novell NetWare User ID + * $SYNTAX$ + * FT_NWUID( [ ] ) -> cUid + * $ARGUMENTS$ + * is a connection number, or logical station number, + * to find a userid for. Under NetWare 286, this number can be from + * 1 to 100. Under NetWare 386, 1-250. If not supplied, FT_NWUID() + * defaults to the current connection (i.e., the connection running + * the application). + * $RETURNS$ + * A string containing the userid, or "login name." + * The maximum length of this string, as defined by current + * versions of Novell NetWare, is 48 characters. + * $DESCRIPTION$ + * FT_NWUID() returns the current NetWare userid, or "login + * name." This is useful for implementing security or audit + * trail procedures within your programs. + * + * There is no simple way a user can "fool" this function into + * retrieving an incorrect value, provided a NetWare shell is loaded. + * + * This function requires FT_INT86() and FT_NWLSTAT() + * + * This function does NOT test for the existence of the NetWare shell. + * The behavior is undefined if no shell is loaded. You'll usually get + * garbage. This function has not been tested on NetWare 386. + * $EXAMPLES$ + * QOut( "I am: " + FT_NWUID() ) + * + * FOR x := 1 TO 100 + * cUid := FT_NWUID( x ) + * IF .NOT Empty( cUid ) + * QOut( Str( x, 3 ) + Space(3) + cUid ) + * ENDIF + * NEXT + * $END$ + */ + +#include "FTINT86.CH" + +#define DOS 33 +#define NW_LOG 227 + +#ifdef FT_TEST + FUNCTION MAIN() + local x, cUid + QOut( "I am: [" + FT_NWUID() + "]" ) + QOut( "---------------------" ) + + for x:= 1 to 100 + cUid := FT_NWUID( x ) + if .not. empty( cUid ) + QOut( str( x, 3 ) + space(3) + cUid ) + endif + next + + return ( nil ) +#endif + +FUNCTION FT_NWUID( nConn ) + LOCAL aRegs[ INT86_MAX_REGS ], ; + cReqPkt, ; + cRepPkt + + nConn := IIF( nConn == nil, FT_NWLSTAT(), nConn ) + + // Set up request packet + + cReqPkt := chr( 22 ) // Function 22: Get Connection Information + cReqPkt += chr( nConn ) + cReqPkt := i2bin( len( cReqPkt ) ) + cReqPkt + + // Set up reply packet + + cRepPkt := space(63) + + // Assign registers + + aRegs[ AX ] := MAKEHI( NW_LOG ) + aRegs[ DS ] := cReqPkt + aRegs[ SI ] := REG_DS + aRegs[ ES ] := cRepPkt + aRegs[ DI ] := REG_ES + + FT_INT86( DOS, aRegs ) + RETURN alltrim( strtran( substr( aRegs[ ES ], 9, 48 ), chr(0) ) ) + + diff --git a/harbour/contrib/libnf/ontick.c b/harbour/contrib/libnf/ontick.c new file mode 100644 index 0000000000..44966c9b82 --- /dev/null +++ b/harbour/contrib/libnf/ontick.c @@ -0,0 +1,139 @@ +/* + * File......: ONTICK.C + * Author....: Ted Means + * CIS ID....: 73067,3332 + * + * This function is an original work by Ted Means and is placed in the + * public domain. + * + * Modification history: + * --------------------- + * + * Rev 1.0 01 Jan 1995 03:01:00 TED + * Initial release + */ + + +/* $DOC$ + * $FUNCNAME$ + * FT_OnTick() + * $CATEGORY$ + * Event + * $ONELINER$ + * Evaluate a designated code block at a designated interval. + * $SYNTAX$ + * FT_OnTick( bCode, nInterval ) + * $ARGUMENTS$ + * is the code block to evaluate. + * is the number of clock ticks to wait between + * evaluations of the code block. + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * This function effectively allows you to run tasks in the background + * by transparently and periodically calling a designated routine. + * + * To halt the execution of the background function, call FT_OnTick() + * with no arguments. + * + * This function makes heavy use of several undocumented internal + * routines. If this fact makes you uncomfortable then don't use + * this function, you quivering sack of cowardly slime. + * $EXAMPLES$ + * + * // Set up a self-updating on-screen clock + * + * FT_OnTick( "CLOCK", 9 ) + * + * procedure Clock + * + * local nRow := Row() + * local nCol := Col() + * + * @ 0, 0 say Time() + * + * SetPos( nRow, nCol ) + * + * return + * + * $SEEALSO$ + * $END$ + */ + +#include +#include +#include + +typedef union +{ + long far * Address; + struct + { + unsigned int Offset; + unsigned int Segment; + } Pointer; +} LONGPTR; + +void cdecl _evLow( unsigned int, void *, unsigned int ); +void cdecl _bcopy( void *, void *, unsigned int ); + +static long far Ticks = 0; +static long far Interval = 1; +static ITEM far codeBlock; +static char inProgress = 0; + +static void cdecl TickTock( void ) +{ + auto unsigned int ProtMode = cpmiIsProtected(); + auto LONGPTR Timer; + auto EVALINFO eval; + + if ( inProgress ) return; + + inProgress = 1; + + if ( ProtMode ) + { + Timer.Pointer.Segment = cpmiProtectedPtr( ( long * ) ( 0x0000046C ), sizeof( long ) ); + Timer.Pointer.Offset = 0; + + if ( Timer.Pointer.Segment == 0 ) goto Exit; + } + else + Timer.Address = ( long * ) ( 0x0000046C ); + + if ( *Timer.Address >= ( Ticks + Interval ) || + ( *Timer.Address < Ticks ) ) + { + Ticks = *Timer.Address; + + _evalNew( &eval, codeBlock ); + + _itemRelease( _evalLaunch( &eval ) ); + } + + if ( ProtMode ) cpmiFreeSelector( Timer.Pointer.Segment ); + + Exit: inProgress = 0; + + return; +} + + +CLIPPER FT_OnTick( void ) +{ + if ( _itemType( codeBlock ) == BLOCK ) _itemRelease( codeBlock ); + + codeBlock = _itemParam( 1 ); + + if ( _itemType( codeBlock ) == BLOCK ) + { + Interval = _parnl( 2 ); + + _evLow( 5, TickTock, TRUE ); + } + else + _evLow( 5, TickTock, FALSE ); + + return; +} diff --git a/harbour/contrib/libnf/origin.c b/harbour/contrib/libnf/origin.c new file mode 100644 index 0000000000..d74a65dd9f --- /dev/null +++ b/harbour/contrib/libnf/origin.c @@ -0,0 +1,77 @@ +/* + * $Id$ + */ + +/* + * File......: ORIGIN.C + * Author....: Steve Larsen + * CIS ID....: 76370,1532 + * + * This is an original work by K. Stephan Larsen and is placed in the + * public domain. + * + * Modification history: + * --------------------- + * + * Rev 1.1 09 Nov 1992 22:35:52 GLENN + * Function was inadvertently named origin() instead of ft_origin() when + * it went from an .asm to a .c file. Renamed it back to ft_origin(). + * + * Rev 1.0 03 Oct 1992 02:13:54 GLENN + * Initial revision. + * + */ + +/* $DOC$ + * $FUNCNAME$ + * FT_ORIGIN() + * $CATEGORY$ + * Environment + * $ONELINER$ + * Report the drive, path and filename of the current program + * $SYNTAX$ + * FT_ORIGIN() -> cString + * $ARGUMENTS$ + * None + * $RETURNS$ + * A string containing the full drive/directory/filename of + * the currently executing file. + * $DESCRIPTION$ + * Often users will install multiple copies of application software, + * especially on networks and in situations where the user is trying + * to get around a copy protection scheme. + * + * This function enables you to learn the name and source location + * of the currently executing file, so that you may take whatever + * action you need to. + * + * Requires DOS v3.xx and above. + * $EXAMPLES$ + * cMyFile := FT_ORIGIN() + * + * IF cMyFile <> "C:\APPDIR\MYFILE.EXE" + * ?"Incorrect startup file. Please remove/rename and start again" + * QUIT + * ENDIF + * $INCLUDE$ + * extend.h + * $SEEALSO$ + * FT_WHEREIS() FT_TREE() + * $END$ + */ + +#include + +HB_FUNC(FT_ORIGIN) +{ +#if defined(HB_OS_DOS) || defined(HB_OS_WIN_32) + { + + extern char **_argv; + + hb_retc( *_argv ); + + return; +} +#endif +} diff --git a/harbour/contrib/libnf/page.prg b/harbour/contrib/libnf/page.prg new file mode 100644 index 0000000000..0f68e605de --- /dev/null +++ b/harbour/contrib/libnf/page.prg @@ -0,0 +1,110 @@ +/* + * File......: PAGE.PRG + * Author....: Glenn Scott + * CIS ID....: 71620,1521 + * + * This is an original work by Glenn Scott and is placed in the + * public domain. + * + * Modification history: + * --------------------- + * + * Rev 1.3 15 Aug 1991 23:05:18 GLENN + * Forest Belt proofread/edited/cleaned up doc + * + * Rev 1.2 14 Jun 1991 19:52:36 GLENN + * Minor edit to file header + * + * Rev 1.1 12 Jun 1991 02:29:14 GLENN + * Documentation mods and check for ft_int86() compatibility + * + * Rev 1.0 01 Apr 1991 01:01:58 GLENN + * Nanforum Toolkit + * + */ + +#include "FTINT86.CH" + +#define VIDEO 16 + +/* $DOC$ + * $FUNCNAME$ + * FT_SETVPG() + * $CATEGORY$ + * Video + * $ONELINER$ + * Set the current video page + * $SYNTAX$ + * FT_SETVPG( ) -> NIL + * $ARGUMENTS$ + * is a valid video page. + * $RETURNS$ + * NIL + * $DESCRIPTION$ + * Selects the video page. + * + * For more information on graphics programming and video pages, + * consult a reference such as "Programmer's Guide to PC and PS/2 + * Video Systems" (Microsoft Press). + * $EXAMPLES$ + * // The following sets the current video page to 1 + * + * FT_SETVPG( 1 ) + * $SEEALSO$ + * FT_GETVPG() + * $END$ + */ + + +FUNCTION FT_SETVPG( nPage ) +/* + LOCAL aRegs[ INT86_MAX_REGS ] + + aRegs[ AX ] = MAKEHI( 5 ) + nPage + FT_INT86( VIDEO, aRegs ) + */ + _ft_setvpg(nPage) + + RETURN( NIL ) + + + +/* $DOC$ + * $FUNCNAME$ + * FT_GETVPG() + * $CATEGORY$ + * Video + * $ONELINER$ + * Get the currently selected video page + * $SYNTAX$ + * FT_GETVPG() -> + * $ARGUMENTS$ + * None. + * $RETURNS$ + * The video page, as a numeric. + * $DESCRIPTION$ + * Get the currently selected video page + * + * For more information on graphics programming and video pages, + * consult a reference such as _Programmer's Guide to PC and PS/2 + * Video Systems_ (Microsoft Press). + * + * $EXAMPLES$ + * nPage := FT_GETVPG() + * $SEEALSO$ + * FT_SETVPG() + * $END$ + */ + + + +FUNCTION FT_GETVPG() +/* + LOCAL aRegs[ INT86_MAX_REGS ] + + aRegs[ AX ] := MAKEHI( 15 ) + FT_INT86( VIDEO, aRegs ) + + RETURN ( HIGHBYTE( aRegs[ BX ] ) ) */ + Return _ft_getvpg() + diff --git a/harbour/contrib/libnf/pchr.prg b/harbour/contrib/libnf/pchr.prg new file mode 100644 index 0000000000..0a172b5e1d --- /dev/null +++ b/harbour/contrib/libnf/pchr.prg @@ -0,0 +1,224 @@ +/* + * File......: PCHR.PRG + * Author....: Jim Gale + * CIS ID....: 73670,2561 + * + * This is an original work by Jim Gale and is placed in the + * public domain. + * + * Modification history: + * --------------------- + * + * Rev 1.2 17 Aug 1991 15:40:16 GLENN + * Don Caton fixed some spelling errors in the doc + * + * Rev 1.1 15 Aug 1991 23:06:00 GLENN + * Forest Belt proofread/edited/cleaned up doc + * + * Rev 1.0 12 Jun 1991 01:45:04 GLENN + * Initial revision. + * + */ + + +/* $DOC$ + * $FUNCNAME$ + * FT_PCHR() + * $CATEGORY$ + * String + * $ONELINER$ + * Convert printer control codes + * $SYNTAX$ + * FT_PCHR( ) -> + * $ARGUMENTS$ + * is the representation of the printer control codes in + * text, numeric, hexadecimal, Epson command format, or any combination + * separated by commas. + * $RETURNS$ + * A character string of printer control codes. + * $DESCRIPTION$ + * This function is useful for allowing the user to enter printer + * control codes in text (enclosed in double quotes), numeric, + * hexadecimal, or Epson commands preceded by a slash and returns + * the printer control code equivalent. + * + * NOTES" + * + * - Combinations of text, numbers, hex, and commands must be + * separated by commas ("A",27,&1B,/RESET). + * - Text must be enclosed in double quotes ("x"). + * - Hexadecimal must be preceded by an ampersand (&1B). + * - Epson commands, listed below, must be preceded by a forward + * slash (/RESET). + * + * Epson commands: (slash commands are specific to the Epson) + * + * Job Control: + * + * /RESET or /INIT Reset or initialize the printer + * /BELL or /BEEP Cause the printer's speaker to beep (not HS) + * /CAN Clear print buffers (not MX) + * /SLOW Set low speed mode (not CR, HS, MX) + * /FAST Cancel low speed mode (not CR, HS, MX) + * /ONE Select Unidirectional mode + * /TWO Select Directional mode + * /ON Activate printer + * /OFF Turn off printer + * + * /FF or /EJECT Form Feed + * + * Page Control: + * + * /1/6 Set 6 lines per inch + * /1/8 Set 8 lines per inch + * /SKIP Set Skip perforation ON + * /SKIPOFF Set Skip perforation OFF + * + * Font Selection and Manipulation: + * + * /ITALIC Select italic char. set (only FX86, EX, LX, + * no LQ-1500, SX) + * /GRAPHIC Select graphic char. set (only FX86, EX, LX, + * no LQ-1500, SX) + * /ROMAN Choose Roman font + * /SANS Choose Sans Serif font + * /DRAFT Choose draft + * /NLQ Choose near letter quality + * /PICA Choose 10 chars per inch + * /ELITE Choose 12 chars per inch + * /COND or /SI Choose 15 chars per inch + * /EMPH Turn emphasize on + * /EMPHOFF Turn emphasize off + * /SPANISH Select spanish international char set + * /USA Select USA international char set + * + * $EXAMPLES$ + * cSetUp := '27,116,1' + * Set Print ON + * ? FT_PCHR( cSetUp ) -> (CHR(27)+CHR(116)+CHR(1)) + *