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

2008-11-08 16:18 UTC+0200 Viktor Szakats (harbour.01 syenar hu)

Browse Source 
* source/rtl/version.c
    + Implemented:
      hb_version( HB_VERSION_BUILD_DATE )
      hb_version( HB_VERSION_BUILD_TIME )

  * source/rtl/gtwvt/gtwvt.c
    * Formatting.

  * source/rdd/hbsix/sxini.prg
  * source/rdd/hbsix/sxcompat.prg
  * source/rdd/hbsix/sxtrig.prg
    * Formatted to std Harbour. Generated pcode unchanged.

  * ChangeLog
    * Marked finished TODO/TOFIXes as [DONE].
This commit is contained in:
Viktor Szakats
2008-11-08 15:20:16 +00:00
parent 4b5a545545
commit 50e1dd9efc
6 changed files with 484 additions and 433 deletions
Download Patch File Download Diff File Expand all files Collapse all files

33
harbour/ChangeLog
View File

@@ -8,6 +8,23 @@
2008-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org)
*/
2008-11-08 16:18 UTC+0200 Viktor Szakats (harbour.01 syenar hu)
* source/rtl/version.c
+ Implemented:
hb_version( HB_VERSION_BUILD_DATE )
hb_version( HB_VERSION_BUILD_TIME )
* source/rtl/gtwvt/gtwvt.c
* Formatting.
* source/rdd/hbsix/sxini.prg
* source/rdd/hbsix/sxcompat.prg
* source/rdd/hbsix/sxtrig.prg
* Formatted to std Harbour. Generated pcode unchanged.
* ChangeLog
* Marked finished TODO/TOFIXes as [DONE].
2008-11-08 14:15 UTC+0200 Viktor Szakats (harbour.01 syenar hu)
* bin/hbmk.bat
+ Added C_USR support for OpenWatcom.
@@ -86,7 +103,7 @@
2008-11-08 10:25 UTC+0200 Viktor Szakats (harbour.01 syenar hu)
* source/vm/set.c
+ Implemented rest of hb_setSetItem() values.
; TODO: Please review.
; TODO: Please review. [DONE]
! Fixed HB_SET_FILECASE and HB_SET_DIRCASE to not allow
invalid numeric values to be set.
! Added missing 'break;' to hb_setSetItem2();
@@ -95,7 +112,7 @@
! Fixed a few places where '+' operator was used
instead of '|'.
* Minor opt/formatting.
; TOFIX: The window positioning bug is still to be solved.
; TOFIX: The window positioning bug is still to be solved. [DONE]
2008-11-07 23:39 UTC+0100 Francesco Saverio Giudice (info fsgiudice com)
* source/rdd/usrrdd/rdds/arrayrdd.prg
@@ -160,9 +177,9 @@
* harbour/source/vm/set.c
+ added hb_setSetItem2() C function for SETs which needs two parameters
+ added support for HB_SET_DECIMALS and HB_SET_EPOCH in hb_setSetItem()
Still 22 SETs are marked as TODO
Still 22 SETs are marked as TODO [DONE]
+ added internal function hb_setSetFile() for HB_SET_ALTFILE,
HB_SET_EXTRAFILE, HB_SET_PRINTFILE - function body marked as TODO.
HB_SET_EXTRAFILE, HB_SET_PRINTFILE - function body marked as TODO [DONE].
I'll implement it later.
2008-11-07 00:39 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
@@ -395,7 +412,7 @@
* contrib/hbwhat/whtlv.c
! Fixed memory leak.
! Fixed to use hb_strncpy() instead of unsafe lstrcpy().
TOFIX: The destination address isn't properly allocated and the
; TOFIX: The destination address isn't properly allocated and the
size of it is unknown, so this modification is not enough.
; TOFIX: Unicode conversion, buffer allocation for item.pszText.
@@ -1031,7 +1048,7 @@
- HB_VER_C_USR
- HB_VER_L_USR
- HB_VER_PRG_USR
; TOFIX: Some term anomalies regarding 'REVISION'.
; TOFIX: Some term anomalies regarding 'REVISION'. [DONE]
* source/vm/runner.c
* Minor formatting and added "s_" prefix to static var.
@@ -1321,7 +1338,7 @@
; NOTE: If there are no objections, I'd remove the
__ARCH*BIT__ and __*ENDIAN__ predefined macros,
as these can be misleading on some systems.
; TODO: Implement HB_V_DATE and HB_V_TIME.
; TODO: Implement HB_V_DATE and HB_V_TIME. [DONE]
; TODO: Add HB_MTVM() functionality. [DONE]
; TODO: Add __PLATFORM__* equivalent. [DONE]
; TODO: Add HB_OS_UNIX_COMPATIBLE equivalent. [DONE]
@@ -1442,7 +1459,7 @@
* source/rdd/hbsix/sxtrig.prg
* 'end' -> 'endswitch'
% 'ValType() == "x"' -> 'IS*()'
; TODO: Reformat to Harbour standards.
; TODO: Reformat to Harbour standards. [DONE]
2008-10-27 21:43 UTC+0200 Viktor Szakats (harbour.01 syenar hu)
* contrib/Makefile

653
harbour/source/rdd/hbsix/sxcompat.prg
View File

