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

2008-10-27 23:38 UTC+0200 Viktor Szakats (harbour.01 syenar hu)

Browse Source 
* contrib/hbmysql/tmysql.prg
  * contrib/xhb/hbcompat.ch
  * contrib/xhb/dirrec.prg
  * contrib/xhb/txml.prg
  * contrib/xhb/hblog.prg
  * contrib/xhb/cstruct.prg
  * contrib/hbodbc/todbc.prg
  * contrib/hbtpathy/telepath.prg
  * contrib/hbmsql/tmsql.prg
  * contrib/hbpgsql/tpostgre.prg
  * contrib/hbgd/gd.prg
  * contrib/hbgd/gdimage.prg
  * contrib/hbgd/gdbarcod.prg
  * contrib/hbgd/gdchart.prg
  * contrib/hbgd/gdbar.prg
  * contrib/hbmisc/stringp.prg
  * contrib/hbtip/thtml.prg
  * contrib/hbtip/popcln.prg
  * contrib/hbtip/sendmail.prg
  * contrib/hbtip/cgi.prg
  * contrib/hbtip/httpcln.prg
  * contrib/hbtip/encoder.prg
  * contrib/hbtip/smtpcln.prg
  * contrib/hbtip/mail.prg
  * contrib/hbtip/ftpcln.prg
  * contrib/hbwin/win_reg.prg
  * contrib/hbwin/win_tole.prg
  * source/rdd/usrrdd/rdds/arrayrdd.prg
  * source/rdd/usrrdd/rdds/hscdx.prg
  * source/rdd/usrrdd/rdds/rlcdx.prg
  * utils/hbdoc/genos2.prg
  * utils/hbdoc/genng.prg
  * utils/hbdoc/genchm.prg
  * utils/hbdoc/genhtm.prg
  * utils/hbdoc/genrtf.prg
  * utils/hbdoc/gentrf.prg
  * utils/hbmake/hbmake.prg
    % 'ValType() == "?"' -> IS*()
    % *trim( Str() ) -> hb_NToS()
    ; In few places in hbtip the length limit 
      was removed from Str(), as it was used 
      inconsistently and could also cause 
      infinite loops and invalid filenames.
    % Some other minor updates.
This commit is contained in:
Viktor Szakats
2008-10-27 22:40:04 +00:00
parent 1239fa60dd
commit 75f19c85c4
38 changed files with 235 additions and 215 deletions
Download Patch File Download Diff File Expand all files Collapse all files

46
harbour/ChangeLog
View File

@@ -8,6 +8,52 @@
2008-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org)
*/
2008-10-27 23:38 UTC+0200 Viktor Szakats (harbour.01 syenar hu)
* contrib/hbmysql/tmysql.prg
* contrib/xhb/hbcompat.ch
* contrib/xhb/dirrec.prg
* contrib/xhb/txml.prg
* contrib/xhb/hblog.prg
* contrib/xhb/cstruct.prg
* contrib/hbodbc/todbc.prg
* contrib/hbtpathy/telepath.prg
* contrib/hbmsql/tmsql.prg
* contrib/hbpgsql/tpostgre.prg
* contrib/hbgd/gd.prg
* contrib/hbgd/gdimage.prg
* contrib/hbgd/gdbarcod.prg
* contrib/hbgd/gdchart.prg
* contrib/hbgd/gdbar.prg
* contrib/hbmisc/stringp.prg
* contrib/hbtip/thtml.prg
* contrib/hbtip/popcln.prg
* contrib/hbtip/sendmail.prg
* contrib/hbtip/cgi.prg
* contrib/hbtip/httpcln.prg
* contrib/hbtip/encoder.prg
* contrib/hbtip/smtpcln.prg
* contrib/hbtip/mail.prg
* contrib/hbtip/ftpcln.prg
* contrib/hbwin/win_reg.prg
* contrib/hbwin/win_tole.prg
* source/rdd/usrrdd/rdds/arrayrdd.prg
* source/rdd/usrrdd/rdds/hscdx.prg
* source/rdd/usrrdd/rdds/rlcdx.prg
* utils/hbdoc/genos2.prg
* utils/hbdoc/genng.prg
* utils/hbdoc/genchm.prg
* utils/hbdoc/genhtm.prg
* utils/hbdoc/genrtf.prg
* utils/hbdoc/gentrf.prg
* utils/hbmake/hbmake.prg
% 'ValType() == "?"' -> IS*()
% *trim( Str() ) -> hb_NToS()
; In few places in hbtip the length limit
was removed from Str(), as it was used
inconsistently and could also cause
infinite loops and invalid filenames.
% Some other minor updates.
2008-10-27 22:39 UTC+0200 Viktor Szakats (harbour.01 syenar hu)
* tests/db_brows.prg
* contrib/hbmysql/tmysql.prg

12
harbour/contrib/hbgd/gd.prg
View File

@@ -50,12 +50,6 @@
*
*/
/*
*
* See doc/license files for licensing terms.
*
*/
#include "common.ch"
FUNCTION gdImageChar( im, font, x, y, char, color )
@@ -187,7 +181,7 @@ FUNCTION gdImageToString( oImage )
//Tracelog( "oImage, oImage:ClassName, oImage:IsDerivedFrom( 'GDIMAGE' )", ;
// oImage, oImage:ClassName, oImage:IsDerivedFrom( 'GDIMAGE' ) )
IF ValType( oImage ) == "O" .AND. ( oImage:ClassName == "GDIMAGE" .OR. oImage:IsDerivedFrom( "GDIMAGE" ) )
IF ISOBJECT( oImage ) .AND. ( oImage:ClassName == "GDIMAGE" .OR. oImage:IsDerivedFrom( "GDIMAGE" ) )
WITH OBJECT oImage
IF :cType != NIL
DO CASE
@@ -211,7 +205,7 @@ PROCEDURE gdImageToFile( oImage, cFile )
//Tracelog( "oImage, oImage:ClassName, oImage:IsDerivedFrom( 'GDIMAGE' )", ;
// oImage, oImage:ClassName, oImage:IsDerivedFrom( 'GDIMAGE' ) )
IF ValType( oImage ) == "O" .AND. ( oImage:ClassName == "GDIMAGE" .OR. oImage:IsDerivedFrom( "GDIMAGE" ) )
IF ISOBJECT( oImage ) .AND. ( oImage:ClassName == "GDIMAGE" .OR. oImage:IsDerivedFrom( "GDIMAGE" ) )
WITH OBJECT oImage
IF :cType != NIL
DO CASE
@@ -243,7 +237,7 @@ PROCEDURE gdImageToHandle( oImage, nHandle )
//Tracelog( "oImage, oImage:ClassName, oImage:IsDerivedFrom( 'GDIMAGE' )", ;
// oImage, oImage:ClassName, oImage:IsDerivedFrom( 'GDIMAGE' ) )
IF ValType( oImage ) == "O" .AND. ( oImage:ClassName == "GDIMAGE" .OR. oImage:IsDerivedFrom( "GDIMAGE" ) )
IF ISOBJECT( oImage ) .AND. ( oImage:ClassName == "GDIMAGE" .OR. oImage:IsDerivedFrom( "GDIMAGE" ) )
WITH OBJECT oImage
IF :cType != NIL
DO CASE

12
harbour/contrib/hbgd/gdbar.prg
View File

@@ -50,11 +50,6 @@
*
*/
/*
*
* See doc/license files for licensing terms.
*
*/
#include "gd.ch"
#include "hbclass.ch"
#include "common.ch"
@@ -377,9 +372,4 @@ METHOD Finish( image_style, quality, nFG ) CLASS TBarCode
Return .T.
FUNCTION IsInt( pvar )
If Valtype( pvar ) == "C"
Return .F.
EndIf
Return .T.
Return ! ISCHARACTER( pvar )

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

@@ -50,11 +50,6 @@
*
*/
/*
*
* See doc/license files for licensing terms.
*
*/
#include "hbclass.ch"
#include "common.ch"
@@ -444,7 +439,7 @@ METHOD Draw128( cText, cModeCode ) CLASS TCode
::settext( cText )
If !Empty( cModeCode )
If valtype(cModeCode)='C' .and. Upper(cModeCode) $'ABC'
If ISCHARACTER( cModeCode ) .and. Upper(cModeCode) $'ABC'
cModeCode := Upper(cModeCode)
Else
::DrawError("Code 128 Modes are A,B o C. Character values.")

11
harbour/contrib/hbgd/gdchart.prg
View File

@@ -50,13 +50,6 @@
*
*/
/*
*
* See doc/license files for licensing terms.
*
*/
#include "common.ch"
#include "hbclass.ch"
#include "gd.ch"
@@ -117,13 +110,13 @@ METHOD AddData( hData ) CLASS GDChart
RETURN Self
METHOD SetData( aData ) CLASS GDChart
IF ValType( aData ) == "A"
IF ISARRAY( aData )
::aDataOfHashes := aData
ENDIF
RETURN Self
METHOD AddDef( cDefKey, xDefVal ) CLASS GDChart
IF ValType( cDefKey ) == "C"
IF ISCHARACTER( cDefKey )
HB_hSet( ::hDefs, Upper( cDefKey ), xDefVal )
ENDIF
RETURN Self

6
harbour/contrib/hbgd/gdimage.prg
View File

