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

2012-10-04 12:47 UTC+0200 Viktor Szakats (harbour syenar.net)

Browse Source 
* src/rtl/tget.prg
    ! fixed regression from 2012-01-29 17:22 UTC+0100
      when non-numeric index was allowed on a non-hash
      variable and then an RTE generated.
      Caused rto_get.prg to RTE in the middle.

  * contrib/gtwvg/activex.prg
  * contrib/gtwvg/class.prg
  * contrib/gtwvg/tests/demoxbp.prg
  * contrib/gtwvg/tests/utils.prg
  * contrib/rddads/doc/en/adsfuncs.txt
  * contrib/rddads/doc/en/readme.txt
  * contrib/xhb/tfile.prg
  * contrib/xhb/txml.prg
  * contrib/xhb/xhbole.prg
  * doc/windll.txt
  * extras/gtwvw/gtwvw.c
  * extras/gtwvw/hbgtwvw.h
  * extras/gtwvw/tests/maincoor.prg
  * extras/gtwvw/wvwcheck.c
  * extras/gtwvw/wvwdraw.c
  * extras/gtwvw/wvwedit.c
  * extras/gtwvw/wvwfuncs.c
  * extras/gtwvw/wvwmenu.c
  * extras/gtwvw/wvwpush.c
  * extras/gtwvw/wvwstbar.c
  * extras/gtwvw/wvwtbar.c
  * extras/hbdoc/tmplates.prg
  * tests/gtcolors.prg
  * tests/ipclnt.prg
  * tests/ipsvr.prg
  * tests/rto_get.prg
  * tests/rto_tb.prg
  * tests/usrrdd/exarr.prg
  * tests/usrrdd/exfcm.prg
  * tests/usrrdd/exhsx.prg
  * tests/usrrdd/exlog.prg
  * tests/usrrdd/exmemo.prg
  * tests/usrrdd/exrlx.prg
  * tests/wcecon.prg
    * full formatting using hbformat (where needed)
    * Win32 -> Windows
    * 32-bit deleted where it didn't make sense
    * using K_* constants
    ! fixed != operators where used on strings (more to come)
      Thanks to Jose F. Gimenez for the ones in txml.prg.
    * avoid "common.ch"
    % use hb_ntos() in Harbour specific code
This commit is contained in:
Viktor Szakats
2012-10-04 10:54:07 +00:00
parent 89c4211f5b
commit c0dc8c254d
36 changed files with 405 additions and 345 deletions
Download Patch File Download Diff File Expand all files Collapse all files

50
harbour/ChangeLog
View File

@@ -16,6 +16,56 @@
The license applies to all entries newer than 2009-04-28.
*/
2012-10-04 12:47 UTC+0200 Viktor Szakats (harbour syenar.net)
* src/rtl/tget.prg
! fixed regression from 2012-01-29 17:22 UTC+0100
when non-numeric index was allowed on a non-hash
variable and then an RTE generated.
Caused rto_get.prg to RTE in the middle.
* contrib/gtwvg/activex.prg
* contrib/gtwvg/class.prg
* contrib/gtwvg/tests/demoxbp.prg
* contrib/gtwvg/tests/utils.prg
* contrib/rddads/doc/en/adsfuncs.txt
* contrib/rddads/doc/en/readme.txt
* contrib/xhb/tfile.prg
* contrib/xhb/txml.prg
* contrib/xhb/xhbole.prg
* doc/windll.txt
* extras/gtwvw/gtwvw.c
* extras/gtwvw/hbgtwvw.h
* extras/gtwvw/tests/maincoor.prg
* extras/gtwvw/wvwcheck.c
* extras/gtwvw/wvwdraw.c
* extras/gtwvw/wvwedit.c
* extras/gtwvw/wvwfuncs.c
* extras/gtwvw/wvwmenu.c
* extras/gtwvw/wvwpush.c
* extras/gtwvw/wvwstbar.c
* extras/gtwvw/wvwtbar.c
* extras/hbdoc/tmplates.prg
* tests/gtcolors.prg
* tests/ipclnt.prg
* tests/ipsvr.prg
* tests/rto_get.prg
* tests/rto_tb.prg
* tests/usrrdd/exarr.prg
* tests/usrrdd/exfcm.prg
* tests/usrrdd/exhsx.prg
* tests/usrrdd/exlog.prg
* tests/usrrdd/exmemo.prg
* tests/usrrdd/exrlx.prg
* tests/wcecon.prg
* full formatting using hbformat (where needed)
* Win32 -> Windows
* 32-bit deleted where it didn't make sense
* using K_* constants
! fixed != operators where used on strings (more to come)
Thanks to Jose F. Gimenez for the ones in txml.prg.
* avoid "common.ch"
% use hb_ntos() in Harbour specific code
2012-10-04 04:56 UTC+0200 Viktor Szakats (harbour syenar.net)
* contrib/gtwvg/tests/dyndlgs.prg
* contrib/gtwvg/tests/wvtcls.prg

2
harbour/contrib/gtwvg/activex.prg
View File

