FiveTech Support Forums

FiveWin / Harbour / xBase community
Board index FiveWin for Harbour/xHarbour Problem with application terminating
Posts: 708
Joined: Fri Oct 28, 2005 09:53 AM
Problem with application terminating
Posted: Fri Oct 28, 2005 10:28 AM

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.)
*~*~*~*~*~*~*~*~*~*
Darrell Ortiz
CDM Software Solutions, Inc.
https://www.cdmsoft.com
Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
Problem with application terminating
Posted: Fri Oct 28, 2005 11:38 AM

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

Continue the discussion