@@ -50,12 +50,6 @@
*
*/
/*
*
* See doc/license files for licensing terms.
*
*/
#include "common.ch"
#include "hbclass.ch"
#include "gd.ch"

2
harbour/contrib/hbmisc/stringp.prg
View File

@@ -99,7 +99,7 @@ function ToChar( xTxt, cSeparator, lDebug )
cOut := iif( lDebug, '"'+xTxt+'"', xTxt )
case cValTxt=="N" // Numeric
cOut := Alltrim(Str(xTxt))
cOut := hb_NToS(xTxt)
case cValTxt=="U" // Nothing to write
cOut := iif( lDebug, "NIL", "" )

34
harbour/contrib/hbmsql/tmsql.prg
View File

@@ -121,7 +121,7 @@ METHOD FieldPut(nNum, Value) CLASS TmSQLRow
if nNum > 0 .AND. nNum <= Len(::aRow)
if Valtype(Value) == Valtype(::aRow[nNum]) .OR. Empty(::aRow[nNum])
// if it's a char field encode singole quotes
if ValType(Value) == "C"
if ISCHARACTER(Value)
::aRow[nNum] := StrTran(Value, "'", "\'")
else
::aRow[nNum] := Value
@@ -430,11 +430,11 @@ METHOD Update(oRow) CLASS TmSQLTable
for i := 1 to Len(oRow:aRow)
if oRow:aDirty[i]
do case
case Valtype(oRow:aRow[i]) == "N"
cField := AllTrim(Str(oRow:aRow[i]))
case ISNUMBER(oRow:aRow[i])
cField := hb_NToS(oRow:aRow[i])
cUpdateQuery += oRow:aFieldStruct[i][MSQL_FS_NAME] + "=" + cField + ","
case Valtype(oRow:aRow[i]) == "D"
case ISDATE(oRow:aRow[i])
if !Empty(oRow:aRow[i])
// mSQL dates are like this 1-Oct-1900
cUpdateQuery += oRow:aFieldStruct[i][MSQL_FS_NAME] + "=" + "'" + Str(Day(oRow:aRow[i]), 2) + "-" + Left(CMonth(oRow:aRow[i]), 3) + "-" + Str(Year(oRow:aRow[i]), 4) + "',"
@@ -442,11 +442,11 @@ METHOD Update(oRow) CLASS TmSQLTable
cUpdateQuery += oRow:aFieldStruct[i][MSQL_FS_NAME] + "=" + "'',"
endif
case Valtype(oRow:aRow[i]) == "C"
case ISCHARACTER(oRow:aRow[i])
cUpdateQuery += oRow:aFieldStruct[i][MSQL_FS_NAME] + "='" + oRow:aRow[i] + "',"
case Valtype(oRow:aRow[i]) == "L"
cField := AllTrim(Str(iif(oRow:aRow[i] == .F., 0, 1)))
case ISLOGICAL(oRow:aRow[i])
cField := iif(oRow:aRow[i], "1", "0")
cUpdateQuery += oRow:aFieldStruct[i][MSQL_FS_NAME] + "=" + cField + ","
otherwise
@@ -459,7 +459,7 @@ METHOD Update(oRow) CLASS TmSQLTable
// remove last comma
cUpdateQuery := Left(cUpdateQuery, Len(cUpdateQuery) -1)
cUpdateQuery += " WHERE _rowid=" + AllTrim(Str(oRow:nRowID))
cUpdateQuery += " WHERE _rowid=" + hb_NToS(oRow:nRowID)
if msqlQuery(::nSocket, cUpdateQuery) == 1
// All values are commited
@@ -480,7 +480,7 @@ METHOD Delete(oRow) CLASS TmSQLTable
// is this a row of this table ?
if oRow:cTable == ::cTable
cDeleteQuery += AllTrim(Str(oRow:nRowID))
cDeleteQuery += hb_NToS(oRow:nRowID)
if msqlQuery(::nSocket, cDeleteQuery) == 1
return .T.
@@ -512,14 +512,14 @@ METHOD Append(oRow) CLASS TmSQLTable
for i := 1 to Len(oRow:aRow)
do case
case Valtype(oRow:aRow[i]) == "N"
cField := AllTrim(Str(oRow:aRow[i]))
case ISNUMBER(oRow:aRow[i])
cField := hb_NToS(oRow:aRow[i])
cInsertQuery += cField + ","
case Valtype(oRow:aRow[i]) == "C"
case ISCHARACTER(oRow:aRow[i])
cInsertQuery += "'" + oRow:aRow[i] + "',"
case Valtype(oRow:aRow[i]) == "D"
case ISDATE(oRow:aRow[i])
if !Empty(oRow:aRow[i])
// mSQL dates have this form " 1-Oct-1990"
/* NOTE: current implementation CANNOT retrieve from mSQL dates BEFORE 1st January 1970 */
@@ -528,8 +528,8 @@ METHOD Append(oRow) CLASS TmSQLTable
cInsertQuery += "'',"
endif
case Valtype(oRow:aRow[i]) == "L"
cField := AllTrim(Str(iif(oRow:aRow[i] == .F., 0, 1)))
case ISLOGICAL(oRow:aRow[i])
cField := iif(oRow:aRow[i], "1", "0")
cInsertQuery += cField + ","
otherwise
@@ -650,7 +650,7 @@ METHOD CreateTable(cTable, aStruct) CLASS TmSQLServer
for i := 1 to Len(aStruct)
do case
case aStruct[i][DBS_TYPE] == "C"
cCreateQuery += aStruct[i][DBS_NAME] + " char(" + AllTrim(Str(aStruct[i][DBS_LEN])) + "),"
cCreateQuery += aStruct[i][DBS_NAME] + " char(" + hb_NToS(aStruct[i][DBS_LEN]) + "),"
case aStruct[i][DBS_TYPE] == "N"
if aStruct[i][DBS_DEC] == 0
@@ -666,7 +666,7 @@ METHOD CreateTable(cTable, aStruct) CLASS TmSQLServer
cCreateQuery += aStruct[i][DBS_NAME] + " uint,"
otherwise
cCreateQuery += aStruct[i][DBS_NAME] + " char(" + AllTrim(Str(aStruct[i][DBS_LEN])) + "),"
cCreateQuery += aStruct[i][DBS_NAME] + " char(" + hb_NToS(aStruct[i][DBS_LEN]) + "),"
endcase

42
harbour/contrib/hbmysql/tmysql.prg
View File

