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.)
Problem with application terminating
-
Antonio Linares
- Site Admin
- Posts: 37481
- Joined: Thu Oct 06, 2005 5:47 pm
- Location: Spain
- Contact: