Files
harbour-core/harbour/tests/testdbf.prg
Viktor Szakats 7d17a485e2 2012-10-15 12:20 UTC+0200 Viktor Szakats (harbour syenar.net)
* contrib/hbformat/hbfmtcls.prg
    * new TOFIX:
        ".T.," / ".F.," gets wrongly corrected to ".T. ," / ".F. ,"

  * contrib/hbct/tests/atrepl.prg
  * contrib/hbct/tests/ctwtest.prg
  * contrib/hbct/tests/datetime.prg
  * contrib/hbgd/gdbar.prg
  * contrib/hbgd/gdbarcod.prg
  * contrib/hbgd/tests/barms.prg
  * contrib/hbgd/tests/bartest.prg
  * contrib/hbgd/tests/gdtestcl.prg
  * contrib/hbgd/tests/test_out.prg
  * contrib/hbhpdf/tests/harupdf.prg
  * contrib/hbmisc/fcomma.prg
  * contrib/hbnf/calendar.prg
  * contrib/hbnf/dispmsg.prg
  * contrib/hbnf/floptst.prg
  * contrib/hbnf/ftround.prg
  * contrib/hbnf/mouse1.prg
  * contrib/hbnf/pegs.prg
  * contrib/hbnf/popadder.prg
  * contrib/hbnf/tempfile.prg
  * contrib/hbnf/tests/aading.prg
  * contrib/hbnf/tests/calendar.prg
  * contrib/hbnf/tests/clrsel.prg
  * contrib/hbnf/tests/dispmsg.prg
  * contrib/hbnf/tests/findith.prg
  * contrib/hbnf/tests/menu1.prg
  * contrib/hbnf/tests/tbwhile.prg
  * contrib/hbnf/tests/vertmenu.prg
  * contrib/hbsqlit3/tests/authoriz.prg
  * contrib/hbsqlit3/tests/backup.prg
  * contrib/hbsqlit3/tests/hooks.prg
  * contrib/hbsqlit3/tests/metadata.prg
  * contrib/hbsqlit3/tests/pack.prg
  * contrib/hbsqlit3/tests/sl3_test.prg
  * contrib/hbtip/sendmail.prg
  * contrib/hbtip/tests/base64.prg
  * contrib/hbtip/tests/httpadv.prg
  * contrib/hbtip/thtml.prg
  * contrib/hbtpathy/telepath.prg
  * contrib/hbwin/tests/testole.prg
  * contrib/rddads/tests/datad.prg
  * contrib/rddads/tests/testmg.prg
  * contrib/rddsql/tests/arrayrdd.prg
  * contrib/sddmy/tests/test1.prg
  * contrib/sddoci/tests/test1.prg
  * contrib/sddodbc/tests/test1.prg
  * contrib/sddodbc/tests/test2.prg
  * contrib/sddsqlt3/tests/test1.prg
  * contrib/xhb/dumpvar.prg
  * contrib/xhb/hblog.prg
  * contrib/xhb/trpc.prg
  * contrib/xhb/trpccli.prg
  * contrib/xhb/ttable.prg
  * contrib/xhb/xcstr.prg
  * contrib/xhb/xhberr.prg
  * contrib/xhb/xhbtedit.prg
  * extras/gtwvw/tests/cbtest6.prg
  * extras/gtwvw/tests/drawimg.prg
  * extras/gtwvw/tests/ebtest7.prg
  * extras/gtwvw/tests/maximize.prg
  * extras/gtwvw/tests/prog0.prg
  * extras/gtwvw/tests/prog1.prg
  * extras/gtwvw/tests/prog2.prg
  * extras/gtwvw/tests/wvwtest9.prg
  * extras/hbvpdf/hbvpdf.prg
  * extras/hbvpdf/tests/pdf_demo.prg
  * extras/httpsrv/modules/info.prg
  * extras/httpsrv/modules/showcounter.prg
  * tests/ac_test2.prg
  * tests/adirtest.prg
  * tests/and_or.prg
  * tests/brwpos.prg
  * tests/clasname.prg
  * tests/extend1.prg
  * tests/newrdd.prg
  * tests/testbrw.prg
  * tests/testcdx.prg
  * tests/testdbf.prg
  * tests/transtst.prg
  * tests/tstasort.prg
  * tests/usrrdd/exarr.prg
  * tests/usrrdd/exhsx.prg
    * formatting (mostly fixing one formatting error by hbformat)
