Problem with application terminating

Post Reply
User avatar
cdmmaui
Posts: 653
Joined: Fri Oct 28, 2005 9:53 am
Location: The Woodlands - Dallas - Scottsdale - London
Contact:

Problem with application terminating

Post by cdmmaui »

Hello, I am having a problem with an application that continues to exit with no error message. The application is reading a folder with incoming files; opens the file; parses the information; then stores to a database. I think the problem might relate to the number of files in the folder which exceeds 1000. I did recompile using FW++ and the application worked with no problems. I am attaching the code in case it helps.

// PROGRAM: cargo.prg
//-----------------------------------------------------------------------------
#include "fivewin.ch"

static oMenu

REQUEST DBFCDX
REQUEST DBFFPT
REQUEST _ADS

function Main()

PUBLIC cEol := CHR(13)+CHR(10) , ;
Pdebug := .F. , ;
oWnd[25] , ;
PA[25] , ;
cSay := "" , ;
oSay , ;
aSay[05] , ;
Pext := ".IDX" , ;
Prdd := "ADS" , ;
Pdd := "\\topocean-cdm\ocean\" , ;
Prca := "\\topocean-cdm\toptrack\"

// Init...
IF Pdebug
Pext := ".CDX"
Prdd := "DBFCDX"
Pdd := "c:\winapps\frt\data\"
Prca := "c:\clipweb\winrca\"
ENDIF

// RDD...
RddRegister( "ADS", 1 )
RddSetDefault( "DBFCDX" )

// Caching...
ADSLocking(.F.)

// Init...
PA[001] := ""
PA[002] := ""
PA[003] := ""
PA[004] := "CDM WinEDI Version 5.0"
PA[005] := "20051020 : 2305"
PA[006] := "DBFCDX"
PA[007] := ""
PA[008] := 0
PA[009] := 0
PA[010] := "001"
PA[011] := "company name"
PA[012] := "company addr"
PA[013] := "company city"
PA[014] := "company phone"
PA[015] := "company fax"
PA[016] := "company e-mail"
PA[017] := .T.
PA[018] := ""
PA[019] := ""
PA[020] := CHR(13)+CHR(10)
PA[021] := ""
PA[022] := ""

// Icon...
DEFINE ICON PA[001] RESOURCE "CDMLOGO"

DEFINE WINDOW oWnd[01] MDI FROM 10,00 TO 25,70 ;
TITLE PA[004] ;
MENU BuildMenu() COLOR "B/W+" ;
ICON PA[001]

// Say...
@01,01 SAY oSay VAR cSay OF oWnd[01] SIZE 800,80

SET MESSAGE OF oWnd[01] TO "(c)2005. CDM Software Solutions, Inc. " + PA[005] ;
CENTERED COLOR "B/W+" ;
KEYBOARD ;
DATE ;
TIME

ACTIVATE WINDOW oWnd[01] ;
ON INIT ( StartUp() , ;
oWnd[01]:End() )

// Close...
DbCloseAll()

RETURN nil

//----------------------------------------------------------------------------//
function BuildMenu()

MENU oMenu
MENUITEM "" ACTION oWnd[01]:End()
ENDMENU

RETURN oMenu

//----------------------------------------------------------------------------//
function Startup( cAuto )

local lEof := .F. , ;
cLine := "" , ;
aFolder := {} , ;
cFolder := "" , ;
cTmp := "" , ;
nTmp := 0 , ;
nHan := 0 , ;
hHan := 0 , ;
nCtnr := 0 , ;
nFile := 0 , ;
nUpd := 0 , ;
cMask := "*.*" , ;
nX := 0 , ;
nY := 0 , ;
nZ := 0 , ;
cMsg := "" , ;
cOrgf := "" , ;
cDstf := "" , ;
nProc := 0 , ;
lUpd := .F. , ;
lFirst := .T. , ;
cChar := "" , ;
nTag := 1