@@ -141,7 +141,7 @@ METHOD FieldPut(cnField, Value) CLASS TMySQLRow
if Valtype(Value) == Valtype(::aRow[nNum]) .OR. ::aRow[nNum]==NIL
// if it is a char field remove trailing spaces
if ValType(Value) == "C"
if ISCHARACTER(Value)
Value := RTrim(Value)
endif
@@ -584,8 +584,8 @@ METHOD GetRow(nRow) CLASS TMySQLQuery
otherwise
//DAVID: Alert("Unknown type from SQL Server Field: " + LTrim(Str(i))+" is type "+LTrim(Str(::aFieldStruct[i][MYSQL_FS_TYPE])))
// QOUT("Unknown type from SQL Server Field: " + LTrim(Str(i))+" is type "+LTrim(Str(::aFieldStruct[i][MYSQL_FS_TYPE])))
//DAVID: Alert("Unknown type from SQL Server Field: " + hb_NToS(i)+" is type "+hb_NToS(::aFieldStruct[i][MYSQL_FS_TYPE]))
// QOUT("Unknown type from SQL Server Field: " + hb_NToS(i)+" is type "+hb_NToS(::aFieldStruct[i][MYSQL_FS_TYPE]))
endcase
@@ -662,7 +662,7 @@ METHOD FieldGet(cnField) CLASS TMySQLQuery
local nNum,Value
if ValType(cnField) == "C"
if ISCHARACTER(cnField)
nNum := ::FieldPos(cnField)
else
nNum := cnField
@@ -1228,7 +1228,7 @@ METHOD FieldPut(cnField, Value) CLASS TMySQLTable
local nNum
if ValType(cnField) == "C"
if ISCHARACTER(cnField)
nNum := ::FieldPos(cnField)
else
nNum := cnField
@@ -1240,7 +1240,7 @@ METHOD FieldPut(cnField, Value) CLASS TMySQLTable
if Valtype(Value) == Valtype(::aRow[nNum]) .OR. ::aRow[nNum]==NIL
// if it is a char field remove trailing spaces
if ValType(Value) == "C"
if ISCHARACTER(Value)
Value := RTrim(Value)
endif
@@ -1463,7 +1463,7 @@ METHOD CreateTable(cTable, aStruct,cPrimaryKey,cUniqueKey,cAuto) CLASS TMySQLSer
for i := 1 to Len(aStruct)
do case
case aStruct[i][DBS_TYPE] == "C"
::cCreateQuery += aStruct[i][DBS_NAME] + " char(" + AllTrim(Str(aStruct[i][DBS_LEN])) + ")" + Eval(cNN, aStruct[i])+ iif(aStruct[i][DBS_NAME]==cPrimaryKey," NOT NULL ",'' )+ ","
::cCreateQuery += aStruct[i][DBS_NAME] + " char(" + hb_NToS(aStruct[i][DBS_LEN]) + ")" + Eval(cNN, aStruct[i])+ iif(aStruct[i][DBS_NAME]==cPrimaryKey," NOT NULL ",'' )+ ","
case aStruct[i][DBS_TYPE] == "M"
::cCreateQuery += aStruct[i][DBS_NAME] + " text" + Eval(cNN, aStruct[i]) + ","
@@ -1471,25 +1471,25 @@ METHOD CreateTable(cTable, aStruct,cPrimaryKey,cUniqueKey,cAuto) CLASS TMySQLSer
case aStruct[i][DBS_TYPE] == "N"
/*
if aStruct[i][DBS_DEC] == 0
::cCreateQuery += aStruct[i][DBS_NAME] + " int(" + AllTrim(Str(aStruct[i][DBS_LEN])) + ")" + Eval(cNN, aStruct[i]) + iif(aStruct[i][DBS_NAME]==cPrimaryKey," NOT NULL ",'' )+ iif(aStruct[i][DBS_NAME]==cAuto," auto_increment ",'' ) + ","
::cCreateQuery += aStruct[i][DBS_NAME] + " int(" + hb_NToS(aStruct[i][DBS_LEN]) + ")" + Eval(cNN, aStruct[i]) + iif(aStruct[i][DBS_NAME]==cPrimaryKey," NOT NULL ",'' )+ iif(aStruct[i][DBS_NAME]==cAuto," auto_increment ",'' ) + ","
else
::cCreateQuery += aStruct[i][DBS_NAME] + " real(" + AllTrim(Str(aStruct[i][DBS_LEN])) + "," + AllTrim(Str(aStruct[i][DBS_DEC])) + ")" + Eval(cNN, aStruct[i]) + ","
::cCreateQuery += aStruct[i][DBS_NAME] + " real(" + hb_NToS(aStruct[i][DBS_LEN]) + "," + hb_NToS(aStruct[i][DBS_DEC]) + ")" + Eval(cNN, aStruct[i]) + ","
endif
*/
if (aStruct[i][DBS_DEC] == 0) .and. (aStruct[i][DBS_LEN] <= 18)
do case
case (aStruct[i][DBS_LEN] <= 4)
::cCreateQuery += aStruct[i][DBS_NAME] + " smallint(" + AllTrim(Str(aStruct[i][DBS_LEN])) + ")"
::cCreateQuery += aStruct[i][DBS_NAME] + " smallint(" + hb_NToS(aStruct[i][DBS_LEN]) + ")"
case (aStruct[i][DBS_LEN] <= 6)
::cCreateQuery += aStruct[i][DBS_NAME] + " mediumint(" + AllTrim(Str(aStruct[i][DBS_LEN])) + ")"
::cCreateQuery += aStruct[i][DBS_NAME] + " mediumint(" + hb_NToS(aStruct[i][DBS_LEN]) + ")"
case (aStruct[i][DBS_LEN] <= 9)
::cCreateQuery += aStruct[i][DBS_NAME] + " int(" + AllTrim(Str(aStruct[i][DBS_LEN])) + ")"
::cCreateQuery += aStruct[i][DBS_NAME] + " int(" + hb_NToS(aStruct[i][DBS_LEN]) + ")"
otherwise
::cCreateQuery += aStruct[i][DBS_NAME] + " bigint(" + AllTrim(Str(aStruct[i][DBS_LEN])) + ")"
::cCreateQuery += aStruct[i][DBS_NAME] + " bigint(" + hb_NToS(aStruct[i][DBS_LEN]) + ")"
endcase
::cCreateQuery += Eval(cNN, aStruct[i]) + iif(aStruct[i][DBS_NAME]==cPrimaryKey," NOT NULL ",'' )+ iif(aStruct[i][DBS_NAME]==cAuto," auto_increment ",'' ) + ","
else
::cCreateQuery += aStruct[i][DBS_NAME] + " real(" + AllTrim(Str(aStruct[i][DBS_LEN])) + "," + AllTrim(Str(aStruct[i][DBS_DEC])) + ")" + Eval(cNN, aStruct[i]) + ","
::cCreateQuery += aStruct[i][DBS_NAME] + " real(" + hb_NToS(aStruct[i][DBS_LEN]) + "," + hb_NToS(aStruct[i][DBS_DEC]) + ")" + Eval(cNN, aStruct[i]) + ","
endif
case aStruct[i][DBS_TYPE] == "D"
::cCreateQuery += aStruct[i][DBS_NAME] + " date " + Eval(cNN, aStruct[i]) + ","
@@ -1504,7 +1504,7 @@ METHOD CreateTable(cTable, aStruct,cPrimaryKey,cUniqueKey,cAuto) CLASS TMySQLSer
::cCreateQuery += aStruct[i][DBS_NAME] + " mediumint " + Eval(cNN, aStruct[i]) + ","
otherwise
::cCreateQuery += aStruct[i][DBS_NAME] + " char(" + AllTrim(Str(aStruct[i][DBS_LEN])) + ")" + Eval(cNN, aStruct[i]) + ","
::cCreateQuery += aStruct[i][DBS_NAME] + " char(" + hb_NToS(aStruct[i][DBS_LEN]) + ")" + Eval(cNN, aStruct[i]) + ","
endcase
@@ -1719,10 +1719,10 @@ static function ClipValue2SQL(Value)
local cValue
do case
case Valtype(Value) == "N"
cValue := AllTrim(Str(Value))
case ISNUMBER(Value)
cValue := hb_NToS(Value)
case Valtype(Value) == "D"
case ISDATE(Value)
if !Empty(Value)
// MySQL dates are like YYYY-MM-DD
cValue := "'"+StrZero(Year(Value), 4) + "-" + StrZero(Month(Value), 2) + "-" + StrZero(Day(Value), 2) + "'"
@@ -1731,7 +1731,7 @@ static function ClipValue2SQL(Value)
endif
case Valtype(Value) $ "CM"
IF Empty( Value)
IF Empty( Value )
cValue="''"
ELSE
cValue := "'"
@@ -1739,8 +1739,8 @@ static function ClipValue2SQL(Value)
cValue+= value+ "'"
ENDIF
case Valtype(Value) == "L"
cValue := AllTrim(Str(iif(Value == .F., 0, 1)))
case ISLOGICAL(Value)
cValue := iif(Value, "1", "0")
otherwise
cValue := "''" // NOTE: Here we lose values we cannot convert

2
harbour/contrib/hbodbc/todbc.prg
View File

@@ -776,7 +776,7 @@ METHOD LoadData(nPos) CLASS TODBC
.or. nType == SQL_INTEGER;
.or. nType == SQL_FLOAT;
.or. nType == SQL_REAL
IF VALTYPE(uData) =="C"
IF ISCHARACTER(uData)
uData := strtran(uData,",",".")
uData := Round( Val(uData), ::Fields[ i ]:DataSize )
ENDIF

10
harbour/contrib/hbpgsql/tpostgre.prg
View File

@@ -383,13 +383,13 @@ METHOD CreateTable( cTable, aStruct ) CLASS TPQserver
cQuery += aStruct[i, 1]
if aStruct[ i, 2 ] == "C"
cQuery += ' Char(' + ltrim(str(aStruct[i, 3])) + ')'
cQuery += ' Char(' + hb_NToS(aStruct[i, 3]) + ')'
elseif aStruct[ i, 2 ] == "D"
cQuery += ' Date '
elseif aStruct[ i, 2 ] == "N"
cQuery += ' Numeric(' + ltrim(str(aStruct[i, 3])) + ',' + ltrim(str(aStruct[i,4])) + ')'
cQuery += ' Numeric(' + hb_NToS(aStruct[i, 3]) + ',' + hb_NToS(aStruct[i,4]) + ')'
elseif aStruct[ i, 2 ] == "L"
cQuery += ' boolean '
@@ -830,7 +830,7 @@ METHOD Delete(oRow) CLASS TPQquery
nField := oRow:Fieldpos(::aKeys[i])
xField := oRow:FieldGetOld(nField)
cWhere += ::aKeys[i] + ' = $' + ltrim(str(i))
cWhere += ::aKeys[i] + ' = $' + hb_NToS(i)
AADD( aParams, ValueToString(xField) )
@@ -885,7 +885,7 @@ METHOD Append( oRow ) CLASS TPQquery
For i := 1 to oRow:FCount()
if ::lallCols .or. oRow:Changed(i)
nParams++
cQuery += '$' + ltrim(str(nParams)) + ','
cQuery += '$' + hb_NToS(nParams) + ','
aadd( aParams, ValueToString(oRow:FieldGet(i)) )
endif
Next
@@ -947,7 +947,7 @@ METHOD Update(oRow) CLASS TPQquery
if ::lallcols .or. oRow:Changed(i)
lChanged := .t.
nParams++
cQuery += oRow:Fieldname(i) + ' = $' + ltrim(str(nParams)) + ','
cQuery += oRow:Fieldname(i) + ' = $' + hb_NToS(nParams) + ','
aadd( aParams, ValueToString(oRow:FieldGet(i)) )
end
Next

20
harbour/contrib/hbtip/cgi.prg
View File

