Si no es tarde; este es el ejemplo vino en alguna distribuci贸n de Harbour o xHarblour; ya no recuerdo
*****************************************************
* Hash Grammar test
*
* Giancarlo Niccolai (C) 2003
*
* This is a test that demonstrates how to use hashes
*
* $Id: hash.prg,v 1.9 2003/12/13 19:27:00 ronpinkas Exp $
*
PROCEDURE Main()
聽 聽LOCAL hHash, hTemp
聽 聽LOCAL nSum, nLevel, eError
聽 聽LOCAL xKey, xValue, hDest
聽 聽SET DATE TO ITALIAN
聽 聽CLEAR SCREEN
聽 聽@0,0 SAY "*** Hash test ***"
聽 聽? "Giancarlo Niccolai"
聽 聽?
聽 聽* Creation by PP command:
聽 聽* Equivalent to Hash( K1, V1, ... KN, VN )
聽 聽hHash := Hash()
聽 聽HSetPartition( hHash, 2, 2 )
聽 聽/* Insertion by API */
聽 聽hHash["Kval"] = 'StrKey 0'
聽 聽hHash[ 8 ] = 'Num Key 0'
聽 聽HSet( hHash, 4, 聽"Numeric key 1" )
聽 聽HSet( hHash, 2, 聽"Numeric key 2" )
聽 聽HSet( hHash, "Str8", "String key 1" )
聽 聽HSet( hHash, "Str1", "String key 2" )
聽 聽HSet( hHash, CToD("1/1/2003"), "Date key 1" )
聽 聽HSet( hHash, CToD("30/11/2002") , "Date key 2" )
聽 聽? "Standard API compliance test:"
聽 聽? "Hash type:", ValType( hHash )
聽 聽? "Hash length:", Len( hHash )
聽 聽? "Hash value:", ValToPrg( hHash )
聽 聽? "Empty hash value:", ValToPrg( { => } )
聽 聽? "String representation (should be nothing):", {=>}
聽 聽? "Equality of hashes (Success for .T. , .F.): ", hHash == hHash, hHash == {=>}
聽 聽HGetPartition(hHash, @nSum, @nLevel )
聽 聽? "Hash partitioned as: ", nSum, nLevel
聽 聽? "Plus operator: ", ValToPrg( { 1=>1, 'a'=>2} + { 3=>3, 'b'=>4 } )
聽 聽hHash += { 5=> "numkey 3" }
聽 聽? "Plusequal operator (success if Len(hHash) == 9: ", Len(hHash), ",(", hHash[5], ")"
聽 聽hTemp := {'a'=>1, 1=>2, 'c'=>3}
聽 聽? "Minus hash - hash operator: ", ValToPrg( hTemp - { 1=>2, 'c'=>3} )
聽 聽? "Minus hash - array operator: ", ValToPrg( hTemp - { 1, 'a'} )
聽 聽? "Minus hash - item operator: ", ValToPrg( hTemp - 'a' )
聽 聽? "Hash is now: ", ValToPrg( hHash )
聽 聽? "operator kval IN hash", ('Str1' IN hHash)
聽 聽? "operator {=>} IN hash", ({ "Str8" => "String key 1" } IN hHash)
聽 聽? "Turning autoadd off (currently:", HGetAutoAdd( hHash ), ")"
聽 聽HSetAutoAdd( hHash, .F. )
聽 聽TRY
聽 聽 聽 hHash[ 'a very new key' ] := 'a value'
聽 聽 聽 ? "Failure (new key inserted)"
聽 聽CATCH eError
聽 聽 聽 ? "Success: ", eError:description
聽 聽END
聽 聽HSetAutoAdd( hHash, .T. )
聽 聽? "Press a Key to continue"
聽 聽?
聽 聽Inkey(0)
聽 聽? "VM compliance test:"
聽 聽? "Numeric key value hHash[4]:", hHash[4]
聽 聽? "Date key value hHash[CToD('1/1/2003')]:", hHash[CToD('1/1/2003')]
聽 聽? "String key value hHash['Kval']:", hHash['Kval']
聽 聽? "Assign eval hHash['Kval'] := 100", (hHash['Kval'] := 100)
聽 聽? "Assign eval result hHash['Kval']", hHash['Kval']
聽 聽M->iPos := 2
聽 聽? "Memvar test hHash[ m->iPos ]: ", hHash[ m->iPos ]
聽 聽m->hMem := hHash
聽 聽? "Memvar assign m->hMem := hHash, ValType( m->hMem ): ", ValType( m->hMem )
聽 聽TRY
聽 聽 聽 ? "Wrong index test: hHash[Array()]: Failed", hHash[Array()]
聽 聽CATCH eError
聽 聽 聽 ? "Wrong index test: hHash[Array()]: Passed (", eError:description, ")"
聽 聽END
聽 聽HSetCaseMatch( hHash, .F. )
聽 聽? "Hash gramar ':' existing key insensitive:", hHash:kval
聽 聽HSetCaseMatch( hHash, .Y. )
聽 聽? "Hash gramar ':' adding key:", ( hHash:ColonKey := 'Colon value' )
聽 聽? "Hash gramar ':' retreiving key:", hHash:ColonKey
聽 聽? "Hash grammar ':' classname:", hHash:ClassName
聽 聽? "Hash grammar ':' keys:", ValToPrg( hHash:Keys )
聽 聽? "Hash grammar ':' values:", ValToPrg( hHash:Values )
聽 聽? "Press a Key to continue"
聽 聽?
聽 聽Inkey(0)
聽 聽? "HASH api test:"
聽 聽? "HGetPos existing key:", HGetPos( hHash, 2 )
聽 聽? "HGetPos unexisting key:", HGetPos( hHash, 1000 )
聽 聽? "HDel key Str1: (should be ok) "
聽 聽 聽 HDel( hHash, "Str1" )
聽 聽? "HGetKeys: ", ValToPrg( hGetKeys( hHash ) )
聽 聽? "HGetValues: ", ValToPrg( hGetValues( hHash ) )
聽 聽? "HGetKeyAt 3d pos: ", HGetKeyAt( hHash, 3 )
聽 聽? "HGetValueAt 3d pos: ", HGetValueAt( hHash, 3 )
聽 聽? "HGetPairAt 4th pos (as array):", ValToPrg( HGetPairAt( hHash, 4 ) )
聽 聽HGetPairAt( hHash, 4, @xKey, @xValue )
聽 聽? "HGetPairAt 4th pos (as byref):", xKey, xValue
聽 聽? "HDelAt 4th position:"
聽 聽 聽 HDelAt( hHash, 4 )
聽 聽? "Setting 4th value to 'A newer value'"
聽 聽 聽 HSetValueAt( hHash, 4, 'A newer value' )
聽 聽? "Hash is now: ", ValToPrg( hHash )
聽 聽? "Press a Key to continue"
聽 聽?
聽 聽Inkey(0)
聽 聽? "HASH Case insensitive test:"
聽 聽HSetCaseMatch( hHash, .F. )
聽 聽hHash[ 'a' ] := 100
聽 聽TRY
聽 聽 聽 HSetCaseMatch( hHash, .T. )
聽 聽 聽 ? "Sensitivity test failed: ", hHash[ 'A' ]
聽 聽CATCH eError
聽 聽 聽 ? "Sensitivity test Passed (", eError:description, 聽")"
聽 聽END
聽 聽HSetCaseMatch( hHash, .F. )
聽 聽TRY
聽 聽 聽 ? "Insensitivity test passed: ", hHash[ 'A' ]
聽 聽CATCH eError
聽 聽 聽 ? "Insensitivity test Failed (", eError:description, 聽")"
聽 聽END
聽 聽TRY
聽 聽 聽 hHash['A'] := 50
聽 聽 聽 ? "Insensitive assignment (success if 50): ", hHash[ 'a' ]
聽 聽CATCH eError
聽 聽 聽 ? "Insensitivity assignment Failed (", eError:description, 聽")"
聽 聽END
聽 聽? "Press a Key to continue"
聽 聽?
聽 聽Inkey(0)
聽 聽? "HGetPos existing key:", HGetPos( hHash, 2 )
聽 聽? "HGetPos unexisting key:", HGetPos( hHash, 1000 )
聽 聽? "HDel key Str1: (should be ok) "
聽 聽 聽 HDel( hHash, "Str8" )
聽 聽? "HGetKeys: ", ValToPrg( hGetKeys( hHash ) )
聽 聽? "HGetValues: ", ValToPrg( hGetValues( hHash ) )
聽 聽? "HGetKeyAt 3d pos: ", HGetKeyAt( hHash, 3 )
聽 聽? "HGetValueAt 3d pos: ", HGetValueAt( hHash, 3 )
聽 聽? "HGetPairAt 4th pos (as array):", ValToPrg( HGetPairAt( hHash, 4 ) )
聽 聽HGetPairAt( hHash, 4, @xKey, @xValue )
聽 聽? "HGetPairAt 4th pos (as byref):", xKey, xValue
聽 聽? "HDelAt 4th position:"
聽 聽 聽 HDelAt( hHash, 4 )
聽 聽? "Setting 4th value to 'A newer value'"
聽 聽 聽 HSetValueAt( hHash, 4, 'A newer value' )
聽 聽? "Hash is now: ", ValToPrg( hHash )
聽 聽? "Press a Key to continue"
聽 聽?
聽 聽Inkey(0)
聽 聽? "HASH Secondary API test:"
聽 聽? "Scanning for value 'A newer value': ", HScan( hHash, 'A newer value' )
聽 聽? "Scanning for value 'A newer value' using CB: ",;
聽 聽 聽 聽HScan( hHash, {| cKey, cVal| HB_ISSTRING(cVal) .and. cVal == 'A newer value'} )
聽 聽nSum := 0
聽 聽HEval( hHash, { | cKey, cVal|;
聽 聽 聽 聽IIF (HB_ISNUMERIC(cKey), nSum += cKey, )} )
聽 聽? "Eval summing up all the numeric keys :", nSum
聽 聽? "Clone of the hash:", ValToPrg(HClone( hHash ))
聽 聽hDest := { 'A'=> 1, 'b'=>2 }
聽 聽? "Merging hash with { 'a'=> 1, 'b'=>2 }:"
聽 聽? "Result: ", ValToPrg(HCopy( hHash, hDest ))
聽 聽hDest := { 'B'=> 1, 'A'=>2 }
聽 聽? "Merging limited with a codeblock (Only numeric values): "
聽 聽? "Result: ", ValToPrg( HMerge( hDest, hHash, { |cKey, nVal| HB_IsNumeric( nVal ) } ) )
聽 聽* The last "2" means XOR
聽 聽? "Doing a xor merge with the original one (first 4 elements): "
聽 聽? "Result: ", 聽ValToPrg( HCopy( hHash, hDest, , , 2 ) )
聽 聽? "Doing an AND merge with { 'A'=>0, 'B'=>1 } "
聽 聽? "Result: ", 聽ValToPrg( HMerge( hDest, {'A'=>0, 'B'=>1 }, 1) )
聽 聽? "Press a Key to continue"
聽 聽?
聽 聽Inkey(0)