@@ -86,471 +86,470 @@
#include "ord.ch"
#include "hbsxdef.ch"
function sxChar( nLen, xKeyVal )
FUNCTION sxChar( nLen, xKeyVal )
switch valType( xKeyVal )
case "C"
case "M"
exit
case "N"
xKeyVal := str( xKeyVal )
exit
case "D"
xKeyVal := dtos( xKeyVal )
exit
case "L"
SWITCH ValType( xKeyVal )
CASE "C"
CASE "M"
EXIT
CASE "N"
xKeyVal := Str( xKeyVal )
EXIT
CASE "D"
xKeyVal := DToS( xKeyVal )
EXIT
CASE "L"
xKeyVal := iif( xKeyVal, "T", "F" )
exit
otherwise
xKeyVal := iif( ISNUMBER( nLen ), "", space( 10 ) )
exit
endswitch
EXIT
OTHERWISE
xKeyVal := iif( ISNUMBER( nLen ), "", Space( 10 ) )
EXIT
ENDSWITCH
return iif( ISNUMBER( nLen ), padr( ltrim( xKeyVal ), nLen ), xKeyVal )
RETURN iif( ISNUMBER( nLen ), PadR( LTrim( xKeyVal ), nLen ), xKeyVal )
function sxNum( xKeyVal )
FUNCTION sxNum( xKeyVal )
switch valType( xKeyVal )
case "N"
exit
case "C"
case "M"
xKeyVal := val( xKeyVal )
exit
case "D"
xKeyVal := xKeyVal - ctod( "" )
exit
case "L"
SWITCH ValType( xKeyVal )
CASE "N"
EXIT
CASE "C"
CASE "M"
xKeyVal := Val( xKeyVal )
EXIT
CASE "D"
xKeyVal := xKeyVal - hb_SToD()
EXIT
CASE "L"
xKeyVal := iif( xKeyVal, 1, 0 )
exit
otherwise
EXIT
OTHERWISE
xKeyVal := 0.00
exit
endswitch
EXIT
ENDSWITCH
return xKeyVal
RETURN xKeyVal
FUNCTION sxDate( xKeyVal )
function sxDate( xKeyVal )
SWITCH ValType( xKeyVal )
CASE "D"
EXIT
CASE "C"
CASE "M"
xKeyVal := CToD( xKeyVal )
EXIT
CASE "N"
xKeyVal := hb_SToD() + xKeyVal
EXIT
OTHERWISE
xKeyVal := hb_SToD()
EXIT
ENDSWITCH
switch valType( xKeyVal )
case "D"
exit
case "C"
case "M"
xKeyVal := ctod( xKeyVal )
exit
case "N"
xKeyVal := ctod( "" ) + xKeyVal
exit
otherwise
xKeyVal := ctod( "" )
exit
endswitch
RETURN xKeyVal
return xKeyVal
FUNCTION sxLog( xKeyVal )
function sxLog( xKeyVal )
switch valType( xKeyVal )
case "L"
exit
case "C"
case "M"
switch xKeyVal
case "T"; case "t"; case "Y"; case "y"
case ".T."; case ".t."; case ".Y."; case ".y."
xKeyVal := .t.
exit
otherwise
xKeyVal := .f.
exit
endswitch
exit
case "N"
SWITCH ValType( xKeyVal )
CASE "L"
EXIT
CASE "C"
CASE "M"
SWITCH xKeyVal
CASE "T"; CASE "t"; CASE "Y"; CASE "y"
CASE ".T."; CASE ".t."; CASE ".Y."; CASE ".y."
xKeyVal := .T.
EXIT
OTHERWISE
xKeyVal := .F.
EXIT
ENDSWITCH
EXIT
CASE "N"
xKeyVal := xKeyVal != 0
exit
otherwise
xKeyVal := .f.
exit
endswitch
EXIT
OTHERWISE
xKeyVal := .F.
EXIT
ENDSWITCH
return xKeyVal
RETURN xKeyVal
function Sx_Compress( xVal )
local cType := valType( xVal ), xRetVal
if cType $ "CM"
FUNCTION Sx_Compress( xVal )
LOCAL cType := ValType( xVal ), xRetVal
IF cType $ "CM"
xRetVal := _sx_strCompress( xVal )
elseif cType == "A"
xRetVal := array( len( xVal ) )
ELSEIF cType == "A"
xRetVal := Array( Len( xVal ) )
aEval( xVal, { |x| xRetVal := Sx_Compress( x ) } )
else
ELSE
xRetVal := xVal
endif
return xRetVal
ENDIF
RETURN xRetVal
function Sx_Decompress( xVal )
local cType := valType( xVal ), xRetVal
if cType $ "CM"
FUNCTION Sx_Decompress( xVal )
LOCAL cType := ValType( xVal ), xRetVal
IF cType $ "CM"
xRetVal := _sx_strDecompress( xVal )
elseif cType == "A"
xRetVal := array( len( xVal ) )
ELSEIF cType == "A"
xRetVal := Array( Len( xVal ) )
aEval( xVal, { |x| xRetVal := Sx_Decompress( x ) } )
else
ELSE
xRetVal := xVal
endif
return xRetVal
ENDIF
RETURN xRetVal
function Sx_TagInfo( cIndex )
local aInfo, nOrds, nFirst, i
FUNCTION Sx_TagInfo( cIndex )
LOCAL aInfo, nOrds, nFirst, i
if Used() .AND. ( nOrds := OrdCount( cIndex ) ) > 0
aInfo := array( nOrds, 6 )
if ISCHARACTER( cIndex )
IF Used() .AND. ( nOrds := OrdCount( cIndex ) ) > 0
aInfo := Array( nOrds, 6 )
IF ISCHARACTER( cIndex )
nFirst := dbOrderInfo( DBOI_BAGORDER, cIndex )
nOrds += nFirst - 1
else
ELSE
nFirst := 1
endif
for i := nFirst to nOrds
ENDIF
FOR i := nFirst TO nOrds
aInfo[ i, 1 ] := ordName( i )
aInfo[ i, 2 ] := ordKey( i )
aInfo[ i, 3 ] := ordFor( i )
aInfo[ i, 4 ] := ordIsUnique( i )
aInfo[ i, 5 ] := ordDescend( i )
aInfo[ i, 6 ] := ordCustom( i )
next
else
NEXT
ELSE
aInfo := {}
endif
return aInfo
ENDIF
RETURN aInfo
function Sx_TagCount( xIndex )
local nTags := 0, cIndex, nOrder
if Used()
if ISNUMBER( xIndex )
FUNCTION Sx_TagCount( xIndex )
LOCAL nTags := 0, cIndex, nOrder
IF Used()
IF ISNUMBER( xIndex )
nOrder := Sx_TagOrder( 1, xIndex )
if nOrder != 0
IF nOrder != 0
cIndex := dbOrderInfo( DBOI_FULLPATH,, nOrder )
endif
elseif ISCHARACTER( xIndex ) .and. !Empty( xIndex )
ENDIF
ELSEIF ISCHARACTER( xIndex ) .AND. !Empty( xIndex )
cIndex := xIndex
else
ELSE
cIndex := dbOrderInfo( DBOI_FULLPATH )
endif
if !Empty( cIndex )
ENDIF
IF !Empty( cIndex )
nTags := ordCount( cIndex )
endif
endif
return nTags
ENDIF
ENDIF
RETURN nTags
function Sx_Tags( xIndex )
local aTagNames := {}, nOrder, nTags
if Used()
if ISNUMBER( xIndex )
FUNCTION Sx_Tags( xIndex )
LOCAL aTagNames := {}, nOrder, nTags
IF Used()
IF ISNUMBER( xIndex )
nOrder := Sx_TagOrder( 1, xIndex )
elseif ISCHARACTER( xIndex ) .and. !Empty( xIndex )
ELSEIF ISCHARACTER( xIndex ) .AND. !Empty( xIndex )
nOrder := dbOrderInfo( DBOI_BAGORDER, xIndex )
else
ELSE
nOrder := OrdNumber()
endif
if nOrder != 0
ENDIF
IF nOrder != 0
nTags := ordCount( dbOrderInfo( DBOI_FULLPATH,, nOrder ) )
while --nTags >= 0
aadd( aTagNames, ordName( nOrder++ ) )
enddo
endif
endif
return aTagNames
DO WHILE --nTags >= 0
AAdd( aTagNames, ordName( nOrder++ ) )
ENDDO
ENDIF
ENDIF
RETURN aTagNames
function Sx_SetTag( xTag, xIndex )
local lRet := .f., nOrder := 0, nOldOrd, cIndex
if Used() .and. valtype( xTag ) $ "CN"
if ISNUMBER( xTag )
if empty( xIndex ) .or. !valtype( xIndex ) $ "CN"
FUNCTION Sx_SetTag( xTag, xIndex )
LOCAL lRet := .F., nOrder := 0, nOldOrd, cIndex
IF Used() .AND. ValType( xTag ) $ "CN"
IF ISNUMBER( xTag )
IF Empty( xIndex ) .OR. !ValType( xIndex ) $ "CN"
nOrder := xTag
elseif ISCHARACTER( xIndex )
if xTag >= 1 .and. xTag <= ordCount( xIndex )
ELSEIF ISCHARACTER( xIndex )
IF xTag >= 1 .AND. xTag <= ordCount( xIndex )
nOrder := dbOrderInfo( DBOI_BAGORDER, xIndex ) + xTag - 1
endif
else
ENDIF
ELSE
nOrder := Sx_TagOrder( xTag, xIndex )
endif
else
if empty( xIndex ) .or. !valtype( xIndex ) $ "CN"
ENDIF
ELSE
IF Empty( xIndex ) .OR. !ValType( xIndex ) $ "CN"
nOrder := OrdNumber( xTag )
elseif ISCHARACTER( xIndex )
ELSEIF ISCHARACTER( xIndex )
nOrder := Sx_TagOrder( xTag, xIndex )
else
ELSE
nOrder := Sx_TagOrder( 1, xIndex )
if nOrder != 0
IF nOrder != 0
cIndex := dbOrderInfo( DBOI_FULLPATH,, nOrder )
if empty( cIndex )
IF Empty( cIndex )
nOrder := 0
else
ELSE
nOrder := Sx_TagOrder( xTag, cIndex )
endif
endif
endif
endif
if nOrder != 0
ENDIF
ENDIF
ENDIF
ENDIF
IF nOrder != 0
nOldOrd := OrdNumber()
OrdSetFocus( nOrder )
lRet := nOrder == OrdSetFocus()
if ! lRet
IF ! lRet
OrdSetFocus( nOldOrd )
endif
elseif empty( xTag )
ENDIF
ELSEIF Empty( xTag )
OrdSetFocus( 0 )
lRet := .t.
endif
endif
return lRet
lRet := .T.
ENDIF
ENDIF
RETURN lRet
function Sx_KillTag( xTag, xIndex )
local lRet := .f., nOrder, cIndex
if ISLOGICAL( xTag )
if xTag
if empty( xIndex )
FUNCTION Sx_KillTag( xTag, xIndex )
LOCAL lRet := .F., nOrder, cIndex
IF ISLOGICAL( xTag )
IF xTag
IF Empty( xIndex )
cIndex := Sx_IndexName()
elseif ISNUMBER( xIndex )
ELSEIF ISNUMBER( xIndex )
cIndex := Sx_IndexName( 1, xIndex )
elseif ISCHARACTER( xIndex )
ELSEIF ISCHARACTER( xIndex )
nOrder := dbOrderInfo( DBOI_BAGORDER, xIndex )
if nOrder != 0
IF nOrder != 0
cIndex := dbOrderInfo( DBOI_FULLPATH,, nOrder )
endif
endif
if !empty( cIndex )
if ordBagClear( cIndex )
ENDIF
ENDIF
IF !Empty( cIndex )
IF ordBagClear( cIndex )
lRet := ferase( cIndex ) != -1
endif
endif
endif
else
if ISNUMBER( xTag )
if empty( xIndex ) .or. !valtype( xIndex ) $ "CN"
ENDIF
ENDIF
ENDIF
ELSE
IF ISNUMBER( xTag )
IF Empty( xIndex ) .OR. !ValType( xIndex ) $ "CN"
nOrder := xTag
elseif ISCHARACTER( xIndex )
if xTag >= 1 .and. xTag <= ordCount( xIndex )
ELSEIF ISCHARACTER( xIndex )
IF xTag >= 1 .AND. xTag <= ordCount( xIndex )
nOrder := dbOrderInfo( DBOI_BAGORDER, xIndex ) + xTag - 1
else
ELSE
nOrder := 0
endif
else
ENDIF
ELSE
nOrder := Sx_TagOrder( xTag, xIndex )
endif
else
if empty( xIndex ) .or. !valtype( xIndex ) $ "CN"
ENDIF
ELSE
IF Empty( xIndex ) .OR. !ValType( xIndex ) $ "CN"
nOrder := OrdNumber( xTag )
elseif ISCHARACTER( xIndex )
ELSEIF ISCHARACTER( xIndex )
nOrder := Sx_TagOrder( xTag, xIndex )
else
ELSE
nOrder := Sx_TagOrder( 1, xIndex )
if nOrder != 0
IF nOrder != 0
cIndex := dbOrderInfo( DBOI_FULLPATH,, nOrder )
if empty( cIndex )
IF Empty( cIndex )
nOrder := 0
else
ELSE
nOrder := Sx_TagOrder( xTag, cIndex )
endif
endif
endif
endif
if nOrder != 0
ENDIF
ENDIF
ENDIF
ENDIF
IF nOrder != 0
lRet := ordDestroy( nOrder )
endif
endif
return lRet
ENDIF
ENDIF
RETURN lRet
function Sx_FileOrder()
return dbOrderInfo( DBOI_BAGNUMBER )
FUNCTION Sx_FileOrder()
RETURN dbOrderInfo( DBOI_BAGNUMBER )
function Sx_SetFileOrd( nIndex )
return iif( ISNUMBER( nIndex ), ;
OrdSetFocus( Sx_TagOrder( 1, nIndex ) ), ;
OrdSetFocus() )
FUNCTION Sx_SetFileOrd( nIndex )
RETURN iif( ISNUMBER( nIndex ), ;
OrdSetFocus( Sx_TagOrder( 1, nIndex ) ), ;
OrdSetFocus() )
function RDD_Count()
return len( RDDList() )
FUNCTION RDD_Count()
RETURN Len( RDDList() )
function RDD_Name( nRDD )
local aRDD
FUNCTION RDD_Name( nRDD )
LOCAL aRDD
if ISNUMBER( nRDD ) .and. nRDD >= 1
IF ISNUMBER( nRDD ) .AND. nRDD >= 1
aRDD := RDDList()
if nRDD <= len( aRDD )
return aRDD[ nRDD ]
endif
endif
return ""
IF nRDD <= Len( aRDD )
RETURN aRDD[ nRDD ]
ENDIF
ENDIF
RETURN ""
function RDD_Info( xID )
local aInfo, cRDD
FUNCTION RDD_Info( xID )
LOCAL aInfo, cRDD
if ISNUMBER( xID )
if !empty( alias( xID ) )
IF ISNUMBER( xID )
IF !Empty( Alias( xID ) )
( xID )->( RDDName() )
endif
elseif ISCHARACTER( xID )
cRDD := upper( alltrim( xID ) )
if ascan( RDDList(), {|x| upper( x ) == cRDD } ) == 0
ENDIF
ELSEIF ISCHARACTER( xID )
cRDD := Upper( AllTrim( xID ) )
IF ascan( RDDList(), {|x| Upper( x ) == cRDD } ) == 0
cRDD := NIL
endif
elseif xID == NIL
ENDIF
ELSEIF xID == NIL
cRDD := rddSetDefault()
endif
ENDIF
if empty( cRDD )
IF Empty( cRDD )
aInfo := {}
else
aInfo := array( 6 )
ELSE
aInfo := Array( 6 )
aInfo[ 1 ] := cRDD
aInfo[ 2 ] := .t.
aInfo[ 3 ] := rddInfo( RDDI_TABLEEXT, NIL, cRDD )
aInfo[ 4 ] := rddInfo( RDDI_ORDBAGEXT, NIL, cRDD )
aInfo[ 5 ] := rddInfo( RDDI_ORDEREXT, NIL, cRDD )
aInfo[ 6 ] := rddInfo( RDDI_MEMOEXT, NIL, cRDD )
endif
return aInfo
aInfo[ 2 ] := .T.
aInfo[ 3 ] := hb_rddInfo( RDDI_TABLEEXT, NIL, cRDD )
aInfo[ 4 ] := hb_rddInfo( RDDI_ORDBAGEXT, NIL, cRDD )
aInfo[ 5 ] := hb_rddInfo( RDDI_ORDEREXT, NIL, cRDD )
aInfo[ 6 ] := hb_rddInfo( RDDI_MEMOEXT, NIL, cRDD )
ENDIF
RETURN aInfo
function Sx_IsDBT( cRDD )
return rddInfo( RDDI_MEMOTYPE, NIL, cRDD ) == DB_MEMO_DBT
FUNCTION Sx_IsDBT( cRDD )
RETURN hb_rddInfo( RDDI_MEMOTYPE, NIL, cRDD ) == DB_MEMO_DBT
function Sx_MemoExt( cNewExt, cRDD )
return rddInfo( RDDI_MEMOEXT, cNewExt, cRDD )
FUNCTION Sx_MemoExt( cNewExt, cRDD )
RETURN hb_rddInfo( RDDI_MEMOEXT, cNewExt, cRDD )
function Sx_MemoBlk( nNewBlock, cRDD )
return rddInfo( RDDI_MEMOBLOCKSIZE, nNewBlock, cRDD )
FUNCTION Sx_MemoBlk( nNewBlock, cRDD )
RETURN hb_rddInfo( RDDI_MEMOBLOCKSIZE, nNewBlock, cRDD )
function Sx_SetMemoBlock( nNewBlock, cRDD )
return rddInfo( RDDI_MEMOBLOCKSIZE, nNewBlock, cRDD )
FUNCTION Sx_SetMemoBlock( nNewBlock, cRDD )
RETURN hb_rddInfo( RDDI_MEMOBLOCKSIZE, nNewBlock, cRDD )
function Sx_StrxCheck( lStrict, cRDD )
return rddInfo( RDDI_STRICTSTRUCT, lStrict, cRDD )
FUNCTION Sx_StrxCheck( lStrict, cRDD )
RETURN hb_rddInfo( RDDI_STRICTSTRUCT, lStrict, cRDD )
function Sx_LockRetry( nRetry, cRDD )
return rddInfo( RDDI_LOCKRETRY, nRetry, cRDD )
FUNCTION Sx_LockRetry( nRetry, cRDD )
RETURN hb_rddInfo( RDDI_LOCKRETRY, nRetry, cRDD )
function Sx_AutoOpen( lAuto, cRDD )
return rddInfo( RDDI_AUTOOPEN, lAuto, cRDD )
FUNCTION Sx_AutoOpen( lAuto, cRDD )
RETURN hb_rddInfo( RDDI_AUTOOPEN, lAuto, cRDD )
function Sx_AutoShare( lAuto, cRDD )
return rddInfo( RDDI_AUTOSHARE, lAuto, cRDD )
FUNCTION Sx_AutoShare( lAuto, cRDD )
RETURN hb_rddInfo( RDDI_AUTOSHARE, lAuto, cRDD )
function Sx_BLOB2File( cFileName, cFldName )
return dbFileGet( cFldName, cFileName, FILEGET_OVERWRITE )
FUNCTION Sx_BLOB2File( cFileName, cFldName )
RETURN dbFileGet( cFldName, cFileName, FILEGET_OVERWRITE )
function Sx_File2BLOB( cFileName, cFldName, nActionCode )
local nAction := 0
if HB_BITAND( nActionCode, BLOB_FILECOMPRESS ) != 0
FUNCTION Sx_File2BLOB( cFileName, cFldName, nActionCode )
LOCAL nAction := 0
IF HB_BITAND( nActionCode, BLOB_FILECOMPRESS ) != 0
nAction := HB_BITOR( nAction, FILEPUT_COMPRESS )
endif
if HB_BITAND( nActionCode, BLOB_FILEENCRYPT ) != 0
ENDIF
IF HB_BITAND( nActionCode, BLOB_FILEENCRYPT ) != 0
nAction := HB_BITOR( nAction, FILEPUT_ENCRYPT )
endif
return dbFileGet( cFldName, cFileName, nAction )
ENDIF
RETURN dbFileGet( cFldName, cFileName, nAction )
function Sx_dbCreate( cFileName, aStruct, cRDD )
local aField, aDbStruct
FUNCTION Sx_dbCreate( cFileName, aStruct, cRDD )
LOCAL aField, aDbStruct
aDbStruct := AClone( aStruct )
for each aField in aDbStruct
switch aField[ 2 ]
case "V"
FOR EACH aField IN aDbStruct
SWITCH aField[ 2 ]
CASE "V"
aField[ 3 ] += 6
exit
case "D"
if aField[ 3 ] == 3
EXIT
CASE "D"
IF aField[ 3 ] == 3
aField[ 2 ] := "V"
endif
exit
case "I"
if aField[ 3 ] == 4
ENDIF
EXIT
CASE "I"
IF aField[ 3 ] == 4
aField[ 2 ] := "V"
endif
exit
endswitch
next
ENDIF
EXIT
ENDSWITCH
NEXT
return dbCreate( cFileName, aDbStruct, cRDD )
RETURN dbCreate( cFileName, aDbStruct, cRDD )
function Sx_VSigLen( xField )
local nResult := 0, nField := 0
FUNCTION Sx_VSigLen( xField )
LOCAL nResult := 0, nField := 0
if Used()
if ISCHARACTER( xField )
IF Used()
IF ISCHARACTER( xField )
nField := FieldPos( xField )
elseif ISNUMBER( xField )
ELSEIF ISNUMBER( xField )
nField := xField
endif
if nField >= 1 .and. nField <= FCount()
ENDIF
IF nField >= 1 .AND. nField <= FCount()
nResult := FieldLen( nField )
if FieldType( nField ) == "V" .and. nResult >= 6
IF FieldType( nField ) == "V" .AND. nResult >= 6
nResult -= 6
endif
endif
endif
ENDIF
ENDIF
ENDIF
return nResult
RETURN nResult
function Sx_VFGet( cExpr, nLen )
FUNCTION Sx_VFGet( cExpr, nLen )
/* Our RDDs does not use any internal flags to cut V-Fields so
* we can simply evaluate given expression */
*/
if Used() .and. PCount() == 2
return padr( &cExpr, nLen )
endif
IF Used() .AND. PCount() == 2
RETURN PadR( &cExpr, nLen )
ENDIF
return NIL
RETURN NIL
function Sx_IsLocked( xRec )
local lResult := .f., xRecord
FUNCTION Sx_IsLocked( xRec )
LOCAL lResult := .F., xRecord
if Used()
xRecord := IIF( xRec == NIL, RecNo(), xRec )
IF Used()
xRecord := iif( xRec == NIL, RecNo(), xRec )
/*
* Don't be confused by function name.
* Even if it looks strange and results are not very usable due
* to possible race condition then this is what SIX3 exactly does.
*/
if Sx_RLock( xRecord )
IF Sx_RLock( xRecord )
Sx_UnLock( xRecord )
else
lResult := .t.
endif
endif
ELSE
lResult := .T.
ENDIF
ENDIF
return lResult
RETURN lResult
function Sx_SetTrigger( nAction, cTriggerName, cRDD /* Harbour extensions */ )
local cPrevTrigger := ""
FUNCTION Sx_SetTrigger( nAction, cTriggerName, cRDD /* Harbour extensions */ )
LOCAL cPrevTrigger := ""
if ISNUMBER( nAction )
if nAction == TRIGGER_PENDING
if ISCHARACTER( cTriggerName )
rddInfo( RDDI_PENDINGTRIGGER, cTriggerName, cRDD )
endif
elseif Used()
IF ISNUMBER( nAction )
IF nAction == TRIGGER_PENDING
IF ISCHARACTER( cTriggerName )
hb_rddInfo( RDDI_PENDINGTRIGGER, cTriggerName, cRDD )
ENDIF
ELSEIF Used()
cPrevTrigger := dbInfo( DBI_TRIGGER )
switch nAction
case TRIGGER_ENABLE
SWITCH nAction
CASE TRIGGER_ENABLE
dbInfo( DBI_TRIGGER, .T. )
exit
case TRIGGER_DISABLE
EXIT
CASE TRIGGER_DISABLE
dbInfo( DBI_TRIGGER, .F. )
exit
case TRIGGER_REMOVE
EXIT
CASE TRIGGER_REMOVE
dbInfo( DBI_TRIGGER, "" )
exit
case TRIGGER_INSTALL
if ISCHARACTER( cTriggerName )
EXIT
CASE TRIGGER_INSTALL
IF ISCHARACTER( cTriggerName )
dbInfo( DBI_TRIGGER, cTriggerName )
endif
exit
endswitch
endif
endif
ENDIF
EXIT
ENDSWITCH
ENDIF
ENDIF
return cPrevTrigger
RETURN cPrevTrigger