@@ -289,12 +289,12 @@ METHOD ErrHandler( xError ) CLASS TIpCgi
::Print( '<tr><td>SCRIPT NAME:</td><td>' + getenv( 'SCRIPT_NAME' ) + '</td></tr>' )
if valtype( xError ) == "O"
if ISOBJECT( xError )
::Print( '<tr><td>CRITICAL ERROR:</td><td>' + xError:Description + '</td></tr>' )
::Print( '<tr><td>OPERATION:</td><td>' + xError:Operation + '</td></tr>' )
::Print( '<tr><td>OS ERROR:</td><td>' + alltrim( str( xError:OsCode ) ) + ' IN ' + xError:SubSystem + '/' + alltrim( str( xError:SubCode ) ) + '</td></tr>' )
::Print( '<tr><td>FILENAME:</td><td>' + right( xError:FileName, 40 ) + '</td></tr>' )
elseif valtype( xError ) == "C"
elseif ISCHARACTER( xError )
::Print( '<tr><td>ERROR MESSAGE:</td><td>' + xError + '</td></tr>' )
endif
@@ -560,10 +560,10 @@ STATIC FUNCTION HtmlScript( xVal, cKey )
if valtype( cVal ) == "H"
if ( nPos := hb_HPos( cVal, "src" ) ) != 0
cVal := hb_HValueAt( cVal, nPos )
if valtype( cVal ) == "C"
if ISCHARACTER( cVal )
cVal := { cVal }
endif
if valtype( cVal ) == "A"
if ISARRAY( cVal )
cTmp := ""
ascan( cVal, { |cFile| cTmp += '<script src="' + cFile + '" type="text/javascript">' + _CRLF } )
cVal := cTmp
@@ -571,10 +571,10 @@ STATIC FUNCTION HtmlScript( xVal, cKey )
endif
if ( nPos := hb_HPos( cVal, "var" ) ) != 0
cVal := hb_HValueAt( cVal, nPos )
if valtype( cVal ) == "C"
if ISCHARACTER( cVal )
cVal := { cVal }
endif
if valtype( cVal ) == "A"
if ISARRAY( cVal )
cTmp := ""
ascan( cVal, { |cVar| cTmp += cVar } )
cVal := '<script type="text/javascript">' + _CRLF + '<!--' + _CRLF + cTmp + _CRLF + '-->' + _CRLF + '</script>' + _CRLF
@@ -601,10 +601,10 @@ STATIC FUNCTION HtmlStyle( xVal, cKey )
if valtype( cVal ) == "H"
if ( nPos := hb_HPos( cVal, "src" ) ) != 0
cVal := hb_HValueAt( cVal, nPos )
if valtype( cVal ) == "C"
if ISCHARACTER( cVal )
cVal := { cVal }
endif
if valtype( cVal ) == "A"
if ISARRAY( cVal )
cTmp := ""
ascan( cVal, { |cFile| cTmp += '<link rel="StyleSheet" href="' + cFile + '" type="text/css" />' + _CRLF } )
cVal := cTmp
@@ -612,10 +612,10 @@ STATIC FUNCTION HtmlStyle( xVal, cKey )
endif
if ( nPos := hb_HPos( cVal, "var" ) ) != 0
cVal := hb_HValueAt( cVal, nPos )
if valtype( cVal ) == "C"
if ISCHARACTER( cVal )
cVal := { cVal }
endif
if valtype( cVal ) == "A"
if ISARRAY( cVal )
cTmp := ""
ascan( cVal, { |cVar| cTmp += cVar } )
cVal := '<style type="text/css">' + _CRLF + '<!--' + _CRLF + cTmp + _CRLF + '-->' + _CRLF + '</style>' + _CRLF

5
harbour/contrib/hbtip/encoder.prg
View File

@@ -64,12 +64,13 @@
#include "hbclass.ch"
#include "fileio.ch"
#include "tip.ch"
#include "common.ch"
FUNCTION TIp_GetEncoder( cModel )
LOCAL oEncoder
IF !( Valtype( cModel ) == "C" )
IF ! ISCHARACTER( cModel )
cModel := "as-is"
ENDIF
@@ -108,7 +109,7 @@ ENDCLASS
METHOD New( cModel ) class TIPEncoder
IF !( Valtype( cModel ) == "C" )
IF ! ISCHARACTER( cModel )
cModel := "as-is"
ENDIF
::cName := cModel

8
harbour/contrib/hbtip/ftpcln.prg
View File

@@ -179,10 +179,10 @@ METHOD New( oUrl,lTrace, oCredentials) CLASS tIPClientFTP
if !file("ftp.log")
::nHandle := fcreate("ftp.log")
else
while file(cFile+LTrim(str(Int(n)))+".log")
while file(cFile+hb_NToS(Int(n))+".log")
n++
enddo
::cLogFile:= cFile+LTrim(str(Int(n)))+".log"
::cLogFile:= cFile+hb_NToS(Int(n))+".log"
::nHandle := fcreate(::cLogFile)
endif
endif
@@ -242,7 +242,7 @@ METHOD GetReply() CLASS tIPClientFTP
// now, if the reply has a "-" as fourth character, we need to proceed...
DO WHILE .not. Empty(cRep) .and. SubStr( cRep, 4, 1 ) == "-"
::cReply := ::InetRecvLine( ::SocketCon, @nLen, 128 )
cRep := IIf(ValType(::cReply) == "C", ::cReply, "")
cRep := IIf(ISCHARACTER(::cReply), ::cReply, "")
ENDDO
// 4 and 5 are error codes
@@ -661,7 +661,7 @@ METHOD MPUT( cFileSpec, cAttr ) CLASS tIPClientFTP
LOCAL nCount := 0
LOCAL cStr := ""
IF !( Valtype( cFileSpec ) == "C" )
IF ! ISCHARACTER( cFileSpec )
RETURN 0
ENDIF

4
harbour/contrib/hbtip/httpcln.prg
View File

@@ -171,7 +171,7 @@ METHOD Post( cPostData, cQuery ) CLASS tIPClientHTTP
ENDIF
::InetSendall( ::SocketCon, "Content-Length: " + ;
LTrim(Str( Len( cData ) ) ) + ::cCRLF )
hb_NToS( Len( cData ) ) + ::cCRLF )
// End of header
::InetSendall( ::SocketCon, ::cCRLF )
@@ -597,7 +597,7 @@ METHOD PostMultiPart( cPostData, cQuery ) CLASS tIPClientHTTP
ENDIF
::InetSendall( ::SocketCon, "Content-Length: " + ;
LTrim(Str( Len( cData ) ) ) + ::cCRLF )
hb_NToS( Len( cData ) ) + ::cCRLF )
// End of header
::InetSendall( ::SocketCon, ::cCRLF )

19
harbour/contrib/hbtip/mail.prg
View File

@@ -61,6 +61,7 @@
*/
#include "hbclass.ch"
#include "common.ch"
CLASS TipMail
DATA hHeaders
@@ -534,29 +535,29 @@ RETURN cBound
METHOD setHeader( cSubject, cFrom, cTo, cCC, cBCC ) CLASS TipMail
LOCAL aTo, aCC, aBCC, i, imax
IF !( Valtype( csubject ) == "C" )
IF ! ISCHARACTER( csubject )
cSubject := ""
ENDIF
IF !( Valtype( cFrom ) == "C" )
IF ! ISCHARACTER( cFrom )
RETURN .F.
ENDIF
IF Valtype( cTo ) == "C"
IF ISCHARACTER( cTo )
aTo := { cTo }
ELSEIF Valtype( cTo ) == "A"
ELSEIF ISARRAY( cTo )
aTo := cTo
ENDIF
IF Valtype( cCC ) == "C"
IF ISCHARACTER( cCC )
aCC := { cCC }
ELSEIF Valtype( cCC ) == "A"
ELSEIF ISARRAY( cCC )
aCC := cCC
ENDIF
IF Valtype( cBCC ) == "C"
IF ISCHARACTER( cBCC )
aBCC := { cBCC }
ELSEIF Valtype( cBCC ) == "A"
ELSEIF ISARRAY( cBCC )
aBCC := cBCC
ENDIF
@@ -642,7 +643,7 @@ METHOD detachFile( cPath ) CLASS TipMail
RETURN .F.
ENDIF
IF Valtype( cPath ) == "C"
IF ISCHARACTER( cPath )
cFileName := StrTran( cPath + cDelim + cFileName, cDelim+cDelim, cDelim )
ENDIF

7
harbour/contrib/hbtip/popcln.prg
View File

