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

2012-10-23 03:27 UTC+0200 Viktor Szakats (harbour syenar.net)

Browse Source 
* contrib/gtwvg/class.prg
  * contrib/hbct/tests/attoken.prg
  * contrib/hbct/tests/charnot.prg
  * contrib/hbct/tests/charrll.prg
  * contrib/hbct/tests/charrlr.prg
  * contrib/hbct/tests/charshl.prg
  * contrib/hbct/tests/charshr.prg
  * contrib/hbct/tests/csetarge.prg
  * contrib/hbct/tests/datetime.prg
  * contrib/hbct/tests/finan.prg
  * contrib/hbct/tests/token.prg
  * contrib/hbct/tests/tokensep.prg
  * contrib/hbct/tests/trig.prg
  * contrib/hbgd/gdbarcod.prg
  * contrib/hbnf/doc/en/fttext.txt
  * contrib/hbnf/doc/en/nwsem.txt
  * contrib/hbnf/popadder.prg
  * contrib/hbnf/tests/mouse1.prg
  * contrib/hbsqlit3/tests/hdbctest.prg
  * contrib/hbtip/httpcli.prg
  * contrib/hbtpathy/telepath.prg
  * contrib/xhb/stream.prg
  * contrib/xhb/tedit.prg
  * contrib/xhb/thtm.prg
  * contrib/xhb/ttable.prg
  * contrib/xhb/xcstr.prg
  * contrib/xhb/xhbmemo.prg
  * contrib/xhb/xhbtedit.prg
  * extras/gtwvw/tests/ebtest7.prg
  * extras/hbxlsxml/xlsxml.prg
  * extras/rddado/adordd.prg
  * src/debug/debugger.prg
  * src/rtl/memoedit.prg
  * tests/sdf_test.prg
  * tests/tstasort.prg
  * tests/videotst.prg
  * tests/vmasort.prg
    % minor cleanups, fixes, optimizations and formatting
      (f.e. using hb_ntos(), avoiding '== .F./.T.' expressions, etc)
    ; NOTE: hbformat couldn't reformat adordd.prg, and even 
            after removing parts that caused and error and 
            finished error free, it failed to format the file 
            after a certain line.
This commit is contained in:
Viktor Szakats
2012-10-23 01:31:32 +00:00
parent 262471e895
commit 83d87b45ad
38 changed files with 405 additions and 382 deletions
Download Patch File Download Diff File Expand all files Collapse all files

45
harbour/ChangeLog
View File

@@ -16,6 +16,51 @@
The license applies to all entries newer than 2009-04-28.
*/
2012-10-23 03:27 UTC+0200 Viktor Szakats (harbour syenar.net)
* contrib/gtwvg/class.prg
* contrib/hbct/tests/attoken.prg
* contrib/hbct/tests/charnot.prg
* contrib/hbct/tests/charrll.prg
* contrib/hbct/tests/charrlr.prg
* contrib/hbct/tests/charshl.prg
* contrib/hbct/tests/charshr.prg
* contrib/hbct/tests/csetarge.prg
* contrib/hbct/tests/datetime.prg
* contrib/hbct/tests/finan.prg
* contrib/hbct/tests/token.prg
* contrib/hbct/tests/tokensep.prg
* contrib/hbct/tests/trig.prg
* contrib/hbgd/gdbarcod.prg
* contrib/hbnf/doc/en/fttext.txt
* contrib/hbnf/doc/en/nwsem.txt
* contrib/hbnf/popadder.prg
* contrib/hbnf/tests/mouse1.prg
* contrib/hbsqlit3/tests/hdbctest.prg
* contrib/hbtip/httpcli.prg
* contrib/hbtpathy/telepath.prg
* contrib/xhb/stream.prg
* contrib/xhb/tedit.prg
* contrib/xhb/thtm.prg
* contrib/xhb/ttable.prg
* contrib/xhb/xcstr.prg
* contrib/xhb/xhbmemo.prg
* contrib/xhb/xhbtedit.prg
* extras/gtwvw/tests/ebtest7.prg
* extras/hbxlsxml/xlsxml.prg
* extras/rddado/adordd.prg
* src/debug/debugger.prg
* src/rtl/memoedit.prg
* tests/sdf_test.prg
* tests/tstasort.prg
* tests/videotst.prg
* tests/vmasort.prg
% minor cleanups, fixes, optimizations and formatting
(f.e. using hb_ntos(), avoiding '== .F./.T.' expressions, etc)
; NOTE: hbformat couldn't reformat adordd.prg, and even
after removing parts that caused and error and
finished error free, it failed to format the file
after a certain line.
2012-10-23 01:31 UTC+0200 Viktor Szakats (harbour syenar.net)
* contrib/hbgd/gdbar.prg
* contrib/hbgd/gdbarcod.prg

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

@@ -2725,8 +2725,7 @@ METHOD wvtScrollbar:GetPos()
METHOD wvtScrollbar:SetTooltip()
::Tooltip := LTrim( Str( ::nCurrent, 12, 0 ) ) + " / " + ;
LTrim( Str( ::nTotal, 12, 0 ) )
::Tooltip := hb_ntos( Int( ::nCurrent ) ) + " / " + hb_ntos( Int( ::nTotal ) )
Wvt_SetToolTip( ::nTop, ::nLeft, ::nBottom, ::nRight, ::Tooltip )

6
harbour/contrib/hbct/tests/attoken.prg
View File