118
harbour/source/rdd/hbsix/sxini.prg
View File

@@ -58,99 +58,99 @@
#define HB_SIX_SECTION "SXKEYWORDS"
memvar SxIniInfo
MEMVAR SxIniInfo
static function _sx_INIlogical( cVal )
switch Upper( cVal )
case ".T."
case "TRUE"
case "YES"
case "ON"
return .T.
case ".F."
case "FALSE"
case "NO"
case "OFF"
return .F.
endswitch
return NIL
STATIC FUNCTION _sx_INIlogical( cVal )
SWITCH Upper( cVal )
CASE ".T."
CASE "TRUE"
CASE "YES"
CASE "ON"
RETURN .T.
CASE ".F."
CASE "FALSE"
CASE "NO"
CASE "OFF"
RETURN .F.
ENDSWITCH
RETURN NIL
function _sx_INIinit( nArea )
local cFile, cPath, cName, cExt, cDrive
local xShared, xReadOnly, xAlias, xTrigger
local hIni, item, sect, h, a
FUNCTION _sx_INIinit( nArea )
LOCAL cFile, cPath, cName, cExt, cDrive
LOCAL xShared, xReadOnly, xAlias, xTrigger
LOCAL hIni, item, sect, h, a
/* SIX3 keeps information about ini sections in array[250] stored
* in public variable called "SxIniInfo". This array is indexed
* by workarea number. In Harbour we are using hash arrays.
*/
if Type( "SxIniInfo" ) = "U" /* NOTE: Intentionally using '=' operator */
IF Type( "SxIniInfo" ) = "U" /* NOTE: Intentionally using '=' operator */
public SxIniInfo := {=>}
HB_HCaseMatch( SxIniInfo, .f. )
HB_HCaseMatch( SxIniInfo, .F. )
HB_HAutoAdd( SxIniInfo, HB_HAUTOADD_ASSIGN )
endif
ENDIF
if nArea == NIL
return .f.
endif
IF nArea == NIL
RETURN .F.
ENDIF
cFile := ( nArea )->( dbInfo( DBI_FULLPATH ) )
hb_FNameSplit( cFile, @cPath, @cName, @cExt, @cDrive )
cFile := hb_FNameMerge( cPath, cName, ".ini", cDrive )
hIni := hb_IniRead( cFile, .F.,, .F. )
if !Empty( hIni )
if hb_HHasKey( hIni, HB_SIX_SECTION )
for each item in hIni[ HB_SIX_SECTION ]
switch item:__enumKey()
case "SHARED"
IF !Empty( hIni )
IF hb_HHasKey( hIni, HB_SIX_SECTION )
FOR EACH item IN hIni[ HB_SIX_SECTION ]
SWITCH item:__enumKey()
CASE "SHARED"
xShared := _sx_INIlogical( item )
exit
case "READONLY"
EXIT
CASE "READONLY"
xReadOnly := _sx_INIlogical( item )
exit
case "ALIAS"
EXIT
CASE "ALIAS"
xAlias := item
exit
case "TRIGGER"
EXIT
CASE "TRIGGER"
xTrigger := item
exit
endswitch
next
if xTrigger != NIL
EXIT
ENDSWITCH
NEXT
IF xTrigger != NIL
( nArea )->( Sx_SetTrigger( TRIGGER_INSTALL, xTrigger ) )
endif
ENDIF
_sxOpenInit( nArea, xShared, xReadOnly, xAlias )
endif
ENDIF
/* convert hash array into normal array */
for each item in hIni
if HB_IsHash( item )
FOR EACH item IN hIni
IF hb_isHash( item )
sect := Array( Len( item ) )
for each h, a in item, sect
FOR EACH h, a IN item, sect
a := { h:__enumKey(), h }
next
NEXT
item := sect
endif
next
ENDIF
NEXT
SxIniInfo[ nArea ] := hIni
endif
ENDIF
return .f.
RETURN .F.
function Sx_INIheader( cHeaderName, nArea )
FUNCTION Sx_INIheader( cHeaderName, nArea )
if nArea == NIL
IF nArea == NIL
nArea := Select()
endif
ENDIF
if hb_HHasKey( SxIniInfo, nArea )
if hb_HHasKey( SxIniInfo[ nArea ], cHeaderName )
return SxIniInfo[ nArea, cHeaderName ]
endif
endif
IF hb_HHasKey( SxIniInfo, nArea )
IF hb_HHasKey( SxIniInfo[ nArea ], cHeaderName )
RETURN SxIniInfo[ nArea, cHeaderName ]
ENDIF
ENDIF
return {}
RETURN {}