// Init...
IF Pdebug
AADD( aFolder, "c:\edi\TOPLAX\meau\" )
AADD( aFolder, "c:\edi\TOPLAX\oocl\" )
ELSE
AADD( aFolder, "d:\ftp\maeu\" )
AADD( aFolder, "d:\ftp\oocl\" )
ENDIF

// Open...
_db( "" , "edilog" )
_db( Pdd, "import" )
_db( Pdd, "impctnr" )
_db( Pdd, "event" )
_db( Prca, "rcaevnt" )

// Process...
FOR nZ=1 TO LEN( aFolder )
cFolder := aFolder[nZ]
nHan := ADIR( cFolder + cMask )
DECLARE aEdi[nHan]
ADIR( cFolder + cMask, aEdi )

FOR nY=1 TO nHan

// Message...
cSay := LTRIM( STR( ROUND( (nY/nHan)*100, 0), 3) ) + "% Complete..." + cEol
cSay += "Total = " + LTRIM(STR(nHan ,9)) + cEol
cSay += "Files = " + LTRIM(STR(nFile,9)) + cEol
cSay += "Containers = " + LTRIM(STR(nCtnr,9)) + cEol
cSay += "Updates = " + LTRIM(STR(nUpd ,9)) + cEol
oSay:Refresh()
Sysrefresh()

hHan := FOPEN( cFolder + aEdi[nY], 0)
IF (hHan >= 0)

// Init...
lEof := .F.
cEq := ""
cMbl := ""
cEvent := ""
cEname := ""
cDay := ""
cMon := ""
cYear := ""
cTime := ""
lMove := .T.

// Process...
DO WHILE ! lEof

// Refresh...
SysRefresh()

// Init...
cLine := ""

// Read...
Ureadln( hHan, @cLine, 1, @lEof )

// Update...
IF ( ! EMPTY( cLine ) )
DO CASE
CASE LEFT(cLine,2) == "B4"
cChar := ""
cTmp := ""
nTag := 1

FOR nX = 1 TO LEN( cLine )
cChar = SUBSTR( cLine, nX, 1 )
IF cChar="*"
DO CASE
CASE nTag=4
cEvent := cTmp
CASE nTag=5
cYear := SUBSTR( cTmp, 1, 4 )
cMon := SUBSTR( cTmp, 5, 2 )
cDay := SUBSTR( cTmp, 7, 2 )
CASE nTag=6
cTime := cTmp
ENDCASE
nTag++
cTmp := ""
ELSE
cTmp += cChar
ENDIF
NEXT nX

CASE SUBSTR(cLine,4,2) == "BM"
cMbl := SUBSTR( cLine, 7 )
CASE SUBSTR(cLine,4,2) == "EQ"
cEq := SUBSTR( cLine, 7, 12 )
ENDCASE

// Find by MBL...
IF (! EMPTY( cEq ) ) .AND. (! EMPTY( cEvent ) )

// Init...
cMsg := aEdi[nY] + cEol
cMsg += "EV: " + cEvent+ cEol
cMsg += "YR: " + cYear + cEol
cMsg += "MO: " + cMon + cEol
cMsg += "DY: " + cDay + cEol
cMsg += "TM: " + cTime + cEol
//IF MsgNoYes( cMsg )
// DbCloseAll()
// oWnd[01]:End()
// QUIT
//ENDIF

// Init...
cEname := _Event( cEvent )
dDate := CTOD( cMon + "/" + cDay + "/" + cYear )

SELECT impctnr
SET ORDER TO TAG S1
GO TOP
SEEK '001' + LEFT( cEq + SPACE(15), 15 )
IF FOUND()

// Init...
nCtnr++

DO WHILE ! EOF() .AND. ( LEFT( cEq + SPACE(15), 15 ) == impctnr->ctnr )

// Init...
lUpd := .T.

SELECT import
SET ORDER TO TAG SA
GO TOP
SEEK '001' + impctnr->file
IF FOUND()

// Init...
nFile++

// Event...
SELECT event
GO TOP
SEEK '001' + import->file
IF FOUND()
DO WHILE ! EOF() .AND. ( import->file == event->file )

IF ( ALLTRIM( event->event )==ALLTRIM( cEvent ) ) .AND. ( event->date == dDate ) .AND. ( event->time == cTime )
lUpd := .F.
ENDIF

SELECT event
SKIP
ENDDO
ENDIF

// Update...
IF lUpd
// Event...
SELECT event
APPEND BLANK
event->file := import->file
event->event := cEvent
event->date := dDate
event->time := cTime
event->by := "CDMEDI"
event->notes := cEname
event->( dbcommit() )

// CTS Events...
SELECT rcaevnt
APPEND BLANK
rcaevnt->file := import->file
rcaevnt->event := cEvent
rcaevnt->date := dDate
rcaevnt->time := cTime
rcaevnt->by := "CDMEDI"
rcaevnt->notes := cEname
rcaevnt->( dbcommit() )

// Init...
nUpd++
ENDIF

ELSE
lUpd := .F.

ENDIF

// Next...
SELECT impctnr
SKIP

ENDDO

ENDIF

// Init...
cMbl := ""
cEq := ""
cEvent := ""
ENDIF

ENDIF

ENDDO

// Close...
FCLOSE( hHan )

// Init...
cOrgf := cFolder + aEdi[nY]
cDstf := cFolder + "history\" + aEdi[nY]

// Message...
cSay := "Moving " + cOrgf + cEol
cSay += "to " + cDstf
oSay:Refresh()
Sysrefresh()

// Copy to History...
COPY FILE (cOrgf) TO (cDstf)
IF FILE( cDstf )
FERASE( cOrgf )
ENDIF

ENDIF
NEXT nY

RELEASE aEdi

NEXT nZ

// Log...
IF (nCtnr + nFile > 0)
SELECT edilog
APPEND BLANK
edilog->date := DATE()
edilog->time := TIME()
edilog->filecnt := nFile
edilog->ctnr := nCtnr
edilog->( dbcommit() )
ENDIF

// Close...
DbCloseAll()

// Init...
cMsg := ""
FOR nX=1 TO LEN( aFolder )
cMsg += aFolder[nX] + cEol
NEXT nX
cMsg += "Containers = " + LTRIM(TRANSF(nCtnr,"999,999")) + cEol
cMsg += "File(s) = " + LTRIM(TRANSF(nFile,"999,999")) + cEol
cMsg += "Update(s) = " + LTRIM(TRANSF(nUpd ,"999,999")) + cEol
// MsgInfo( cMsg, PA[04] )

RETURN (.T.)


//----------------------------------------------------------------------------//
FUNC _Event( cCode )

local cRet := ""

DO CASE
CASE ALLTRIM( cCode ) == "EE"
cRet := "EMPTY CONTAINER OUT EMPTY AGAINST BOOKING"
CASE ALLTRIM( cCode ) == "I"
cRet := "CONTAINER RETURNED TO YARD"
CASE ALLTRIM( cCode ) == "AL"
cRet := "CONTAINER LOADED ON RAIL"
CASE ALLTRIM( cCode ) == "AR"
cRet := "CONTAINER UNLOADED FROM RAIL"
CASE ALLTRIM( cCode ) == "AE"
cRet := "CONTAINER LOADED ON VESSEL"
CASE ALLTRIM( cCode ) == "VD"
cRet := "VESSEL DEPARTURE"
CASE ALLTRIM( cCode ) == "VA"
cRet := "VESSEL ARRIVAL"
CASE ALLTRIM( cCode ) == "UV"
cRet := "CONTAINER DISCHARGED FROM VESSEL"
CASE ALLTRIM( cCode ) == "CU"
cRet := "CUSTOMS/FREIGHT RELEASE"
CASE ALLTRIM( cCode ) == "CT"
cRet := "CUSTOMS/FREIGHT RELEASE"
CASE ALLTRIM( cCode ) == "OA"
cRet := "CONTAINER LEFT PORT OF DISCHARGE"
CASE ALLTRIM( cCode ) == "D"
cRet := "CONTAINER OUT FOR DELIVERY"
CASE ALLTRIM( cCode ) == "RD"
cRet := "CONTAINER RETURNED EMPTY"
CASE ALLTRIM( cCode ) == "AV"
cRet := "CONTAINER AVAILABLE FOR PICKUP/DELIVERY"
CASE ALLTRIM( cCode ) == "AF"
cRet := "CONTAINER ACTUAL DOOR PICKUP"
CASE ALLTRIM( cCode ) == "RL"
cRet := "DEPATURE FROM 1ST INTERMODAL HUB"
CASE ALLTRIM( cCode ) == "Z2"
cRet := "LAST DERAMP UNDER O/B"
CASE ALLTRIM( cCode ) == "Z6"
cRet := "TRANSHIPMENT VESSEL ARRIVAL"
CASE ALLTRIM( cCode ) == "Z4"
cRet := "CONTAINER DISCHARGED FROM TRANSHIPMENT PORT"
CASE ALLTRIM( cCode ) == "Z3"
cRet := "CONTAINER LOADED AT TRANSHIPMENT PORT"
CASE ALLTRIM( cCode ) == "Z7"
cRet := "TRANSHIPMENT VESSEL DEPARTURE"
CASE ALLTRIM( cCode ) == "Z5"
cRet := "1ST LOADED ON RAIL UNDER I/B"
CASE ALLTRIM( cCode ) == "Z1"
cRet := "INTERMODAL DEPARTURE FROM LAST PORT OF DISCHARGE"
CASE ALLTRIM( cCode ) == "Z8"
cRet := "PICKED UP AT FINAL DESTINATION FOR DELIVERY"
CASE ALLTRIM( cCode ) == "UR"
cRet := "LAST DERAMP UNDER I/B"
CASE ALLTRIM( cCode ) == "CR"
cRet := "CARRIER RELEASED"
CASE ALLTRIM( cCode ) == "OB"
cRet := "ORIGINAL BOL RECEIVED"
CASE ALLTRIM( cCode ) == "NO"
cRet := "FREIGHT SETTLEMENT"
CASE ALLTRIM( cCode ) == "PA"
cRet := "CUSTOMS HOLD"
CASE ALLTRIM( cCode ) == "TM"
cRet := "INTRA TERMINAL MOVE"
CASE ALLTRIM( cCode ) == "PL"
cRet := "USDA HOLD"
CASE ALLTRIM( cCode ) == "PU"
cRet := "OTHER GOV'T AGENCY HOLD"
ENDCASE

RETURN (cRet)

//----------------------------------------------------------------------------//
FUNC Ureadln( hHandle, cReturn, nLen, lEof, cSkip, cSkipchr )

local cChar := "" , ;
lRestline := .F. , ;
nRead := 1

IF PCOUNT()<6
cSkipchr = CHR(255)
ENDIF
IF PCOUNT()<5
cSkip = .F.
ENDIF
IF PCOUNT()<3
nLen = 1
ENDIF

// Init...
IF nRead > 1
cChar = SPACE(nRead)
ENDIF

DO WHILE (! lEof)

// Init...
Mline = .F.
IF nLen = 1
cChar = FREADSTR(hHandle,1)
ELSE

nRead = FREAD(hHandle, @cChar, nLen)

IF nRead<>nLen
lEof = .T.
ENDIF
EXIT
ENDIF

DO CASE
CASE ASC(cChar) = 10
EXIT

CASE ASC(cChar) = 13
LOOP

CASE ASC(cChar) = 9 // Replace TAB with SPACE(1)...
cReturn += SPACE(1)

CASE ASC(cChar) = 0 .OR. ASC(cChar) = 27
lEof = .T.

OTHERWISE
IF cSkip
IF cChar = cSkipchr
lRestline = .T.
LOOP
ENDIF
ENDIF

// Add to character string if rest of line not be ignored
IF ! lRestline
cReturn += cChar
ENDIF
ENDCASE
ENDDO

// Trim...
IF nLen>1
Mtmp = LEFT(cChar, LEN(cChar)-2)
cReturn = Mtmp
ENDIF

RETURN nil

//---------------------------------------------------------------------------//
FUNCTION _db
PARAM cDir, cDb, lExclusive, cAlias

local nHoldCnt := 1 , ;
cErr := "" , ;
cDvr := Prdd

IF PCOUNT()<4
cAlias = cDb
ENDIF
IF PCOUNT()<3
lExclusive = .F.
ENDIF
IF PCOUNT()<2
cDb = ""
ENDIF
IF PCOUNT()<1
cDir = ""
ENDIF

// Init...
IF EMPTY(cDir)
cDir = Pdd
ENDIF

** Open...
DO WHILE (.T.)
IF (SELECT( UPPER(cDb) ) > 0) .AND. ( cDb=cAlias )
SELECT &cDb
RETURN (.T.)
ELSE

DO CASE
CASE UPPER(LEFT(cDb,3))=="RCA"
cDvr = "DBFCDX"
CASE UPPER(cDb)=="RCACTNR"
cDvr = "DBFCDX"
CASE UPPER(cDb)=="RCAPO"
cDvr = "DBFCDX"
CASE UPPER(cDb)=="RCAEVNT"
cDvr = "DBFCDX"
CASE UPPER(cDb)=="PROFILE"
cDvr = "DBFCDX"
CASE UPPER(cDb)=="PROPO"
cDvr = "DBFCDX"
CASE UPPER(cDb)=="PO"
cDvr = "DBFCDX"
CASE UPPER(cDb)=="PODET"
cDvr = "DBFCDX"
CASE UPPER(cDb)=="PONOTE"
cDvr = "DBFCDX"
CASE UPPER(cDb)=="POTRACK"
cDvr = "DBFCDX"
CASE UPPER(cDb)=="FLG"
cDvr = "DBFCDX"
CASE UPPER(cDb)=="ARHOLD"
cDvr = "DBFCDX"
ENDCASE

// Open....
DbUseArea( .T., cDvr, cDir+cDb, cAlias, ! lExclusive )
ENDIF

IF NETERR()
cErr := "You are not the only one in this Module." + CHR(13)+CHR(10)
cErr += CHR(13)+CHR(10)
cErr += "Everyone else must exit before you can continue!" + CHR(13)+CHR(10)
cErr += CHR(13)+CHR(10)
cErr += "The file trying to be used exclusively is " + CHR(13)+CHR(10)
cErr += cDir + cDb

// MsgWait2( cErr, cDir + cDb, .5 )
nHoldCnt++
IF nHoldCnt>2
RETURN (.F.)
ENDIF
LOOP
ENDIF

DO CASE
CASE UPPER(cDb)=="QUOTE"
SET INDEX TO &cDir.qtx01&Pext
CASE UPPER(cDb)=="QTEDIM"
SET INDEX TO &cDir.qtxdim&Pext
CASE UPPER(cDb)=="QTEDET"
SET INDEX TO &cDir.qtxdet&Pext
CASE UPPER(cDb)=="BOOKING"
SET INDEX TO &cDir.bkgx01&Pext
CASE UPPER(cDb)=="BKGDIM"
SET INDEX TO &cDir.bkgxdim&Pext
CASE UPPER(cDb)=="BKGRATE"
SET INDEX TO &cDir.bkgxrat&Pext
CASE UPPER(cDb)=="BKNUM"
SET INDEX TO &cDir.bkgxnum&Pext
CASE UPPER(cDb)=="WR"
SET INDEX TO &cDir.wrx01&Pext
CASE UPPER(cDb)=="WRDET"
SET INDEX TO &cDir.wrx02&Pext
CASE UPPER(cDb)=="WRDETSN"
SET INDEX TO &cDir.wrxsn&Pext
CASE UPPER(cDb)=="WRDETPA"
SET INDEX TO &cDir.wrxpa&Pext
CASE UPPER(cDb)=="WRDETSZ"
SET INDEX TO &cDir.wrxsz&Pext
CASE UPPER(cDb)=="WHLOC"
SET INDEX TO &cDir.whxloc&Pext
CASE UPPER(cDb)=="WHLOG"
SET INDEX TO &cDir.wlx01&Pext
CASE UPPER(cDb)=="WRRATE"
SET INDEX TO &cDir.wrxr01&Pext
CASE UPPER(cDb)=="WRR"
SET INDEX TO &cDir.wrrx01&Pext
CASE UPPER(cDb)=="WRRDET"
SET INDEX TO &cDir.wrrx02&Pext
CASE UPPER(cDb)=="WRRDETSN"
SET INDEX TO &cDir.wrrx03&Pext
CASE UPPER(cDb)=="WRRCOMM"
SET INDEX TO &cDir.wrrx04&Pext
CASE UPPER(cDb)=="WRRPICK"
SET INDEX TO &cDir.wrrx05&Pext
CASE UPPER(cDb)=="WRRDETSZ"
SET INDEX TO &cDir.wrrxsz&Pext
CASE UPPER(cDb)=="WRPICK"
SET INDEX TO &cDir.wrpx01&Pext
CASE UPPER(cDb)=="WRPICKD"
SET INDEX TO &cDir.wrpx02&Pext
CASE UPPER(cDb)=="WRINV"
SET INDEX TO &cDir.wrix01&Pext
CASE UPPER(cDb)=="WRIDET"
SET INDEX TO &cDir.wrdx01&Pext
CASE UPPER(cDb)=="WREDET"
SET INDEX TO &cDir.wrex01&Pext
CASE UPPER(cDb)=="MT"
SET INDEX TO &cDir.mt01&Pext
CASE UPPER(cDb)=="MTDET"
SET INDEX TO &cDir.mt02&Pext
CASE UPPER(cDb)=="MTDETSN"
SET INDEX TO &cDir.mt03&Pext
CASE UPPER(cDb)=="INVADJ"
SET INDEX TO &cDir.invadj01&Pext
CASE UPPER(cDb)=="INVADJD"
SET INDEX TO &cDir.invadj02&Pext
CASE UPPER(cDb)=="SHPREF"
SET INDEX TO &cDir.shpxref&Pext
CASE UPPER(cDb)=="OCEAN"
SET INDEX TO &cDir.ocnx01
CASE UPPER(cDb)=="OCNDET"
SET INDEX TO &cDir.ocnxdet&Pext
CASE UPPER(cDb)=="OCNCTNR"
SET INDEX TO &cDir.ocnxctnr
CASE UPPER(cDb)=="OCNCLS"
SET INDEX TO &cDir.ocnxcls
CASE UPPER(cDb)=="OCNRATE"
SET INDEX TO &cDir.ocnxrate
CASE UPPER(cDb)=="OCNBKG"
SET INDEX TO &cDir.ocnxbkg&Pext
CASE UPPER(cDb)=="OCNSTAT"
SET INDEX TO &cDir.ocnxstat&Pext
CASE UPPER(cDb)=="AIRDISP"
SET INDEX TO &cDir.airxdisp
CASE UPPER(cDb)=="AIR"
SET INDEX TO &cDir.airx01
CASE UPPER(cDb)=="AIRDET"
SET INDEX TO &cDir.airxdet&Pext
CASE UPPER(cDb)=="AIRDIM"
SET INDEX TO &cDir.airxdim&Pext
CASE UPPER(cDb)=="AIRMAN"
SET INDEX TO &cDir.airmanx&Pext
CASE UPPER(cDb)=="SITA"
SET INDEX TO &cDir.sitax01
CASE UPPER(cDb)=="NOTES"
SET INDEX TO &cDir.notes&Pext
CASE UPPER(cDb)=="SEDDAT"
SET INDEX TO &cDir.sedxdat&Pext
CASE UPPER(cDb)=="SEDDET"
SET INDEX TO &cDir.sedxdet&Pext
CASE UPPER(cDb)=="SEDVEH"
SET INDEX TO &cDir.sedxveh&Pext
CASE UPPER(cDb)=="MASTER"
SET INDEX TO &cDir.mastx01&Pext
CASE UPPER(cDb)=="CONTTBL"
SET INDEX TO &cDir.contt01&Pext
CASE UPPER(cDb)=="CONSTMN"
SET INDEX TO &cDir.conxtop&Pext
CASE UPPER(cDb)=="TICKLER"
SET INDEX TO &cDir.tickx01&Pext
CASE UPPER(cDb)=="CARRIER"
SET INDEX TO &cDir.carr01&Pext, &cDir.carr02&Pext, &cDir.carr03&Pext, &cDir.carr04&Pext
CASE UPPER(cDb)=="CARRLOC"
SET INDEX TO &cDir.frxcaloc&Pext
CASE UPPER(cDb)=="AWBDET"
SET INDEX TO &cDir.awbdet&Pext, &cDir.awbdet2&Pext
CASE UPPER(cDb)=="INVOICE"
SET INDEX TO &cDir.invx01
CASE UPPER(cDb)=="INVDET"
SET INDEX TO &cDir.invdx01
CASE UPPER(cDb)=="INVCOST"
SET INDEX TO &cDir.invcx01
CASE UPPER(cDb)=="INVSUMM"
SET INDEX TO &cDir.invxsumm&Pext
CASE UPPER(cDb)=="EDITRACK"
SET INDEX TO &cDir.edi01&Pext
CASE UPPER(cDb)=="EDI"
SET INDEX TO &cDir.edix01&Pext
CASE UPPER(cDb)=="EDILOG"
SET INDEX TO &cDir.edixlog&Pext
CASE UPPER(cDb)=="ARCUST"
SET INDEX TO &cDir.custx01&Pext
CASE UPPER(cDb)=="ARHOLD"
SET INDEX TO &cDir.arhldx01.cdx
CASE UPPER(cDb)=="ARGLCD"
SET INDEX TO &cDir.arxglcd&Pext, &cDir.arxglnm&Pext
CASE UPPER(cDb)=="ARREPCD"
SET INDEX TO &cDir.arxrepcd&Pext, &cDir.arxrepnm&Pext
CASE UPPER(cDb)=="TERMS"
SET INDEX TO &cDir.terms&Pext
CASE UPPER(cDb)=="BANK"
SET INDEX TO &cDir.bank&Pext
CASE UPPER(cDb)=="SAILING"
SET INDEX TO &cDir.sail01&Pext, &cDir.sail02&Pext, &cDir.sail03&Pext, &cDir.sail04&Pext, &cDir.sail05&Pext
CASE UPPER(cDb)=="CTNR"
SET INDEX TO &cDir.ctnr01&Pext, &cDir.ctnr02&Pext
CASE UPPER(cDb)=="RATES"
SET INDEX TO &cDir.ratexid&Pext, &cDir.ratexorg&Pext, &cDir.ratexdst&Pext
CASE UPPER(cDb)=="RATECOST"
SET INDEX TO &cDir.ratexcst&Pext
CASE UPPER(cDb)=="PRODUCT"
SET INDEX TO &cDir.prodxcd&Pext, &cDir.prodxnm&Pext, &cDir.prodxcs&Pext, &cDir.prodxsu&Pext
CASE UPPER(cDb)=="PRODRESV"
SET INDEX TO &cDir.prodrsv&Pext
CASE UPPER(cDb)=="PRODSIZE"
SET INDEX TO &cDir.prodsiz&Pext
CASE UPPER(cDb)=="APVEND"
SET INDEX TO &cDir.vendx01&Pext
CASE UPPER(cDb)=="APEXPCD"
SET INDEX TO &cDir.apxglcd&Pext, &cDir.apxglnm&Pext
CASE UPPER(cDb)=="SED"
SET INDEX TO &cDir.schbx01&Pext
CASE UPPER(cDb)=="PORTS"
SET INDEX TO &cDir.portxcd&Pext, &cDir.portxnm&Pext
CASE UPPER(cDb)=="UNCODE"
SET INDEX TO &cDir.unxloc&Pext
CASE UPPER(cDb)=="COB"
SET INDEX TO &cDir.cobx01&Pext
CASE UPPER(cDb)=="POD"
SET INDEX TO &cDir.podx01&Pext
CASE UPPER(cDb)=="SHIPCYCL"
SET INDEX TO &cDir.shpcyx01&Pext
CASE UPPER(cDb)=="FILECNT"
SET INDEX TO &cDir.filexcnt&Pext
CASE UPPER(cDb)=="IMPORT"
SET INDEX TO &cDir.impx01&Pext,&cDir.impx02&Pext
CASE UPPER(cDb)=="IMPCTNR"
SET INDEX TO &cDir.impxctnr&Pext
CASE UPPER(cDb)=="IMPHSE"
SET INDEX TO &cDir.impxhser&Pext
CASE UPPER(cDb)=="IMPDATA"
SET INDEX TO &cDir.impxdat&Pext
CASE UPPER(cDb)=="IMPREL"
SET INDEX TO &cDir.imprx&Pext
CASE UPPER(cDb)=="IMPRELD"
SET INDEX TO &cDir.imprdx&Pext
CASE UPPER(cDb)=="IMPDET"
SET INDEX TO &cDir.impxdet&Pext
CASE UPPER(cDb)=="TRUCK"
SET INDEX TO &cDir.trkx01&Pext
CASE UPPER(cDb)=="TRKDET"
SET INDEX TO &cDir.trkxdet
CASE UPPER(cDb)=="TRKBRK"
SET INDEX TO &cDir.trkbx01&Pext
CASE UPPER(cDb)=="TRKCARR"
SET INDEX TO &cDir.trkcx01&Pext

CASE UPPER(cDb)=="CARR"
SET INDEX TO &cDir.sedx01&Pext, &cDir.sedx02&Pext
CASE UPPER(cDb)=="CONTROL"
SET INDEX TO &cDir.sedx03&Pext
CASE UPPER(cDb)=="EXPLIC"
SET INDEX TO &cDir.sedx04&Pext, &cDir.sedx05&Pext
CASE UPPER(cDb)=="SEDPROC"
SET INDEX TO &cDir.sedx06&Pext, &cDir.sedx07&Pext, &cDir.sedx08&Pext
CASE UPPER(cDb)=="SEDSHIP"
SET INDEX TO &cDir.sedx09&Pext
CASE UPPER(cDb)=="MEXSTATE"
SET INDEX TO &cDir.sedx10&Pext, &cDir.sedx11&Pext
CASE UPPER(cDb)=="SCHC"
SET INDEX TO &cDir.sedx12&Pext, &cDir.sedx13&Pext, &cDir.sedx13b&Pext
CASE UPPER(cDb)=="SCHD"
SET INDEX TO &cDir.sedx14&Pext, &cDir.sedx15&Pext
CASE UPPER(cDb)=="SCHK"
SET INDEX TO &cDir.sedx16&Pext, &cDir.sedx17&Pext
CASE UPPER(cDb)=="SCAC"
SET INDEX TO &cDir.sedx19&Pext, &cDir.sedx20&Pext
CASE UPPER(cDb)=="ARTEMP"
SET INDEX TO &cDir.ar01&Pext, &cDir.ar02&Pext, &cDir.ar03&Pext
CASE UPPER(cDb)=="PAYTEMP"
SET INDEX TO &cDir.rop01&Pext
CASE UPPER(cDb)=="PAYTEMPT"
SET INDEX TO &cDir.ropdet&Pext
CASE UPPER(cDb)=="APTEMP"
SET INDEX TO &cDir.ap01&Pext, &cDir.ap02&Pext, &cDir.ap03&Pext
CASE UPPER(cDb)=="APTEMPT"
SET INDEX TO &cDir.ap04&Pext, &cDir.ap05&Pext
CASE UPPER(cDb)=="APRECUR"
SET INDEX TO &cDir.apr01&Pext
CASE UPPER(cDb)=="CHKTEMPT"
SET INDEX TO &cDir.chkdet&Pext
CASE UPPER(cDb)=="ARHIST"
SET INDEX TO &cDir.arhist01&Pext, &cDir.arhist02&Pext, &cDir.arhist03&Pext, &cDir.arhist04&Pext, &cDir.arhist05&Pext, &cDir.arhist06&Pext
CASE UPPER(cDb)=="ARNOTES"
SET INDEX TO &cDir.arnotes&Pext
CASE UPPER(cDb)=="APHIST"
SET INDEX TO &cDir.aphist01&Pext, &cDir.aphist02&Pext, &cDir.aphist03&Pext, &cDir.aphist04&Pext, &cDir.aphist05&Pext
CASE UPPER(cDb)=="APNOTES"
SET INDEX TO &cDir.apnotes&Pext
CASE UPPER(cDb)=="APRECON"
SET INDEX TO &cDir.aprec01&Pext, &cDir.aprec02&Pext, &cDir.aprec03&Pext
CASE UPPER(cDb)=="GLACCT"
SET INDEX TO &cDir.glacct01&Pext, &cDir.glacct02&Pext
CASE UPPER(cDb)=="GLCAT"
SET INDEX TO &cDir.glcat01&Pext
CASE UPPER(cDb)=="GL"
SET INDEX TO &cDir.glje01&Pext
CASE UPPER(cDb)=="GLAPPLY"
SET INDEX TO &cDir.glje02&Pext
CASE UPPER(cDb)=="GLHIST"
SET INDEX TO &cDir.glhist01&Pext, &cDir.glhist02&Pext
CASE UPPER(cDb)=="GLPCLOSE"
SET INDEX TO &cDir.glpclose&Pext
CASE UPPER(cDb)=="GLYCLOSE"
SET INDEX TO &cDir.glyclose&Pext
CASE UPPER(cDb)=="GLSUM"
SET INDEX TO &cDir.glsum01&Pext
CASE UPPER(cDb)=="COMINV"
SET INDEX TO &cDir.cominv01&Pext, &cDir.cominv02&Pext, &cDir.cominv03&Pext, &cDir.cominv04&Pext
CASE UPPER(cDb)=="COMDET"
SET INDEX TO &cDir.comdet&Pext
CASE UPPER(cDb)=="CANCUS"
SET INDEX TO &cDir.cancus01&Pext
CASE UPPER(cDb)=="CANCUSD"
SET INDEX TO &cDir.cancus02&Pext
CASE UPPER(cDb)=="ISRAEL"
SET INDEX TO &cDir.isrl01&Pext
CASE UPPER(cDb)=="ISRAELD"
SET INDEX TO &cDir.isrld01&Pext
CASE UPPER(cDb)=="CARGOAGT"
SET INDEX TO &cDir.cargo01&Pext, &cDir.cargo02&Pext
CASE UPPER(cDb)=="CARGODET"
SET INDEX TO &cDir.cargo03&Pext, &cDir.cargo04&Pext
CASE UPPER(cDb)=="CARINV"
SET INDEX TO &cDir.carinv01&Pext, &cDir.carinv02&Pext, &cDir.carinv03&Pext
CASE UPPER(cDb)=="CARDET"
SET INDEX TO &cDir.cardet&Pext
CASE UPPER(cDb)=="DRAFT"
SET INDEX TO &cDir.draft01&Pext, &cDir.draft02&Pext
CASE UPPER(cDb)=="DFTCNT"
SET INDEX TO &cDir.dftcnt&Pext
CASE UPPER(cDb)=="DOCTRANS"
SET INDEX TO &cDir.doc01&Pext
CASE UPPER(cDb)=="HAZMAT"
SET INDEX TO &cDir.haz01&Pext
CASE UPPER(cDb)=="HAZDET"
SET INDEX TO &cDir.hazdet&Pext
CASE UPPER(cDb)=="NAFTA"
SET INDEX TO &cDir.nafta01&Pext, &cDir.nafta02&Pext
CASE UPPER(cDb)=="NAFDET"
SET INDEX TO &cDir.nafdet&Pext
CASE UPPER(cDb)=="CANCO"
SET INDEX TO &cDir.canco01&Pext
CASE UPPER(cDb)=="CCODET"
SET INDEX TO &cDir.canco02&Pext
CASE UPPER(cDb)=="CANCED"
SET INDEX TO &cDir.ced01&Pext
CASE UPPER(cDb)=="CEDDET"
SET INDEX TO &cDir.ced02&Pext
CASE UPPER(cDb)=="INSCFT"
SET INDEX TO &cDir.inscft01&Pext, &cDir.inscft02&Pext
CASE UPPER(cDb)=="CREDNOTE"
SET INDEX TO &cDir.crednote&Pext
CASE UPPER(cDb)=="CREDDET"
SET INDEX TO &cDir.creddet&Pext
CASE UPPER(cDb)=="TIC"
SET INDEX TO &cDir.tic&Pext
CASE UPPER(cDb)=="WEST"
SET INDEX TO &cDir.west&Pext
CASE UPPER(cDb)=="GLOBIMP"
SET INDEX TO &cDir.globimp&Pext
CASE UPPER(cDb)=="APEX"
SET INDEX TO &cDir.apex01&Pext
CASE UPPER(cDb)=="NJ"
SET INDEX TO &cDir.nj&Pext
CASE UPPER(cDb)=="USTC"
SET INDEX TO &cDir.ustc&Pext
CASE UPPER(cDb)=="SHIPSTAT"
SET INDEX TO &cDir.shipxsta&Pext
CASE UPPER(cDb)=="STATFILE"
SET INDEX TO &cDir.statxfil&Pext
CASE UPPER(cDb)=="USER"
IF ! FILE(cDir + "USER" + Pext )
INDEX ON company+pw TO &cDir.user&Pext
ENDIF
SET INDEX TO &cDir.user&Pext
CASE UPPER(cDb)=="ERROR"
IF ! FILE(cDir + "ERROR" + Pext )
INDEX ON DTOS(date) TO &Psys.error&Pext DESCENDING
ENDIF
SET INDEX TO &cDir.error&Pext
CASE UPPER(cDb)=="CDMLOG"
IF ! FILE( cDir + "LOGX01" + Pext )
MsgWait( "Building Log Search Keys", "CDM WinFrt", 1 )
INDEX ON DTOS(date)+process TAG S1 TO &cDir.logx01&Pext DESCENDING
INDEX ON user+DTOS(date)+process TAG S2 TO &cDir.logx01&Pext DESCENDING
INDEX ON process+DTOS(date) TAG S3 TO &cDir.logx01&Pext DESCENDING
ENDIF
SET INDEX TO &cDir.logx01&Pext
CASE UPPER(cDb)=="PROFILE"
IF ! FILE(cDir + "PROFX01.CDX")
INDEX ON custid TAG S1 TO &cDir.profx01.cdx
INDEX ON pw TAG S2 TO &cDir.profx01.cdx
ENDIF
SET INDEX TO &cDir.profx01
CASE UPPER(cDb)=="RCANOTES"
SET INDEX TO &cDir.rcanx01
CASE UPPER(cDb)=="RCA"
SET INDEX TO &cDir.rcax01
CASE UPPER(cDb)=="RCACTNR"
SET INDEX TO &cDir.rcax04
CASE UPPER(cDb)=="RCAPO"
SET INDEX TO &cDir.rcax05
CASE UPPER(cDb)=="RCAEVNT"
SET INDEX TO &cDir.rcax07

CASE UPPER(cDb)=="FLG"
SET INDEX TO &cDir.flgx01, &cDir.flgx02, &cDir.flgx03, &cDir.flgx04, &cDir.flgx05, &cDir.flgx06
CASE UPPER(cDb)=="PROPO"
SET INDEX TO &cDir.proxpo
CASE UPPER(cDb)=="PO"
SET INDEX TO &cDir.pox01
CASE UPPER(cDb)=="PODET"
SET INDEX TO &cDir.podtx01
CASE UPPER(cDb)=="PONOTE"
SET INDEX TO &cDir.ponx01
CASE UPPER(cDb)=="POTRACK"
SET INDEX TO &cDir.potx01
CASE UPPER(cDb)=="ZIPCODES"
SET INDEX TO &cDir.zipx01
CASE UPPER(cDb)=="ROUTE"
SET INDEX TO &cDir.rtex01
CASE UPPER(cDb)=="EMPLOYEE"
SET INDEX TO &cDir.emp01&Pext, &cDir.emp02&Pext
CASE UPPER(cDb)=="DEPT"
SET INDEX TO &cDir.dept01&Pext, &cDir.dept02&Pext
CASE UPPER(cDb)=="FEDERAL"
SET INDEX TO &cDir.federal&Pext
CASE UPPER(cDb)=="PAYROLL"
SET INDEX TO &cDir.pay01&Pext, &cDir.pay02&Pext, &cDir.pay03&Pext
CASE UPPER(cDb)=="PAYHIST"
SET INDEX TO &cDir.payhst01&Pext, &cDir.payhst02&Pext, &cDir.payhst03&Pext
CASE UPPER(cDb)=="CODES"
SET INDEX TO &cDir.codesx01&Pext, &cDir.codesx02&Pext, &cDir.codesx03&Pext
CASE UPPER(cDb)=="ELOG"
SET INDEX TO &cDir.elogx&Pext
CASE UPPER(cDb)=="PROFSPLT"
SET INDEX TO &cDir.psx01&Pext
CASE UPPER(cDb)=="PSDET"
SET INDEX TO &cDir.psx02&Pext

CASE UPPER(cDb)=="EVENT"
SET INDEX TO &cDir.evntx01&Pext
ENDCASE
INKEY(.1)
EXIT
ENDDO

RETURN (.T.)

******************************************************************************
* FUNC: _dbclose - Database Open Close Facility... *
******************************************************************************
FUNCTION _dbclose( cDb )

// Init...
local cDbFile := cDb

// Close...
&cDbFile.->( dbclosearea() )

RETURN (.T.)
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Post by Antonio Linares »

Darrell,

Are you using Harbour or xHarbour ? Please try it with both. You have them from our setup files.

Probably xHarbour will support that amount of files with no problems at all. Harbour requires an extra module to support so many files.
regards, saludos

Antonio Linares
www.fivetechsoft.com
Post Reply