2012-10-15 10:24:57 +00:00

190 lines
5.4 KiB
Plaintext

/*
* $Id$
*/
PROCEDURE Main()
LOCAL nI, aStruct := { ;
{ "CHARACTER", "C", 25, 0 }, ;
{ "NUMERIC", "N", 8, 0 }, ;
{ "DOUBLE", "N", 8, 2 }, ;
{ "DATE", "D", 8, 0 }, ;
{ "LOGICAL", "L", 1, 0 }, ;
{ "MEMO1", "M", 10, 0 }, ;
{ "MEMO2", "M", 10, 0 } }
REQUEST DBFCDX
dbCreate( "testdbf", aStruct, "DBFCDX", .T., "MYALIAS" )
? "[" + MYALIAS->MEMO1 + "]"
? "[" + MYALIAS->MEMO2 + "]"
? "-"
MYALIAS->( dbAppend() )
MYALIAS->MEMO1 := "Hello world!"
MYALIAS->MEMO2 := "Harbour power"
? "[" + MYALIAS->MEMO1 + "]"
? "[" + MYALIAS->MEMO2 + "]"
MYALIAS->( dbAppend() )
MYALIAS->MEMO1 := "This is a test for field MEMO1."
MYALIAS->MEMO2 := "This is a test for field MEMO2."
? "[" + MYALIAS->MEMO1 + "]"
? "[" + MYALIAS->MEMO2 + "]"
MYALIAS->NUMERIC := 90
MYALIAS->DOUBLE := 120.138
? "[" + Str( MYALIAS->DOUBLE ) + "]"
? "[" + Str( MYALIAS->NUMERIC ) + "]"
? ""
? "Press any key..."
Inkey( 0 )
? ""
? "Append 50 records with memos..."
FOR nI := 1 TO 50
MYALIAS->( dbAppend() )
MYALIAS->MEMO1 := "This is a very long string. " + ;
"This may seem silly however strings like this are still " + ;
"used. Not by good programmers though, but I've seen " + ;
"stuff like this used for Copyright messages and other " + ;
"long text. What is the point to all of this you'd say. " + ;
"Well I am coming to the point right now, the constant " + ;
"string is limited to 256 characters and this string is " + ;
"a lot bigger. Do you get my drift ? If there is somebody " + ;
"who has read this line upto the very end: Esto es un " + ;
"sombrero grande ridiculo." + Chr( 13 ) + Chr( 10 ) + ;
"/" + Chr( 13 ) + Chr( 10 ) + "[;-)" + Chr( 13 ) + Chr( 10 ) + ;
"\"
NEXT
MYALIAS->( dbCommit() )
? "Records before ZAP:", MYALIAS->( LastRec() )
? "Size of files (data and memo):", Directory( "testdbf.dbf" )[ 1 ][ 2 ], ;
Directory( "testdbf.fpt" )[ 1 ][ 2 ]
MYALIAS->( __dbZap() )
MYALIAS->( dbCommit() )
? "Records after ZAP:", MYALIAS->( LastRec() )
? "Size of files (data and memo):", Directory( "testdbf.dbf" )[ 1 ][ 2 ], ;
Directory( "testdbf.fpt" )[ 1 ][ 2 ]
? "Value of fields MEMO1, MEMO2, DOUBLE and NUMERIC:"
? "[" + MYALIAS->MEMO1 + "]"
? "[" + MYALIAS->MEMO2 + "]"
? "[" + Str( MYALIAS->DOUBLE ) + "]"
? "[" + Str( MYALIAS->NUMERIC ) + "]"
? "Press any key..."
Inkey( 0 )
dbCloseAll()
dbCreate( "testdbf", aStruct, , .T., "MYALIAS" )
FOR nI := 1 TO 10
MYALIAS->( dbAppend() )
MYALIAS->NUMERIC := nI
? "Adding a record", nI
IF nI == 3 .OR. nI == 7
MYALIAS->( dbDelete() )
? "Deleting record", nI
ENDIF
NEXT
MYALIAS->( dbCommit() )
? ""
? "With SET DELETED OFF"
? "Press any key..."
Inkey( 0 )
MYALIAS->( dbGoTop() )
DO WHILE !MYALIAS->( EOF() )
? MYALIAS->NUMERIC
MYALIAS->( dbSkip() )
ENDDO
SET DELETED ON
? ""
? "With SET DELETED ON"
? "Press any key..."
Inkey( 0 )
MYALIAS->( dbGoTop() )
DO WHILE !MYALIAS->( EOF() )
? MYALIAS->NUMERIC
MYALIAS->( dbSkip() )
ENDDO
? ""
? "With SET DELETED ON"
? "and SET FILTER TO MYALIAS->NUMERIC > 2 .AND. MYALIAS->NUMERIC < 8"
? "Press any key..."
Inkey( 0 )
MYALIAS->( dbSetFilter( {|| MYALIAS->NUMERIC > 2 .AND. MYALIAS->NUMERIC < 8 }, ;
"MYALIAS->NUMERIC > 2 .AND. MYALIAS->NUMERIC < 8" ) )
MYALIAS->( dbGoTop() )
DO WHILE !MYALIAS->( EOF() )
? MYALIAS->NUMERIC
MYALIAS->( dbSkip() )
ENDDO
SET DELETED OFF
? ""
? "With SET DELETED OFF"
? "and SET FILTER TO MYALIAS->NUMERIC > 2 .AND. MYALIAS->NUMERIC < 8"
? "Press any key..."
Inkey( 0 )
MYALIAS->( dbSetFilter( {|| MYALIAS->NUMERIC > 2 .AND. MYALIAS->NUMERIC < 8 }, ;
"MYALIAS->NUMERIC > 2 .AND. MYALIAS->NUMERIC < 8" ) )
MYALIAS->( dbGoTop() )
DO WHILE !MYALIAS->( EOF() )
? MYALIAS->NUMERIC
MYALIAS->( dbSkip() )
ENDDO
? "dbFilter() => " + dbFilter()
? ""
? "Testing __dbPack()"
? "Records before PACK:", MYALIAS->( LastRec() )
? "Size of files (data and memo):", Directory( "testdbf.dbf" )[ 1 ][ 2 ], ;
Directory( "testdbf.dbt" )[ 1 ][ 2 ]
SET FILTER TO
MYALIAS->( __dbPack() )
MYALIAS->( dbCommit() )
? "Records after PACK:", MYALIAS->( LastRec() )
? "Size of files (data and memo):", Directory( "testdbf.dbf" )[ 1 ][ 2 ], ;
Directory( "testdbf.dbt" )[ 1 ][ 2 ]
? "Press any key..."
Inkey( 0 )
? "Value of fields:"
MYALIAS->( dbGoTop() )
DO WHILE !MYALIAS->( EOF() )
? MYALIAS->NUMERIC
MYALIAS->( dbSkip() )
ENDDO
? ""
? "Open test.dbf and LOCATE FOR TESTDBF->SALARY > 145000"
? "Press any key..."
Inkey( 0 )
dbUseArea( , , "test", "TESTDBF" )
LOCATE for TESTDBF->SALARY > 145000
DO WHILE TESTDBF->( Found() )
? TESTDBF->FIRST, TESTDBF->LAST, TESTDBF->SALARY
CONTINUE
ENDDO
? ""
? "LOCATE FOR TESTDBF->MARRIED .AND. TESTDBF->FIRST > 'S'"
? "Press any key..."
Inkey( 0 )
dbUseArea( , , "test", "TESTDBF" )
LOCATE for TESTDBF->MARRIED .AND. TESTDBF->FIRST > 'S'
DO WHILE TESTDBF->( Found() )
? TESTDBF->FIRST, TESTDBF->LAST, TESTDBF->MARRIED
CONTINUE
ENDDO
dbCloseAll()
hb_dbDrop( "testdbf",, "DBFCDX" )
RETURN