@@ -154,7 +154,7 @@ METHOD WvgActiveXControl:Create( oParent, oOwner, aPos, aSize, aPresParams, lVis
::license := cLicense
::hContainer := ::oParent:getHWND()
IF ValType( ::hContainer ) + ValType( ::CLSID ) != "NC"
IF ! HB_ISNUMERIC( ::hContainer ) .OR. ! HB_ISSTRING( ::CLSID )
RETURN NIL
ENDIF

2
harbour/contrib/gtwvg/class.prg
View File

@@ -380,7 +380,7 @@ METHOD wvtDialog:Execute()
ENDIF
ENDDO
ELSE
DO WHILE ( ::Inkey() != K_ESC )
DO WHILE ::Inkey() != K_ESC
ENDDO
ENDIF

2
harbour/contrib/gtwvg/tests/demoxbp.prg
View File

@@ -258,7 +258,7 @@ FUNCTION Main()
oCrt:show()
DO WHILE .T.
IF inkey() == 27
IF inkey() == K_ESC
EXIT
ENDIF
ENDDO

5
harbour/contrib/gtwvg/tests/utils.prg
View File

@@ -477,7 +477,7 @@ FUNCTION ClearStatusMsg()
FUNCTION WvtPictures( nSlot,cFilePic )
IF nSlot != NIL .AND. nSlot <= 20 .AND. file( cFilePic )
IF t_pic_[ nSlot ] != cFilePic
IF !( t_pic_[ nSlot ] == cFilePic )
IF Wvt_LoadPicture( cFilePic, nSlot )
t_pic_[ nSlot ] := cFilePic
ENDIF
@@ -524,7 +524,8 @@ FUNCTION MyError( oError )
? procname( 2 ), procline( 2 )
? procname( 3 ), procline( 3 )
? procname( 4 ), procline( 4 )
DO WHILE inkey() != 27; ENDDO
DO WHILE inkey() != K_ESC
ENDDO
RETURN NIL

81
harbour/contrib/rddads/doc/en/adsfuncs.txt
View File

@@ -43,7 +43,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit only
* Windows
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -83,7 +83,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit only
* Windows
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -114,7 +114,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit
* Windows
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -183,7 +183,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit
* Windows
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -218,7 +218,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit
* Windows
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -251,7 +251,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit
* Windows
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -282,7 +282,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit
* Windows
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -314,7 +314,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit
* Windows
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -348,7 +348,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit
* Windows
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -384,7 +384,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit
* Windows
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -415,7 +415,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit
* Windows
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -454,7 +454,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit
* Windows
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -492,7 +492,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit
* Windows
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -541,7 +541,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit
* Windows
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -591,7 +591,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit
* Windows
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -637,7 +637,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit
* Windows
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -680,7 +680,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit
* Windows
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -714,6 +714,7 @@
* DLLs doing all the indexing. So to do progress meters
* you need to implement this.
* $EXAMPLES$
* #include "inkey.ch"
* PROCEDURE Main()
* ...
* AdsRegCallBack( {| nPercent | outputstuff( nPercent ) } )
@@ -722,18 +723,18 @@
* The codeblock can return .T. to abort. */
* INDEX ON First+LAST+LABEL1+LABEL2 TAG First
* AdsClrCallBack()
* RETURN
* RETURN
*
* FUNCTION outputstuff( nPercent ) /* The "callback" function */
* ? "output stuff", nPercent
* RETURN Inkey() == 27
* /* If press ESC, returns .T. to abort. */
* RETURN Inkey() == K_ESC
* /* If press ESC, returns .T. to abort. */
* $STATUS$
* R
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit, Linux
* Windows, Linux
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -765,7 +766,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit, Linux
* Windows, Linux
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -802,7 +803,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit, Linux
* Windows, Linux
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -841,7 +842,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit, Linux
* Windows, Linux
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -877,7 +878,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit, Linux
* Windows, Linux
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -913,7 +914,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit, Linux
* Windows, Linux
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -955,7 +956,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit, Linux
* Windows, Linux
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -987,7 +988,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit, Linux
* Windows, Linux
* $FILES$
* Library is RddAds
* $SEEALSO$
@@ -1035,7 +1036,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit, Linux
* Windows, Linux
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -1066,7 +1067,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit, Linux
* Windows, Linux
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -1112,7 +1113,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit, Linux
* Windows, Linux
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -1153,7 +1154,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit, Linux
* Windows, Linux
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -1190,7 +1191,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit, Linux
* Windows, Linux
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -1230,7 +1231,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit, Linux
* Windows, Linux
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -1260,7 +1261,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit, Linux
* Windows, Linux
* $FILES$
* $SEEALSO$
* ADSCONNECT60()
@@ -1299,7 +1300,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit, Linux
* Windows, Linux
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -1337,7 +1338,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit, Linux
* Windows, Linux
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -1376,7 +1377,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit, Linux
* Windows, Linux
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -1413,7 +1414,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Ads 7.x and above, Windows 32-bit, Linux
* Ads 7.x and above, Windows, Linux
* $FILES$
* Library is RddAds
* Header is ads.ch
@@ -1448,7 +1449,7 @@
* $COMPLIANCE$
* Harbour extension
* $PLATFORMS$
* Windows 32-bit, Linux
* Windows, Linux
* $FILES$
* Library is RddAds
* Header is ads.ch

7
harbour/contrib/rddads/doc/en/readme.txt
View File

@@ -128,6 +128,7 @@
* codeblock by the ADS server.
*
* <table>
* #include "inkey.ch"
* PROCEDURE Main()
* ...
* AdsRegCallBack( {| nPercent | outputstuff( nPercent ) } )
@@ -136,12 +137,12 @@
* The codeblock can return .T. to abort. */
* INDEX ON First+LAST+LABEL1+LABEL2 TAG First
* AdsClrCallBack()
* RETURN
* RETURN
*
* FUNCTION outputstuff( nPercent ) /* The "callback" function */
* ? "output stuff", nPercent
* RETURN Inkey() == 27
* /* If press ESC, returns .T. to abort. */
* RETURN Inkey() == K_ESC
* /* If press ESC, returns .T. to abort. */
* </table>
*
* For programmers who are already familiar with the ACE engine,

170
harbour/contrib/xhb/tfile.prg
View File

@@ -49,9 +49,10 @@
#include "fileio.ch"
#include "cgi.ch"
#translate FPOS(<f>) => FSEEK( <f>, 0, FS_RELATIVE )
#translate FPOS( <f> ) => FSeek( <f>, 0, FS_RELATIVE )
CLASS TCgiFile
DATA Buffer INIT ""
DATA Name INIT ""
DATA Handle
@@ -66,24 +67,24 @@ CLASS TCgiFile
METHOD Open( nMode )
METHOD CLOSE() INLINE Fclose( ::Handle ),;
::Handle := - 999
METHOD CLOSE() INLINE FClose( ::Handle ), ;
::Handle := - 999
METHOD RENAME( c ) INLINE Frename( ::File, c ) == 0
METHOD RENAME( c ) INLINE FRename( ::File, c ) == 0
METHOD ERASE() INLINE Ferase( ::File ) == 0
METHOD ERASE() INLINE FErase( ::File ) == 0
METHOD Exists() INLINE File( ::File )
METHOD Error() INLINE Ferror() != 0
METHOD Error() INLINE FError() != 0
METHOD Tell() INLINE Fseek( ::handle, FS_RELATIVE, 0 )
METHOD Tell() INLINE FSeek( ::handle, FS_RELATIVE, 0 )
METHOD Pointer() INLINE FPOS( ::handle )
METHOD ReadStr( n ) INLINE ::Buffer := ;
Freadstr( ::Handle, n )
METHOD Write( c, n ) INLINE Fwrite( ::Handle, c, n )
FReadStr( ::Handle, n )
METHOD Write( c, n ) INLINE FWrite( ::Handle, c, n )
METHOD WriteByte( nByte )
@@ -93,15 +94,15 @@ CLASS TCgiFile
METHOD GetBuffer() INLINE ::Buffer
METHOD GoTop() INLINE Fseek( ::Handle, 0 )
METHOD GoTop() INLINE FSeek( ::Handle, 0 )
METHOD GoBottom() INLINE Fseek( ::Handle, 0, FS_END )
METHOD GoBottom() INLINE FSeek( ::Handle, 0, FS_END )
METHOD Bof() INLINE( FPOS( ::Handle ) == 0 )
METHOD BOF() INLINE( FPOS( ::Handle ) == 0 )
METHOD Eof() INLINE FPOS( ::Handle ) == ::FileSize
METHOD EOF() INLINE FPOS( ::Handle ) == ::FileSize
METHOD SEEK( n, o ) INLINE Fseek( ::Handle, n, o )
METHOD SEEK( n, o ) INLINE FSeek( ::Handle, n, o )
METHOD CREATE( nAttr )
@@ -133,10 +134,8 @@ CLASS TCgiFile
ENDCLASS
METHOD New( cName ) CLASS TCgiFile
::Name := cName
::Buffer := ""
::Handle := 0
@@ -146,22 +145,22 @@ METHOD New( cName ) CLASS TCgiFile
::nPage := 0
::nPageSize := 1024
::nRecord := 0
RETURN Self
RETURN Self
/*
** ::Open( [<nMode>] ) --> lSuccess
*/
METHOD Open( nMode ) CLASS TCgiFile
DEFAULT nMode TO FO_EXCLUSIVE
::Handle := Fopen( ::Name, nMode )
::Handle := FOpen( ::Name, nMode )
IF ::Handle > 0
::Size()
ENDIF
RETURN ::Handle > 0
RETURN ::Handle > 0
/*
** ::Create( [<nAttrib>] ) --> lSuccess
@@ -169,13 +168,13 @@ RETURN ::Handle > 0
METHOD CREATE ( nAttr ) CLASS TCgiFile
LOCAL nSuccess
DEFAULT nAttr TO 0
nSuccess := Fcreate( ::Name, nAttr )
nSuccess := FCreate( ::Name, nAttr )
::Handle := nSuccess
RETURN nSuccess != - 1
RETURN nSuccess != -1
/*
** ::Size() --> nFileSize
@@ -183,35 +182,32 @@ RETURN nSuccess != - 1
** RETURNs the size in bytes of the current file.
*/
METHOD Size() CLASS TCgiFile
LOCAL nCurrent
LOCAL nLength
nCurrent := FPOS( ::Handle )
nLength := Fseek( ::Handle, 0, FS_END )
nLength := FSeek( ::Handle, 0, FS_END )
Fseek( ::Handle, nCurrent )
FSeek( ::Handle, nCurrent )
::FileSize := nLength
RETURN nLength
RETURN nLength
/*
** ::Read( [<nSize>], [@<cBuff>] ) --> nBytesRead
*/
METHOD _Read( nSize, cBuff ) CLASS TCgiFile
DEFAULT nSize TO 1024
DEFAULT cBuff TO Space( nSize )
::BytesRead := Fread( ::Handle, @cBuff, nSize )
::BytesRead := FRead( ::Handle, @cBuff, nSize )
::Buffer := cBuff
RETURN cBuff //nBytesRead )
RETURN cBuff //nBytesRead )
/*
** ::ReadAhead( [<nSize>], [@<cBuff>] ) --> nBytesRead
@@ -219,7 +215,6 @@ RETURN cBuff //nBytesRead )
** Read forward in the file without moving the pointer.
*/
METHOD ReadAhead( nSize, cBuff ) CLASS TCgiFile
LOCAL nCurrent
@@ -227,25 +222,23 @@ METHOD ReadAhead( nSize, cBuff ) CLASS TCgiFile
DEFAULT nSize TO 1024
DEFAULT cBuff TO Space( nSize )
// --> save position in file
// --> save position in file
nCurrent := FPOS( ::Handle )
// --> read ahead
::BytesRead := Fread( ::Handle, @cBuff, nSize )
// --> read ahead
::BytesRead := FRead( ::Handle, @cBuff, nSize )
// --> RETURN to saved position
Fseek( ::Handle, nCurrent )
// --> RETURN to saved position
FSeek( ::Handle, nCurrent )
RETURN cBuff
RETURN cBuff
/*
** ::ReadLine( [<nBytes>] ) --> cLine
*/
METHOD Readline( nSize ) CLASS TCgiFile
LOCAL cString
LOCAL nCurrent
LOCAL nCr
@@ -256,92 +249,86 @@ METHOD Readline( nSize ) CLASS TCgiFile
RETURN ""
ENDIF
nCurrent := Fseek( ::Handle, 0, 1 )
cString := Freadstr( ::Handle, nSize )
nCurrent := FSeek( ::Handle, 0, 1 )
cString := FReadStr( ::Handle, nSize )
nCr := At( Chr( 13 ), cString )
Fseek( ::Handle, nCurrent, 0 )
Fseek( ::Handle, nCr + 1, 1 )
FSeek( ::Handle, nCurrent, 0 )
FSeek( ::Handle, nCr + 1, 1 )
::Buffer := Substr( cString, 1, nCr - 1 )
::Buffer := SubStr( cString, 1, nCr - 1 )
::nRecord ++
RETURN ::Buffer
RETURN ::Buffer
/*
** ::ReadByte() --> nByte or -1 if unsuccessfull
*/
METHOD ReadByte() CLASS TCgiFile
LOCAL nBytes
LOCAL cBuff := Space( 1 )
nBytes := Fread( ::Handle, @cBuff, hb_BLen( cBuff ) )
nBytes := FRead( ::Handle, @cBuff, hb_BLen( cBuff ) )
RETURN iif( nBytes > 0, Asc( cBuff ), - 1 )
RETURN iif( nBytes > 0, Asc( cBuff ), -1 )
/*
** ::ReadInt() --> nUnsignedInt or -1 if unsuccessfull
*/
METHOD ReadInt() CLASS TCgiFile
LOCAL nBytes
LOCAL cBuff := Space( 2 )
nBytes := Fread( ::Handle, @cBuff, hb_BLen( cBuff ) )
nBytes := FRead( ::Handle, @cBuff, hb_BLen( cBuff ) )
RETURN iif( nBytes > 0, Bin2i( cBuff ), - 1 )
RETURN iif( nBytes > 0, Bin2I( cBuff ), -1 )
/*
** ::ReadLong() --> nLong or -1 if unsuccessfull
*/
METHOD ReadLong() CLASS TCgiFile
LOCAL nBytes
LOCAL cBuff := Space( 4 )
nBytes := Fread( ::Handle, @cBuff, hb_BLen( cBuff ) )
nBytes := FRead( ::Handle, @cBuff, hb_BLen( cBuff ) )
RETURN iif( nBytes > 0, Bin2l( cBuff ), - 1 )
RETURN iif( nBytes > 0, Bin2L( cBuff ), -1 )
/*
** ::WriteByte( nByte ) --> lSuccess
*/
METHOD WriteByte( nByte ) CLASS TCgiFile
LOCAL lSuccess := ( FWrite( ::nHandle, hb_BCode( nByte ), 1 ) == 1 )
LOCAL lSuccess := ( Fwrite( ::nHandle, hb_BCode( nByte ), 1 ) == 1 )
RETURN lSuccess
RETURN lSuccess
/*
** ::WriteInt( nInt ) --> lSuccess
*/
METHOD WriteInt( nInt ) CLASS TCgiFile
LOCAL lSuccess := ( FWrite( ::nHandle, I2Bin( nInt ), 2 ) == 2 )
LOCAL lSuccess := ( Fwrite( ::nHandle, I2bin( nInt ), 2 ) == 2 )
RETURN lSuccess
RETURN lSuccess
/*
** ::WriteLong( nLong ) --> lSuccess
*/
METHOD WriteLong( nLong ) CLASS TCgiFile
LOCAL lSuccess := ( FWrite( ::nHandle, L2Bin( nLong ), 4 ) == 4 )
LOCAL lSuccess := ( Fwrite( ::nHandle, L2bin( nLong ), 4 ) == 4 )
RETURN lSuccess
RETURN lSuccess
/*
** ::GOTO( <nLine> ) --> nPrevPos
@@ -350,9 +337,7 @@ RETURN lSuccess
**
*/
METHOD Goto( nLine ) CLASS TCgiFile
METHOD GOTO( nLine ) CLASS TCgiFile
LOCAL nCount := 1
LOCAL nPos := FPOS( ::Handle )
@@ -379,7 +364,7 @@ METHOD Goto( nLine ) CLASS TCgiFile
nCount ++
ENDDO
RETURN nPos
RETURN nPos
/*
** ::Skip( [<nLines>] ) --> nPrevPos
@@ -388,10 +373,8 @@ RETURN nPos
**
*/
METHOD SKIP( nLines ) CLASS TCgiFile
LOCAL nCount := 0
LOCAL nPos := FPOS( ::Handle )
@@ -412,28 +395,25 @@ METHOD SKIP( nLines ) CLASS TCgiFile
::ReadLine()
nCount ++
ENDDO
RETURN nPos
RETURN nPos
/*
** ::MaxPages( <nPageSize> ) --> nMaxPages
*/
METHOD MaxPages( nPageSize ) CLASS TCgiFile
DEFAULT nPageSize TO ::nPageSize
RETURN ::Size() / nPageSize
RETURN ::Size() / nPageSize
/*
** ::PrevPage( [<nBytes>] ) --> cPage
*/
METHOD PrevPage( nBytes ) CLASS TCgiFile
DEFAULT nBytes TO 1024
IF nBytes <= 0
@@ -441,23 +421,20 @@ METHOD PrevPage( nBytes ) CLASS TCgiFile
ENDIF
IF !::BOF()
Fseek( ::Handle, - nBytes, FS_RELATIVE )
::cPage := Freadstr( ::Handle, nBytes )
Fseek( ::Handle, - nBytes, FS_RELATIVE )
FSeek( ::Handle, - nBytes, FS_RELATIVE )
::cPage := FReadStr( ::Handle, nBytes )
FSeek( ::Handle, - nBytes, FS_RELATIVE )
::nPage --
ENDIF
RETURN ::cPage
RETURN ::cPage
/*
** ::NextPage( [<nBytes>] ) --> cPage
*/
METHOD NextPage( nBytes ) CLASS TCgiFile
DEFAULT nBytes TO 1024
IF nBytes <= 0
@@ -465,11 +442,11 @@ METHOD NextPage( nBytes ) CLASS TCgiFile
ENDIF
IF !::EOF()
::cPage := Freadstr( ::Handle, nBytes )
::cPage := FReadStr( ::Handle, nBytes )
::nPage ++
ENDIF
RETURN ::cPage
RETURN ::cPage
/*
** ::PrevLine( [<nBytes>] ) --> ::Buffer
@@ -477,7 +454,6 @@ RETURN ::cPage
METHOD PrevLine( nBytes ) CLASS TCgiFile
LOCAL fHandle := ::Handle
LOCAL nOrigPos := FPOS( fHandle )
LOCAL nMaxRead
@@ -499,20 +475,20 @@ METHOD PrevLine( nBytes ) CLASS TCgiFile
lMoved := .T.
// Check preceeding 2 chars for CR+LF
Fseek( fHandle, - 2, FS_RELATIVE )
FSeek( fHandle, - 2, FS_RELATIVE )
cTemp := Space( 2 )
Fread( fHandle, @cTemp, hb_BLen( cTemp ) )
FRead( fHandle, @cTemp, hb_BLen( cTemp ) )
IF cTemp == CRLF()
Fseek( fHandle, - 2, FS_RELATIVE )
FSeek( fHandle, - 2, FS_RELATIVE )
ENDIF
nMaxRead := Min( nBytes, FPOS( fHandle ) )
cBuff := Space( nMaxRead )
nNewPos := Fseek( fHandle, - nMaxRead, FS_RELATIVE )
Fread( fHandle, @cBuff, nMaxRead )
nWhereCrLf := Rat( CRLF(), cBuff )
nNewPos := FSeek( fHandle, - nMaxRead, FS_RELATIVE )
FRead( fHandle, @cBuff, nMaxRead )
nWhereCrLf := RAt( CRLF(), cBuff )
IF nWhereCrLf == 0
nPrev := nNewPos
@@ -521,12 +497,12 @@ METHOD PrevLine( nBytes ) CLASS TCgiFile
ELSE
nPrev := nNewPos + nWhereCrLf + 1
::Buffer := Substr( cBuff, nWhereCrLf + 2 )
::Buffer := SubStr( cBuff, nWhereCrLf + 2 )
ENDIF
Fseek( fHandle, nPrev, FS_SET )
FSeek( fHandle, nPrev, FS_SET )
ENDIF
RETURN iif( lMoved, ::Buffer, "" )
RETURN iif( lMoved, ::Buffer, "" )

6
harbour/contrib/xhb/txml.prg
View File

@@ -266,7 +266,7 @@ RETURN Self
METHOD MatchCriteria( oFound ) CLASS TXmlIteratorScan
IF ::cName != NIL .and. ( oFound:cName == NIL .or. ::cName != oFound:cName )
IF ::cName != NIL .and. ( oFound:cName == NIL .or. !( ::cName == oFound:cName ) )
RETURN .F.
ENDIF
@@ -275,11 +275,11 @@ METHOD MatchCriteria( oFound ) CLASS TXmlIteratorScan
ENDIF
IF ::cValue != NIL .and. ;
hb_HScan( oFound:aAttributes, {| xKey, cValue| HB_SYMBOL_UNUSED( xKey ), ::cValue == cValue}) == 0
hb_HScan( oFound:aAttributes, {| xKey, cValue | HB_SYMBOL_UNUSED( xKey ), ::cValue == cValue } ) == 0
RETURN .F.
ENDIF
IF ::cData != NIL .and. ( oFound:cData == NIL .or. ::cData != oFound:cData )
IF ::cData != NIL .and. ( oFound:cData == NIL .or. !( ::cData == oFound:cData ) )
RETURN .F.
ENDIF

2
harbour/contrib/xhb/xhbole.prg
View File

@@ -230,7 +230,7 @@ OLE OPERATOR "==" METHOD OleValueExactEqual WITH xArg IS ::OleValue == xArg
OLE OPERATOR "=" METHOD OleValueEqual WITH xArg IS ::OleValue = xArg
OLE OPERATOR "!=" METHOD OleValueNotEqual WITH xArg IS ::OleValue != xArg
OLE OPERATOR "!=" METHOD OleValueNotEqual WITH xArg IS ::OleValue != xArg /* Intentionally using != operator */
OLE OPERATOR "+" METHOD OleValuePlus WITH xArg IS ::OleValue + xArg

4
harbour/doc/windll.txt
View File

@@ -2,8 +2,8 @@
* $Id$
*/
Windows 32-bit DLLs with Harbour code
=====================================
Windows DLLs with Harbour code
==============================
Programs created with Clipper or Harbour are traditionally a
monolithic EXE containing all executable code. This includes

8
harbour/extras/gtwvw/gtwvw.c
View File

@@ -3,7 +3,7 @@
*/
/*
* Video subsystem for Win32 using GUI windows instead of Console
* Video subsystem for Windows using GUI windows instead of Console
* with multiple windows support
* Copyright 2004 Budyanto Dj. <budyanto@centrin.net.id>
*
@@ -12,14 +12,14 @@
* =Id: gtwvt.c,v 1.60 2004/01/26 08:14:07 vouchcac Exp =
*
* Harbour Project source code:
* Video subsystem for Win32 using GUI windows instead of Console
* Video subsystem for Windows using GUI windows instead of Console
* Copyright 2003 Peter Rees <peter@rees.co.nz>
* Rees Software & Systems Ltd
* based on
* Bcc ConIO Video subsystem by
* Copyright 2002 Marek Paliwoda <paliwoda@inteia.pl>
* Copyright 2002 Przemyslaw Czerpak <druzus@polbox.com>
* Video subsystem for Win32 compilers
* Video subsystem for Windows compilers
* Copyright 1999-2000 Paul Tucker <ptucker@sympatico.ca>
* Copyright 2002 Przemyslaw Czerpak <druzus@polbox.com>
*
@@ -1177,7 +1177,7 @@ static const char * hb_gt_wvw_Version( PHB_GT pGT, int iType )
if ( iType == 0 )
return HB_GT_DRVNAME( HB_GT_NAME );
return( "Harbour Terminal: Win32 buffered WVW" );
return( "Harbour Terminal: Windows buffered WVW" );
}

4
harbour/extras/gtwvw/hbgtwvw.h
View File

@@ -4,13 +4,13 @@
/*
* Harbour Project source code:
* Video subsystem for Win32 using GUI windows instead of Console
* Video subsystem for Windows using GUI windows instead of Console
* WITH MULTIPLE WINDOW SUPPORT
* Copyright 2004 Budyanto Dj. <budyanto@centrin.net.id>
*
* initially based on:
*
* Header File for Video subsystem for Win32 using GUI windows instead of Console
* Header File for Video subsystem for Windows using GUI windows instead of Console
* Copyright 2003 Peter Rees <peter@rees.co.nz>
* Rees Software & Systems Ltd
* www - http://harbour-project.org

58
harbour/extras/gtwvw/tests/maincoor.prg
View File

@@ -9,33 +9,39 @@
Standard Mode of GTWVW.
*/
#include "inkey.ch"
proc main
setcolor("N/W")
PROCEDURE Main()
WVW_SetMainCoord(.F.) //Standard Mode
fillscreen()
SetColor( "N/W" )
WVW_SetMainCoord(.T.) //MainCoord Mode
fillscreen()
return
WVW_SetMainCoord( .F. ) //Standard Mode
fillscreen()
proc fillscreen()
local i,j
scroll()
WVW_nOpenWindow("Win2", 10,10,19,69)
WVW_nOpenWindow("Win3", 15,15,22,75)
devpos(0,0)
?? "I'm gonna fill this (" + alltrim(str(maxrow()+1)) + "x" + alltrim(str(maxcol()+1)) + ") screen"
devpos(1,0)
for i := 1 to maxrow()-1
for j := 0 to maxcol()
?? alltrim(str(j % 10,0))
next
next
?? "Done. Press ESC to exit."
do while inkey(0)!=27
enddo
WVW_lCloseWindow()
WVW_lCloseWindow()
return
WVW_SetMainCoord( .T. ) //MainCoord Mode
fillscreen()
RETURN
PROCEDURE fillscreen()
LOCAL i, j
Scroll()
WVW_nOpenWindow( "Win2", 10, 10, 19, 69 )
WVW_nOpenWindow( "Win3", 15, 15, 22, 75 )
DevPos( 0, 0 )
?? "I'm gonna fill this (" + hb_ntos( MaxRow() + 1 ) + "x" + hb_ntos( MaxCol() + 1 ) + ") screen"
DevPos( 1, 0 )
FOR i := 1 TO MaxRow() - 1
FOR j := 0 TO MaxCol()
?? AllTrim( Str( j % 10, 0 ) )
NEXT
NEXT
?? "Done. Press ESC to exit."
DO WHILE Inkey( 0 ) != K_ESC
ENDDO
WVW_lCloseWindow()
WVW_lCloseWindow()
RETURN

6
harbour/extras/gtwvw/wvwcheck.c
View File

@@ -3,7 +3,7 @@
*/
/*
* Video subsystem for Win32 using GUI windows instead of Console
* Video subsystem for Windows using GUI windows instead of Console
* with multiple windows support
* Copyright 2004 Budyanto Dj. <budyanto@centrin.net.id>
* gtwvw checkbox/progressbar functions
@@ -12,14 +12,14 @@
* =Id: gtwvt.c,v 1.60 2004/01/26 08:14:07 vouchcac Exp =
*
* Harbour Project source code:
* Video subsystem for Win32 using GUI windows instead of Console
* Video subsystem for Windows using GUI windows instead of Console
* Copyright 2003 Peter Rees <peter@rees.co.nz>
* Rees Software & Systems Ltd
* based on
* Bcc ConIO Video subsystem by
* Copyright 2002 Marek Paliwoda <paliwoda@inteia.pl>
* Copyright 2002 Przemyslaw Czerpak <druzus@polbox.com>
* Video subsystem for Win32 compilers
* Video subsystem for Windows compilers
* Copyright 1999-2000 Paul Tucker <ptucker@sympatico.ca>
* Copyright 2002 Przemyslaw Czerpak <druzus@polbox.com>
*

6
harbour/extras/gtwvw/wvwdraw.c
View File

@@ -3,7 +3,7 @@
*/
/*
* Video subsystem for Win32 using GUI windows instead of Console
* Video subsystem for Windows using GUI windows instead of Console
* with multiple windows support
* Copyright 2004 Budyanto Dj. <budyanto@centrin.net.id>
* gtwvw draw functions
@@ -12,14 +12,14 @@
* =Id: gtwvt.c,v 1.60 2004/01/26 08:14:07 vouchcac Exp =
*
* Harbour Project source code:
* Video subsystem for Win32 using GUI windows instead of Console
* Video subsystem for Windows using GUI windows instead of Console
* Copyright 2003 Peter Rees <peter@rees.co.nz>
* Rees Software & Systems Ltd
* based on
* Bcc ConIO Video subsystem by
* Copyright 2002 Marek Paliwoda <paliwoda@inteia.pl>
* Copyright 2002 Przemyslaw Czerpak <druzus@polbox.com>
* Video subsystem for Win32 compilers
* Video subsystem for Windows compilers
* Copyright 1999-2000 Paul Tucker <ptucker@sympatico.ca>
* Copyright 2002 Przemyslaw Czerpak <druzus@polbox.com>
*

6
harbour/extras/gtwvw/wvwedit.c
View File

@@ -3,7 +3,7 @@
*/
/*
* Video subsystem for Win32 using GUI windows instead of Console
* Video subsystem for Windows using GUI windows instead of Console
* with multiple windows support
* Copyright 2004 Budyanto Dj. <budyanto@centrin.net.id>
* gtwvw edit functions
@@ -12,14 +12,14 @@
* =Id: gtwvt.c,v 1.60 2004/01/26 08:14:07 vouchcac Exp =
*
* Harbour Project source code:
* Video subsystem for Win32 using GUI windows instead of Console
* Video subsystem for Windows using GUI windows instead of Console
* Copyright 2003 Peter Rees <peter@rees.co.nz>
* Rees Software & Systems Ltd
* based on
* Bcc ConIO Video subsystem by
* Copyright 2002 Marek Paliwoda <paliwoda@inteia.pl>
* Copyright 2002 Przemyslaw Czerpak <druzus@polbox.com>
* Video subsystem for Win32 compilers
* Video subsystem for Windows compilers
* Copyright 1999-2000 Paul Tucker <ptucker@sympatico.ca>
* Copyright 2002 Przemyslaw Czerpak <druzus@polbox.com>
*

6
harbour/extras/gtwvw/wvwfuncs.c
View File

@@ -3,7 +3,7 @@
*/
/*
* Video subsystem for Win32 using GUI windows instead of Console
* Video subsystem for Windows using GUI windows instead of Console
* with multiple windows support
* Copyright 2004 Budyanto Dj. <budyanto@centrin.net.id>
* gtwvw draw functions
@@ -12,14 +12,14 @@
* =Id: gtwvt.c,v 1.60 2004/01/26 08:14:07 vouchcac Exp =
*
* Harbour Project source code:
* Video subsystem for Win32 using GUI windows instead of Console
* Video subsystem for Windows using GUI windows instead of Console
* Copyright 2003 Peter Rees <peter@rees.co.nz>
* Rees Software & Systems Ltd
* based on
* Bcc ConIO Video subsystem by
* Copyright 2002 Marek Paliwoda <paliwoda@inteia.pl>
* Copyright 2002 Przemyslaw Czerpak <druzus@polbox.com>
* Video subsystem for Win32 compilers
* Video subsystem for Windows compilers
* Copyright 1999-2000 Paul Tucker <ptucker@sympatico.ca>
* Copyright 2002 Przemyslaw Czerpak <druzus@polbox.com>
*

6
harbour/extras/gtwvw/wvwmenu.c
View File

@@ -3,7 +3,7 @@
*/
/*
* Video subsystem for Win32 using GUI windows instead of Console
* Video subsystem for Windows using GUI windows instead of Console
* with multiple windows support
* Copyright 2004 Budyanto Dj. <budyanto@centrin.net.id>
* gtwvw menu Functions
@@ -12,14 +12,14 @@
* =Id: gtwvt.c,v 1.60 2004/01/26 08:14:07 vouchcac Exp =
*
* Harbour Project source code:
* Video subsystem for Win32 using GUI windows instead of Console
* Video subsystem for Windows using GUI windows instead of Console
* Copyright 2003 Peter Rees <peter@rees.co.nz>
* Rees Software & Systems Ltd
* based on
* Bcc ConIO Video subsystem by
* Copyright 2002 Marek Paliwoda <paliwoda@inteia.pl>
* Copyright 2002 Przemyslaw Czerpak <druzus@polbox.com>
* Video subsystem for Win32 compilers
* Video subsystem for Windows compilers
* Copyright 1999-2000 Paul Tucker <ptucker@sympatico.ca>
* Copyright 2002 Przemyslaw Czerpak <druzus@polbox.com>
*

6
harbour/extras/gtwvw/wvwpush.c
View File

@@ -3,7 +3,7 @@
*/
/*
* Video subsystem for Win32 using GUI windows instead of Console
* Video subsystem for Windows using GUI windows instead of Console
* with multiple windows support
* Copyright 2004 Budyanto Dj. <budyanto@centrin.net.id>
* gtwvw pushbutton/ combobox functions
@@ -12,14 +12,14 @@
* =Id: gtwvt.c,v 1.60 2004/01/26 08:14:07 vouchcac Exp =
*
* Harbour Project source code:
* Video subsystem for Win32 using GUI windows instead of Console
* Video subsystem for Windows using GUI windows instead of Console
* Copyright 2003 Peter Rees <peter@rees.co.nz>
* Rees Software & Systems Ltd
* based on
* Bcc ConIO Video subsystem by
* Copyright 2002 Marek Paliwoda <paliwoda@inteia.pl>
* Copyright 2002 Przemyslaw Czerpak <druzus@polbox.com>
* Video subsystem for Win32 compilers
* Video subsystem for Windows compilers
* Copyright 1999-2000 Paul Tucker <ptucker@sympatico.ca>
* Copyright 2002 Przemyslaw Czerpak <druzus@polbox.com>
*

6
harbour/extras/gtwvw/wvwstbar.c
View File

@@ -3,7 +3,7 @@
*/
/*
* Video subsystem for Win32 using GUI windows instead of Console
* Video subsystem for Windows using GUI windows instead of Console
* with multiple windows support
* Copyright 2004 Budyanto Dj. <budyanto@centrin.net.id>
* gtwvw statusbar/scrollbar functions
@@ -12,14 +12,14 @@
* =Id: gtwvt.c,v 1.60 2004/01/26 08:14:07 vouchcac Exp =
*
* Harbour Project source code:
* Video subsystem for Win32 using GUI windows instead of Console
* Video subsystem for Windows using GUI windows instead of Console
* Copyright 2003 Peter Rees <peter@rees.co.nz>
* Rees Software & Systems Ltd
* based on
* Bcc ConIO Video subsystem by
* Copyright 2002 Marek Paliwoda <paliwoda@inteia.pl>
* Copyright 2002 Przemyslaw Czerpak <druzus@polbox.com>
* Video subsystem for Win32 compilers
* Video subsystem for Windows compilers
* Copyright 1999-2000 Paul Tucker <ptucker@sympatico.ca>
* Copyright 2002 Przemyslaw Czerpak <druzus@polbox.com>
*

6
harbour/extras/gtwvw/wvwtbar.c
View File

@@ -3,7 +3,7 @@
*/
/*
* Video subsystem for Win32 using GUI windows instead of Console
* Video subsystem for Windows using GUI windows instead of Console
* with multiple windows support
* Copyright 2004 Budyanto Dj. <budyanto@centrin.net.id>
* gtwvw toolbar and tooltips functions
@@ -12,14 +12,14 @@
* =Id: gtwvt.c,v 1.60 2004/01/26 08:14:07 vouchcac Exp =
*
* Harbour Project source code:
* Video subsystem for Win32 using GUI windows instead of Console
* Video subsystem for Windows using GUI windows instead of Console
* Copyright 2003 Peter Rees <peter@rees.co.nz>
* Rees Software & Systems Ltd
* based on
* Bcc ConIO Video subsystem by
* Copyright 2002 Marek Paliwoda <paliwoda@inteia.pl>
* Copyright 2002 Przemyslaw Czerpak <druzus@polbox.com>
* Video subsystem for Win32 compilers
* Video subsystem for Windows compilers
* Copyright 1999-2000 Paul Tucker <ptucker@sympatico.ca>
* Copyright 2002 Przemyslaw Czerpak <druzus@polbox.com>
*

2
harbour/extras/hbdoc/tmplates.prg
View File

@@ -338,8 +338,6 @@ PROCEDURE init_Templates()
{ "SUNOS", "This is available on the SUNOS platform" }, ;
{ "Unix", "This is available on the Unix platform(s)" }, ;
{ "Win", "This is available on the MS-Windows platform(s)" }, ;
{ "Win32", "This is available on the MS-Windows (32-bit) platform(s)" }, ;
{ "Win64", "This is available on the MS-Windows (64-bit) platform(s)" }, ;
{ "WinCE", "This is available on the MS-Windows-CE platform" } ;
}

9
harbour/src/rtl/tget.prg
View File

@@ -510,13 +510,15 @@ METHOD varPut( xValue ) CLASS GET
nLen := Len( aSubs )
aValue := Eval( ::bBlock )
FOR i := 1 TO nLen - 1
IF ValType( aSubs[ i ] ) $ "NCDT"
IF HB_ISNUMERIC( aSubs[ i ] ) .OR. ;
( HB_ISHASH( aValue ) .AND. ValType( aSubs[ i ] ) $ "CDT" )
aValue := aValue[ aSubs[ i ] ]
ELSE
EXIT
ENDIF
NEXT
IF ValType( aSubs[ i ] ) $ "NCDT"
IF HB_ISNUMERIC( aSubs[ i ] ) .OR. ;
( HB_ISHASH( aValue ) .AND. ValType( aSubs[ i ] ) $ "CDT" )
aValue[ aSubs[ i ] ] := xValue
ENDIF
ELSE
@@ -541,7 +543,8 @@ METHOD varGet() CLASS GET
nLen := Len( aSubs )
xValue := Eval( ::bBlock )
FOR i := 1 TO nLen
IF ValType( aSubs[ i ] ) $ "NCDT"
IF HB_ISNUMERIC( aSubs[ i ] ) .OR. ;
( HB_ISHASH( xValue ) .AND. ValType( aSubs[ i ] ) $ "CDT" )
xValue := xValue[ aSubs[ i ] ]
ELSE
EXIT

4
harbour/tests/gtcolors.prg
View File

@@ -11,6 +11,8 @@
*
*/
#include "inkey.ch"
PROCEDURE Main( xBlink )
LOCAL bg, fg, n
@@ -30,7 +32,7 @@ PROCEDURE Main( xBlink )
NEXT
?
?
WHILE Inkey( 0 ) != 13
WHILE Inkey( 0 ) != K_ENTER
ENDDO
RETURN

2
harbour/tests/ipclnt.prg
View File

@@ -2,8 +2,6 @@
* $Id$
*/
#include "common.ch"
#include "hbsocket.ch"
#define ADDRESS "127.0.0.1"

4
harbour/tests/ipsvr.prg
View File

@@ -2,7 +2,7 @@
* $Id$
*/
#include "common.ch"
#include "inkey.ch"
#include "hbsocket.ch"
@@ -46,7 +46,7 @@ PROCEDURE Main()
? "accept socket request"
hb_threadDetach( hb_threadStart( @process(), hSocket ) )
ENDIF
IF Inkey() == 27
IF Inkey() == K_ESC
? "quitting - esc pressed"
EXIT
ENDIF

25
harbour/tests/rto_get.prg
View File

@@ -52,7 +52,6 @@
/* NOTE: This source can be compiled with both Harbour and CA-Cl*pper. */
#include "common.ch"
#include "error.ch"
#include "fileio.ch"
#include "inkey.ch"
@@ -93,10 +92,18 @@ PROCEDURE Main( cArg01, cArg02, cArg03, cArg04 )
LOCAL nOldRow
LOCAL nOldCol
DEFAULT cArg01 TO ""
DEFAULT cArg02 TO ""
DEFAULT cArg03 TO ""
DEFAULT cArg04 TO ""
IF cArg01 == NIL
cArg01 := ""
ENDIF
IF cArg02 == NIL
cArg02 := ""
ENDIF
IF cArg03 == NIL
cArg03 := ""
ENDIF
IF cArg04 == NIL
cArg04 := ""
ENDIF
SET DATE ANSI
@@ -726,10 +733,12 @@ PROCEDURE Main( cArg01, cArg02, cArg03, cArg04 )
PROCEDURE TGetTOVS( o, aKeys, lInsert )
LOCAL tmp, tmp1
DEFAULT lInsert TO .F.
IF !( ValType( lInsert ) == "L" )
lInsert := .F.
ENDIF
FOR tmp := 1 TO Len( aKeys )
IF ISCHAR( aKeys[ tmp ] )
IF ValType( aKeys[ tmp ] ) == "C"
FOR tmp1 := 1 TO Len( aKeys[ tmp ] )
IF lInsert
TEST_CALL( o, "o:insert( '" + SubStr( aKeys[ tmp ], tmp1, 1 ) + "' )", {|| o:insert( SubStr( aKeys[ tmp ], tmp1, 1 ) ) } )
@@ -737,7 +746,7 @@ PROCEDURE TGetTOVS( o, aKeys, lInsert )
TEST_CALL( o, "o:overStrike( '" + SubStr( aKeys[ tmp ], tmp1, 1 ) + "' )", {|| o:overStrike( SubStr( aKeys[ tmp ], tmp1, 1 ) ) } )
ENDIF
NEXT
ELSEIF ISNUM( aKeys[ tmp ] )
ELSEIF ValType( aKeys[ tmp ] ) == "N"
DO CASE
CASE aKeys[ tmp ] == K_INS ; lInsert := ! lInsert
CASE aKeys[ tmp ] == K_HOME ; TEST_LINE( o:Home() )

23
harbour/tests/rto_tb.prg
View File

@@ -63,7 +63,6 @@
/* NOTE: This source can be compiled with both Harbour and CA-Cl*pper. */
#include "common.ch"
#include "error.ch"
#include "fileio.ch"
@@ -97,10 +96,18 @@ PROCEDURE Main( cArg01, cArg02, cArg03, cArg04 )
LOCAL cCommandLine
DEFAULT cArg01 TO ""
DEFAULT cArg02 TO ""
DEFAULT cArg03 TO ""
DEFAULT cArg04 TO ""
IF cArg01 == NIL
cArg01 := ""
ENDIF
IF cArg02 == NIL
cArg02 := ""
ENDIF
IF cArg03 == NIL
cArg03 := ""
ENDIF
IF cArg04 == NIL
cArg04 := ""
ENDIF
SET DATE ANSI
@@ -306,7 +313,7 @@ PROCEDURE TBRAssign( xVar )
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:nLeft := xVar )
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:nRight := xVar )
// ; This is needed for CA-Cl*pper 5.x otherwise an unmaskable (bug?) RTE would be thrown. [vszakats]
IF ISNUMBER( xVar ) .AND. xVar < o:nBottom
IF ValType( xVar ) == "N" .AND. xVar < o:nBottom
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:nTop := xVar )
ENDIF
o := TBrowseNew( 10, 10, 20, 50 ) ; TEST_L_TBR( o:RightVisible := xVar )
@@ -501,7 +508,7 @@ PROCEDURE LogTBRVars( o, desc, xResult )
FOR tmp := 1 TO o:colCount
FWrite( s_fhnd, " Column: " + StrZero( tmp, 3 ) + hb_eol() )
col := o:GetColumn( tmp )
IF ISOBJECT( col )
IF ValType( col ) == "O"
FWrite( s_fhnd, " Block " + XToStr( col:Block ) + hb_eol() )
FWrite( s_fhnd, " Cargo " + XToStr( col:Cargo ) + hb_eol() )
FWrite( s_fhnd, " ColorBlock " + XToStr( col:ColorBlock ) + hb_eol() )
@@ -548,7 +555,7 @@ PROCEDURE LogTBCVars( o, desc, xResult )
FWrite( s_fhnd, "---------------------" + hb_eol() )
FWrite( s_fhnd, " s_xVar " + XToStr( s_xVar ) + hb_eol() )
FWrite( s_fhnd, " xResult " + XToStr( xResult ) + hb_eol() )
IF ISOBJECT( o )
IF ValType( o ) == "O"
FWrite( s_fhnd, " Block " + XToStr( o:Block ) + hb_eol() )
FWrite( s_fhnd, " Cargo " + XToStr( o:Cargo ) + hb_eol() )
FWrite( s_fhnd, " ColorBlock " + XToStr( o:ColorBlock ) + hb_eol() )