@@ -57,6 +57,7 @@
*/
#include "hbclass.ch"
#include "common.ch"
/**
* Inet service manager: pop3
@@ -96,10 +97,10 @@ METHOD New( oUrl, lTrace, oCredentials ) CLASS tIPClientPOP
if !file("pop3.log")
::nHandle := fcreate("pop3.log")
else
while file(cFile+alltrim(str(n,2))+".log")
while file(cFile+hb_NToS(n)+".log")
n++
enddo
::nHandle := fcreate(cFile+alltrim(str(n,2))+".log")
::nHandle := fcreate(cFile+hb_NToS(n)+".log")
endif
endif
@@ -361,7 +362,7 @@ RETURN -1
METHOD retrieveAll( lDelete )
LOCAL aMails, i, imax, cMail
IF !( Valtype( lDelete ) == "L" )
IF ! ISLOGICAL( lDelete )
lDelete := .F.
ENDIF

14
harbour/contrib/hbtip/sendmail.prg
View File

@@ -116,7 +116,7 @@ FUNCTION HB_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF
ENDIF
// cTo
IF Valtype( aTo ) == "A"
IF ISARRAY( aTo )
IF Len( aTo ) > 1
FOR EACH cTo IN aTo
IF cTo:__enumIndex() != 1
@@ -135,27 +135,27 @@ FUNCTION HB_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF
// CC (Carbon Copy)
IF Valtype(aCC) =="A"
IF ISARRAY( aCC )
IF Len(aCC) >0
FOR EACH cTmp IN aCC
cCC += cTmp + ","
NEXT
cCC := Substr( cCC, 1, Len( cCC ) - 1 )
ENDIF
ELSEIF Valtype(aCC) =="C"
ELSEIF ISCHARACTER(aCC)
cCC := Alltrim( aCC )
ENDIF
// BCC (Blind Carbon Copy)
IF Valtype(aBCC) =="A"
IF ISARRAY(aBCC)
IF Len(aBCC)>0
FOR EACH cTmp IN aBCC
cBCC += cTmp + ","
NEXT
cBCC := Substr( cBCC, 1, Len( cBCC ) - 1 )
ENDIF
ELSEIF Valtype(aBCC) =="C"
ELSEIF ISCHARACTER(aBCC)
cBCC := Alltrim( aBCC )
ENDIF
@@ -309,10 +309,10 @@ FUNCTION HB_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aF
FOR EACH aThisFile IN AFiles
IF Valtype( aThisFile ) == "C"
IF ISCHARACTER( aThisFile )
cFile := aThisFile
cData := Memoread( cFile ) + chr( 13 ) + chr( 10 )
ELSEIF Valtype( aThisFile ) == "A" .AND. Len( aThisFile ) >= 2
ELSEIF ISARRAY( aThisFile ) .AND. Len( aThisFile ) >= 2
cFile := aThisFile[ 1 ]
cData := aThisFile[ 2 ] + chr( 13 ) + chr( 10 )
ELSE

4
harbour/contrib/hbtip/smtpcln.prg
View File

@@ -98,10 +98,10 @@ local n:=1
if !file("sendmail.log")
::nHandle := fcreate("sendmail.log")
else
while file(cFile+alltrim(str(n,4))+".log")
while file(cFile+hb_NToS(n)+".log")
n++
enddo
::nHandle := fcreate(cFile+alltrim(str(n,4))+".log")
::nHandle := fcreate(cFile+hb_NToS(n)+".log")
endif
endif
RETURN Self

30
harbour/contrib/hbtip/thtml.prg
View File

@@ -143,7 +143,7 @@ METHOD new( cHtmlString ) CLASS THtmlDocument
' </body>' + hb_OSNewLine() +;
'</html>'
IF !( Valtype( cHtmlString ) == "C" )
IF ! ISCHARACTER( cHtmlString )
::root := THtmlNode():new( cEmptyHtmlDoc )
ELSE
IF .NOT. "<html" $ Lower( Left( cHtmlString, 4096 ) )
@@ -600,7 +600,7 @@ METHOD new( oParent, cTagName, cAttrib, cContent ) CLASS THtmlNode
THtmlInit(.T.)
ENDIF
IF Valtype( oParent ) == "C"
IF ISCHARACTER( oParent )
// a HTML string is passed -> build new tree of objects
IF Chr(9) $ oParent
oParent := StrTran( oParent, Chr(9), Chr(32) )
@@ -610,11 +610,11 @@ METHOD new( oParent, cTagName, cAttrib, cContent ) CLASS THtmlNode
::htmlTagType := THtmlTagType( "_root_" )
::htmlContent := {}
::parseHtml( P_PARSER( oParent ) )
ELSEIF Valtype( oParent ) == "O"
ELSEIF ISOBJECT( oParent )
// a HTML object is passed -> we are in the course of building an object tree
::root := oParent:root
::parent := oParent
IF Valtype( cAttrib ) == "C"
IF ISCHARACTER( cAttrib )
IF Right( cAttrib, 1 ) == "/"
cAttrib := Stuff( cAttrib, Len( cAttrib ), 1, " " )
::htmlEndTagName := "/"
@@ -664,7 +664,7 @@ RETURN hb_bitAnd( ::htmlTagType[2], CM_OPT ) > 0
// checks if this is a node (leafs contain no further nodes, e.g. <br>,<hr>,_text_)
METHOD isNode CLASS THtmlNode
RETURN Valtype( ::htmlContent ) == "A" .AND. Len( ::htmlContent ) > 0
RETURN ISARRAY( ::htmlContent ) .AND. Len( ::htmlContent ) > 0
// checks if this is a block node that must be closed with an ending tag: eg: <table></table>, <ul></ul>
@@ -904,7 +904,7 @@ METHOD insertBefore( oTHtmlNode ) CLASS THtmlNode
::root:_document:changed := .T.
ENDIF
IF Valtype( ::parent:htmlContent ) == "A"
IF ISARRAY( ::parent:htmlContent )
hb_AIns( ::parent:htmlContent, 1, oTHtmlNode, .T. )
ENDIF
RETURN oTHtmlNode
@@ -947,7 +947,7 @@ METHOD delete() CLASS THtmlNode
::root:_document:changed := .T.
ENDIF
IF Valtype( ::parent:htmlContent ) == "A"
IF ISARRAY( ::parent:htmlContent )
nPos := AScan( ::parent:htmlContent, self )
hb_ADel( ::parent:htmlContent, nPos, .T. )
ENDIF
@@ -959,7 +959,7 @@ RETURN self
// returns first node in subtree (.F.) or first node of entire tree (.T.)
METHOD firstNode( lRoot ) CLASS THtmlNode
IF !( Valtype( lRoot ) == "L" )
IF ! ISLOGICAL( lRoot )
lRoot := .F.
ENDIF
@@ -975,7 +975,7 @@ RETURN IIF( Empty(::htmlContent), NIL, ::htmlContent[1] )
// returns last node in subtree (.F.) or last node of entire tree (.T.)
METHOD lastNode( lRoot ) CLASS THtmlNode
LOCAL aNodes
IF !( Valtype( lRoot ) == "L" )
IF ! ISLOGICAL( lRoot )
lRoot := .F.
ENDIF
IF ::htmlTagName == "_text_"
@@ -1051,7 +1051,7 @@ METHOD toString( nIndent ) CLASS THtmlNode
ENDIF
ENDIF
IF Valtype( ::htmlContent ) == "A"
IF ISARRAY( ::htmlContent )
#ifdef FOR_EACH_NESTING_LIMIT_IS_ONLY_16_AND_FAR_TOO_SMALL
imax := Len( ::htmlContent )
@@ -1071,7 +1071,7 @@ METHOD toString( nIndent ) CLASS THtmlNode
NEXT
#endif
ELSEIF Valtype( ::htmlContent ) == "C"
ELSEIF ISCHARACTER( ::htmlContent )
cHtml += ::htmlContent
ENDIF
@@ -1096,7 +1096,7 @@ METHOD attrToString() CLASS THtmlNode
IF ::htmlAttributes == NIL
cAttr := ""
ELSEIF Valtype( ::htmlAttributes ) == "C"
ELSEIF ISCHARACTER( ::htmlAttributes )
cAttr := " " + ::htmlAttributes
ELSE
@@ -1250,7 +1250,7 @@ METHOD getAttributes() CLASS THtmlNode
::htmlAttributes := {=>}
hb_hCaseMatch( ::htmlAttributes, .F. )
ELSEIF Valtype( ::htmlAttributes ) == "C"
ELSEIF ISCHARACTER( ::htmlAttributes )
IF ::htmlAttributes == "/"
::htmlAttributes := {=>}
hb_hCaseMatch( ::htmlAttributes, .F. )
@@ -1495,7 +1495,7 @@ METHOD findNodesByTagName( cName, nOrdinal ) CLASS THtmlNode
ENDIF
NEXT
IF Valtype( nOrdinal ) == "N"
IF ISNUMBER( nOrdinal )
IF nOrdinal < 1 .OR. nOrdinal > Len( aRet )
RETURN NIL
ENDIF
@@ -1596,7 +1596,7 @@ RETURN cLeftPart
FUNCTION THtmlInit( lInit )
IF Valtype( lInit ) == "L" .AND. .NOT. lInit
IF ISLOGICAL( lInit ) .AND. .NOT. lInit
saHtmlAttr := NIL
shTagTypes := NIL
saHtmlAnsiEntities := NIL

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

@@ -209,9 +209,9 @@ function tp_open( nPort, nInSize, nOutSize, nBaud, nData, cParity, nStop, cPortn
a full name on cPortName
*/
#ifdef __PLATFORM__LINUX
cPortname := AllTrim( cPortname ) + iif( ValType( nPort ) == "N", AllTrim( Str( nPort - 1 ) ), "" )
cPortname := AllTrim( cPortname ) + iif( ISNUMBER( nPort ), hb_NToS( nPort - 1 ), "" )
#else
cPortname := AllTrim( cPortname ) + iif( ValType( nPort ) == "N", AllTrim( Str( nPort ) ), "" )
cPortname := AllTrim( cPortname ) + iif( ISNUMBER( nPort ), hb_NToS( nPort ), "" )
#endif
#ifdef __PLATFORM__LINUX
@@ -388,7 +388,7 @@ function tp_recvto( nPort, cDelim, nMaxlen, nTimeout )
return ""
endif
if !( ValType( cDelim ) == "C" ) .OR. Empty( cDelim )
if ! ISCHARACTER( cDelim ) .OR. Empty( cDelim )
return ""
endif
@@ -775,7 +775,7 @@ return s_aPorts[ nPort, TPFP_OC ]
static function isport( nPort )
if valtype( nPort ) != "N" .or. nPort < 1 .or. nPort > TP_MAXPORTS
if ! ISNUMBER( nPort ) .OR. nPort < 1 .OR. nPort > TP_MAXPORTS
return .f.
endif