64
harbour/source/rdd/hbsix/sxtrig.prg
View File

@@ -54,43 +54,43 @@
#include "common.ch"
#include "hbsxdef.ch"
function Sx_DefTrigger( nEvent, nArea, nFieldPos, xTrigVal )
FUNCTION Sx_DefTrigger( nEvent, nArea, nFieldPos, xTrigVal )
HB_SYMBOL_UNUSED( nArea )
HB_SYMBOL_UNUSED( nFieldPos )
HB_SYMBOL_UNUSED( xTrigVal )
switch nEvent
case EVENT_PREUSE
SWITCH nEvent
CASE EVENT_PREUSE
// _sx_INIinit( nArea )
Sx_SetTrigger( TRIGGER_REMOVE )
exit
case EVENT_POSTUSE
exit
case EVENT_UPDATE
exit
case EVENT_APPEND
exit
case EVENT_DELETE
exit
case EVENT_RECALL
exit
case EVENT_PACK
exit
case EVENT_ZAP
exit
case EVENT_PUT
exit
case EVENT_GET
exit
case EVENT_PRECLOSE
exit
case EVENT_POSTCLOSE
exit
case EVENT_PREMEMOPACK
exit
case EVENT_POSTMEMOPACK
exit
endswitch
EXIT
CASE EVENT_POSTUSE
EXIT
CASE EVENT_UPDATE
EXIT
CASE EVENT_APPEND
EXIT
CASE EVENT_DELETE
EXIT
CASE EVENT_RECALL
EXIT
CASE EVENT_PACK
EXIT
CASE EVENT_ZAP
EXIT
CASE EVENT_PUT
EXIT
CASE EVENT_GET
EXIT
CASE EVENT_PRECLOSE
EXIT
CASE EVENT_POSTCLOSE
EXIT
CASE EVENT_PREMEMOPACK
EXIT
CASE EVENT_POSTMEMOPACK
EXIT
ENDSWITCH
return .T.
RETURN .T.