68
harbour/tests/usrrdd/exarr.prg
View File

@@ -55,6 +55,7 @@ REQUEST ARRAYRDD
#define USE_DBCREATE_EXTENSIONS
PROCEDURE Main()
LOCAL aStruct
SET DATE ANSI
@@ -63,35 +64,36 @@ PROCEDURE Main()
CLS
? "Create a new dbf in memory using dbCreate() command"
aStruct := { { "NAME" , "C", 40, 0 } ,;
{ "ADDRESS" , "C", 40, 0 } ,;
{ "BIRTHDAY" , "D", 8, 0 } ,;
{ "AGE" , "N", 3, 0 } }
aStruct := { ;
{ "NAME" , "C", 40, 0 } , ;
{ "ADDRESS" , "C", 40, 0 } , ;
{ "BIRTHDAY" , "D", 8, 0 } , ;
{ "AGE" , "N", 3, 0 } }
#ifndef USE_DBCREATE_EXTENSIONS
? "Create it"
dbCreate( "arrtest.dbf", aStruct, "ARRAYRDD" )
wait
WAIT
? "Open it"
USE arrtest.dbf VIA "ARRAYRDD"
wait
WAIT
#else
? "Create it and leave opened"
dbCreate( "arrtest.dbf", aStruct, "ARRAYRDD", .T., "arrtest" )
wait
dbCreate( "arrtest.dbf", aStruct, "ARRAYRDD", .T. , "arrtest" )
WAIT
#endif
? "Show structure"
? hb_ValToExp( dbStruct() )
WAIT
? "ALIAS", ALIAS(), "RECNO", RECNO(), ;
"BOF", BOF(), "EOF", EOF(), "LASTREC", LASTREC()
? RECNO(), '"' + FIELD->NAME + '"'
DBGOBOTTOM()
? RECNO(), '"' + FIELD->NAME + '"'
DBGOTOP()
? RECNO(), '"' + FIELD->NAME + '"'
? "ALIAS", Alias(), "RECNO", RecNo(), ;
"BOF", BOF(), "EOF", EOF(), "LASTREC", LastRec()
? RecNo(), '"' + FIELD->NAME + '"'
dbGoBottom()
? RecNo(), '"' + FIELD->NAME + '"'
dbGoTop()
? RecNo(), '"' + FIELD->NAME + '"'
WAIT
? "Adding some data"
@@ -101,7 +103,7 @@ PROCEDURE Main()
field->birthday := SToD( "19670103" )
field->age := 39
? RECNO(), '"' + FIELD->NAME + '"'
? RecNo(), '"' + FIELD->NAME + '"'
dbAppend()
field->name := "Mouse Mickey"
@@ -110,34 +112,34 @@ PROCEDURE Main()
field->age := 66
WHILE !EOF()
? RECNO(), '"' + FIELD->NAME + '"'
IF RECNO() == 20
INKEY( 0 )
? RecNo(), '"' + FIELD->NAME + '"'
IF RecNo() == 20
Inkey( 0 )
ENDIF
DBSKIP()
dbSkip()
ENDDO
? "ALIAS", ALIAS(), "RECNO", RECNO(), ;
"BOF", BOF(), "EOF", EOF(), "LASTREC", LASTREC()
? "ALIAS", Alias(), "RECNO", RecNo(), ;
"BOF", BOF(), "EOF", EOF(), "LASTREC", LastRec()
WAIT
DBGOBOTTOM()
? "ALIAS", ALIAS(), "RECNO", RECNO(), ;
"BOF", BOF(), "EOF", EOF(), "LASTREC", LASTREC()
dbGoBottom()
? "ALIAS", Alias(), "RECNO", RecNo(), ;
"BOF", BOF(), "EOF", EOF(), "LASTREC", LastRec()
WAIT
WHILE !BOF()
? RECNO(), '[' + FIELD->NAME + ']'
IF RECNO() == LASTREC() - 20
INKEY( 0 )
? RecNo(), '[' + FIELD->NAME + ']'
IF RecNo() == LastRec() - 20
Inkey( 0 )
ENDIF
DBSKIP( -1 )
dbSkip( -1 )
ENDDO
? "ALIAS", ALIAS(), "RECNO", RECNO(), ;
"BOF", BOF(), "EOF", EOF(), "LASTREC", LASTREC()
? "ALIAS", Alias(), "RECNO", RecNo(), ;
"BOF", BOF(), "EOF", EOF(), "LASTREC", LastRec()
WAIT
? "Show it - Please don't press any key except movement keys and ESC"
? " to exit from browse(), otherwise you will get an error"
? " due to missing index support"
WAIT
BROWSE()
Browse()
RETURN
RETURN