22
harbour/contrib/hbwin/win_reg.prg
View File

@@ -141,20 +141,20 @@ FUNCTION w32_regWrite( cRegPath, xValue )
FUNCTION QueryRegistry( nHKEYHandle, cKeyName, cEntryName, xValue, lSetIt )
LOCAL xKey := GetRegistry( nHKEYHandle, cKeyName, cEntryName )
LOCAL cValType := VALTYPE( xValue )
LOCAL cValType := ValType( xValue )
LOCAL rVal
DEFAULT lSetIT TO .F.
IF cValType == "L"
xValue := IIF( xValue, 1, 0 )
cValType := VALTYPE( xValue )
xValue := iif( xValue, 1, 0 )
cValType := ValType( xValue )
ELSEIF cValType == "D"
xValue := DTOS( xValue )
cValType := VALTYPE( xValue )
xValue := DToS( xValue )
cValType := ValType( xValue )
ENDIF
rVal := ( xKey != NIL .AND. xValue != NIL .AND. cValType == VALTYPE( xKey ) .AND. xValue == xKey )
rVal := ( xKey != NIL .AND. xValue != NIL .AND. cValType == ValType( xKey ) .AND. xValue == xKey )
IF ! rVal .AND. lSetIt
rVal := SetRegistry( nHKEYHandle, cKeyName, cEntryName, xValue )
ENDIF
@@ -178,9 +178,9 @@ FUNCTION GetRegistry( nHKEYHandle, cKeyName, cEntryName )
nValueType == REG_DWORD_LITTLE_ENDIAN .OR. ;
nValueType == REG_DWORD_BIG_ENDIAN .OR. ;
nValueType == REG_BINARY
xRetVal := BIN2U( xRetVal )
xRetVal := Bin2U( xRetVal )
ELSE
xRetVal := STRTRAN( xRetVal, CHR( 0 ) )
xRetVal := StrTran( xRetVal, Chr( 0 ) )
ENDIF
ENDIF
@@ -202,15 +202,15 @@ FUNCTION SetRegistry( nHKEYHandle, cKeyName, cEntryName, xValue )
IF win32_RegCreateKeyEx( nHKEYHandle, cKeyName, 0, 0, 0, KEY_SET_VALUE, 0, @nKeyHandle, @nResult ) == ERROR_SUCCESS
/* no support for Arrays, Codeblock ... */
cType := VALTYPE( xValue )
cType := ValType( xValue )
DO CASE
CASE cType == "L"
nValueType := REG_DWORD
cName := IIF( xValue, 1, 0 )
cName := iif( xValue, 1, 0 )
CASE cType == "D"
nValueType := REG_SZ
cName := DTOS( xValue )
cName := DToS( xValue )
CASE cType == "N"
nValueType := REG_DWORD
cName := xValue

32
harbour/contrib/hbwin/win_tole.prg
View File

@@ -216,7 +216,7 @@ METHOD New( uObj, cClass, cLicense ) CLASS TOleAuto
RETURN HB_ExecFromArray( Self, "_New", HB_aParams() )
ENDIF
IF ValType( uObj ) == 'C'
IF ISCHARACTER( uObj )
::hObj := CreateOleObject( uObj, , cLicense )
IF OleError() != 0
@@ -252,11 +252,11 @@ METHOD New( uObj, cClass, cLicense ) CLASS TOleAuto
ENDIF
::cClassName := uObj
ELSEIF ValType( uObj ) == 'N'
ELSEIF ISNUMBER( uObj )
OleAddRef( uObj )
::hObj := uObj
IF ValType( cClass ) == 'C'
IF ISCHARACTER( cClass )
::cClassName := cClass
ELSE
::cClassName := LTrim( Str( uObj ) )
@@ -298,7 +298,7 @@ METHOD GetActiveObject( cClass ) CLASS TOleAuto
LOCAL oErr
IF ValType( cClass ) == 'C'
IF ISCHARACTER( cClass )
::hObj := GetOleObject( cClass )
IF OleError() != 0
@@ -352,7 +352,7 @@ METHOD OleCollection( xIndex, xValue ) CLASS TOleAuto
RETURN ::Item( xIndex )
ENDIF
IF ValType( xIndex ) == 'N' .AND. xIndex < 0
IF ISNUMBER( xIndex ) .AND. xIndex < 0
xIndex += ( ::Count + 1 )
ENDIF
@@ -380,7 +380,7 @@ METHOD OleValuePlus( xArg ) CLASS TOleAuto
oErr:CanSubstitute := .T.
oErr:Description := "argument error"
oErr:GenCode := EG_ARG
oErr:Operation := '+'
oErr:Operation := "+"
oErr:Severity := ES_ERROR
oErr:SubCode := 1081
oErr:SubSystem := "BASE"
@@ -405,7 +405,7 @@ METHOD OleValueMinus( xArg ) CLASS TOleAuto
oErr:CanSubstitute := .T.
oErr:Description := "argument error"
oErr:GenCode := EG_ARG
oErr:Operation := '-'
oErr:Operation := "-"
oErr:Severity := ES_ERROR
oErr:SubCode := 1082
oErr:SubSystem := "BASE"
@@ -430,7 +430,7 @@ METHOD OleValueMultiply( xArg ) CLASS TOleAuto
oErr:CanSubstitute := .T.
oErr:Description := "argument error"
oErr:GenCode := EG_ARG
oErr:Operation := '*'
oErr:Operation := "*"
oErr:Severity := ES_ERROR
oErr:SubCode := 1083
oErr:SubSystem := "BASE"
@@ -455,7 +455,7 @@ METHOD OleValueDivide( xArg ) CLASS TOleAuto
oErr:CanSubstitute := .T.
oErr:Description := "argument error"
oErr:GenCode := EG_ARG
oErr:Operation := '/'
oErr:Operation := "/"
oErr:Severity := ES_ERROR
oErr:SubCode := 1084
oErr:SubSystem := "BASE"
@@ -480,7 +480,7 @@ METHOD OleValueModulus( xArg ) CLASS TOleAuto
oErr:CanSubstitute := .T.
oErr:Description := "argument error"
oErr:GenCode := EG_ARG
oErr:Operation := '%'
oErr:Operation := "%"
oErr:Severity := ES_ERROR
oErr:SubCode := 1085
oErr:SubSystem := "BASE"
@@ -505,7 +505,7 @@ METHOD OleValueInc() CLASS TOleAuto
oErr:CanSubstitute := .T.
oErr:Description := "argument error"
oErr:GenCode := EG_ARG
oErr:Operation := '++'
oErr:Operation := "++"
oErr:Severity := ES_ERROR
oErr:SubCode := 1086
oErr:SubSystem := "BASE"
@@ -530,7 +530,7 @@ METHOD OleValueDec() CLASS TOleAuto
oErr:CanSubstitute := .T.
oErr:Description := "argument error"
oErr:GenCode := EG_ARG
oErr:Operation := '--'
oErr:Operation := "--"
oErr:Severity := ES_ERROR
oErr:SubCode := 1087
oErr:SubSystem := "BASE"
@@ -555,7 +555,7 @@ METHOD OleValuePower( xArg ) CLASS TOleAuto
oErr:CanSubstitute := .T.
oErr:Description := "argument error"
oErr:GenCode := EG_ARG
oErr:Operation := '^'
oErr:Operation := "^"
oErr:Severity := ES_ERROR
oErr:SubCode := 1088
oErr:SubSystem := "BASE"
@@ -580,7 +580,7 @@ METHOD OleValueEqual( xArg ) CLASS TOleAuto
oErr:CanSubstitute := .T.
oErr:Description := "argument error"
oErr:GenCode := EG_ARG
oErr:Operation := '='
oErr:Operation := "="
oErr:Severity := ES_ERROR
oErr:SubCode := 1085
oErr:SubSystem := "BASE"
@@ -605,7 +605,7 @@ METHOD OleValueExactEqual( xArg ) CLASS TOleAuto
oErr:CanSubstitute := .T.
oErr:Description := "argument error"
oErr:GenCode := EG_ARG
oErr:Operation := '=='
oErr:Operation := "=="
oErr:Severity := ES_ERROR
oErr:SubCode := 1085
oErr:SubSystem := "BASE"
@@ -630,7 +630,7 @@ METHOD OleValueNotEqual( xArg ) CLASS TOleAuto
oErr:CanSubstitute := .T.
oErr:Description := "argument error"
oErr:GenCode := EG_ARG
oErr:Operation := '!='
oErr:Operation := "!="
oErr:Severity := ES_ERROR
oErr:SubCode := 1085
oErr:SubSystem := "BASE"

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

