home *** CD-ROM | disk | FTP | other *** search
/ Power CD-ROM!! 7 / POWERCD7.ISO / prgmming / clipper / gt_open.prg < prev    next >
Text File  |  1993-10-14  |  6KB  |  263 lines
  1. /*
  2.     File......: GT_Open.prg
  3.     Author....: Martin Bryant
  4.     BBS.......: The Dark Knight Returns
  5.     Net/Node..: 050/069
  6.     User Name.: Martin Bryant
  7.     Date......: 09/02/93
  8.     Revision..: 1.0
  9.  
  10.     This is an original work by Martin Bryant and is placed
  11.     in the public domain.
  12.  
  13.     Modification history:
  14.     ---------------------
  15.  
  16.     Rev 1.0 09/02/93
  17.     PD Revision.
  18. */
  19.  
  20. /*  $DOC$
  21.  *  $FUNCNAME$
  22.  *      GT_OPEN()
  23.  *  $CATEGORY$
  24.  *      General
  25.  *  $ONELINER$
  26.  *      Open a DBF file with indexes, allowing reindexing, etc.
  27.  *  $SYNTAX$
  28.  *      GT_Open(<cFile>,[<aIndex>],[<cAlias>],[<lFix>], ;
  29.  *              [<lPack>],[<aStruct>]) -> cAlias
  30.  *  $ARGUMENTS$
  31.  *      <cFile> is the name of the file to open.
  32.  *
  33.  *      <aIndex> is an array of text strings representing
  34.  *      index keys.
  35.  *
  36.  *      <cAlias> is the alias to use if successful.
  37.  *
  38.  *      <lFix> Rebuild the indexes ?
  39.  *
  40.  *      <lPack> Pack the  file ?
  41.  *
  42.  *      <aStruct> is the array defining the database
  43.  *      structure if the file is to be built from scratch.
  44.  *  $RETURNS$
  45.  *      cAlias
  46.  *  $DESCRIPTION$
  47.  *      Open a DBF file with indexes, allowing reindexing,
  48.  *      packing and returning the alias.
  49.  *  $EXAMPLES$
  50.  *      // Open customer invoices file indexed on invoice
  51.  *      // number and customer account number, returing the
  52.  *      // alias of INVOICES
  53.  *      IF EMPTY(GT_Open('INVS0293', ;
  54.  *          {'INVS','UPPER(CUSTOMER)'},'INVOICES'))
  55.  *
  56.  *          ? 'Error'
  57.  *
  58.  *      ENDIF
  59.  *  $SEEALSO$
  60.  *
  61.  *  $INCLUDE$
  62.  *
  63.  *  $END$
  64.  */
  65. #include "GT_LIB.ch"
  66.  
  67. MEMVAR cIndexKey
  68.  
  69. FUNCTION GT_Open(cFile,aIndex,cAlias,lFix,lPack,aStruct)
  70.  
  71. LOCAL abAssigns := { ;
  72.     { | | cIndex1 := cNtxName + '1' }, ;
  73.     { | | cIndex2 := cNtxName + '2' }, ;
  74.     { | | cIndex3 := cNtxName + '3' }, ;
  75.     { | | cIndex4 := cNtxName + '4' }, ;
  76.     { | | cIndex5 := cNtxName + '5' }, ;
  77.     { | | cIndex6 := cNtxName + '6' }, ;
  78.     { | | cIndex7 := cNtxName + '7' }, ;
  79.     { | | cIndex8 := cNtxName + '8' }, ;
  80.     { | | cIndex9 := cNtxName + '9' } }
  81.  
  82. LOCAL cBrightMnu := GT_Hilite(SETCOLOR(),'+')
  83. LOCAL cColour := SETCOLOR()
  84. LOCAL cComplete := 'Complete'
  85. LOCAL cFlashMnu := GT_Hilite(SETCOLOR(),'*')
  86. LOCAL cIndex1 := ''
  87. LOCAL cIndex2 := ''
  88. LOCAL cIndex3 := ''
  89. LOCAL cIndex4 := ''
  90. LOCAL cIndex5 := ''
  91. LOCAL cIndex6 := ''
  92. LOCAL cIndex7 := ''
  93. LOCAL cIndex8 := ''
  94. LOCAL cIndex9 := ''
  95. LOCAL cNtxName := ''
  96. LOCAL cPointer := ' ->'
  97. LOCAL cScreen := ''
  98. LOCAL cTitle := '┤ Mending Datafile ├'
  99. LOCAL cWorkWait := 'Working'
  100. LOCAL lSuccess := .F.
  101. LOCAL nBottom := 16
  102. LOCAL nCount := 0
  103. LOCAL nIndexes := 0
  104. LOCAL nLeft := 26
  105. LOCAL nRight := 54
  106. LOCAL nTop := 08
  107.  
  108. PRIVATE cIndexKey := ""
  109.  
  110. Default cFile to ''
  111. Default aIndex to {}
  112. Default cAlias to ''
  113. Default lFix to .F.
  114. Default lPack to .F.
  115. Default aStruct to {}
  116.  
  117. nIndexes := LEN(aIndex)
  118. cAlias := UPPER(cAlias)
  119.  
  120. //  Trim for index name
  121. cNtxName := SUBSTR(cFile,1,RAT('\',cFile)+7)
  122. nCount := AT('.',cNtxName)
  123. IF nCount > 0
  124.     cNtxName := SUBSTR(cNtxName,1,nCount-1)
  125. ENDIF
  126.  
  127. BEGIN SEQUENCE
  128.  
  129.     // Select new file handle
  130.     SELECT(0)
  131.  
  132.     // Extention
  133.     IF .NOT. ('.' $ cFile)
  134.         cFile += '.DBF'
  135.     ENDIF
  136.  
  137.     // Exists ?
  138.     DO CASE
  139.  
  140.         CASE FILE(cFile)
  141.             // File found
  142.             lSuccess := .T.
  143.  
  144.         CASE EMPTY(aStruct)
  145.             // Can't build
  146.             GT_Error('Unable to find <' + cFile + '>')
  147.  
  148.         OTHERWISE
  149.             // Build
  150.             IF UPPER(CHR(GT_AskUser('The file <' + cFile + ;
  151.                 '> does not exists. Do you wish to ' + ;
  152.                 'create it? Please check with your ' + ;
  153.                 'system manager if you are unsure. (Y/N)', ;
  154.                 {ASC('Y'),ASC('N'),ASC('y'),ASC('n')}, ;
  155.                 'File Not found', ;
  156.                 SETCOLOR(),BOX_DS))) == 'Y'
  157.  
  158.                 // Create
  159.                 DBCREATE(cFile,aStruct)
  160.                 lSuccess := FILE(cFile)
  161.  
  162.             ENDIF
  163.  
  164.     ENDCASE
  165.  
  166.     // Open file
  167.     IF lSuccess
  168.         lSuccess := (GT_Use(cFile,.T.,cAlias) == cAlias)
  169.     ENDIF
  170.  
  171.     // Failure
  172.     IF .NOT. lSuccess
  173.         BREAK(NIL)
  174.     ENDIF
  175.  
  176.     // Indexes exist ?
  177.     FOR nCount := 1 TO nIndexes
  178.         IF .NOT. FILE(cNtxName + STR(nCount,1,0) + '.NTX')
  179.             lFix := .T.
  180.             EXIT
  181.         ENDIF
  182.     NEXT
  183.  
  184.     IF lFix .OR. lPack
  185.         // Box
  186.         cScreen := SAVESCREEN(00,00,MAXROW(),MAXCOL())
  187.         GT_Window(nTop,nLeft,nBottom,nRight,BOX_SS, ;
  188.             SETCOLOR(),'Updating ....',.T.)
  189.  
  190.         @ nTop, nLeft + 02 SAY cTitle
  191.         @ nTop + 02, nLeft + 02 SAY 'File: ' + cFile
  192.         @ nTop + 06, nLeft + 02 SAY 'Indexing 0 of ' + ;
  193.             STR(nIndexes,1)
  194.  
  195.     ENDIF
  196.     IF lPack
  197.  
  198.         @ nTop + 04, nLeft + 02 SAY 'Packing '  + ;
  199.             STR(LASTREC(),7) + cPointer
  200.  
  201.         SETCOLOR(cFlashMnu)
  202.         @ nTop + 04, nLeft + 20 SAY cWorkWait
  203.         PACK
  204.         DBGOTOP()
  205.         SETCOLOR(cBrightMnu)
  206.  
  207.         @ nTop + 04, nLeft + 20 SAY ;
  208.             PADR(LTRIM(STR(LASTREC())),7)
  209.  
  210.         lFix := .T.
  211.  
  212.     ENDIF
  213.  
  214.     // Any indexes
  215.     IF nIndexes > 0
  216.  
  217.         // Assign Index variables
  218.         AEVAL(abAssigns, { | bData, nElem | EVAL(bData) }, ;
  219.             1,nIndexes)
  220.  
  221.         IF lFix
  222.             SETCOLOR(cFlashMnu)
  223.             FOR nCount := 1 TO nIndexes
  224.                 @ nTop + 06, nLeft + 11 SAY STR(nCount,1)
  225.                 cIndexKey := aIndex[nCount]
  226.  
  227.                 INDEX ON &cIndexKey TO (cNtxName + ;
  228.                         STR(nCount,1,0))
  229.  
  230.             NEXT
  231.             SETCOLOR(cBrightMnu)
  232.             @ nTop + 06, nLeft + 11 SAY cComplete
  233.  
  234.         ENDIF
  235.         SET INDEX TO (cIndex1), (cIndex2), (cIndex3), ;
  236.             (cIndex4), (cIndex5), (cIndex6), (cIndex7), ;
  237.             (cIndex8), (cIndex9)
  238.  
  239.     ENDIF
  240.  
  241.     // Worked ok
  242.     DBGOTOP()
  243.     lSuccess := .T.
  244.  
  245. ENDSEQUENCE
  246.  
  247. //  Restore screen
  248. IF lFix .OR. lPack
  249.     RESTSCREEN(00,00,MAXROW(),MAXCOL(),cScreen)
  250. ENDIF
  251.  
  252. //  Close due to failure
  253. IF .NOT. lSuccess
  254.     USE // Nothing
  255. ENDIF
  256.  
  257. SETCOLOR(cColour)
  258.  
  259. /*
  260.     End of GT_Open()
  261. */
  262. RETURN(UPPER(ALIAS()))
  263.