46
harbour/tests/usrrdd/exfcm.prg
View File

@@ -7,38 +7,38 @@ REQUEST FCOMMA
PROCEDURE Main()
USE test.csv VIA "FCOMMA"
? "ALIAS", ALIAS(), "RECNO", RECNO(), ;
"BOF", BOF(), "EOF", EOF(), "LASTREC", LASTREC()
? RECNO(), '"' + FIELD->LINE + '"'
DBGOBOTTOM()
? RECNO(), '"' + FIELD->LINE + '"'
DBGOTOP()
? RECNO(), '"' + FIELD->LINE + '"'
? "ALIAS", Alias(), "RECNO", RecNo(), ;
"BOF", BOF(), "EOF", EOF(), "LASTREC", LastRec()
? RecNo(), '"' + FIELD->LINE + '"'
dbGoBottom()
? RecNo(), '"' + FIELD->LINE + '"'
dbGoTop()
? RecNo(), '"' + FIELD->LINE + '"'
WAIT
DO WHILE !EOF()
? RECNO(), '"' + FIELD->LINE + '"'
IF RECNO() == 20
INKEY( 0 )
? RecNo(), '"' + FIELD->LINE + '"'
IF RecNo() == 20
Inkey( 0 )
ENDIF
DBSKIP()
dbSkip()
ENDDO
? "ALIAS", ALIAS(), "RECNO", RECNO(), ;
"BOF", BOF(), "EOF", EOF(), "LASTREC", LASTREC()
? "ALIAS", Alias(), "RECNO", RecNo(), ;
"BOF", BOF(), "EOF", EOF(), "LASTREC", LastRec()
WAIT
DBGOBOTTOM()
? "ALIAS", ALIAS(), "RECNO", RECNO(), ;
"BOF", BOF(), "EOF", EOF(), "LASTREC", LASTREC()
dbGoBottom()
? "ALIAS", Alias(), "RECNO", RecNo(), ;
"BOF", BOF(), "EOF", EOF(), "LASTREC", LastRec()
WAIT
DO WHILE !BOF()
? RECNO(), '[' + FIELD->LINE + ']'
IF RECNO() == LASTREC() - 20
INKEY( 0 )
? RecNo(), '[' + FIELD->LINE + ']'
IF RecNo() == LastRec() - 20
Inkey( 0 )
ENDIF
DBSKIP( -1 )
dbSkip( -1 )
ENDDO
? "ALIAS", ALIAS(), "RECNO", RECNO(), ;
"BOF", BOF(), "EOF", EOF(), "LASTREC", LASTREC()
? "ALIAS", Alias(), "RECNO", RecNo(), ;
"BOF", BOF(), "EOF", EOF(), "LASTREC", LastRec()
WAIT
BROWSE()
Browse()
RETURN