@@ -51,6 +51,7 @@
*/
#include "cstruct.ch"
#include "common.ch"
#include "hboo.ch"
#include "error.ch"
#include "xhb.ch"
@@ -104,10 +105,10 @@ Function __ActiveStructure( cStructure, nAlign )
// In most cases we can simply ignore the redefinition, by returning a FAKED Structure Array!
//TraceLog( "Redefinition of C Structure: " + cStructure )
RETURN ( s_aActiveStructure := { cStructure, NIL, {}, {}, IIF( ValType( nAlign ) == "N", nAlign, 8 ) } )
RETURN ( s_aActiveStructure := { cStructure, NIL, {}, {}, iif( ISNUMBER( nAlign ), nAlign, 8 ) } )
END
aAdd( s_aClasses, { cStructure, NIL, {}, {}, IIF( ValType( nAlign ) == "N", nAlign, 8 ) } )
aAdd( s_aClasses, { cStructure, NIL, {}, {}, iif( ISNUMBER( nAlign ), nAlign, 8 ) } )
//TraceLog( "Registered: " + cStructure, s_aClasses[-1][5] )
s_aActiveStructure := atail(s_aClasses)
@@ -525,7 +526,7 @@ RETURN QSelf()
//---------------------------------------------------------------------------//
STATIC Function Buffer( Buffer, lAdopt )
IF ValType( Buffer ) == "C"
IF ISCHARACTER( Buffer )
IF Len( Buffer ) < QSelf():SizeOf
//TraceLog( Buffer )
Buffer := PadR( Buffer, QSelf():SizeOf, Chr(0) )
@@ -535,7 +536,7 @@ STATIC Function Buffer( Buffer, lAdopt )
QSelf():DeValue( lAdopt )
ENDIF
IF ValType( QSelf():InternalBuffer ) != "C"
IF ! ISCHARACTER( QSelf():InternalBuffer )
QSelf():InternalBuffer := QSelf():Value()
ENDIF
@@ -572,7 +573,7 @@ STATIC Function DeValue( lAdopt )
//aEval( QSelf(), {|xVal| aAdd( aValues, xVal ) }, 1, Len( QSelf() ) - CLASS_PROPERTIES )
IF ValType( Buffer ) != "C" .OR. Len( Buffer ) == 0
IF ! ISCHARACTER( Buffer ) .OR. Len( Buffer ) == 0
//TraceLog( "EMPTY Buffer passed to " + ProcName() )
ELSEIF Len( Buffer ) < QSelf():SizeOf
//TraceLog( "Should have been caught at ::Buffer()!!!", Buffer )

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

