home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a012 / 1.ddi / DDD5.PRG < prev    next >
Encoding:
Text File  |  1991-05-01  |  15.5 KB  |  534 lines
  1. *============================================================================
  2. *
  3. *- OpenEnv() file opening system.
  4. *- Written by Clayton Neff for The Aquarium in Clipper 5.0
  5. *- Copyright 1990 CoN Computing
  6. *
  7. *----------------------------------------------------------------------------
  8. *
  9. *- These functions perform the automatic setup of program environments based
  10. *  on the information contained in three DBF files.
  11. *
  12. *  Compile with the /N option.
  13. *
  14. *============================================================================
  15. *
  16. *- This preprocessor directive allows the addition of new indecies without
  17. *  having to determine whether any others are already open.
  18. *
  19.  
  20. #command SET INDEX ADDITIVE TO <(index1)> [, <(indexN)> ] ;
  21. => ;
  22.             __dbSetIndex( <(index1)> ) ;
  23.          [; __dbSetIndex( <(indexN)> ) ]
  24.  
  25. *
  26. *- This define is for conditional compilation for whether or not you want
  27. *  to use the command defined above.
  28. *
  29.  
  30. #define ADD_OK
  31.  
  32. *
  33. *============================================================================
  34. *
  35. *  FUNCTION LOADENV()
  36. *
  37. *- This function uses the three DBF and NTX files to load the program
  38. *  environments into a static array.
  39. *
  40. *- Parameters : None
  41. *
  42. *- Returns    : A multidimensional array containing all the necessary
  43. *               information to open an environment.  If the array is
  44. *               empty, then one of the files was not available.
  45. *
  46. *- Syntax     : DataEnv_ := LoadEnv()
  47. *
  48. *----------------------------------------------------------------------------
  49. *
  50. function LoadEnv()
  51. *
  52. *- Create the necessary variables.
  53. *
  54. local EnvArray_ := {}
  55. local sDBFs_ := { "DATAREL", "DATANTX", "DATAENV" }
  56. local lError := .f.
  57. local i, nEnvNum, nDBFNum
  58. *
  59. *- Open the controlling files, if they are not already opened.
  60. *
  61. for i := 1 to 3
  62.    if ( ( select( sDBFs_[i] ) == 0 ) .and. ! lError )
  63.       if ! NetAlias( sDBFs_[i], sDBFs_[i], .f., .t., 5, 0.5 )
  64.          lError := .t.
  65.       else
  66.          set index to ( sDBFs_[i] )
  67.          if neterr()
  68.             lError := .t.
  69.          endif
  70.       endif
  71.    endif
  72. next i
  73. *
  74. *- If no error occurred, load the information into EnvArray_.
  75. *
  76. if ! lError
  77.    *
  78.    *- Step through the data files filling the array.
  79.    *
  80.    select DATAENV
  81.    do while ! DATAENV->( eof() )
  82.       *
  83.       *- Make a new element in the array, and store the ID in it.
  84.       *
  85.       AADD( EnvArray_, { DATAENV->ID, {} } )
  86.       nEnvNum := len( EnvArray_ )
  87.       *
  88.       *- Loop through all the DBF data files in this environment.
  89.       *
  90.       do while ( DATAENV->ID == EnvArray_[nEnvNum,1] )
  91.          *
  92.          *- Store the data file information into its part of the array.
  93.          *
  94.          AADD( EnvArray_[nEnvNum,2], { DATAENV->DBF_NAME, ;
  95.                                        DATAENV->DBF_ALIAS, ;
  96.                                        DATAENV->EXCLUSIVE, {}, {} } )
  97.          nDBFNum := len( EnvArray_[nEnvNum,2] )
  98.          *
  99.          *- Seek for associated NTXs.
  100.          *
  101.          if ( DATANTX->( FarSeek( DATAENV->ID + DATAENV->DBF_NAME ) ) )
  102.             *
  103.             *- Loop through DATANTX and load any associated NTXs 
  104.             *  into the proper part of the array.
  105.             *
  106.             do while ( DATANTX->DBF_NAME == DATAENV->DBF_NAME )
  107.                AADD( EnvArray_[nEnvNum,2,nDBFNum,4], DATANTX->NTX_NAME )
  108.                skip 1 alias DATANTX
  109.             enddo
  110.          endif
  111. /*
  112.    This block of code is commented out, due to the lack of support for
  113.    the setting of relations by Clipper 5.0.  When it is supported, just
  114.    uncomment this block.
  115.  
  116.           *
  117.           *- Seek for associated relations.
  118.           *
  119.           if ( DATAREL->( FarSeek( DATAENV->ID + DATAENV->DBF_NAME ) ) )
  120.              *
  121.              *- Loop through DATAREL and load any associated relations
  122.              *  into the proper part of the array.
  123.              *
  124.              do while ( DATAREL->DBF_NAME == DATAENV->DBF_NAME )
  125.                 AADD( EnvArray_[nEnvNum,2,nDBFNum,5], ;
  126.                       { DATAREL->TARGET_DBF, &( DATAREL->REL_EXPR ) } )
  127.                 skip 1 alias DATANTX
  128.              enddo
  129.           endif
  130. */
  131.          *
  132.          *- Move to the next DATAENV record.
  133.          *
  134.          skip 1 alias DATAENV
  135.          *
  136.       enddo while ( DATAENV->ID == EnvArray_[nEnvNum,1] )
  137.       *
  138.    enddo while ! DATAENV->( eof() )
  139.    *
  140. endif ! lError
  141. *
  142. *- Close the opened data files.
  143. *
  144. DATAREL->( FarClose() )
  145. DATANTX->( FarClose() )
  146. DATAENV->( FarClose() )
  147. *
  148. *- Return the EnvArray_ to the calling function.
  149. *
  150. return( EnvArray_ )
  151. *
  152. *- End of LoadEnv().
  153. *
  154. *============================================================================
  155. *
  156. *  FUNCTION OPENENV()
  157. *
  158. *- Parameters : The array containing the desired environment's informatiion.
  159. *   (Optional)  A code block error function to call on failure.
  160. *               The parameters passed to the code block are the environment
  161. *               identifier, and the DBF file when the error occured, and
  162. *               whether the indecies were being opened.
  163. *
  164. *- Returns : A logical value based on whether the desired data environment
  165. *            was opened properly.
  166. *
  167. *- Syntax : DataEnv_ := LoadEnv()
  168. *           if ! OpenEnv( DataEnv_[1] )
  169. *                 or
  170. *           lOpened := OpenEnv( DataEnv_[2], ;
  171. *                               { |id,dbf,ntx| OpenErrs(id,dbf,ntx) )
  172. *
  173. *- Notes : When the function completes successfully, you are left in the last
  174. *          area used during the opening process.
  175. *
  176. *----------------------------------------------------------------------------
  177. *
  178. function OpenEnv( Environ_, bErrFunc )
  179. *
  180. *- Declare and initialize locals needed.
  181. *
  182. local lError    := .f.
  183. local sErrDBF   := ''
  184. local lErrInNTX := .f.
  185. local sErrCall  := ''
  186. local nDBFCount := len( Environ_[2] )
  187. local i := 1
  188. *
  189. *- Loop through the DBF array opening the files.
  190. *
  191. do while ( ! lError .and. ( i <= nDBFCount ) )
  192.    *
  193.    *- Open the DBF data file.
  194.    *
  195.    if NetAlias( Environ_[2,i,1], ;
  196.                 Environ_[2,i,2], ;
  197.                 Environ_[2,i,3], ;
  198.                 .t., 5, 0.5 )
  199.       *
  200.       *- Set the idecies.
  201.       *
  202.       lError := SetNTXs( Environ_[2,1,4] )
  203.       *
  204.       *- If the indecies got set, set the relations.
  205.       *
  206.       if lError
  207.          *
  208.          *- An error occured while setting the indecies.
  209.          *
  210.          sErrDBF   := Environ_[2,i,1]
  211.          lErrInNTX := .t.
  212.          *
  213. *
  214. *- This block of code is commented out, due to the lack of support for
  215. *  the setting of relations by Clipper 5.0.  When it is supported, just
  216. *  uncomment this block.
  217. *
  218. *      else
  219. *         *
  220. *         *- Loop through relations for this environment/data file.
  221. *         *
  222. *         aeval( Environ_[2,i,5], { | RelArray_ | Relate( RelArray_ ) } )
  223. *         *
  224.       endif lError
  225.       *
  226.    else
  227.       *
  228.       *- The data file could not be opened.
  229.       *
  230.       lError  := .t.
  231.       sErrDBF := Environ_[2,i,1]
  232.       *
  233.    endif NetAlias()
  234.    *
  235. enddo
  236. *
  237. *- If there was an error, and an error function name was passed, 
  238. *  call it!
  239. *
  240. if ( lError .and. ( bErrFunc != NIL ) )
  241.    *
  242.    *- Call the code block with the proper parameters.
  243.    *
  244.    eval( bErrFunc, Environ_[1], sErrDbf, lErrInNTX )
  245.    *
  246. endif
  247. *
  248. *- Return whether or not an error occured.
  249. *
  250. return( lError )
  251. *
  252. *- End of OpenEnv().
  253. *
  254. *============================================================================
  255. *
  256. *  FUNCTION NETALIAS()
  257. *
  258. *- This function is a modification of the NetUse function supplied by
  259. *  Nantucket to include the passing of a work area alias.
  260. *
  261. *----------------------------------------------------------------------------
  262. *
  263. function NetAlias( sFileName, sAreaName, lExclusive, lNew, nTries, nDelay )
  264. *
  265. local lDone := .f., i
  266. *
  267. *- If a new work area is desired...
  268. *
  269. if ( lNew )
  270.    select 0
  271. endif
  272. *
  273. *- Try opening up to nTries times.
  274. *
  275. for i := 1 to nTries
  276.    *
  277.    *- Attempt to open the file.
  278.    *
  279.    if ( lExclusive )
  280.       use ( sFileName ) exclusive alias ( sAreaName )
  281.    else
  282.       use ( sFileName ) alias ( sAreaName )
  283.    endif
  284.    *
  285.    *- If no error occured, set flag and exit the loop.
  286.    *
  287.    if ( ! neterr() )
  288.       lDone := .t.
  289.       exit
  290.    endif
  291.    *
  292.    *- Hardcoded delay before retrying.  Could be passed as a parameter.
  293.    *
  294.    inkey(.5)
  295.    *
  296. next i
  297. *
  298. return( lDone )
  299. *
  300. *- End of NetAlias().
  301. *
  302. *============================================================================
  303. *
  304. *  FUNCTION SETNTXS()
  305. *
  306. *- This function set the indecies for a work area.  It assumes that the
  307. *  controlling data files have been opened, and the DATAENV pointer is on
  308. *  the desired record.
  309. *
  310. *  The return value reports whether or not all the desired indecies were
  311. *  opened.
  312. *
  313. *----------------------------------------------------------------------------
  314. *
  315. function SetNTXs( sFiles_ )
  316. *
  317. local nCount  := len( sFiles_ )
  318. local lDone   := .t.
  319. *
  320. *- Conditional compilation based on whether ADD_OK has been defined.
  321. *
  322. #ifdef ADD_OK
  323.    *
  324.    local i := 1
  325.    *
  326.    *- Loop through the array, checking that the array was opened.
  327.    *
  328.    do while ( lDone .and. ( i <= nCount ) )
  329.       set index additive to ( sFiles_[1] )
  330.       lDone := ( ! neterr() )
  331.       i++
  332.    enddo while ( lDone .and. ( i <= nCount ) )
  333.    *
  334. #else
  335.    *
  336.    *- Because of the lack of "set index additive to", the following
  337.    *  "do case" is necessary.
  338.    *
  339.    do case
  340.       *
  341.       *- No indecies associated with this data file, so do nothing.
  342.       *
  343.       case ( nCount == 0 )
  344.       *
  345.       *- One index.
  346.       *
  347.       case ( nCount == 1 )
  348.          set index to ( sFiles_[1] )
  349.       *
  350.       *- Two indecies.
  351.       *
  352.       case ( nCount == 2 )
  353.          set index to ( sFiles_[1] ), ( sFiles_[2] )
  354.       *
  355.       *- Three indecies.
  356.       *
  357.       case ( nCount == 3 )
  358.          set index to ( sFiles_[1] ), ( sFiles_[2] ), ( sFiles_[3] )
  359.       *
  360.       *- Four indecies.
  361.       *
  362.       case ( nCount == 4 )
  363.          set index to ( sFiles_[1] ), ( sFiles_[2] ), ( sFiles_[3] ), ;
  364.                      ( sFiles_[4] )
  365.       *
  366.       *- Five indecies.
  367.       *
  368.       case ( nCount == 5 )
  369.          set index to ( sFiles_[1] ), ( sFiles_[2] ), ( sFiles_[3] ), ;
  370.                      ( sFiles_[4] ), ( sFiles_[5] )
  371.       *
  372.       *- Six indecies.
  373.       *
  374.       case ( nCount == 6 )
  375.          set index to ( sFiles_[1] ), ( sFiles_[2] ), ( sFiles_[3] ), ;
  376.                      ( sFiles_[4] ), ( sFiles_[5] ), ( sFiles_[6] )
  377.       *
  378.       *- Seven indecies.
  379.       *
  380.       case ( nCount == 7 )
  381.          set index to ( sFiles_[1] ), ( sFiles_[2] ), ( sFiles_[3] ), ;
  382.                      ( sFiles_[4] ), ( sFiles_[5] ), ( sFiles_[6] ), ;
  383.                      ( sFiles_[7] )
  384.       *
  385.       *- Eight indecies.
  386.       *
  387.       case ( nCount == 8 )
  388.          set index to ( sFiles_[1] ), ( sFiles_[2] ), ( sFiles_[3] ), ;
  389.                      ( sFiles_[4] ), ( sFiles_[5] ), ( sFiles_[6] ), ;
  390.                      ( sFiles_[7] ), ( sFiles_[8] )
  391.       *
  392.       *- Nine indecies.
  393.       *
  394.       case ( nCount == 9 )
  395.          set index to ( sFiles_[1] ), ( sFiles_[2] ), ( sFiles_[3] ), ;
  396.                      ( sFiles_[4] ), ( sFiles_[5] ), ( sFiles_[6] ), ;
  397.                      ( sFiles_[7] ), ( sFiles_[8] ), ( sFiles_[9] )
  398.       *
  399.       *- Ten indecies.
  400.       *
  401.       case ( nCount == 10 )
  402.          set index to ( sFiles_[1] ), ( sFiles_[2] ), ( sFiles_[3] ), ;
  403.                      ( sFiles_[4] ), ( sFiles_[5] ), ( sFiles_[6] ), ;
  404.                      ( sFiles_[7] ), ( sFiles_[8] ), ( sFiles_[9] ), ;
  405.                      ( sFiles_[10] )
  406.       *
  407.       *- Eleven indecies.
  408.       *
  409.       case ( nCount == 11 )
  410.          set index to ( sFiles_[1] ), ( sFiles_[2] ), ( sFiles_[3] ), ;
  411.                      ( sFiles_[4] ), ( sFiles_[5] ), ( sFiles_[6] ), ;
  412.                      ( sFiles_[7] ), ( sFiles_[8] ), ( sFiles_[9] ), ;
  413.                      ( sFiles_[10] ), ( sFiles_[11] )
  414.       *
  415.       *- Twelve indecies.
  416.       *
  417.       case ( nCount == 12 )
  418.          set index to ( sFiles_[1] ), ( sFiles_[2] ), ( sFiles_[3] ), ;
  419.                      ( sFiles_[4] ), ( sFiles_[5] ), ( sFiles_[6] ), ;
  420.                      ( sFiles_[7] ), ( sFiles_[8] ), ( sFiles_[9] ), ;
  421.                      ( sFiles_[10] ), ( sFiles_[11] ), ( sFiles_[12] )
  422.       *
  423.       *- Thirteen indecies.
  424.       *
  425.       case ( nCount == 13 )
  426.          set index to ( sFiles_[1] ), ( sFiles_[2] ), ( sFiles_[3] ), ;
  427.                      ( sFiles_[4] ), ( sFiles_[5] ), ( sFiles_[6] ), ;
  428.                      ( sFiles_[4] ), ( sFiles_[5] ), ( sFiles_[6] ), ;
  429.                      ( sFiles_[7] ), ( sFiles_[8] ), ( sFiles_[9] ), ;
  430.                      ( sFiles_[10] ), ( sFiles_[11] ), ( sFiles_[12] ), ;
  431.                      ( sFiles_[13] )
  432.       *
  433.       *- Fourteen indecies.
  434.       *
  435.       case ( nCount == 14 )
  436.          set index to ( sFiles_[1] ), ( sFiles_[2] ), ( sFiles_[3] ), ;
  437.                      ( sFiles_[4] ), ( sFiles_[5] ), ( sFiles_[6] ), ;
  438.                      ( sFiles_[4] ), ( sFiles_[5] ), ( sFiles_[6] ), ;
  439.                      ( sFiles_[7] ), ( sFiles_[8] ), ( sFiles_[9] ), ;
  440.                      ( sFiles_[10] ), ( sFiles_[11] ), ( sFiles_[12] ), ;
  441.                      ( sFiles_[13] ), ( sFiles_[14] )
  442.       *
  443.       *- Fifteen indecies.
  444.       *
  445.       case ( nCount == 15 )
  446.          set index to ( sFiles_[1] ), ( sFiles_[2] ), ( sFiles_[3] ), ;
  447.                      ( sFiles_[4] ), ( sFiles_[5] ), ( sFiles_[6] ), ;
  448.                      ( sFiles_[7] ), ( sFiles_[8] ), ( sFiles_[9] ), ;
  449.                      ( sFiles_[10] ), ( sFiles_[11] ), ( sFiles_[12] ), ;
  450.                      ( sFiles_[13] ), ( sFiles_[14] ), ( sFiles_[15] )
  451.       *
  452.    endcase
  453.    *
  454.    *- Check that there were no errors.
  455.    *
  456.    lDone := ( ! neterr() )
  457.    *
  458. #endif
  459. *
  460. return( lDone )
  461. *
  462. *- End of SetNTXs().
  463. *
  464. *============================================================================
  465. *
  466. *- This block of code is commented out, due to the lack of support for
  467. *  the setting of relations by Clipper 5.0.  When it is supported, just
  468. *  uncomment this block.
  469. *
  470. **============================================================================
  471. **
  472. **  FUNCTION RELATE()
  473. **
  474. **- This function set relations additively.
  475. **
  476. **- Parameters : An array of arrays.  Each subarray contains two elements: 
  477. **               the target area and the relating expression.
  478. **
  479. **- Returns    : Nothing.
  480. **
  481. **----------------------------------------------------------------------------
  482. **
  483. *function Relate( RelData_ )
  484. **
  485. *set relation additive to ( eval( RelData_[2] ) ) into ( RelData_[1] )
  486. **
  487. *return( '' )
  488. **
  489. **- End of Relate().
  490. **
  491. *============================================================================
  492. *
  493. *  FUNCTION FARSEEK
  494. *
  495. *- This function allows for seeking a record in an area other than the
  496. *  currently selected working area.
  497. *
  498. *- Parameters : The value to seek.
  499. *
  500. *- Returns    : A logical for whether it was found.
  501. *
  502. *----------------------------------------------------------------------------
  503. *
  504. function FarSeek( xValue )
  505. *
  506. seek xValue
  507. *
  508. return( found() )
  509. *
  510. *- End of FarSeek().
  511. *
  512. *============================================================================
  513. *
  514. *  FUNCTION FARCLOSE
  515. *
  516. *- This function closes a work area, even if it is not currently selected.
  517. *
  518. *- Parameters : None.
  519. *
  520. *- Returns    : Nothing.
  521. *
  522. *----------------------------------------------------------------------------
  523. *
  524. function FarClose
  525. *
  526. use
  527. *
  528. return( '' )
  529. *
  530. *- End of FarClose().
  531. *
  532. *============================================================================
  533. *
  534.