Hello John,
I use xharbour and bcc582.
But the tests I made with your exe.
Best regards,
Otto
#define CRLF Chr(13)+Chr(10)
STATIC pPath
//--------------------------------------------------------------
FUNCTION MAIN()
//--------------------------------------------------------------
LOCAL i := 0
pPath := hb_dirbase()+"DATA"
REQUEST DBFCDX, DBFFPT
RDDSETDEFAULT( "DBFCDX")
SET EPOCH TO 1990
SET CENTURY ON
SET DATE ITALIAN
SET DELETED ON
SET EXCLUSIVE ON
SET AUTOPEN OFF
for i:= 1 to 1000
reindex()
next
alert(str(i)+CRLF+CRLF+"Path: "+PPATH+CRLF+CRLF+"Alias in use: "+Alias())
dbcloseall()
quit
RETURN NIL
//--------------------------------------------------------------
//--------------------------------------------------------------
FUNCTION REINDEX()
//--------------------------------------------------------------
FERASE (pPath+"\CUSTOMER.CDX") // It´s not opened and it has a different name than dbf
SELECT 1
USE (pPath+"\CUST") EXCLUSIVE NEW ALIAS "CUSTOMER"
PACK
INDEX ON FIELD->LAST TO (pPath+"\CUSTOMER") // This line causes error
dbcloseall()
return nil
//--------------------------------------------------------------
#Include "FIveWin.ch"
//-------------------
FUNCTION MAIN()
LOCAL i := 0
LOCAL pPath,cDefa,cFile,nStart
*pPath := hb_dirbase()+"DATA" // does not compile
cFILE := GetModuleFileName( GetInstance() )
// where .exe started from is default directory //
nSTART := RAT( "\", cFILE )
cDEFA := SUBSTR(cFILE,1,nSTART-1)
SET DEFA to ( cDEFA )
pPath := cDefa+"\Data"
REQUEST DBFCDX
rddsetdefault ( "DBFCDX" )
* REQUEST DBFCDX, DBFFPT
* RDDSETDEFAULT( "DBFCDX")
SET EPOCH TO 1990
SET CENTURY ON
SET DATE ITALIAN
SET DELETED ON
* SET EXCLUSIVE ON
* SET AUTOPEN OFF
* for i:= 1 to 1000
* reindex()
* next
* alert(str(i)+CRLF+CRLF+"Path: "+PPATH+CRLF+CRLF+"Alias in use: "+Alias())
* dbcloseall()
* quit
ReIndex( pPath )
RETURN( NIL )
//--------------------------------------------------------------
Static FUNCTION ReIndex( pPath )
Local Saying
FERASE( pPath+"\CUSTOMER.CDX" )
IF File( pPath+"\CUSTOMER.CDX" )
Saying := "Can not Delete "+ pPath+"\CUSTOMER.CDX"+chr(10)
Saying += "Check to see if the File is being Shared"+chr(10)
MsgInfo( Saying )
Return(.f.)
Endif
*SELECT 1
*USE (pPath+"\CUST") EXCLUSIVE NEW ALIAS "CUSTOMER" // missing via "DBFCDX" clause
// .DBF AND .CDX Must be named the same !
SELECT 1
Try
Use ( pPath+"\CUSTOMER.DBF" ) via "DBFCDX" alias "CUST" EXCL
Catch
Saying := "Error opening file "+pPath+"\CUSTOMER.DBF"
MsgInfo( Saying )
Return(.f.)
End Try
Pack
IndexMeter( { | oMeter, oText, oDlg, lEnd | ;
BuildCust( oMeter, oText, oDlg, @lEnd, 1 ) } , ;
ALIAS()+".dbf tag First " )
IndexMeter( { | oMeter, oText, oDlg, lEnd | ;
BuildCust( oMeter, oText, oDlg, @lEnd, 2 ) } , ;
ALIAS()+".dbf tag Last " )
IndexMeter( { | oMeter, oText, oDlg, lEnd | ;
BuildCust( oMeter, oText, oDlg, @lEnd, 3 ) } , ;
ALIAS()+".dbf tag Street " )
IndexMeter( { | oMeter, oText, oDlg, lEnd | ;
BuildCust( oMeter, oText, oDlg, @lEnd, 4 ) } , ;
ALIAS()+".dbf tag City " )
IndexMeter( { | oMeter, oText, oDlg, lEnd | ;
BuildCust( oMeter, oText, oDlg, @lEnd, 5 ) } , ;
ALIAS()+".dbf tag State " )
IndexMeter( { | oMeter, oText, oDlg, lEnd | ;
BuildCust( oMeter, oText, oDlg, @lEnd, 6 ) } , ;
ALIAS()+".dbf tag Zip " )
IndexMeter( { | oMeter, oText, oDlg, lEnd | ;
BuildCust( oMeter, oText, oDlg, @lEnd, 7 ) } , ;
ALIAS()+".dbf tag HireDate " )
IndexMeter( { | oMeter, oText, oDlg, lEnd | ;
BuildCust( oMeter, oText, oDlg, @lEnd, 8 ) } , ;
ALIAS()+".dbf tag Married " )
IndexMeter( { | oMeter, oText, oDlg, lEnd | ;
BuildCust( oMeter, oText, oDlg, @lEnd, 9) } , ;
ALIAS()+".dbf tag Age " )
IndexMeter( { | oMeter, oText, oDlg, lEnd | ;
BuildCust( oMeter, oText, oDlg, @lEnd, 10 ) } , ;
ALIAS()+".dbf tag Salary " )
IndexMeter( { | oMeter, oText, oDlg, lEnd | ;
BuildCust( oMeter, oText, oDlg, @lEnd, 11 ) } , ;
ALIAS()+".dbf tag Notes " )
CLOSE DATABASES
RETURN(NIL)
//-------------------------------------------------------------//
FUNCTION BuildCust( oMeter, oText, oDlg, lEnd, nTAG )
oMeter:nTotal := lastrec()
// do not use field-> pointers in index statement
DO CASE
CASE nTAG = 1
INDEX on upper(First) TAG First ;
EVAL ( oMeter:Set( recno() ), SysRefresh(), !lEnd )
CASE nTAG = 2
INDEX on upper(Last) TAG Last ;
EVAL ( oMeter:Set( recno() ), SysRefresh(), !lEnd )
CASE nTAG = 3
INDEX on upper(Street) TAG street ;
EVAL ( oMeter:Set( recno() ), SysRefresh(), !lEnd )
CASE nTAG = 4
INDEX on upper(City) TAG City ;
EVAL ( oMeter:Set( recno() ), SysRefresh(), !lEnd )
CASE nTAG = 5
INDEX on upper(State) TAG State ;
EVAL ( oMeter:Set( recno() ), SysRefresh(), !lEnd )
CASE nTAG = 6
INDEX on upper(Zip) TAG Zip ;
EVAL ( oMeter:Set( recno() ), SysRefresh(), !lEnd )
CASE nTAG = 7
INDEX on dtos(HireDate) TAG Hiredate ;
EVAL ( oMeter:Set( recno() ), SysRefresh(), !lEnd )
CASE nTAG = 8
INDEX on Married TAG Married ;
EVAL ( oMeter:Set( recno() ), SysRefresh(), !lEnd )
CASE nTAG = 9
INDEX on Age TAG Age ;
EVAL ( oMeter:Set( recno() ), SysRefresh(), !lEnd )
CASE nTAG = 10
INDEX on Salary TAG Salary ;
EVAL ( oMeter:Set( recno() ), SysRefresh(), !lEnd )
CASE nTAG = 11
INDEX on upper(Notes) TAG Notes ;
EVAL ( oMeter:Set( recno() ), SysRefresh(), !lEnd )
ENDCASE
RETURN( NIL )
* FERASE (pPath+"\CUSTOMER.CDX") // It´s not opened and it has a different name than dbf
* SELECT 1
* USE (pPath+"\CUST") EXCLUSIVE NEW ALIAS "CUSTOMER"
* PACK
* INDEX ON FIELD->LAST TO (pPath+"\CUSTOMER") // This line causes error
* dbcloseall()
* return nil
//-------------------------------
Function IndexMeter( bAction, cMsg, cTag )
local oDlg, oMeter, oText
local lEnd := .f.
local nVal := 0
local cTitle
IF EMPTY( cTAG )
cTAG := "Indexing Please wait"
ENDIF
DEFAULT bAction := { || nil },;
cMsg := "Processing...", cTitle := cTAG
DEFINE DIALOG oDlg FROM 5, 5 TO 11, 45 TITLE cTitle ;
STYLE nOr( WS_POPUP,WS_CAPTION,WS_THICKFRAME )
@ 0.2, 0.5 SAY oText VAR cMsg SIZE 130, 10 OF oDlg
@ 1, 0.5 METER oMeter VAR nVal TOTAL 10 SIZE 150, 10 OF oDlg
* @ 2.5, 9.5 BUTTON "&Cancel" OF oDlg SIZE 32, 13 ACTION lEnd := .t.
// This block gets evaluated only the first time the DialogBox is painted !!!
oDlg:bStart := { || Eval( bAction, oMeter, oText, oDlg, @lEnd ),;
lEnd := .t., oDlg:End() }
ACTIVATE DIALOG oDlg CENTERED ;
VALID lEnd
RETURN(NIL)
/* LOGICAL NETUSE( CDATABASE, LOPENMODE, NSECONDS )
CHARACTER CDATABASE - NAME OF DATABASE
LOGICAL LOPENMODE - OPEN MODE .T. exclusive .F. shared
NUMERIC NSECONDS - NUMBER OF SECONDS TO WAIT 0 forever
RETURN .T. if successful, .F. if not
SAMPLE CALL IF NETUSE( "CALLS", .F., 5 )
*/
Func NETUSE( CDATABASE, LOPENMODE, NSECONDS, cAlias )
LOCAL FOREVER, RESTART, WAIT_TIME, YESNO
RESTART = .T.
FOREVER = ( NSECONDS := 0 )
YESNO := {"Yes" , "No"}
DO WHILE RESTART
WAIT_TIME := NSECONDS
DO WHILE ( FOREVER .or. WAIT_TIME > 0 )
IF LOPENMODE
USE ( CDATABASE ) via "DBFCDX" EXCLUSIVE
ELSE
USE ( CDATABASE ) via "DBFCDX" SHARED
ENDIF
IF .NOT. NETERR()
RETURN(.T.)
ENDIF
INKEY(1)
WAIT_TIME--
ENDDO
* lock failed, ask to continue
IF MsgYesNo( "Cannot lock " + CDATABASE + ", retry ?" )
ELSE
EXIT
ENDIF
ENDDO
RETURN(.F.)
nOk := FERASE (pPath+"\CUSTOMER.CDX") // It´s not opened and it has a different name than dbf
IF nOk <> 0
nError := FError()
ENDIF
Rick Lipkin wrote:1) The .dbf and .cdx have to be the same name "Customer.dbf", "Customer.Cdx" but you can use any Alias you wish.
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: Google [Bot] and 89 guests