@@ -70,6 +70,8 @@
* [druzus]
*/
#include "common.ch"
FUNCTION DirectoryRecurse( cPath, cAttr )
LOCAL aResult
@@ -77,7 +79,7 @@ FUNCTION DirectoryRecurse( cPath, cAttr )
hb_FNameSplit( cPath, @cFilePath, @cMask, @cExt )
cMask += cExt
IF !ValType( cAttr ) == "C"
IF ! ISCHARACTER( cAttr )
cAttr := ""
ENDIF
/* The trick with StrTran() below if for strict xHarbour

2
harbour/contrib/xhb/hbcompat.ch
View File

@@ -175,7 +175,7 @@
#xtranslate CStr([<x,...>]) => hb_CStr(<x>)
#xtranslate IsDirectory(<x>) => hb_DirExists(<x>)
#xtranslate SecondsSleep([<x,...>]) => hb_idleSleep(<x>)
#xtranslate NetName(<n>) => iif( ValType( <n> ) == "N" .AND. <n> == 1, hb_UserName(), NetName() )
#xtranslate NetName(<n>) => iif( hb_isNumeric( <n> ) .AND. <n> == 1, hb_UserName(), NetName() )
#xtranslate FileSize(<x>) => hb_FSize(<x>)
#xtranslate WildMatch([<x,...>]) => hb_WildMatch(<x>)
#xtranslate hb_DeserialNext(<x>) => hb_Deserialize(<x>)

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

@@ -191,9 +191,9 @@ FUNCTION HB_BldLogMsg( ... )
LOCAL cMsg := ""
FOR EACH xVar IN HB_aParams()
IF ValType( xVar ) == "N"
IF ISNUMBER( xVar )
cMsg += AllTrim( CStr( xVar ) )
ELSEIF ValType( xVar ) != "C"
ELSEIF ! ISCHARACTER( xVar )
cMsg += CStr( xVar )
ELSE
cMsg += xVar

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

@@ -362,12 +362,12 @@ METHOD New( xElem, nStyle ) CLASS TXmlDocument
::oRoot := TXmlNode():New( HBXML_TYPE_DOCUMENT )
ELSE
SWITCH ValType( xElem )
CASE 'O'
CASE "O"
::oRoot := xElem
EXIT
CASE 'N'
CASE 'C'
CASE "N"
CASE "C"
::oRoot := TXmlNode():New( HBXML_TYPE_DOCUMENT )
::Read( xElem, nStyle )
ENDSWITCH

10
harbour/source/rdd/usrrdd/rdds/arrayrdd.prg
View File

@@ -1013,18 +1013,18 @@ STATIC FUNCTION HB_Decode(...)
// Ok because I have no other value than default, I will check if it is a complex value
// like an array or an hash, so I can get it to decode values
IF xDefault <> NIL .AND. ;
( ValType( xDefault ) == "A" .OR. ;
( ISARRAY( xDefault ) .OR. ;
ValType( xDefault ) == "H" )
// If it is an array I will restart this function creating a linear call
IF ValType( xDefault ) == "A" .AND. Len( xDefault ) > 0
IF ISARRAY( xDefault ) .AND. Len( xDefault ) > 0
// I can have a linear array like { 1, "A", 2, "B", 3, "C" }
// or an array of array couples like { { 1, "A" }, { 2, "B" }, { 3, "C" } }
// first element tell me what type is
// couples of values
IF ValType( xDefault[ 1 ] ) == "A"
IF ISARRAY( xDefault[ 1 ] )
//// If i have an array as default, this contains couples of key / value
//// so I have to convert in a linear array
@@ -1033,7 +1033,7 @@ STATIC FUNCTION HB_Decode(...)
// Check if array has a default value, this will be last value and has a value
// different from an array
IF !( ValType( xDefault[ nLen ] ) == "A" )
IF ! ISARRAY( ValType( xDefault[ nLen ] )
aParams := Array( ( nLen - 1 ) * 2 )
@@ -1102,7 +1102,7 @@ STATIC FUNCTION HB_Decode(...)
// Check if value exists (valtype of values MUST be same of xVal,
// otherwise I will get a runtime error)
// TODO: Have I to check also between different valtypes, jumping different ?
nPos := aScan( aValues, {|e| e == xVal } )
nPos := AScan( aValues, {|e| e == xVal } )
IF nPos == 0 // Not Found, returning default

5
harbour/source/rdd/usrrdd/rdds/hscdx.prg
View File

@@ -62,6 +62,7 @@
#include "hbusrrdd.ch"
#include "fileio.ch"
#include "dbinfo.ch"
#include "common.ch"
ANNOUNCE HSCDX
@@ -192,9 +193,9 @@ FUNCTION HSX_CLOSE( xHSX )
IF USED() .AND. RDDNAME() == "HSCDX"
aWData:= USRRDD_AREADATA( SELECT() )
IF VALTYPE( xHSX ) == "N"
IF ISNUMBER( xHSX )
nSlot := ASCAN( aWData[ 2 ], xHSX )
ELSEIF VALTYPE( xHSX ) == "C"
ELSEIF ISCHARACTER( xHSX )
nSlot := ASCAN( aWData[ 3 ], { |_1| _1 == xHSX } )
ELSE
nSlot := 0

3
harbour/source/rdd/usrrdd/rdds/rlcdx.prg
View File

@@ -60,6 +60,7 @@
#include "rddsys.ch"
#include "hbusrrdd.ch"
#include "common.ch"
ANNOUNCE RLCDX
@@ -154,7 +155,7 @@ STATIC FUNCTION RLCDX_LOCK( nWA, aLockInfo )
STATIC FUNCTION RLCDX_UNLOCK( nWA, xRecID )
LOCAL aWData := USRRDD_AREADATA( nWA ), i
IF VALTYPE( xRecID ) == "N" .AND. xRecID > 0
IF ISNUMBER( xRecID ) .AND. xRecID > 0
IF ( i:= ASCAN( aWData[ 2 ], { |x| x[ 1 ] == xRecID } ) ) != 0
IF --aWData[ 2, i, 2 ] > 0
RETURN SUCCESS

2
harbour/utils/hbdoc/genchm.prg
View File

@@ -779,7 +779,7 @@ oChm:writeText("<br>") //:endpar()
ENDIF
IF !lClassDoc .AND. lEof
IF VALTYPE( oChm ) == "O"
IF ISOBJECT( oChm )
oChm:WriteText( "</p></dd></dl>" )
oChm:Close()
ENDIF

14
harbour/utils/hbdoc/genhtm.prg
View File

@@ -789,7 +789,7 @@ oHtm:writeText("<br>") //:endpar()
ENDIF
IF !lClassDoc .AND. lEof
IF VALTYPE( oHtm ) == "O"
IF ISOBJECT( oHtm )
oHtm:WriteText( "</p></dd></dl>" )
oHtm:Close()
ENDIF
@@ -1981,13 +1981,13 @@ METHOD New( cFile, aMetaContents ) CLASS THTML
FCLOSE( Self:nHandle )
ENDIF
IF VALTYPE( cFile ) != NIL .AND. VALTYPE( cFile ) == "C"
IF ISCHARACTER( cFile )
Self:cFile := LOWER( cFile )
Self:nHandle := FCREATE( Self:cFile )
ENDIF
FWRITE( Self:nHandle, "<HTML>" + CRLF )
FWRITE( Self:nHandle, "<HEAD>" + CRLF )
if Valtype(aMetaContents) != NIL .and. Valtype(aMetaContents)=="A"
if ISARRAY( aMetaContents )
For nCount:=1 to len(aMetaContents)
Self:WriteMetaTag(aMetaContents[nCount,1],aMetaContents[nCount,2])
NEXT
@@ -2104,12 +2104,12 @@ METHOD NewChm( cFile, aMetaContents, cFuncName ) CLASS THTML
FCLOSE( Self:nHandle )
ENDIF
IF VALTYPE( cFile ) != NIL .AND. VALTYPE( cFile ) == "C"
IF ISCHARACTER( cFile )
Self:cFile := LOWER( cFile )
Self:nHandle := FCREATE( Self:cFile )
ENDIF
FWRITE( Self:nHandle, "<HTML>" + CRLF +"<HEAD>" +CRLF)
if Valtype(aMetaContents) != NIL .and. Valtype(aMetaContents)=="A"
if ISARRAY( aMetaContents )
For nCount:=1 to len(aMetaContents)
Self:WriteMetaTag(aMetaContents[nCount,1],aMetaContents[nCount,2])
NEXT
@@ -2124,7 +2124,7 @@ METHOD NewChm( cFile, aMetaContents, cFuncName ) CLASS THTML
RETURN Self
method ADDOBJECT(cType,cClassId) Class THTML
IF VALTYPE(cClassId)!=NIL .and. VALTYPE(cClassId)=="C"
IF ISCHARACTER( cClassId )
FWRITE( Self:nHandle,'<Object type="'+cType+'" classid="'+cClassId+'">'+CRLF)
ELSE
FWRITE( Self:nHandle,'<Object type="'+ cType +'">'+CRLF)
@@ -2145,7 +2145,7 @@ METHOD NewContent( cFile ) CLASS THTML
FCLOSE( Self:nHandle )
ENDIF
IF VALTYPE( cFile ) != NIL .AND. VALTYPE( cFile ) == "C"
IF ISCHARACTER( cFile )
Self:cFile := LOWER( cFile )
Self:nHandle := FCREATE( Self:cFile )
ENDIF

2
harbour/utils/hbdoc/genng.prg
View File

@@ -1798,7 +1798,7 @@ ENDCLASS
METHOD new( cFile ) CLASS TNortonGuide
IF VALTYPE( cFile ) != NIL .AND. VALTYPE( cFile ) == "C"
IF ISCHARACTER( cFile )
Self:cFile := LOWER( cFile )
Self:nHandle := FCREATE( Self:cFile )
ENDIF

2
harbour/utils/hbdoc/genos2.prg
View File

@@ -1359,7 +1359,7 @@ METHOD New( cFile ) CLASS TOs2
Self:nRef := 1
ENDIF
IF VALTYPE( cFile ) != NIL .AND. VALTYPE( cFile ) == "C"
IF ISCHARACTER( cFile )
Self:cFile := LOWER( cFile )
Self:nHandle := FCREATE( Self:cFile )
ENDIF

2
harbour/utils/hbdoc/genrtf.prg
View File

@@ -1354,7 +1354,7 @@ ENDCLASS
METHOD new( cFile ) CLASS TRTF
IF VALTYPE( cFile ) != NIL .AND. VALTYPE( cFile ) == "C"
IF ISCHARACTER( cFile )
Self:cFile := LOWER( cFile )
Self:nHandle := FCREATE( Self:cFile )
ENDIF

2
harbour/utils/hbdoc/gentrf.prg
View File

@@ -561,7 +561,7 @@ ENDCLASS
METHOD NEW( cFile ) CLASS TTROFF
IF VALTYPE( cFile ) != NIL .AND. VALTYPE( cFile ) == "C"
IF ISCHARACTER( cFile )
Self:cFile := LOWER( cFile )
Self:nHandle := FCREATE( Self:cFile )
ENDIF

24
harbour/utils/hbmake/hbmake.prg
View File

@@ -316,11 +316,11 @@ FUNCTION MAIN()
IF ParseMakeFile( cFile ) == RET_ERR
IF s_nLang == LANG_PT /* portuguese brazilian */
cAlertMsg := "<" + cFile + "> nÆo pode ser aberto. FERROR(" + Ltrim(Str(FError())) + "). O HbMake ser  fechado."
cAlertMsg := "<" + cFile + "> nÆo pode ser aberto. FERROR(" + hb_NToS(FError()) + "). O HbMake ser  fechado."
ELSEIF s_nLang == LANG_ES /* spanish */
cAlertMsg := "<" + cFile + "> no pode ser abierto. FERROR(" + Ltrim(Str(FError())) + "). Lo HbMake ser  cerrado."
cAlertMsg := "<" + cFile + "> no pode ser abierto. FERROR(" + hb_NToS(FError()) + "). Lo HbMake ser  cerrado."
ELSE /* english */
cAlertMsg := "<" + cFile + "> cannot be opened. FERROR(" + Ltrim(Str(FError())) + "). HbMake will close."
cAlertMsg := "<" + cFile + "> cannot be opened. FERROR(" + hb_NToS(FError()) + "). HbMake will close."
ENDIF
ShowHelp( cAlertMsg )
@@ -977,7 +977,7 @@ FUNCTION SetBuild( nFHandle )
ELSE /* english */
cAlertMsg := "<"+s_cLinkFile + "> cannot be created."
ENDIF
ALERT( cAlertMsg+" FERROR ("+Ltrim(Str(FError()))+")" )
ALERT( cAlertMsg+" FERROR ("+hb_NToS(FError())+")" )
RETURN NIL
ENDIF
@@ -1475,7 +1475,7 @@ FUNCTION CreateMakeFile( cFile, lCreateAndCompile )
cAlertMsg := "<"+cFile + "> cannot be openned for editing."
ENDIF
ALERT( cAlertMsg+" FERROR ("+LTrim(Str(FError()))+")" )
ALERT( cAlertMsg+" FERROR ("+hb_NToS(FError())+")" )
RESTSCREEN( ,,,, cOldScreen )
RETURN RET_ERR
@@ -1622,7 +1622,7 @@ FUNCTION CreateMakeFile( cFile, lCreateAndCompile )
cAlertMsg := "<"+cFile + "> cannot be created."
ENDIF
ALERT( cAlertMsg+" FERROR ("+Ltrim(Str(FError()))+")" )
ALERT( cAlertMsg+" FERROR ("+hb_NToS(FError())+")" )
RESTSCREEN( ,,,, cOldScreen )
RETURN RET_ERR
@@ -1650,7 +1650,7 @@ FUNCTION CreateMakeFile( cFile, lCreateAndCompile )
cAlertMsg := "<"+cFile + "> cannot be created."
ENDIF
ALERT( cAlertMsg+" FERROR ("+Ltrim(Str(FError()))+")" )
ALERT( cAlertMsg+" FERROR ("+hb_NToS(FError())+")" )
RESTSCREEN( ,,,, cOldScreen )
RETURN RET_ERR
@@ -3357,7 +3357,7 @@ FUNCTION CreateLibMakeFile( cFile )
cAlertMsg := "<"+cFile + "> cannot be openned for edition."
ENDIF
ALERT( cAlertMsg+" FERROR ("+LTrim(Str(FError()))+")" )
ALERT( cAlertMsg+" FERROR ("+hb_NToS(FError())+")" )
RETURN RET_ERR
else
@@ -3435,7 +3435,7 @@ FUNCTION CreateLibMakeFile( cFile )
cAlertMsg := "<"+cFile + "> cannot be openned for edition."
ENDIF
ALERT( cAlertMsg+" FERROR ("+Ltrim(Str(FError()))+")" )
ALERT( cAlertMsg+" FERROR ("+hb_NToS(FError())+")" )
RETURN RET_ERR
@@ -3477,7 +3477,7 @@ FUNCTION CreateLibMakeFile( cFile )
cAlertMsg := "<"+cFile + "> cannot be created."
ENDIF
ALERT( cAlertMsg+" FERROR ("+Ltrim(Str(FError()))+")" )
ALERT( cAlertMsg+" FERROR ("+hb_NToS(FError())+")" )
RETURN RET_ERR
@@ -3505,7 +3505,7 @@ FUNCTION CreateLibMakeFile( cFile )
cAlertMsg := "<"+cFile + "> cannot be created."
ENDIF
ALERT( cAlertMsg+" FERROR ("+Ltrim(Str(FError()))+")" )
ALERT( cAlertMsg+" FERROR ("+hb_NToS(FError())+")" )
RETURN RET_ERR
@@ -4029,7 +4029,7 @@ FUNCTION SetBuildLib( nFHandle )
cAlertMsg := "<"+s_cLinkFile + "> cannot be created."
ENDIF
ALERT( cAlertMsg+" FERROR ("+Ltrim(Str(FError()))+")" )
ALERT( cAlertMsg+" FERROR ("+hb_NToS(FError())+")" )
RETURN RET_ERR
ENDIF