10
harbour/source/rtl/gtwvt/gtwvt.c
View File

@@ -668,7 +668,7 @@ static void hb_gt_wvt_FitSize( PHB_GTWVT pWVT )
top = ( ( wi.bottom - height ) / 2 );
left = ( left < 0 ? 0 : left );
top = ( top < 0 ? 0 : top );
top = ( top < 0 ? 0 : top );
}
SetWindowPos( pWVT->hWnd, NULL, left, top, width, height, SWP_NOZORDER );
@@ -1031,7 +1031,7 @@ static void hb_gt_wvt_MouseEvent( PHB_GTWVT pWVT, UINT message, WPARAM wParam, L
if( rect.left != pWVT->sRectOld.left ||
rect.top != pWVT->sRectOld.top ||
rect.right != pWVT->sRectOld.right ||
rect.bottom != pWVT->sRectOld.bottom )
rect.bottom != pWVT->sRectOld.bottom )
{
#if !defined(HB_WINCE) /* WinCE does not support InvertRgn */
/* Concept forwarded by Andy Wos - thanks. */
@@ -1246,7 +1246,7 @@ static BOOL hb_gt_wvt_KeyEvent( PHB_GTWVT pWVT, UINT message, WPARAM wParam, LPA
}
else if( bCtrl && ( c >= 1 && c <= 26 ) ) /* K_CTRL_A - Z */
{
hb_gt_wvt_AddCharToInputQueue( pWVT, K_Ctrl[c - 1] );
hb_gt_wvt_AddCharToInputQueue( pWVT, K_Ctrl[ c - 1 ] );
}
else
{
@@ -2393,7 +2393,7 @@ static BOOL hb_gt_wvt_Info( PHB_GT pGT, int iType, PHB_GT_INFO pInfo )
HMENU hSysMenu = GetSystemMenu( pWVT->hWnd, FALSE );
if( hSysMenu )
{
EnableMenuItem( hSysMenu, SYS_EV_MARK, MF_BYCOMMAND | ( bNewValue ? MF_ENABLED : MF_GRAYED ) );
EnableMenuItem( hSysMenu, SYS_EV_MARK, MF_BYCOMMAND | ( bNewValue ? MF_ENABLED : MF_GRAYED ) );
pWVT->bSelectCopy = bNewValue;
}
}
@@ -2415,7 +2415,7 @@ static BOOL hb_gt_wvt_Info( PHB_GT pGT, int iType, PHB_GT_INFO pInfo )
HMENU hSysMenu = GetSystemMenu( pWVT->hWnd, FALSE );
if( hSysMenu )
{
EnableMenuItem( hSysMenu, SC_CLOSE, MF_BYCOMMAND | ( bNewValue ? MF_ENABLED : MF_GRAYED ) );
EnableMenuItem( hSysMenu, SC_CLOSE, MF_BYCOMMAND | ( bNewValue ? MF_ENABLED : MF_GRAYED ) );
pWVT->bClosable = bNewValue;
}
}