45
harbour/tests/usrrdd/exhsx.prg
View File

@@ -5,41 +5,44 @@
#include "dbinfo.ch"
PROCEDURE Main()
FIELD FIRST, LAST, STREET, CITY
LOCAL n, hs
dbCreate("_tst", { { "FIRST", "C", 20, 0 },;
{ "LAST", "C", 20, 0 },;
{ "STREET", "C", 30, 0 },;
{ "CITY", "C", 30, 0 },;
{ "STATE", "C", 2, 0 },;
{ "ZIP", "C", 10, 0 },;
{ "HIREDATE", "D", 8, 0 },;
{ "MARRIED", "L", 1, 0 },;
{ "AGE", "N", 2, 0 },;
{ "SALARY", "N", 6, 0 },;
{ "NOTES", "C", 70, 0 } } )
dbCreate( "_tst", { ;
{ "FIRST", "C", 20, 0 }, ;
{ "LAST", "C", 20, 0 }, ;
{ "STREET", "C", 30, 0 }, ;
{ "CITY", "C", 30, 0 }, ;
{ "STATE", "C", 2, 0 }, ;
{ "ZIP", "C", 10, 0 }, ;
{ "HIREDATE", "D", 8, 0 }, ;
{ "MARRIED", "L", 1, 0 }, ;
{ "AGE", "N", 2, 0 }, ;
{ "SALARY", "N", 6, 0 }, ;
{ "NOTES", "C", 70, 0 } } )
USE _tst
HSX_CREATE( "_tst", "FIRST+LAST+STREET+CITY", 2, 0, .T., 3 )
HSX_CREATE( "_tst", "FIRST+LAST+STREET+CITY", 2, 0, .T. , 3 )
APPEND FROM test
/* Look for all records which have 'SHERMAN' string inside */
hs := HSX_HANDLE( "_tst" )
HS_SET( hs, "SHERMAN" )
DO WHILE ( n := HS_NEXT( hs ) ) > 0
DBGOTO( n )
IF HS_VERIFY( hs ) > 0
? RTRIM( FIRST+LAST+STREET+CITY )
hs_Set( hs, "SHERMAN" )
DO WHILE ( n := hs_Next( hs ) ) > 0
dbGoto( n )
IF hs_Verify( hs ) > 0
? RTrim( FIRST + LAST + STREET + CITY )
ENDIF
ENDDO
WAIT
/* Does RDD support Record Map Filters? */
IF DBINFO( DBI_RM_SUPPORTED )
IF dbInfo( DBI_RM_SUPPORTED )
/* if yest then let set filter for all records with 'SHERMAN'
word and look at them in browser */
HS_FILTER( hs, "SHERMAN" )
DBGOTOP()
BROWSE()
hs_Filter( hs, "SHERMAN" )
dbGoTop()
Browse()
ENDIF
RETURN