@@ -52,6 +52,10 @@
*
*/
#ifndef __HARBOUR__
#define hb_ntos( n ) LTrim( Str( n ) )
#endif
#include "ct.ch"
PROCEDURE Main()
@@ -76,7 +80,7 @@ PROCEDURE Main()
? " Value of cStr is:" + Chr( 34 ) + cStr + Chr( 34 )
?
FOR ni := 1 TO numtoken( cStr, ".!", 1 )
? [ Token #] + AllTrim( Str( ni ) ) + [("] + token( cStr, ".!", ni, 1 ) + [")]
? [ Token #] + hb_ntos( ni ) + [("] + token( cStr, ".!", ni, 1 ) + [")]
? " starts at pos " + Str( npos := attoken( cStr, ".!", ni, 1 ), 3 ) + ;
" and is " + iif( SubStr( cStr, npos, 1 ) $ ".!", "", "not " ) + "an empty token."
NEXT

6
harbour/contrib/hbct/tests/charnot.prg
View File

@@ -54,6 +54,10 @@
#include "ct.ch"
#ifndef __HARBOUR__
#define hb_ntos( n ) LTrim( Str( n ) )
#endif
PROCEDURE Main()
LOCAL ni, cStr
@@ -72,7 +76,7 @@ PROCEDURE Main()
? [ ]
cStr := charnot( Chr( 85 ) + Chr( 128 ) + Chr( 170 ) + Chr( 1 ) )
FOR ni := 1 TO Len( cStr )
?? "chr(" + AllTrim( Str( Asc( SubStr( cStr, ni, 1 ) ) ) ) + ")"
?? "chr(" + hb_ntos( Asc( SubStr( cStr, ni, 1 ) ) ) + ")"
IF ni < Len( cStr )
?? "+"
ENDIF

6
harbour/contrib/hbct/tests/charrll.prg
View File

@@ -54,6 +54,10 @@
#include "ct.ch"
#ifndef __HARBOUR__
#define hb_ntos( n ) LTrim( Str( n ) )
#endif
PROCEDURE Main()
LOCAL ni, cStr
@@ -72,7 +76,7 @@ PROCEDURE Main()
? [ ]
cStr := charrll( Chr( 1 ) + Chr( 2 ) + Chr( 4 ) + Chr( 8 ) + Chr( 16 ) + Chr( 32 ) + Chr( 64 ) + Chr( 128 ), 3 )
FOR ni := 1 TO Len( cStr )
?? "chr(" + AllTrim( Str( Asc( SubStr( cStr, ni, 1 ) ) ) ) + ")"
?? "chr(" + hb_ntos( Asc( SubStr( cStr, ni, 1 ) ) ) + ")"
IF ni < Len( cStr )
?? "+"
ENDIF

6
harbour/contrib/hbct/tests/charrlr.prg
View File

@@ -54,6 +54,10 @@
#include "ct.ch"
#ifndef __HARBOUR__
#define hb_ntos( n ) LTrim( Str( n ) )
#endif
PROCEDURE Main()
LOCAL ni, cStr
@@ -72,7 +76,7 @@ PROCEDURE Main()
? [ ]
cStr := charrlr( Chr( 1 ) + Chr( 2 ) + Chr( 4 ) + Chr( 8 ) + Chr( 16 ) + Chr( 32 ) + Chr( 64 ) + Chr( 128 ), 3 )
FOR ni := 1 TO Len( cStr )
?? "chr(" + AllTrim( Str( Asc( SubStr( cStr, ni, 1 ) ) ) ) + ")"
?? "chr(" + hb_ntos( Asc( SubStr( cStr, ni, 1 ) ) ) + ")"
IF ni < Len( cStr )
?? "+"
ENDIF

6
harbour/contrib/hbct/tests/charshl.prg
View File

@@ -54,6 +54,10 @@
#include "ct.ch"
#ifndef __HARBOUR__
#define hb_ntos( n ) LTrim( Str( n ) )
#endif
PROCEDURE Main()
LOCAL ni, cStr
@@ -72,7 +76,7 @@ PROCEDURE Main()
? [ ]
cStr := charshl( Chr( 1 ) + Chr( 2 ) + Chr( 4 ) + Chr( 8 ) + Chr( 16 ) + Chr( 32 ) + Chr( 64 ) + Chr( 128 ), 3 )
FOR ni := 1 TO Len( cStr )
?? "chr(" + AllTrim( Str( Asc( SubStr( cStr, ni, 1 ) ) ) ) + ")"
?? "chr(" + hb_ntos( Asc( SubStr( cStr, ni, 1 ) ) ) + ")"
IF ni < Len( cStr )
?? "+"
ENDIF

6
harbour/contrib/hbct/tests/charshr.prg
View File

@@ -54,6 +54,10 @@
#include "ct.ch"
#ifndef __HARBOUR__
#define hb_ntos( n ) LTrim( Str( n ) )
#endif
PROCEDURE Main()
LOCAL ni, cStr
@@ -72,7 +76,7 @@ PROCEDURE Main()
? [ ]
cStr := charshr( Chr( 1 ) + Chr( 2 ) + Chr( 4 ) + Chr( 8 ) + Chr( 16 ) + Chr( 32 ) + Chr( 64 ) + Chr( 128 ), 3 )
FOR ni := 1 TO Len( cStr )
?? "chr(" + AllTrim( Str( Asc( SubStr( cStr, ni, 1 ) ) ) ) + ")"
?? "chr(" + hb_ntos( Asc( SubStr( cStr, ni, 1 ) ) ) + ")"
IF ni < Len( cStr )
?? "+"
ENDIF

5
harbour/contrib/hbct/tests/csetarge.prg
View File

@@ -52,6 +52,9 @@
*
*/
#ifndef __HARBOUR__
#define hb_ntos( n ) LTrim( Str( n ) )
#endif
#include "ct.ch"
@@ -238,7 +241,7 @@ FUNCTION myerrhandler( oerr )
? " 6 is Block, 7 is Array, 8 is Object"
? " 9 is unknown"
nDigit := Int( oerr:subCode % 10 )
? " Here it's a " + AllTrim( Str( nDigit ) ) + ", so I return a "
? " Here it's a " + hb_ntos( nDigit ) + ", so I return a "
DO CASE
CASE nDigit == 0
?? "NIL."

19
harbour/contrib/hbct/tests/datetime.prg
View File

@@ -70,7 +70,7 @@ PROCEDURE Main( cLang )
"ctodow() Day name to day number ", ;
"ctomonth() Month name to number ", ;
"daysInMonth() number of days in xMonth ", ;
"daystomonth(dDate) Returns num days TO month ", ;
"daystomonth(dDate) Returns num days to month ", ;
"dmy( dDate, lmode) date as DD month YY ", ;
"doy( dDate ) Returns day of the year ", ;
"eom( dDate ) Returns last day of month ", ;
@@ -97,7 +97,7 @@ PROCEDURE Main( cLang )
DO WHILE c
cScr := SaveScreen( 2, 5, 24, 66 )
@ 2, 5 TO 24, 66
@ 2, 5 TO 24, 66
nChoice := AChoice( 3, 7, 23, 65, farr,,, nChoice )
IF Empty( nChoice )
@@ -489,7 +489,7 @@ FUNCTION dInMonthtest()
ELSE
@ 10, 40 SAY "The day number is " + ;
LTrim( Str( daysInMonth( nMonth, IsAffirm( cLeap ) ) ) )
hb_ntos( daysInMonth( nMonth, IsAffirm( cLeap ) ) )
SET CURSOR OFF
Inkey( 0 )
@@ -547,7 +547,7 @@ FUNCTION d2month()
c := .F.
ELSE
@ 11, 10 SAY "The day number is " + ;
LTrim( Str( daystomonth( nMonth, IsAffirm( cLeap ) ) ) )
hb_ntos( daystomonth( nMonth, IsAffirm( cLeap ) ) )
SET CURSOR OFF
Inkey( 0 )
@@ -653,7 +653,7 @@ FUNCTION doytest()
c := .F.
ELSE
@ 11, 10 SAY "The day of the date entered is " + ;
LTrim( Str( doy( dDate ) ) )
hb_ntos( doy( dDate ) )
SET CURSOR OFF
Inkey( 0 )
@@ -913,7 +913,8 @@ FUNCTION lastdayomtest()
iif( Empty( dDate ), dDate := Val( cMth ), dDate )
@ 12, 10 SAY "The number of days in the month is " + ;
LTrim( Str( lastdayom( dDate ) ) )
hb_ntos( lastdayom( dDate ) )
SET CURSOR OFF
Inkey( 0 )
SET CURSOR ON
@@ -1113,7 +1114,7 @@ FUNCTION qtrtest()
ELSE
@ 8, 10 SAY "The quarter number is " + ;
PadR( LTrim( Str( quarter( dDate ) ) ), 10 )
hb_ntos( quarter( dDate ) )
SET CURSOR OFF
Inkey( 0 )
@@ -1244,8 +1245,8 @@ FUNCTION weektest()
c := .F.
ELSE
@ 8, 10 SAY "The week number is " + ;
PadR( LTrim( Str( week( dDate, IsAffirm( cMode ) ) ) ), 10 )
@ 8, 10 SAY "The week number is " + ;
hb_ntos( week( dDate, IsAffirm( cMode ) ) )
SET CURSOR OFF
Inkey( 0 )

2
harbour/contrib/hbct/tests/finan.prg
View File

@@ -101,6 +101,6 @@ PROCEDURE Main()
? " PRESS ANY KEY"
Inkey( 0 )
CTEXIT()
ctexit()
RETURN

8
harbour/contrib/hbct/tests/token.prg
View File

@@ -54,6 +54,10 @@
#include "ct.ch"
#ifndef __HARBOUR__
#define hb_ntos( n ) LTrim( Str( n ) )
#endif
PROCEDURE Main()
LOCAL cStr := ".,.This.,.is.,.a.,.test!"
@@ -78,7 +82,7 @@ PROCEDURE Main()
? [ with skip width == 1 and ".,!" as tokenizer list:]
?
FOR ni := 1 TO numtoken( cStr, ".,!", 1 )
? [ Token #] + AllTrim( Str( ni ) ) + [("] + token( cStr, ".,!", ni, 1, @cPre, @cPost ) + ;
? [ Token #] + hb_ntos( ni ) + [("] + token( cStr, ".,!", ni, 1, @cPre, @cPost ) + ;
[") @ pos ] + Str( npos := attoken( cStr, ".,!", ni, 1 ), 3 ) + [, tokenized by "] + cPre + [" and "] + cPost + [" is ] + iif( SubStr( cStr, npos, 1 ) $ ".,!", "", "not " ) + "empty"
NEXT
@@ -87,7 +91,7 @@ PROCEDURE Main()
? [ with skip width == 3 and ".,!" as tokenizer list:]
?
FOR ni := 1 TO numtoken( cStr, ".,!", 3 )
? [ Token #] + AllTrim( Str( ni ) ) + [("] + token( cStr, ".,!", ni, 3, @cPre, @cPost ) + ;
? [ Token #] + hb_ntos( ni ) + [("] + token( cStr, ".,!", ni, 3, @cPre, @cPost ) + ;
[") @ pos ] + Str( npos := attoken( cStr, ".,!", ni, 3 ), 3 ) + [, tokenized by "] + cPre + [" and "] + cPost + [" is ] + iif( SubStr( cStr, npos, 1 ) $ ".,!", "", "not " ) + "empty."
NEXT

8
harbour/contrib/hbct/tests/tokensep.prg
View File

@@ -54,6 +54,10 @@
#include "ct.ch"
#ifndef __HARBOUR__
#define hb_ntos( n ) LTrim( Str( n ) )
#endif
PROCEDURE Main()
LOCAL cStr := ".,.This.,.is.,.a.,.test!"
@@ -69,7 +73,7 @@ PROCEDURE Main()
? [ with skip width == 1 and ".,!" as tokenizer list:]
?
FOR ni := 1 TO numtoken( cStr, ".,!", 1 )
? [ Token #] + AllTrim( Str( ni ) ) + [("] + token( cStr, ".,!", ni, 1 ) + ;
? [ Token #] + hb_ntos( ni ) + [("] + token( cStr, ".,!", ni, 1 ) + ;
[") is tokenized by "] + tokensep( .F. ) + [" and "] + tokensep( .T. ) + ["]
NEXT
@@ -78,7 +82,7 @@ PROCEDURE Main()
? [ with skip width == 3 and ".,!" as tokenizer list:]
?
FOR ni := 1 TO numtoken( cStr, ".,!", 3 )
? [ Token #] + AllTrim( Str( ni ) ) + [("] + token( cStr, ".,!", ni, 3 ) + ;
? [ Token #] + hb_ntos( ni ) + [("] + token( cStr, ".,!", ni, 3 ) + ;
[") is tokenized by "] + tokensep( .F. ) + [" and "] + tokensep( .T. ) + ["]
NEXT

2
harbour/contrib/hbct/tests/trig.prg
View File

@@ -251,7 +251,7 @@ PROCEDURE Main()
WAIT4()
CTEXIT()
ctexit()
RETURN

8
harbour/contrib/hbgd/gdbarcod.prg
View File

@@ -87,7 +87,7 @@ CREATE CLASS TCode FROM TBarCode
// Utils
METHOD FindCharCode( cstring, cChar )
METHOD FindCharCode( cString, cChar )
METHOD MixCode( value )
METHOD Findcode( uval )
@@ -399,15 +399,15 @@ METHOD DrawText8() CLASS TCode
RETURN NIL
METHOD FindCharCode( cstring, cChar ) CLASS TCode
METHOD FindCharCode( cString, cChar ) CLASS TCode
LOCAL i
LOCAL nC := 0
LOCAL nret := 0
FOR i := 1 TO Len( cstring )
FOR i := 1 TO Len( cString )
IF SubStr( cstring, i, 1 ) == cChar
IF SubStr( cString, i, 1 ) == cChar
++nC
nRet := nC
EXIT

2
harbour/contrib/hbnf/doc/en/fttext.txt
View File

@@ -184,7 +184,7 @@
* IF ft_fUse( "text.c" ) < 0 // open text file
* err := ft_fError()
* ? 'Error opening file "rext.c", error code (' + ;
* LTrim( Str( err ) ) + ')'
* hb_ntos( err ) + ')'
* ENDIF
*
* $SEEALSO$

6
harbour/contrib/hbnf/doc/en/nwsem.txt
View File

@@ -139,9 +139,9 @@
*
* FT_NWSEMEX( nHandle, @nValue, @nOpenCnt )
* ? "Semaphore test -> Open at [" + ;
* AllTrim( Str( nOpenCnt ) ) + ;
* "] stations, value is [" + ;
* AllTrim( Str( nValue ) ) + "]"
* hb_ntos( nOpenCnt ) + ;
* "] stations, value is [" + ;
* hb_ntos( nValue ) + "]"
* $SEEALSO$
* FT_NWSEMOPEN() FT_NWSEMWAIT() FT_NWSEMSIG() FT_NWSEMCLOSE() FT_NWSEMLOCK()
* $END$

2
harbour/contrib/hbnf/popadder.prg
View File

@@ -253,7 +253,7 @@ FUNCTION FT_Adder()
CLEAR TYPEAHEAD
ELSE
_ftError( "there are " + iif( nTotTran > 0, "only " + ;
LTrim( Str( nTotTran, 3, 0 ) ), "no" ) + ;
hb_ntos( nTotTran ), "no" ) + ;
" transactions entered so far." + ;
" No need to scroll!" )
ENDIF

8
harbour/contrib/hbnf/tests/mouse1.prg
View File

@@ -4,6 +4,10 @@
#require "hbnf"
#ifndef __HARBOUR__
#define hb_ntos( n ) LTrim( Str( n ) )
#endif
// Pass valid row and column values for different video modes to change modes
PROCEDURE Main( nRow, nCol )
@@ -59,8 +63,8 @@ PROCEDURE Main( nRow, nCol )
// ..... Start the demo
@ MaxRow(), 0 SAY "Driver version: " + ;
AllTrim( Str( FT_MVERSION( @nMinor, @nType, @nIRQ ), 2, 0 ) ) + "." + ;
AllTrim( Str( nMinor, 2, 0 ) )
hb_ntos( FT_MVERSION( @nMinor, @nType, @nIRQ ) ) + "." + ;
hb_ntos( nMinor )
@ Row(), Col() SAY " " + aType[ nType ] + " mouse using IRQ " + Str( nIRQ, 1, 0 )
FT_MGETSENS( @nHoriz, @nVert, @nDouble ) // Get the current sensitivities

42
harbour/contrib/hbsqlit3/tests/hdbctest.prg
View File

@@ -22,25 +22,25 @@ PROCEDURE Main()
? "dropped"
ENDIF
? 'Creating test table...'
cSql := 'CREATE TABLE test('
cSql += ' Code integer not null primary key, '
cSql += ' dept Integer, '
cSql += ' Name Varchar(40), '
cSql += ' Sales boolean, '
cSql += ' Tax Float4, '
cSql += ' Salary Double Precision, '
cSql += ' Budget Numeric(12,2), '
cSql += ' Discount Numeric (5,2), '
cSql += ' Creation Date, '
cSql += ' Description text ) '
? "Creating test table..."
cSql := "CREATE TABLE test("
cSql += " Code integer not null primary key, "
cSql += " dept Integer, "
cSql += " Name Varchar (40), "
cSql += " Sales boolean, "
cSql += " Tax Float4, "
cSql += " Salary Double Precision, "
cSql += " Budget Numeric (12,2), "
cSql += " Discount Numeric (5,2), "
cSql += " Creation Date, "
cSql += " Description text ) "
oStmt := oConn:createStatement()
oStmt:executeUpdate( cSql )
oStmt:Close()
? "created"
? 'Inserting, declared transaction control '
? "Inserting, declared transaction control "
oConn:StartTransaction()
? "Inserting using direct statement..."
@@ -50,7 +50,7 @@ PROCEDURE Main()
? Time()
FOR n := 1 TO _NUMROWS_
cSql := "INSERT INTO test(code, dept, name, sales, tax, salary, budget, Discount, Creation, Description) "
cSql += "VALUES( " + str( n ) + ", 2, 'TEST', '" + iif( n % 2 != 0, "y", "n" ) + "', 5, 3000, 1500.2, 7.5, '12-22-2003', 'Short Description ')"
cSql += "VALUES( " + Str( n ) + ", 2, 'TEST', '" + iif( n % 2 != 0, "y", "n" ) + "', 5, 3000, 1500.2, 7.5, '12-22-2003', 'Short Description ')"
oStmt := oConn:createStatement()
oStmt:executeUpdate( cSql )
@@ -59,7 +59,7 @@ PROCEDURE Main()
NEXT
? Time()
/*
#if 0
? "Creating prepared statement"
? Time()
@@ -75,13 +75,14 @@ PROCEDURE Main()
oStmt:SetNumber( 7, 1500 )
oStmt:SetNumber( 8, 7.5 )
oStmt:SetDate( 9, Date() )
oStmt:SetString( 10, "Short' Description" )
oStmt:SetString( 10, "Short Description" )
oStmt:executeUpdate()
NEXT
oStmt:close()
? Time()
*/
#endif
oConn:Commit()
oStmt := oConn:createStatement()
@@ -171,7 +172,7 @@ PROCEDURE Main()
oRs:close()
oStmt:close()
/*
#if 0
? "Creating query prepared statement"
oStmt := oConn:prepareStatement( "SELECT code FROM test WHERE name = $1" )
@@ -186,12 +187,11 @@ PROCEDURE Main()
DO WHILE oRs:next()
FOR n := 1 TO 1
? oRs:getString( n )
next
NEXT
ENDDO
oStmt:close()
*/
#endif
oConn:Close()

2
harbour/contrib/hbtip/httpcli.prg
View File

@@ -236,7 +236,7 @@ METHOD ReadHeaders( lClear ) CLASS tIPClientHTTP
::nLength := -1
::bChunked := .F.
cLine := ::InetRecvLine( ::SocketCon, @nPos, 500 )
IF ! lClear == .F. .AND. ! Empty( ::hHeaders )
IF lClear != NIL .AND. lClear .AND. ! Empty( ::hHeaders )
::hHeaders := { => }
ENDIF
DO WHILE ::InetErrorCode( ::SocketCon ) == 0 .AND. ! Empty( cLine )

2
harbour/contrib/hbtpathy/telepath.prg
View File

@@ -105,7 +105,7 @@ FUNCTION tp_inkey( ... )
RETURN inkey( ... )
FUNCTION tp_idle( lNewval )
IF lNewval == .T.
IF lNewval != NIL .AND. lNewval
RETURN .T.
ENDIF
RETURN .F.

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

@@ -100,7 +100,7 @@ METHOD PROCEDURE CopyTo( oTargetStream ) CLASS TStream
LOCAL nRead
LOCAL nPosition
IF oTargetStream:lCanWrite == .F.
IF ! oTargetStream:lCanWrite
Throw( xhb_ErrorNew( "Stream", 0, 1001, ProcName(), "Target not writable.", HB_aParams() ) )
ENDIF

4
harbour/contrib/xhb/tedit.prg
View File

@@ -353,9 +353,9 @@ METHOD Put() CLASS THtmlControl
" value=" + ::aOptions[ i, _OPTION_VALUE ], "" )
cStr += iif( ::aOptions[ i, _OPTION_LABEL ] != NIL, ;
" label=" + ::aOptions[ i, _OPTION_LABEL ], "" )
cStr += iif( ::aOptions[ i, _OPTION_SELECTED ] == .T., ;
cStr += iif( ::aOptions[ i, _OPTION_SELECTED ] != NIL .AND. ::aOptions[ i, _OPTION_SELECTED ], ;
" SELECTED ", "" )
cStr += iif( ::aOptions[ i, _OPTION_DISABLED ] == .T., ;
cStr += iif( ::aOptions[ i, _OPTION_DISABLED ] != NIL .AND. ::aOptions[ i, _OPTION_DISABLED ], ;
" DISABLED ", "" )
cStr += ">" + ::aOptions[ i, _OPTION_TEXT ] + "</OPTION>" + CRLF()
// FWrite( ::nH, cStr )

14
harbour/contrib/xhb/thtm.prg
View File

@@ -1201,7 +1201,7 @@ METHOD CLOSE() CLASS THtml
FWrite( ::nh, ::cStr )
IF !::lCgi
IF ! ::lCgi
FClose( ::nH )
ENDIF
@@ -1299,11 +1299,11 @@ METHOD DefineTable( nCols, nBorder, nWidth, nHeight, ColorFore, ColorBG, ;
cStr += ' bordercolor=' + cClrBorder
ENDIF
IF lRuleCols == .T.
IF lRuleCols
cStr += " RULES=COLS"
ELSEIF lRuleRows == .T.
ELSEIF lRuleRows
cStr += " RULES=ROWS"
ELSEIF lRules == .T.
ELSEIF lRules != NIL .AND. lRules
cStr += " RULES=ALL"
ENDIF
@@ -1505,13 +1505,13 @@ METHOD NewTableCell( cAlign, cColor, ;
cStr += " ROWSPAN=" + '"' + nRowspan + '"'
ENDIF
IF lWrap == .F.
IF ! lWrap
cStr += " NOWRAP"
ENDIF
cStr += ">"
IF !lNoFont
IF ! lNoFont
cStr += '<FONT '
IF nSize != NIL
@@ -1522,7 +1522,7 @@ METHOD NewTableCell( cAlign, cColor, ;
cStr += ' COLOR=' + cFntColor
ENDIF
IF !Empty( cFont )
IF ! Empty( cFont )
cStr += ' FACE="' + cFont + '"' + ">"
ELSE
cStr += ">"

125
harbour/contrib/xhb/ttable.prg
View File

@@ -91,15 +91,15 @@ FUNCTION NetDbUse( cDataBase, cAlias, nSeconds, cDriver, ;
__defaultNIL( @lReadOnly, .F. )
__defaultNIL( @nSeconds, s_nNetDelay )
s_lNetOk := .F.
s_lNetOk := .F.
nSeconds *= 1.00
lforever := ( nSeconds == 0 )
lForever := ( nSeconds == 0 )
hb_keyIns( 255 )
Inkey()
DO WHILE ( lforever .OR. nSeconds > 0 ) .AND. LastKey() != K_ESC
IF !lfirstPass
DO WHILE ( lForever .OR. nSeconds > 0 ) .AND. LastKey() != K_ESC
IF ! lFirstPass
hb_DispOutAt( MaxRow(), 0, ;
PadC( "Network retry | " + ;
LTrim( Str( nSeconds, 4, 1 ) ) + " | ESCape = Exit ", ;
@@ -109,20 +109,20 @@ FUNCTION NetDbUse( cDataBase, cAlias, nSeconds, cDriver, ;
ENDIF
dbUseArea( lNew, ;
( cDriver ), ( cDatabase ), ( cAlias ), ;
cDriver, cDatabase, cAlias, ;
lOpenMode, ;
.F. )
IF !NetErr() // USE SUCCEEDS
IF ! NetErr() // USE SUCCEEDS
RestScreen( MaxRow(), 0, MaxRow(), MaxCol() + 1, cOldScreen )
s_lNetOk := .T.
ELSE
lFirstPass := .F.
ENDIF
IF !s_lNetOk
nKey := Inkey( .5 ) // WAIT 1 SECOND
nSeconds -= .5
IF ! s_lNetOk
nKey := Inkey( 0.5 ) // WAIT 1 SECOND
nSeconds -= 0.5
ELSE
RestScreen( MaxRow(), 0, MaxRow(), MaxCol() + 1, cOldScreen )
EXIT
@@ -152,9 +152,9 @@ FUNCTION NetLock( nType, lReleaseLocks, nSeconds )
LOCAL cWord
IF ! HB_ISNUMERIC( nType ) .OR. ;
( ( nType != 1 ) .AND. ;
( nType != 2 ) .AND. ;
( nType != 3 ) )
( nType != 1 .AND. ;
nType != 2 .AND. ;
nType != 3 )
Alert( "Invalid Argument passed to NETLOCK()" )
RETURN lSuccess
ENDIF
@@ -180,7 +180,7 @@ FUNCTION NetLock( nType, lReleaseLocks, nSeconds )
s_lNetOk := .F.
WHILE lContinue == .T.
WHILE lContinue
#if 0
IF ( nKey := Inkey() ) == K_ESC
@@ -189,7 +189,7 @@ FUNCTION NetLock( nType, lReleaseLocks, nSeconds )
ENDIF
#endif
WHILE nSeconds > 0 .AND. lContinue == .T.
WHILE nSeconds > 0 .AND. lContinue
IF Eval( bOperation, xIdentifier )
nSeconds := 0
lSuccess := .T.
@@ -225,17 +225,13 @@ FUNCTION NetLock( nType, lReleaseLocks, nSeconds )
EXIT
ENDIF
IF !lSuccess
IF ! lSuccess
nSeconds := nWaitTime
nCh := Alert( RETRY_MSG, { " YES ", " NO " } )
nCh := Alert( RETRY_MSG, { " YES ", " NO " } )
IF nCh == 1
lContinue := .T.
ELSE
lContinue := .F.
ENDIF
lContinue := ( nCh == 1 )
IF lContinue == .F.
IF ! lContinue
//EXIT
RestScreen( MaxRow(), 0, MaxRow(), MaxCol() + 1, cSave )
RETURN lSuccess
@@ -255,8 +251,8 @@ FUNCTION NetFunc( bBlock, nSeconds )
__defaultNIL( @nSeconds, s_nNetDelay )
lForever := ( nSeconds == 0 )
// Keep trying as long as specified or default
DO WHILE ( lForever .OR. ( nSeconds > 0 ) )
// Keep trying as long as specified or default
DO WHILE lForever .OR. nSeconds > 0
IF Eval( bBlock )
RETURN .T. // NOTE
@@ -281,7 +277,7 @@ FUNCTION NetOpenFiles( aFiles )
FOR EACH xFile IN aFiles
IF !hb_FileExists( xFile[ 1 ] )
IF ! hb_FileExists( xFile[ 1 ] )
nRet := -1
EXIT
ENDIF
@@ -305,18 +301,18 @@ FUNCTION NetOpenFiles( aFiles )
RETURN nRet
/* NETWORK METHODS */
/* NETWORK METHODS */
FUNCTION NetDelete()
s_lNetOk := .F.
IF NetLock( NET_RECLOCK ) == .T.
IF NetLock( NET_RECLOCK )
dbDelete()
s_lNetOk := .T.
ENDIF
IF !NetErr()
IF ! NetErr()
dbSkip( 0 )
dbCommit()
ELSE
@@ -330,12 +326,12 @@ FUNCTION NetReCall()
s_lNetOk := .F.
IF NetLock( NET_RECLOCK ) == .T.
IF NetLock( NET_RECLOCK )
dbRecall()
s_lNetOk := .T.
ENDIF
IF !NetErr()
IF ! NetErr()
dbSkip( 0 )
dbCommit()
ELSE
@@ -375,10 +371,10 @@ FUNCTION NetAppend( nSeconds, lReleaseLocks )
__defaultNIL( @lReleaseLocks, .T. )
__defaultNIL( @nSeconds, s_nNetDelay )
s_lNetOk := .F.
nOrd := ordSetFocus( 0 ) // --> set order to 0 to append ???
nOrd := ordSetFocus( 0 ) // --> set order to 0 to append ???
IF NetLock( NET_APPEND, , nSeconds )
//DbGoBottom()
// dbGoBottom()
s_lNetOk := .T.
ENDIF
@@ -399,7 +395,7 @@ FUNCTION NetCommitAll()
LOCAL n
FOR n := 1 TO MAX_TABLE_AREAS
IF !Empty( Alias( n ) )
IF ! Empty( Alias( n ) )
( Alias( n ) )->( dbCommit(), dbUnlock() )
ENDIF
NEXT
@@ -498,8 +494,6 @@ FUNCTION GetTable( cAlias )
*
* CLASS HBField()
*
*
*
*/
CREATE CLASS HBField
@@ -596,8 +590,6 @@ METHOD PROCEDURE Put() CLASS HBRecord
*
* CLASS HBTable
*
*
*
*/
//METHOD SetFocus() INLINE ( ::Alias )->( Select( ::Area ) )
@@ -820,7 +812,7 @@ METHOD OPEN() CLASS HBTable
dbUseArea( ::IsNew, ::Driver, ::cDBF, ::Alias, ::IsNET, ::IsREADONLY )
IF ::IsNET == .T.
IF ::IsNET
IF NetErr()
Alert( _NET_USE_FAIL_MSG )
lSuccess := .F.
@@ -887,7 +879,7 @@ METHOD FldInit() CLASS HBTable
::Read()
ENDIF
// --> create new oObject class from this one...
// --> create new oObject class from this one...
adb := HBClass():new( ::alias, { "hbtable" } )
@@ -945,7 +937,7 @@ METHOD PROCEDURE READ( lKeepBuffer ) CLASS HBTable
__defaultNIL( @lKeepBuffer, .F. )
//? len( ::Buffer )
// ? Len( ::Buffer )
FOR EACH Buffer in ::Buffer
@@ -958,7 +950,7 @@ METHOD PROCEDURE READ( lKeepBuffer ) CLASS HBTable
NEXT
IF ( lKeepBuffer == .T. ) .OR. ( ::lMonitor == .T. )
IF lKeepBuffer .OR. ::lMonitor
AAdd( ::ReadBuffers, { ( ::Alias )->( RecNo() ), ::Buffer } )
ENDIF
@@ -989,7 +981,7 @@ METHOD PROCEDURE ReadBlank( lKeepBuffer ) CLASS HBTable
NEXT
IF ( lKeepBuffer == .T. ) .OR. ( ::lMonitor == .T. )
IF lKeepBuffer .OR. ::lMonitor
AAdd( ::ReadBuffers, { ( ::Alias )->( RecNo() ), ::Buffer } )
ENDIF
@@ -1010,7 +1002,7 @@ METHOD Write( lKeepBuffer ) CLASS HBTable
__defaultNIL( @lKeepBuffer, .F. )
IF ( lKeepBuffer == .T. ) .OR. ( ::lMonitor == .T. )
IF lKeepBuffer .OR. ::lMonitor
// --> save old record in temp buffer
FOR EACH xBuffer IN aOldBuffer
@@ -1077,19 +1069,19 @@ METHOD __oTDelete( lKeepBuffer ) // ::Delete()
LOCAL lRet
LOCAL lDeleted := Set( _SET_DELETED, .F. ) // make deleted records visible
// temporarily...
// temporarily...
__defaultNIL( @lKeepBuffer, .F. )
::Read()
IF ::isNet
lRet := iif( ( ::Alias )->( NetDelete() ), .T., .F. )
lRet := ( ::Alias )->( NetDelete() )
ELSE
( ::alias )->( dbDelete() ) ; lRet := .T.
( ::alias )->( dbDelete() )
lRet := .T.
ENDIF
IF ( ( lKeepBuffer == .T. ) .OR. ( ::lMonitor == .T. ) ) .AND. ;
( lRet == .T. )
IF ( lKeepBuffer .OR. ::lMonitor ) .AND. lRet
AAdd( ::DeleteBuffers, { ( ::Alias )->( RecNo() ), ::Buffer } )
ENDIF
@@ -1105,12 +1097,12 @@ METHOD SetMonitor( l ) CLASS HBTable
LOCAL lTemp := ::lMonitor
::lMonitor := !( l )
::lMonitor := ! l
RETURN lTemp
//
// Transaction control subsystem...
// Transaction control subsystem...
//
METHOD Undo( nBuffer, nLevel ) CLASS HBTable
@@ -1131,7 +1123,7 @@ METHOD Undo( nBuffer, nLevel ) CLASS HBTable
CASE _DELETE_BUFFER
IF !Empty( ::DeleteBuffers )
IF ! Empty( ::DeleteBuffers )
Set( _SET_DELETED, .F. ) // make deleted records visible temporarily...
@@ -1140,15 +1132,12 @@ METHOD Undo( nBuffer, nLevel ) CLASS HBTable
__defaultNIL( @nLevel, nLen )
IF nLevel == 0 .OR. nLevel == nLen // DO ALL...
FOR EACH aBuffers IN ::deleteBuffers
( ::Alias )->( dbGoto( aBuffers[ 1 ] ) )
IF ( ::Alias )->( NetRecall() )
lRet := .T.
ELSE
lRet := .F.
ENDIF
lRet := ( ::Alias )->( NetRecall() )
NEXT
@@ -1163,11 +1152,7 @@ METHOD Undo( nBuffer, nLevel ) CLASS HBTable
( ::Alias )->( dbGoto( aBuffers[ 1 ] ) )
IF ( ::Alias )->( NetRecall() )
lRet := .T.
ELSE
lRet := .F.
ENDIF
lRet := ( ::Alias )->( NetRecall() )
ENDIF
NEXT
@@ -1183,7 +1168,8 @@ METHOD Undo( nBuffer, nLevel ) CLASS HBTable
EXIT
CASE _WRITE_BUFFER
IF !Empty( ::WriteBuffers )
IF ! Empty( ::WriteBuffers )
nLen := Len( ::WriteBuffers )
__defaultNIL( @nLevel, nLen )
@@ -1287,7 +1273,7 @@ METHOD REINDEX() CLASS HBTable
ENDIF
ENDIF
IF !::Open()
IF ! ::Open()
RETURN .F.
ENDIF
@@ -1296,7 +1282,7 @@ METHOD REINDEX() CLASS HBTable
::Kill()
::IsNet := .T.
IF !::Open()
IF ! ::Open()
RETURN .F.
ENDIF
@@ -1326,7 +1312,7 @@ METHOD FastReindex() CLASS HBTable
ENDIF
ENDIF
IF !::Open()
IF ! ::Open()
RETURN .F.
ENDIF
@@ -1335,7 +1321,7 @@ METHOD FastReindex() CLASS HBTable
::Kill()
::IsNet := .T.
IF !::Open()
IF ! ::Open()
RETURN .F.
ENDIF
@@ -1396,7 +1382,7 @@ METHOD GetOrderLabels() CLASS HBTable
LOCAL aRet := {}
IF !Empty( ::aOrders )
IF ! Empty( ::aOrders )
AEval( ::aOrders, {| e | AAdd( aRet, e:Label ) } )
ENDIF
@@ -1415,8 +1401,8 @@ PROCEDURE AddChild( oChild, cKey ) CLASS HBTable // ::addChild()
RETURN
/****
* FixExt( cFileName )
* extract .cdx filename from .dbf filename
* FixExt( cFileName )
* extract .cdx filename from .dbf filename
*/
STATIC FUNCTION FixExt( cFileName )
@@ -1519,6 +1505,7 @@ METHOD New( cTag, cKey, cLabel, cFor, cWhile, lUnique, bEval, nInterval, cOrderB
__defaultNIL( @bEval, {|| .T. } )
__defaultNIL( @nInterval, 1 )
__defaultNIL( @cLabel, cTag )
::cOrderBag := cOrderBag
::Tag := cTag
::cKey := cKey

11
harbour/contrib/xhb/xcstr.prg
View File

@@ -114,10 +114,13 @@ FUNCTION CStrToVal( cExp, cType )
FUNCTION StringToLiteral( cString )
LOCAL lDouble := .F., lSingle := .F.
LOCAL lDouble := .F.
LOCAL lSingle := .F.
IF hb_regexHas( "\n|\r", cString ) .OR. ;
( ( lDouble := '"' $ cString ) .AND. ( lSingle := "'" $ cString ) .AND. hb_regexHas( "\[|\]", cString ) )
( ( lDouble := '"' $ cString ) .AND. ;
( lSingle := "'" $ cString ) .AND. ;
hb_regexHas( "\[|\]", cString ) )
cString := StrTran( cString, '"', '\"' )
cString := StrTran( cString, Chr( 10 ), "\n" )
@@ -126,9 +129,9 @@ FUNCTION StringToLiteral( cString )
//TraceLog( cString )
RETURN 'E"' + cString + '"'
ELSEIF lDouble == .F.
ELSEIF ! lDouble
RETURN '"' + cString + '"'
ELSEIF lSingle == .F.
ELSEIF ! lSingle
RETURN "'" + cString + "'"
ENDIF

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

@@ -505,7 +505,7 @@ FUNCTION xhb_MemoEdit( cString,;
// 2006/AUG/06 - E.F. Clipper's <cUserFunction> in .T. or. F. is samething.
//
IF !HB_ISLOGICAL( xUDF ) //.OR. cUserFunction == .T.
IF !HB_ISLOGICAL( xUDF ) // .OR. cUserFunction
oEd:Edit()

4
harbour/contrib/xhb/xhbtedit.prg
View File

@@ -1567,7 +1567,7 @@ METHOD K_Del() CLASS XHBEditor
// in case of softcr, reparse the paragraph.
//
IF ::aText[ ::nRow ]:lSoftCR == .T.
IF ::aText[ ::nRow ]:lSoftCR
IF !( Right( ::aText[ ::nRow ]:cText, 1 ) == " " )
::aText[ ::nRow ]:cText += " "
ENDIF
@@ -1653,7 +1653,7 @@ METHOD K_Tab() CLASS XHBEditor
::aText[ ::nRow ]:cText := ::aText[ ::nRow ]:cText + ::GetLine( ::nRow + 1 )
::RemoveLine( ::nRow + 1 )
::aText[ ::nRow ]:lSoftCR := !lHardCR // .T. if lHardCR == .F.
::aText[ ::nRow ]:lSoftCR := ! lHardCR // .T. if ! lHardCR
::SplitLine( ::nRow )
::RefreshWindow()

30
harbour/extras/gtwvw/tests/ebtest7.prg
View File

@@ -459,7 +459,7 @@ STATIC PROCEDURE ToCloseWindow( nwinnum, lPermitted )
// allow to close topmost window only
lPermitted := ( nwinnum == wvw_nnumwindows() - 1 )
IF !lpermitted
IF ! lpermitted
MyMessageBox( nwinnum, "Window " + hb_ntos( nwinnum ) + " is not allowed to be closed, yet" + hb_eol() + ;
"Please close window " + hb_ntos( wvw_nnumwindows() - 1 ) + " first" )
ENDIF
@@ -470,13 +470,13 @@ STATIC PROCEDURE ToCloseWindow( nwinnum, lPermitted )
STATIC FUNCTION nGetIndex( aEBGets, nEBId )
RETURN AScan( aEBGets, {| x | x[__GET_NEBID] == nEBId } )
RETURN AScan( aEBGets, {| x | x[ __GET_NEBID ] == nEBId } )
// returns index to aEBGets array containing editbox that is/was in focus
STATIC FUNCTION nFocused( aEBGets )
RETURN AScan( aEBGets, {| x | x[__GET_LFOCUSED] == .T. } )
RETURN AScan( aEBGets, {| x | x[ __GET_LFOCUSED ] } )
#define EN_SETFOCUS 0x0100
@@ -631,7 +631,7 @@ STATIC PROCEDURE ProcessCharMask( mnwinnum, mnebid, mcvaltype, mcpict )
IF CB == "." .OR. CB == ","
pc++
ENDIF
NEXT x
NEXT
// RL 89
IF Left( InBuffer, 1 ) == "." .OR. Left( InBuffer, 1 ) == ","
@@ -645,8 +645,8 @@ STATIC PROCEDURE ProcessCharMask( mnwinnum, mnebid, mcvaltype, mcpict )
fnb := x
EXIT
ENDIF
NEXT x
ENDIF //pcount()>1
NEXT
ENDIF
ENDIF
BackInBuffer := InBuffer
@@ -735,7 +735,7 @@ STATIC PROCEDURE ProcessCharMask( mnwinnum, mnebid, mcvaltype, mcpict )
OutBuffer := OutBuffer + CM
ENDCASE
NEXT x
NEXT
// Replace Content
IF ! ( BackInBuffer == OutBuffer )
@@ -746,7 +746,7 @@ STATIC PROCEDURE ProcessCharMask( mnwinnum, mnebid, mcvaltype, mcpict )
//pc>1 means we must to JUMP to the decimal point
// RL 104
IF NegativeZero == .T.
IF NegativeZero
Output := Transform( GetValFromText( wvw_ebgettext( mnwinnum, mnebid ), mcvaltype ), Mask )
//x better:
@@ -762,7 +762,7 @@ STATIC PROCEDURE ProcessCharMask( mnwinnum, mnebid, mcvaltype, mcpict )
ENDIF
ELSE
IF pFlag == .T.
IF pFlag
ncp := At( ".", wvw_ebgettext( mnwinnum, mnebid ) )
wvw_ebsetsel( mnwinnum, mnebid, ncp, ncp )
ELSE
@@ -784,7 +784,7 @@ STATIC PROCEDURE ProcessCharMask( mnwinnum, mnebid, mcvaltype, mcpict )
ELSE
EXIT
ENDIF
NEXT x
NEXT
ENDIF
ENDIF
@@ -810,7 +810,7 @@ STATIC FUNCTION CharMaskTekstOK( cString, cvaltype, cMask )
OTHERWISE
// lPassed:=.T.
ENDCASE
NEXT i
NEXT
RETURN .T.
ENDIF
@@ -819,7 +819,7 @@ STATIC FUNCTION CharMaskTekstOK( cString, cvaltype, cMask )
CM := SubStr( cMask, x, 1 )
DO CASE
// JK
CASE ( CM ) == "A" .OR. ( CM ) == "!"
CASE CM == "A" .OR. CM == "!"
IF IsAlpha( CB ) .OR. CB == " "
// lPassed := .T.
ELSE
@@ -840,7 +840,7 @@ STATIC FUNCTION CharMaskTekstOK( cString, cvaltype, cMask )
OTHERWISE
// lPassed := .T.
ENDCASE
NEXT i
NEXT
RETURN .T. //lPassed
@@ -868,7 +868,7 @@ STATIC FUNCTION GetValFromText( Text, mcvaltype )
IF c $ "0123456789" .OR. c $ ".-"
s += c
ENDIF
NEXT x
NEXT
IF Left( AllTrim( Text ), 1 ) == "(" .OR. Right( AllTrim( Text ), 2 ) == "DB"
s := "-" + s
@@ -900,7 +900,7 @@ STATIC FUNCTION GetNumMask( Text, mcvaltype )
IF c == "$" .OR. c == "*"
s += "9"
ENDIF
NEXT i
NEXT
RETURN s

23
harbour/extras/hbxlsxml/xlsxml.prg
View File

@@ -8,7 +8,7 @@
* Copyright 2011 Fausto Di Creddo Trautwein, ftwein@yahoo.com.br
* www - http://www.xharbour.org http://harbour-project.org
*
* Thanks TO Robert F Greer, PHP original version
* Thanks to Robert F Greer, PHP original version
* http://sourceforge.net/projects/excelwriterxml/
*
* This program is free software; you can redistribute it AND/OR modify
@@ -113,20 +113,20 @@ METHOD ExcelWriterXML:new( fileName )
METHOD ExcelWriterXML:setOverwriteFile( overwrite )
IF ! HB_ISLOGICAL( overwrite )
::overwriteFile := .F.
ELSE
IF HB_ISLOGICAL( overwrite )
::overwriteFile := overwrite
ELSE
::overwriteFile := .F.
ENDIF
RETURN NIL
METHOD ExcelWriterXML:showErrorSheet( show )
IF ! HB_ISLOGICAL( show )
::lShowErrorSheet := .T.
ELSE
IF HB_ISLOGICAL( show )
::lShowErrorSheet := show
ELSE
::lShowErrorSheet := .T.
ENDIF
RETURN NIL
@@ -135,7 +135,8 @@ METHOD ExcelWriterXML:addError( cFunction, cMessage )
LOCAL tmp
tmp := { "FUNCTION" => cFunction, ;
tmp := { ;
"FUNCTION" => cFunction, ;
"MESSAGE" => cMessage }
::formatErrors += tmp
@@ -242,19 +243,19 @@ METHOD ExcelWriterXML:writeData( target )
ENDIF
fileExists := hb_FileExists( target )
IF ( fileExists == .T. .AND. ::overwriteFile == .F. )
IF fileExists .AND. ! ::overwriteFile
::cError := target + " exists and overwriteFile is set to false"
::errors := .T.
RETURN .F.
ENDIF
handle := hb_FCreate( target, FC_NORMAL, FO_EXCLUSIVE )
IF handle == - 1
IF handle == F_ERROR
::cError := "Not able to open " + target + " for writing"
::errors := .T.
RETURN .F.
ENDIF
IF ::lShowErrorSheet == .T.
IF ::lShowErrorSheet
format := ::addStyle( "formatErrorsHeader" )
format:setFontBold()
format:bgColor( "red" )

339
harbour/extras/rddado/adordd.prg
View File

@@ -137,15 +137,16 @@ STATIC FUNCTION ADO_NEW( nWA )
STATIC FUNCTION ADO_CREATE( nWA, aOpenInfo )
LOCAL cDataBase := HB_TokenGet( aOpenInfo[ UR_OI_NAME ], 1, ";" )
LOCAL cTableName := HB_TokenGet( aOpenInfo[ UR_OI_NAME ], 2, ";" )
LOCAL cDbEngine := HB_TokenGet( aOpenInfo[ UR_OI_NAME ], 3, ";" )
LOCAL cServer := HB_TokenGet( aOpenInfo[ UR_OI_NAME ], 4, ";" )
LOCAL cUserName := HB_TokenGet( aOpenInfo[ UR_OI_NAME ], 5, ";" )
LOCAL cPassword := HB_TokenGet( aOpenInfo[ UR_OI_NAME ], 6, ";" )
LOCAL cDataBase := hb_tokenGet( aOpenInfo[ UR_OI_NAME ], 1, ";" )
LOCAL cTableName := hb_tokenGet( aOpenInfo[ UR_OI_NAME ], 2, ";" )
LOCAL cDbEngine := hb_tokenGet( aOpenInfo[ UR_OI_NAME ], 3, ";" )
LOCAL cServer := hb_tokenGet( aOpenInfo[ UR_OI_NAME ], 4, ";" )
LOCAL cUserName := hb_tokenGet( aOpenInfo[ UR_OI_NAME ], 5, ";" )
LOCAL cPassword := hb_tokenGet( aOpenInfo[ UR_OI_NAME ], 6, ";" )
LOCAL oConnection := win_OleCreateObject( "ADODB.Connection" )
LOCAL oCatalog := win_OleCreateObject( "ADOX.Catalog" )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL oCatalog := win_OleCreateObject( "ADOX.Catalog" )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL oError, n
DO CASE
@@ -159,7 +160,7 @@ STATIC FUNCTION ADO_CREATE( nWA, aOpenInfo )
IF ! hb_FileExists( cDataBase )
oCatalog:Create( "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + cDataBase + ";Extended Properties='Excel 8.0;HDR=YES';Persist Security Info=False" )
ENDIF
oConnection:Open( "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + cDataBase + ";Extended Properties='Excel 8.0;HDR=YES';Persist Security Info=False")
oConnection:Open( "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + cDataBase + ";Extended Properties='Excel 8.0;HDR=YES';Persist Security Info=False" )
CASE Lower( Right( cDataBase, 3 ) ) == ".db"
IF ! hb_FileExists( cDataBase )
@@ -175,11 +176,12 @@ STATIC FUNCTION ADO_CREATE( nWA, aOpenInfo )
oConnection:CursorLocation := adUseClient
CASE Upper( cDbEngine ) == "MYSQL"
oConnection:Open( "DRIVER={MySQL ODBC 3.51 Driver};" + ;
"server=" + cServer + ;
";database=" + cDataBase + ;
";uid=" + cUserName + ;
";pwd=" + cPassword )
oConnection:Open( ;
"Driver={MySQL ODBC 3.51 Driver};" + ;
"server=" + cServer + ;
";database=" + cDataBase + ;
";uid=" + cUserName + ;
";pwd=" + cPassword )
ENDCASE
@@ -196,15 +198,15 @@ STATIC FUNCTION ADO_CREATE( nWA, aOpenInfo )
ENDIF
RECOVER
oError := ErrorNew()
oError:GenCode := EG_CREATE
oError:SubCode := 1004
oError:Description := HB_LANGERRMSG( EG_CREATE ) + " (" + ;
HB_LANGERRMSG( EG_UNSUPPORTED ) + ")"
oError:FileName := aOpenInfo[ UR_OI_NAME ]
oError:CanDefault := .T.
oError:GenCode := EG_CREATE
oError:SubCode := 1004
oError:Description := hb_langErrMsg( EG_CREATE ) + " (" + ;
hb_langErrMsg( EG_UNSUPPORTED ) + ")"
oError:FileName := aOpenInfo[ UR_OI_NAME ]
oError:CanDefault := .T.
FOR n := 0 To oConnection:Errors:Count - 1
oError:Description += oConnection:Errors(n):Description
FOR n := 0 TO oConnection:Errors:Count - 1
oError:Description += oConnection:Errors( n ):Description
NEXT
UR_SUPER_ERROR( nWA, oError )
@@ -221,7 +223,7 @@ STATIC FUNCTION ADO_CREATEFIELDS( nWA, aStruct )
aWAData[ WA_SQLSTRUCT ] := ""
FOR n := 1 to Len( aStruct )
FOR n := 1 TO Len( aStruct )
IF n > 1
aWAData[ WA_SQLSTRUCT ] += ", "
ENDIF
@@ -272,14 +274,14 @@ STATIC FUNCTION ADO_OPEN( nWA, aOpenInfo )
/* When there is no ALIAS we will create new one using file name */
IF Empty( aOpenInfo[ UR_OI_ALIAS ] )
HB_FNAMESPLIT( aOpenInfo[ UR_OI_NAME ], , @cName )
hb_FNameSplit( aOpenInfo[ UR_OI_NAME ],, @cName )
aOpenInfo[ UR_OI_ALIAS ] := cName
ENDIF
IF Empty( aOpenInfo[ UR_OI_CONNECT ] )
aWAData[ WA_CONNECTION ] := win_OleCreateObject( "ADODB.Connection" )
aWAData[ WA_TABLENAME ] := t_cTableName
aWAData[ WA_QUERY ] := t_cQuery
aWAData[ WA_QUERY ] := t_cQuery
aWAData[ WA_USERNAME ] := t_cUserName
aWAData[ WA_PASSWORD ] := t_cPassword
aWAData[ WA_SERVER ] := t_cServer
@@ -305,32 +307,32 @@ STATIC FUNCTION ADO_OPEN( nWA, aOpenInfo )
CASE aWAData[ WA_ENGINE ] == "MYSQL"
aWAData[ WA_CONNECTION ]:Open( "DRIVER={MySQL ODBC 3.51 Driver};" + ;
"server=" + aWAData[ WA_SERVER ] + ;
";database=" + aOpenInfo[ UR_OI_NAME ] + ;
";uid=" + aWAData[ WA_USERNAME ] + ;
";pwd=" + aWAData[ WA_PASSWORD ] )
"server=" + aWAData[ WA_SERVER ] + ;
";database=" + aOpenInfo[ UR_OI_NAME ] + ;
";uid=" + aWAData[ WA_USERNAME ] + ;
";pwd=" + aWAData[ WA_PASSWORD ] )
case aWAData[ WA_ENGINE ] == "SQL"
CASE aWAData[ WA_ENGINE ] == "SQL"
aWAData[ WA_CONNECTION ]:Open( "Provider=SQLOLEDB;" + ;
"server=" + aWAData[ WA_SERVER ] + ;
";database=" + aOpenInfo[ UR_OI_NAME ] + ;
";uid=" + aWAData[ WA_USERNAME ] + ;
";pwd=" + aWAData[ WA_PASSWORD ] )
"server=" + aWAData[ WA_SERVER ] + ;
";database=" + aOpenInfo[ UR_OI_NAME ] + ;
";uid=" + aWAData[ WA_USERNAME ] + ;
";pwd=" + aWAData[ WA_PASSWORD ] )
CASE aWAData[ WA_ENGINE ] == "ORACLE"
aWAData[ WA_CONNECTION ]:Open( "Provider=MSDAORA.1;" + ;
"Persist Security Info=False" + ;
iif( Empty( aWAData[ WA_SERVER ] ),;
"", ";Data source=" + aWAData[ WA_SERVER ] ) + ;
";User ID=" + aWAData[ WA_USERNAME ] + ;
";Password=" + aWAData[ WA_PASSWORD ] )
"Persist Security Info=False" + ;
iif( Empty( aWAData[ WA_SERVER ] ), ;
"", ";Data source=" + aWAData[ WA_SERVER ] ) + ;
";User ID=" + aWAData[ WA_USERNAME ] + ;
";Password=" + aWAData[ WA_PASSWORD ] )
CASE aWAData[ WA_ENGINE ] == "FIREBIRD"
aWAData[ WA_CONNECTION ]:Open( "Driver=Firebird/InterBase(r) driver;" + ;
"Persist Security Info=False" +;
";Uid=" + aWAData[ WA_USERNAME ] +;
";Pwd=" + aWAData[ WA_PASSWORD ] +;
";DbName=" + aOpenInfo[ UR_OI_NAME ] )
"Persist Security Info=False" + ;
";Uid=" + aWAData[ WA_USERNAME ] + ;
";Pwd=" + aWAData[ WA_PASSWORD ] + ;
";DbName=" + aOpenInfo[ UR_OI_NAME ] )
ENDCASE
ELSE
aWAData[ WA_CONNECTION ] := win_OleAuto()
@@ -355,19 +357,19 @@ STATIC FUNCTION ADO_OPEN( nWA, aOpenInfo )
IF oRecordSet == NIL
oError := ErrorNew()
oError:GenCode := EG_OPEN
oError:SubCode := 1001
oError:Description := HB_LANGERRMSG( EG_OPEN )
oError:FileName := aOpenInfo[ UR_OI_NAME ]
oError:OsCode := 0 /* TODO */
oError:CanDefault := .T.
oError:GenCode := EG_OPEN
oError:SubCode := 1001
oError:Description := hb_langErrMsg( EG_OPEN )
oError:FileName := aOpenInfo[ UR_OI_NAME ]
oError:OsCode := 0 /* TODO */
oError:CanDefault := .T.
UR_SUPER_ERROR( nWA, oError )
RETURN HB_FAILURE
ENDIF
oRecordSet:CursorType := adOpenDynamic
oRecordSet:CursorType := adOpenDynamic
oRecordSet:CursorLocation := adUseClient
oRecordSet:LockType := adLockPessimistic
oRecordSet:LockType := adLockPessimistic
IF aWAData[ WA_QUERY ] == "SELECT * FROM "
oRecordSet:Open( aWAData[ WA_QUERY ] + aWAData[ WA_TABLENAME ], aWAData[ WA_CONNECTION ] )
ELSE
@@ -394,16 +396,16 @@ STATIC FUNCTION ADO_OPEN( nWA, aOpenInfo )
FOR n := 1 TO nTotalFields
aField := Array( UR_FI_SIZE )
aField[ UR_FI_NAME ] := oRecordSet:Fields( n - 1 ):Name
aField[ UR_FI_TYPE ] := ADO_GETFIELDTYPE( oRecordSet:Fields( n - 1 ):Type )
aField[ UR_FI_NAME ] := oRecordSet:Fields( n - 1 ):Name
aField[ UR_FI_TYPE ] := ADO_GETFIELDTYPE( oRecordSet:Fields( n - 1 ):Type )
aField[ UR_FI_TYPEEXT ] := 0
aField[ UR_FI_LEN ] := ADO_GETFIELDSIZE( aField[ UR_FI_TYPE ], oRecordSet:Fields( n - 1 ):DefinedSize )
aField[ UR_FI_DEC ] := 0
aField[ UR_FI_LEN ] := ADO_GETFIELDSIZE( aField[ UR_FI_TYPE ], oRecordSet:Fields( n - 1 ):DefinedSize )
aField[ UR_FI_DEC ] := 0
#ifdef UR_FI_FLAGS
aField[ UR_FI_FLAGS ] := 0
aField[ UR_FI_FLAGS ] := 0
#endif
#ifdef UR_FI_STEP
aField[ UR_FI_STEP ] := 0
aField[ UR_FI_STEP ] := 0
#endif
UR_SUPER_ADDFIELD( nWA, aField )
NEXT
@@ -424,13 +426,13 @@ STATIC FUNCTION ADO_CLOSE( nWA )
BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }
oRecordSet:Close()
IF ! Empty( aWAData[ WA_CONNOPEN ] )
IF aWAData[ WA_CONNECTION ]:State != adStateClosed
IF aWAData[ WA_CONNECTION ]:State != adStateOpen
aWAData[ WA_CONNECTION ]:Cancel()
ELSE
aWAData[ WA_CONNECTION ]:Close()
ENDIF
ENDIF
IF aWAData[ WA_CONNECTION ]:State != adStateClosed
IF aWAData[ WA_CONNECTION ]:State != adStateOpen
aWAData[ WA_CONNECTION ]:Cancel()
ELSE
aWAData[ WA_CONNECTION ]:Close()
ENDIF
ENDIF
ENDIF
RECOVER
END SEQUENCE
@@ -452,19 +454,19 @@ STATIC FUNCTION ADO_GETVALUE( nWA, nField, xValue )
IF ADO_GETFIELDTYPE( rs:Fields( nField - 1 ):Type ) == HB_FT_STRING
IF ValType( xValue ) == "U"
xValue := Space( rs:Fields( nField - 1 ):DefinedSize )
xValue := Space( rs:Fields( nField - 1 ):DefinedSize )
ELSE
xValue := PadR( xValue, rs:Fields( nField - 1 ):DefinedSize )
xValue := PadR( xValue, rs:Fields( nField - 1 ):DefinedSize )
ENDIF
ELSEIF ADO_GETFIELDTYPE( rs:Fields( nField - 1 ):Type ) == HB_FT_DATE
/* Null values */
IF ValType( xValue ) == "U"
xValue := hb_SToD()
xValue := hb_SToD()
ENDIF
ELSEIF ADO_GETFIELDTYPE( rs:Fields( nField - 1 ):Type ) == HB_FT_TIMESTAMP
/* Null values */
IF ValType( xValue ) == "U"
xValue := hb_SToD()
xValue := hb_SToD()
ENDIF
ENDIF
ENDIF
@@ -485,6 +487,7 @@ STATIC FUNCTION ADO_GOTO( nWA, nRecord )
RETURN iif( nRecord == nRecNo, HB_SUCCESS, HB_FAILURE )
STATIC FUNCTION ADO_GOTOID( nWA, nRecord )
LOCAL nRecNo
LOCAL rs := USRRDD_AREADATA( nWA )[ WA_RECORDSET ]
@@ -498,7 +501,7 @@ STATIC FUNCTION ADO_GOTOID( nWA, nRecord )
STATIC FUNCTION ADO_GOTOP( nWA )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL oRecordSet := aWAData[ WA_RECORDSET ]
IF oRecordSet:RecordCount() != 0
@@ -512,7 +515,7 @@ STATIC FUNCTION ADO_GOTOP( nWA )
STATIC FUNCTION ADO_GOBOTTOM( nWA )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL oRecordSet := aWAData[ WA_RECORDSET ]
oRecordSet:MoveLast()
@@ -524,9 +527,9 @@ STATIC FUNCTION ADO_GOBOTTOM( nWA )
STATIC FUNCTION ADO_SKIPRAW( nWA, nToSkip )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL oRecordSet := aWAData[ WA_RECORDSET ]
LOCAL nResult := HB_SUCCESS
LOCAL nResult := HB_SUCCESS
IF ! Empty( aWAData[ WA_PENDINGREL ] )
IF ADO_FORCEREL( nWA ) != HB_SUCCESS
@@ -544,7 +547,7 @@ STATIC FUNCTION ADO_SKIPRAW( nWA, nToSkip )
ENDIF
BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }
IF aWAData[ WA_CONNECTION ]:State != adStateClosed
IF nToSkip < 0 .AND. oRecordSet:AbsolutePosition <= -nToSkip
IF nToSkip < 0 .AND. oRecordSet:AbsolutePosition <= - nToSkip
oRecordSet:MoveFirst()
aWAData[ WA_BOF ] := .T.
aWAData[ WA_EOF ] := oRecordSet:EOF
@@ -561,7 +564,6 @@ STATIC FUNCTION ADO_SKIPRAW( nWA, nToSkip )
END SEQUENCE
ENDIF
RETURN nResult
STATIC FUNCTION ADO_BOF( nWA, lBof )
@@ -575,7 +577,7 @@ STATIC FUNCTION ADO_BOF( nWA, lBof )
STATIC FUNCTION ADO_EOF( nWA, lEof )
LOCAL oRecordSet := USRRDD_AREADATA( nWA )[ WA_RECORDSET ]
LOCAL nResult := HB_SUCCESS
LOCAL nResult := HB_SUCCESS
BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }
IF USRRDD_AREADATA( nWA )[ WA_CONNECTION ]:State != adStateClosed
@@ -593,10 +595,10 @@ STATIC FUNCTION ADO_DELETED( nWA, lDeleted )
BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }
IF oRecordSet:Status == adRecDeleted
lDeleted := .T.
ELSE
lDeleted := .F.
ENDIF
lDeleted := .T.
ELSE
lDeleted := .F.
ENDIF
RECOVER
lDeleted := .F.
END SEQUENCE
@@ -616,23 +618,24 @@ STATIC FUNCTION ADO_DELETE( nWA )
STATIC FUNCTION ADO_RECNO( nWA, nRecNo )
LOCAL oRecordSet := USRRDD_AREADATA( nWA )[ WA_RECORDSET ]
LOCAL nResult := HB_SUCCESS
LOCAL nResult := HB_SUCCESS
BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }
IF USRRDD_AREADATA( nWA )[ WA_CONNECTION ]:State != adStateClosed
nRecno := iif( oRecordSet:AbsolutePosition == -3, oRecordSet:RecordCount() + 1, oRecordSet:AbsolutePosition )
ELSE
nRecno := 0
nRecno := 0
nResult := HB_FAILURE
ENDIF
RECOVER
nRecNo := 0
nRecNo := 0
nResult := HB_FAILURE
END SEQUENCE
RETURN nResult
STATIC FUNCTION ADO_RECID( nWA, nRecNo )
RETURN ADO_RECNO( nWA, @nRecNo )
STATIC FUNCTION ADO_RECCOUNT( nWA, nRecords )
@@ -686,20 +689,20 @@ STATIC FUNCTION ADO_FLUSH( nWA )
STATIC FUNCTION ADO_ORDINFO( nWA, nIndex, aOrderInfo )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL oRecordSet := aWAData[ WA_RECORDSET ]
LOCAL nResult := HB_SUCCESS
DO CASE
CASE nIndex == DBOI_EXPRESSION
IF ! Empty( aWAData[ WA_CATALOG ] ) .AND. !Empty( aOrderInfo[ UR_ORI_TAG ] ) .AND.;
IF ! Empty( aWAData[ WA_CATALOG ] ) .AND. !Empty( aOrderInfo[ UR_ORI_TAG ] ) .AND. ;
aOrderInfo[ UR_ORI_TAG ] < aWAData[ WA_CATALOG ]:Tables( aWAData[ WA_TABLENAME ] ):Indexes:Count
aOrderInfo[ UR_ORI_RESULT ] := aWAData[ WA_CATALOG ]:Tables( aWAData[ WA_TABLENAME ] ):Indexes( aOrderInfo[ UR_ORI_TAG ] ):Name
ELSE
aOrderInfo[ UR_ORI_RESULT ] := ""
ENDIF
CASE nIndex == DBOI_NAME
IF ! Empty( aWAData[ WA_CATALOG ] ) .AND. !Empty( aOrderInfo[ UR_ORI_TAG ] ) .AND.;
IF ! Empty( aWAData[ WA_CATALOG ] ) .AND. !Empty( aOrderInfo[ UR_ORI_TAG ] ) .AND. ;
aOrderInfo[ UR_ORI_TAG ] < aWAData[ WA_CATALOG ]:Tables( aWAData[ WA_TABLENAME ] ):Indexes:Count
aOrderInfo[ UR_ORI_RESULT ] := aWAData[ WA_CATALOG ]:Tables( aWAData[ WA_TABLENAME ] ):Indexes( aOrderInfo[ UR_ORI_TAG ] ):Name
ELSE
@@ -746,15 +749,18 @@ STATIC FUNCTION ADO_ORDINFO( nWA, nIndex, aOrderInfo )
aOrderInfo[ UR_ORI_RESULT ] := 0
nResult := HB_FAILURE
ENDIF
ENDCASE
ENDCASE
RETURN nResult
STATIC FUNCTION ADO_RECINFO( nWA, nRecord, nInfoType, uInfo )
LOCAL nResult := HB_SUCCESS
//LOCAL oRecordSet := USRRDD_AREADATA( nWA )[ WA_RECORDSET ]
// LOCAL oRecordSet := USRRDD_AREADATA( nWA )[ WA_RECORDSET ]
HB_SYMBOL_UNUSED( nWA )
#ifdef UR_DBRI_DELETED
DO CASE
CASE nInfoType == UR_DBRI_DELETED
@@ -785,6 +791,7 @@ STATIC FUNCTION ADO_RECINFO( nWA, nRecord, nInfoType, uInfo )
RETURN nResult
STATIC FUNCTION ADO_FIELDNAME( nWA, nField, cFieldName )
LOCAL nResult := HB_SUCCESS
LOCAL oRecordSet := USRRDD_AREADATA( nWA )[ WA_RECORDSET ]
@@ -792,7 +799,7 @@ STATIC FUNCTION ADO_FIELDNAME( nWA, nField, cFieldName )
cFieldName := oRecordSet:Fields( nField - 1 ):Name
RECOVER
cFieldName := ""
nResult := HB_FAILURE
nResult := HB_FAILURE
END SEQUENCE
RETURN nResult
@@ -898,29 +905,33 @@ STATIC FUNCTION ADO_ORDLSTFOCUS( nWA, aOrderInfo )
ADO_GOTOP( nWA )
ADO_GOTO( nWA, nRecNo )
*/
RETURN HB_SUCCESS
STATIC FUNCTION ADO_PACK( nWA )
//LOCAL oRecordSet := USRRDD_AREADATA( nWA )[ WA_RECORDSET ]
// LOCAL oRecordSet := USRRDD_AREADATA( nWA )[ WA_RECORDSET ]
HB_SYMBOL_UNUSED( nWA )
RETURN HB_SUCCESS
STATIC FUNCTION ADO_RAWLOCK( nWA, nAction, nRecNo )
/* TODO
LOCAL oRecordSet := USRRDD_AREADATA( nWA )[ WA_RECORDSET ]
*/
// LOCAL oRecordSet := USRRDD_AREADATA( nWA )[ WA_RECORDSET ]
/* TODO */
HB_SYMBOL_UNUSED( nRecNo )
HB_SYMBOL_UNUSED( nWA )
HB_SYMBOL_UNUSED( nAction )
RETURN HB_SUCCESS
STATIC FUNCTION ADO_LOCK( nWA, aLockInfo )
STATIC FUNCTION ADO_LOCK( nWA, aLockInfo )
// LOCAL oRecordSet := USRRDD_AREADATA( nWA )[ WA_RECORDSET ]
//LOCAL oRecordSet := USRRDD_AREADATA( nWA )[ WA_RECORDSET ]
HB_SYMBOL_UNUSED( nWA )
aLockInfo[ UR_LI_METHOD ] := DBLM_MULTIPLE
@@ -931,9 +942,10 @@ STATIC FUNCTION ADO_LOCK( nWA, aLockInfo )
STATIC FUNCTION ADO_UNLOCK( nWA, xRecID )
/* TODO
LOCAL oRecordSet := USRRDD_AREADATA( nWA )[ WA_RECORDSET ]
*/
// LOCAL oRecordSet := USRRDD_AREADATA( nWA )[ WA_RECORDSET ]
/* TODO */
HB_SYMBOL_UNUSED( xRecId )
HB_SYMBOL_UNUSED( nWA )
@@ -960,10 +972,10 @@ STATIC FUNCTION ADO_CLEARFILTER( nWA )
STATIC FUNCTION ADO_ZAP( nWA )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL oRecordSet := aWAData[ WA_RECORDSET ]
IF aWAData[ WA_CONNECTION ] != NIL .and. aWAData[ WA_TABLENAME ] != NIL
IF aWAData[ WA_CONNECTION ] != NIL .AND. aWAData[ WA_TABLENAME ] != NIL
BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }
aWAData[ WA_CONNECTION ]:Execute( "TRUNCATE TABLE " + aWAData[ WA_TABLENAME ] )
RECOVER
@@ -986,7 +998,7 @@ STATIC FUNCTION ADO_SETLOCATE( nWA, aScopeInfo )
STATIC FUNCTION ADO_LOCATE( nWA, lContinue )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL oRecordSet := aWAData[ WA_RECORDSET ]
oRecordSet:Find( aWAData[ WA_SCOPEINFO ][ UR_SI_CFOR ], iif( lContinue, 1, 0 ) )
@@ -1017,6 +1029,7 @@ STATIC FUNCTION ADO_CLEARREL( nWA )
STATIC FUNCTION ADO_RELAREA( nWA, nRelNo, nRelArea )
LOCAL aWAData := USRRDD_AREADATA( nWA )
BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }
IF nRelNo <= aWAData[ WA_CATALOG ]:Tables( aWAData[ WA_TABLENAME ] ):Keys:Count()
nRelArea := Select( aWAData[ WA_CATALOG ]:Tables( aWAData[ WA_TABLENAME ] ):Keys( nRelNo - 1 ):RelatedTable )
@@ -1045,12 +1058,12 @@ STATIC FUNCTION ADO_SETREL( nWA, aRelInfo )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL cParent := Alias( aRelInfo[ UR_RI_PARENT ] )
LOCAL cChild := Alias( aRelInfo[ UR_RI_CHILD ] )
LOCAL cChild := Alias( aRelInfo[ UR_RI_CHILD ] )
LOCAL cKeyName := cParent + "_" + cChild
BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }
aWAData[ WA_CATALOG ]:Tables( aWAData[ WA_TABLENAME ] ):Keys:Append( cKeyName, adKeyForeign,;
aRelInfo[ UR_RI_CEXPR ], cChild, aRelInfo[ UR_RI_CEXPR ] )
aWAData[ WA_CATALOG ]:Tables( aWAData[ WA_TABLENAME ] ):Keys:Append( cKeyName, adKeyForeign, ;
aRelInfo[ UR_RI_CEXPR ], cChild, aRelInfo[ UR_RI_CEXPR ] )
RECOVER
/* raise error for can't create relation */
END SEQUENCE
@@ -1073,11 +1086,12 @@ STATIC FUNCTION ADO_FORCEREL( nWA )
RETURN HB_SUCCESS
STATIC FUNCTION ADO_RELEVAL( nWA, aRelInfo )
LOCAL aInfo, nReturn, nOrder, uResult
nReturn := ADO_EVALBLOCK( aRelInfo[ UR_RI_PARENT ], aRelInfo[ UR_RI_BEXPR ], @uResult )
IF nReturn == HB_SUCCESS
IF nReturn == HB_SUCCESS
/*
* Check the current order
*/
@@ -1132,15 +1146,15 @@ STATIC FUNCTION ADO_ORDCREATE( nWA, aOrderCreateInfo )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL oIndex, oError, n, lFound := .F.
if aWAData[ WA_CATALOG ]:Tables( aWAData[ WA_TABLENAME ] ):Indexes != NIL
for n := 1 to aWAData[ WA_CATALOG ]:Tables( aWAData[ WA_TABLENAME ] ):Indexes:Count
oIndex := aWAData[ WA_CATALOG ]:Tables( aWAData[ WA_TABLENAME ] ):Indexes( n - 1 )
if oIndex:Name == iif( ! Empty( aOrderCreateInfo[ UR_ORCR_TAGNAME ] ), aOrderCreateInfo[ UR_ORCR_TAGNAME ], aOrderCreateInfo[ UR_ORCR_CKEY ] )
lFound := .T.
exit
endif
next
endif
IF aWAData[ WA_CATALOG ]:Tables( aWAData[ WA_TABLENAME ] ):Indexes != NIL
FOR n := 1 TO aWAData[ WA_CATALOG ]:Tables( aWAData[ WA_TABLENAME ] ):Indexes:Count
oIndex := aWAData[ WA_CATALOG ]:Tables( aWAData[ WA_TABLENAME ] ):Indexes( n - 1 )
IF oIndex:Name == iif( ! Empty( aOrderCreateInfo[ UR_ORCR_TAGNAME ] ), aOrderCreateInfo[ UR_ORCR_TAGNAME ], aOrderCreateInfo[ UR_ORCR_CKEY ] )
lFound := .T.
EXIT
ENDIF
NEXT
ENDIF
BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }
IF aWAData[ WA_CATALOG ]:Tables( aWAData[ WA_TABLENAME ] ):Indexes == NIL .OR. ! lFound
@@ -1153,12 +1167,12 @@ STATIC FUNCTION ADO_ORDCREATE( nWA, aOrderCreateInfo )
ENDIF
RECOVER
oError := ErrorNew()
oError:GenCode := EG_CREATE
oError:SubCode := 1004
oError:Description := HB_LANGERRMSG( EG_CREATE ) + " (" + ;
HB_LANGERRMSG( EG_UNSUPPORTED ) + ")"
oError:FileName := aOrderCreateInfo[ UR_ORCR_BAGNAME ]
oError:CanDefault := .T.
oError:GenCode := EG_CREATE
oError:SubCode := 1004
oError:Description := hb_langErrMsg( EG_CREATE ) + " (" + ;
hb_langErrMsg( EG_UNSUPPORTED ) + ")"
oError:FileName := aOrderCreateInfo[ UR_ORCR_BAGNAME ]
oError:CanDefault := .T.
UR_SUPER_ERROR( nWA, oError )
END SEQUENCE
@@ -1199,7 +1213,7 @@ STATIC FUNCTION ADO_EVALBLOCK( nArea, bBlock, uResult )
RETURN HB_SUCCESS
STATIC FUNCTION ADO_EXISTS( nRdd, cTable, cIndex, ulConnect )
//LOCAL n
// LOCAL n
LOCAL lRet := HB_FAILURE
LOCAL aRData := USRRDD_RDDDATA( nRDD )
@@ -1223,7 +1237,7 @@ STATIC FUNCTION ADO_EXISTS( nRdd, cTable, cIndex, ulConnect )
RETURN lRet
STATIC FUNCTION ADO_DROP( nRdd, cTable, cIndex, ulConnect )
//LOCAL n
// LOCAL n
LOCAL lRet := HB_FAILURE
LOCAL aRData := USRRDD_RDDDATA( nRDD )
@@ -1253,80 +1267,7 @@ STATIC FUNCTION ADO_SEEK( nWA, lSoftSeek, cKey, lFindLast )
HB_SYMBOL_UNUSED( cKey )
HB_SYMBOL_UNUSED( lFindLast )
/* TODO */
#if 0
LOCAL oRecordSet := USRRDD_AREADATA( nWA )[ WA_RECORDSET ]
LPCDXTAG pTag;
if ( FAST_GOCOLD( ( AREAP ) pArea ) == HB_FAILURE )
RETURN HB_FAILURE;
/*oRecordSet:Find( aWAData[ WA_SCOPEINFO ][ UR_SI_CFOR ], iif( lContinue, 1, 0 ) ) */
LPCDXKEY pKey;
HB_ERRCODE retval = HB_SUCCESS;
HB_BOOL fEOF = HB_FALSE, fLast;
ULONG ulRec;
IF ! Empty( aWAData[ WA_PENDINGREL ] )
ADO_FORCEREL( nWA )
ENDIF
pArea->fTop = pArea->fBottom = HB_FALSE;
pArea->fEof = HB_FALSE;
if( pTag->UsrUnique )
fLast = !pTag->UsrAscend;
else
fLast = pTag->UsrAscend ? fFindLast : !fFindLast;
/* TODO: runtime error if valtype( pKeyItm ) != pTag->Type */
pKey = hb_cdxKeyPutItem( NULL, pKeyItm, fLast ? CDX_MAX_REC_NUM : CDX_IGNORE_REC_NUM, pTag, HB_TRUE, HB_FALSE );
hb_cdxIndexLockRead( pTag->pIndex );
hb_cdxTagRefreshScope( pTag );
ulRec = hb_cdxTagKeyFind( pTag, pKey );
if( ( ulRec == 0 && ! fSoftSeek ) || pTag->TagEOF )
fEOF = HB_TRUE;
else /* if ( fSoftSeek ) */
{
if ( ! hb_cdxBottomScope( pTag ) )
fEOF = HB_TRUE;
else if ( ! hb_cdxTopScope( pTag ) )
{
hb_cdxTagGoTop( pTag );
if ( pTag->CurKey->rec == 0 )
fEOF = HB_TRUE;
}
}
hb_cdxIndexUnLockRead( pTag->pIndex );
if ( !fEOF )
{
retval = SELF_GOTO( ( AREAP ) pArea, pTag->CurKey->rec );
if ( retval != HB_FAILURE && pArea->fPositioned )
{
retval = SELF_SKIPFILTER( ( AREAP ) pArea, fFindLast ? -1 : 1 );
if ( retval != HB_FAILURE && ulRec && pArea->fPositioned )
{
pArea->fFound = ( ulRec == pArea->ulRecNo ||
hb_cdxValCompare( pTag, pKey->val, pKey->len,
pTag->CurKey->val, pTag->CurKey->len, HB_FALSE ) == 0 );
if ( ! pArea->fFound && ! fSoftSeek )
fEOF = HB_TRUE;
}
}
}
if ( retval != HB_FAILURE &&
( fEOF || ! hb_cdxTopScope( pTag ) ||
! hb_cdxBottomScope( pTag ) ) )
{
retval = SELF_GOTO( ( AREAP ) pArea, 0 );
}
pArea->fBof = HB_FALSE;
hb_cdxKeyFree( pKey );
RETURN retval;
#endif
/* TODO */
RETURN HB_FAILURE
@@ -1378,7 +1319,7 @@ FUNCTION ADORDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID )
aADOFunc[ UR_ZAP ] := @ADO_ZAP()
aADOFunc[ UR_SETLOCATE ] := @ADO_SETLOCATE()
aADOFunc[ UR_LOCATE ] := @ADO_LOCATE()
aAdoFunc[ UR_FOUND ] := @ADO_FOUND()
aADOFunc[ UR_FOUND ] := @ADO_FOUND()
aADOFunc[ UR_FORCEREL ] := @ADO_FORCEREL()
aADOFunc[ UR_RELEVAL ] := @ADO_RELEVAL()
aADOFunc[ UR_CLEARREL ] := @ADO_CLEARREL()
@@ -1395,10 +1336,12 @@ FUNCTION ADORDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID )
aADOFunc[ UR_DROP ] := @ADO_DROP()
RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ;
/* NO SUPER RDD */, aADOFunc )
/* NO SUPER RDD */, aADOFunc )
INIT PROCEDURE ADORDD_INIT()
rddRegister( "ADORDD", RDT_FULL )
RETURN
STATIC FUNCTION ADO_GETFIELDSIZE( nDBFFieldType, nADOFieldSize )
@@ -1516,8 +1459,6 @@ STATIC FUNCTION ADO_GETFIELDTYPE( nADOFieldType )
CASE nADOFieldType == adFileTime
#ifdef HB_FT_DATETIME
nDBFFieldType := HB_FT_DATETIME
#else
//nDBFFieldType := HB_FT_DATE
#endif
CASE nADOFieldType == adBSTR

2
harbour/src/debug/debugger.prg
View File

@@ -3198,7 +3198,7 @@ STATIC PROCEDURE SetsKeyPressed( nKey, oBrwSets, nSets, oWnd, cCaption, bEdit )
RefreshVarsS( oBrwSets )
oWnd:SetCaption( cCaption + "[" + RTrim( Str( oBrwSets:Cargo[ 1 ] ) ) + ".." + RTrim( Str( nSets ) ) + "]" )
oWnd:SetCaption( cCaption + "[" + hb_ntos( oBrwSets:Cargo[ 1 ] ) + ".." + hb_ntos( nSets ) + "]" )
RETURN

2
harbour/src/rtl/memoedit.prg
View File

@@ -309,7 +309,7 @@ FUNCTION MemoEdit( cString,;
oEd:MemoInit( xUserFunction )
oEd:display()
IF ! HB_ISLOGICAL( xUserFunction ) .OR. xUserFunction == .T.
IF ! HB_ISLOGICAL( xUserFunction ) .OR. xUserFunction
nOldCursor := SetCursor( iif( Set( _SET_INSERT ), SC_INSERT, SC_NORMAL ) )
oEd:Edit()
IF oEd:Changed() .AND. oEd:Saved()

10
harbour/tests/sdf_test.prg
View File

@@ -19,13 +19,13 @@ PROCEDURE Main()
COPY TO test1 SDF
// Copy only address fields for records with salary over 50,000.
COPY FIELD first, last, street, city, state, zip TO test2 SDF for _field->salary > 50000
COPY FIELD first, last, street, city, state, zip TO test2 SDF FOR _field->salary > 50000
// Only copy record 3.
COPY record 3 TO test3 SDF
COPY RECORD 3 TO test3 SDF
// Copy records 4 through 7.
COPY next 4 TO test4 SDF
COPY NEXT 4 TO test4 SDF
// Try to copy 10 records, starting 5 records from EOF, using WHILE
GO BOTTOM
@@ -45,10 +45,10 @@ PROCEDURE Main()
// Copy only some of the last 10 records.
GO BOTTOM
SKIP -9
COPY REST TO test7 SDF for _field->married
COPY REST TO test7 SDF FOR _field->married
// Try to append from a file that we know does not exist.
DELETE file test8.txt
DELETE FILE test8.txt
APPEND FROM test8 SDF
RETURN

6
harbour/tests/tstasort.prg
View File

@@ -2,6 +2,10 @@
* $Id$
*/
#ifndef __HARBOUR__
#define hb_ntos( n ) LTrim( Str( n ) )
#endif
PROCEDURE Main()
LOCAL oError := ErrorNew()
@@ -46,7 +50,7 @@ FUNCTION xToStr( xValue )
CASE cType == "C" .OR. cType == "M"
RETURN xValue
CASE cType == "N"
RETURN AllTrim( Str( xValue ) )
RETURN hb_ntos( xValue )
CASE cType == "D"
RETURN DToC( xValue )
CASE cType == "L"

5
harbour/tests/videotst.prg
View File

@@ -13,7 +13,7 @@
PROCEDURE Main()
LOCAL nMode := 1, nRow, lSuccess
LOCAL nMode := 1, nRow
LOCAL aVModes := { ;
{ 12, 40, " 12 x 40 " }, ;
{ 25, 40, " 25 x 40 " }, ;
@@ -41,9 +41,8 @@ PROCEDURE Main()
MENU TO nMode
IF nMode > 0
lSuccess := SetMode( aVModes[ nMode ][ HB_VROW ], aVModes[ nMode ][ HB_VCOL ] )
IF lSuccess == .T.
IF SetMode( aVModes[ nMode ][ HB_VROW ], aVModes[ nMode ][ HB_VCOL ] )
TESTBOX( aVModes[ nMode ][ HB_PROMPT ] )
ELSE
@ MaxRow(), 0 SAY HB_NOT_SUPPORTED

8
harbour/tests/vmasort.prg
View File

@@ -2,6 +2,10 @@
* $Id$
*/
#ifndef __HARBOUR__
#define hb_ntos( n ) LTrim( Str( n ) )
#endif
PROCEDURE Main( nPass )
LOCAL aTest
@@ -13,7 +17,7 @@ PROCEDURE Main( nPass )
nPass := Val( nPass )
ENDIF
? "Testing aSort with " + Str( nPass ) + " loops."
? "Testing aSort with " + hb_ntos( nPass ) + " loops."
?
aTest := aMkArray( nPass )
aOrig := AClone( aTest )
@@ -67,7 +71,7 @@ FUNCTION xToStr( xValue )
CASE cType == "C" .OR. cType == "M"
RETURN xValue
CASE cType == "N"
RETURN AllTrim( Str( xValue ) )
RETURN hb_ntos( xValue )
CASE cType == "D"
RETURN DToC( xValue )
CASE cType == "L"