39
harbour/source/rtl/version.c
View File

@@ -81,8 +81,43 @@ HB_FUNC( HB_VERSION )
case HB_VERSION_PCODE_VER: hb_retni( HB_PCODE_VER ); break;
case HB_VERSION_PCODE_VER_STR: hb_retc_buffer( hb_verPCode() ); break;
case HB_VERSION_BUILD_DATE_STR: hb_retc_buffer( hb_verBuildDate() ); break;
case HB_VERSION_BUILD_DATE: hb_retds( NULL ); break; /* TODO */
case HB_VERSION_BUILD_TIME: hb_retc( NULL ); break; /* TODO */
case HB_VERSION_BUILD_DATE:
{
char * pszBuildDate = hb_verBuildDate();
if( strlen( pszBuildDate ) >= 11 )
{
static const char * s_months[] = { "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" };
char szDate[ 9 ];
int iMonth;
memcpy( szDate, pszBuildDate + 7, 4 );
szDate[ 4 ] = szDate[ 5 ] = '0';
szDate[ 6 ] = pszBuildDate[ 4 ] == ' ' ? '0' : pszBuildDate[ 4 ];
szDate[ 7 ] = pszBuildDate[ 5 ];
szDate[ 8 ] = '\0';
for( iMonth = 11; iMonth >= 0; iMonth-- )
{
if( memcmp( pszBuildDate, s_months[ iMonth ], 3 ) == 0 )
hb_snprintf( szDate + 4, 2, "%02d", iMonth );
}
hb_retds( szDate );
}
else
hb_retds( NULL );
hb_xfree( pszBuildDate );
break;
}
case HB_VERSION_BUILD_TIME:
{
char * pszBuildDate = hb_verBuildDate();
hb_retc( strlen( pszBuildDate ) >= 20 ? pszBuildDate + 12 : NULL );
hb_xfree( pszBuildDate );
break;
}
case HB_VERSION_FLAG_PRG: hb_retc_const( hb_verFlagsPRG() ); break;
case HB_VERSION_FLAG_C: hb_retc_const( hb_verFlagsC() ); break;
case HB_VERSION_FLAG_LINKER: hb_retc_const( hb_verFlagsL() ); break;