23
harbour/tests/usrrdd/exlog.prg
View File

@@ -16,22 +16,22 @@ PROCEDURE Main()
// Set LOGRDD as default RDD otherwise I have to set explicitly use
// with DRIVER option
RDDSetDefault( "LOGRDD" )
rddSetDefault( "LOGRDD" )
// Adding Memofile Info
rddInfo( RDDI_MEMOVERSION, DB_MEMOVER_CLIP, "LOGRDD" )
// Define Log File Name and position
hb_LogRddLogFileName( "logs\changes.log" )
// Define Tag to add for each line logged
hb_LogRddTag( NETNAME() + "\" + hb_USERNAME() )
hb_LogRddTag( NetName() + "\" + hb_UserName() )
// Activate Logging, it can be stopped/started at any moment
hb_LogRddActive( .T. )
// Uncomment next command to change logged string that I have to return to standard LOGRDD file
// hb_LogRddMsgLogBlock( {| cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3 | MyToString( cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3 ) } )
// hb_LogRddMsgLogBlock( {| cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3 | MyToString( cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3 ) } )
// Uncomment next command to change standard destination of my logged string
// hb_LogRddUserLogBlock( {| cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3 | hb_toOutDebug( MyToString( cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3 ) + "\n\r" ) } )
// hb_LogRddUserLogBlock( {| cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3 | hb_toOutDebug( MyToString( cTag, cRDDName, cCmd, nWA, xPar1, xPar2, xPar3 ) + "\n\r" ) } )
// Start program logic
@@ -49,6 +49,7 @@ PROCEDURE Main()
RETURN
STATIC FUNCTION MyToString( cCmd, nWA, xPar1, xPar2, xPar3 )
LOCAL cString
DO CASE
@@ -60,30 +61,32 @@ STATIC FUNCTION MyToString( cCmd, nWA, xPar1, xPar2, xPar3 )
cString := hb_ValToExp( xPar1 )
CASE cCmd == "OPEN"
// Parameters received: xPar1 = aOpenInfo
// cString := 'Table : "' + xPar1[ UR_OI_NAME ] + '", Alias : "' + Alias() + '", WorkArea : ' + LTrim( Str( nWA ) )
// cString := 'Table : "' + xPar1[ UR_OI_NAME ] + '", Alias : "' + Alias() + '", WorkArea : ' + hb_ntos( nWA )
// In this example I don't want to log Open Command
CASE cCmd == "CLOSE"
// Parameters received: xPar1 = cTableName, xPar2 = cAlias
//cString := 'Table : "' + xPar1 + '", Alias : "' + xPar2 + '", WorkArea : ' + LTrim( Str( nWA ) )
//cString := 'Table : "' + xPar1 + '", Alias : "' + xPar2 + '", WorkArea : ' + hb_ntos( nWA )
// In this example I don't want to log Close Command
CASE cCmd == "APPEND"
// Parameters received: xPar1 = lUnlockAll
cString := Alias() + "->RecNo() = " + LTrim( Str( RecNo() ) )
cString := Alias() + "->RecNo() = " + hb_ntos( RecNo() )
CASE cCmd == "DELETE"
// Parameters received: none
cString := Alias() + "->RecNo() = " + LTrim( Str( RecNo() ) )
cString := Alias() + "->RecNo() = " + hb_ntos( RecNo() )
CASE cCmd == "RECALL"
// Parameters received: none
cString := Alias() + "->RecNo() = " + LTrim( Str( RecNo() ) )
cString := Alias() + "->RecNo() = " + hb_ntos( RecNo() )
CASE cCmd == "PUTVALUE"
// Parameters received: xPar1 = nField, xPar2 = xValue, xPar3 = xOldValue
HB_SYMBOL_UNUSED( xPar3 ) // Here don't log previous value
cString := Alias() + "(" + LTrim( Str( RecNo() ) ) + ")->" + PadR( FieldName( xPar1 ), 10 ) + " := " + hb_LogRddValueToText( xPar2 )
cString := Alias() + "(" + hb_ntos( RecNo() ) + ")->" + PadR( FieldName( xPar1 ), 10 ) + " := " + hb_LogRddValueToText( xPar2 )
CASE cCmd == "ZAP"
// Parameters received: none
cString := 'Alias : "' + Alias() + ' Table : "' + dbInfo( DBI_FULLPATH ) + '"'
ENDCASE
RETURN cString
FUNCTION hb_LogRddInherit()
RETURN "DBFCDX"

6
harbour/tests/usrrdd/exmemo.prg
View File

@@ -8,8 +8,8 @@ REQUEST SMTCDX
PROCEDURE Main()
DBCREATE( "table1", { { "F1", "M", 4, 0 } }, "DBTCDX" )
DBCREATE( "table2", { { "F1", "M", 4, 0 } }, "FPTCDX" )
DBCREATE( "table3", { { "F1", "M", 4, 0 } }, "SMTCDX" )
dbCreate( "table1", { { "F1", "M", 4, 0 } }, "DBTCDX" )
dbCreate( "table2", { { "F1", "M", 4, 0 } }, "FPTCDX" )
dbCreate( "table3", { { "F1", "M", 4, 0 } }, "SMTCDX" )
RETURN

42
harbour/tests/usrrdd/exrlx.prg
View File

@@ -6,44 +6,44 @@ REQUEST RLCDX
PROCEDURE Main()
DBCREATE( "_tst", { { "F1", "C", 10, 0 } }, "RLCDX" )
dbCreate( "_tst", { { "F1", "C", 10, 0 } }, "RLCDX" )
USE _tst VIA "RLCDX" SHARED
? "Table: ", ALIAS(), " open VIA: ", RDDNAME()
? "Table: ", Alias(), " open VIA: ", rddName()
? "APPEND"
DBAPPEND()
dbAppend()
? "Current record locks:"
AEVAL( DBRLOCKLIST(), {| nRecNo | qqout( nRecNo ) } )
AEval( dbRLockList(), {| nRecNo | QQOut( nRecNo ) } )
? "APPEND"
DBAPPEND()
dbAppend()
? "Current record locks:"
AEVAL( DBRLOCKLIST(), {| nRecNo | qqout( nRecNo ) } )
AEval( dbRLockList(), {| nRecNo | QQOut( nRecNo ) } )
? "UNLOCK"
DBUNLOCK()
dbUnlock()
? "Current record locks:"
AEVAL( DBRLOCKLIST(), {| nRecNo | qqout( nRecNo ) } )
AEval( dbRLockList(), {| nRecNo | QQOut( nRecNo ) } )
? "Locking record 1", DBRLOCK( 1 )
? "Locking record 1", DBRLOCK( 1 )
? "Locking record 1", DBRLOCK( 1 )
? "Locking record 2", DBRLOCK( 2 )
? "Locking record 1", dbRLock( 1 )
? "Locking record 1", dbRLock( 1 )
? "Locking record 1", dbRLock( 1 )
? "Locking record 2", dbRLock( 2 )
? "Current record locks:"
AEVAL( DBRLOCKLIST(), {| nRecNo | qqout( nRecNo ) } )
AEval( dbRLockList(), {| nRecNo | QQOut( nRecNo ) } )
? "UnLocking record 1..."
DBRUNLOCK(1)
dbRUnlock( 1 )
? "Current record locks:"
AEVAL( DBRLOCKLIST(), {| nRecNo | qqout( nRecNo ) } )
AEval( dbRLockList(), {| nRecNo | QQOut( nRecNo ) } )
? "UnLocking record 2..."
DBRUNLOCK(2)
dbRUnlock( 2 )
? "Current record locks:"
AEVAL( DBRLOCKLIST(), {| nRecNo | qqout( nRecNo ) } )
AEval( dbRLockList(), {| nRecNo | QQOut( nRecNo ) } )
? "UnLocking record 1..."
DBRUNLOCK(1)
dbRUnlock( 1 )
? "Current record locks:"
AEVAL( DBRLOCKLIST(), {| nRecNo | qqout( nRecNo ) } )
AEval( dbRLockList(), {| nRecNo | QQOut( nRecNo ) } )
? "UnLocking record 1..."
DBRUNLOCK(1)
dbRUnlock( 1 )
? "Current record locks:"
AEVAL( DBRLOCKLIST(), {| nRecNo | qqout( nRecNo ) } )
AEval( dbRLockList(), {| nRecNo | QQOut( nRecNo ) } )
CLOSE

2
harbour/tests/wcecon.prg
View File

@@ -98,7 +98,7 @@ proc main()
?
? "@ - interrupt, keycodes test "
while ( k := inkey( 0 ) ) != 64
while ( k := inkey( 0 ) ) != hb_keyCode( "@" )
? ; devout( "key=" + str( k, 4 ) + ", char='" + chr( k ) + "'" )
enddo