home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / VS_804.ZIP / MAINTSRC.EXE / C_DBF.PRG < prev    next >
Encoding:
Text File  |  1991-10-30  |  3.9 KB  |  188 lines
  1. * Filename......: C_Dbf.Prg
  2. *
  3. * Author........: Vernon E. Six, Jr.
  4. *
  5. * Last Update...: Wed  10-30-1991  13:48:45
  6. *
  7. * Notice........: Copyright (c) 1991 by Vernon E. Six, Jr.
  8. *                 All Rights Reserved World Wide
  9. *
  10. * Dialect.......: Clipper v5.0x
  11.  
  12. #include "INKEY.CH"
  13. #include "SETCURS.CH"
  14.  
  15. FUNCTION C_Dbf()
  16. *****
  17. * Copy a database
  18. *****
  19. LOCAL a_Temp    := {}
  20. LOCAL a_Struct  := {}
  21. LOCAL ac_Ntx    := {}
  22. LOCAL c_CurrDbf := _DICTHDR->DBF_NAME
  23. LOCAL a_Values  := {}
  24. LOCAL n_Cntr
  25. LOCAL n_Cntr2
  26. LOCAL c_NewDbf
  27.  
  28.    *****
  29.    * Get the new database's name
  30.    *****
  31.    IF EMPTY( a_Temp := A_DictHdr(.F.) )
  32.       RETURN(NIL)
  33.     ELSE
  34.       c_NewDbf = a_Temp[1]
  35.    ENDIF
  36.  
  37.    BEGIN SEQUENCE
  38.  
  39.       *══ Header ════════════════════════════════════════════════*
  40.       
  41.       a_Values := {}
  42.  
  43.       IF .NOT. _DICTHDR->( dbSeek( c_CurrDbf ) )
  44.  
  45.          BREAK
  46.       ENDIF
  47.  
  48.       *****
  49.       * Get all the header information  (let's be generic!!!)
  50.       *****
  51.       FOR n_Cntr = 1 TO _DICTHDR->( FCount() )
  52.  
  53.          AADD( a_Values, _DICTHDR->( FieldGet(n_Cntr) ) )
  54.  
  55.          IF ALLTRIM( _DICTHDR->( FieldName(n_Cntr) ) ) == "DBF_NAME"
  56.             a_Values[n_Cntr] = c_NewDbf
  57.          ENDIF
  58.  
  59.       NEXT n_Cntr
  60.  
  61.       *****
  62.       * Create the new record
  63.       *****
  64.       IF .NOT. _DICTHDR->( VS_AddRec() )
  65.          BREAK
  66.       ENDIF
  67.  
  68.       FOR n_Cntr = 1 TO LEN( a_Values )
  69.  
  70.          _DICTHDR->( FieldPut( n_Cntr, a_Values[n_Cntr] ) )
  71.  
  72.       NEXT n_Cntr
  73.       
  74.  
  75.  
  76.       *══ Fields ════════════════════════════════════════════════*
  77.  
  78.       *****
  79.       * Get the structure
  80.       *****
  81.       _DICTFLD->( dbSeek( c_CurrDbf ) )
  82.       
  83.       a_Struct := {}
  84.  
  85.       DO WHILE .NOT. _DICTFLD->( EOF() )
  86.  
  87.          IF _DICTFLD->DBF_NAME <> c_CurrDbf
  88.             EXIT
  89.          ENDIF
  90.  
  91.          a_Values := {}
  92.  
  93.          FOR n_Cntr = 1 TO _DICTFLD->( FCount() )
  94.  
  95.             AADD( a_Values, _DICTFLD->( FieldGet(n_Cntr) ) )
  96.  
  97.             IF ALLTRIM( _DICTFLD->( FieldName(n_Cntr) ) ) == "DBF_NAME"
  98.                a_Values[n_Cntr] = c_NewDbf
  99.             ENDIF
  100.  
  101.          NEXT n_Cntr
  102.  
  103.          AADD( a_Struct, a_Values )
  104.  
  105.          _DICTFLD->( dbSkip() )
  106.  
  107.       ENDDO
  108.  
  109.       *****
  110.       * Create the new records
  111.       *****
  112.       FOR n_Cntr = 1 TO LEN( a_Struct )
  113.  
  114.          IF .NOT. _DICTFLD->( VS_AddRec() )
  115.             BREAK
  116.          ENDIF
  117.  
  118.          a_Values = a_Struct[n_Cntr]
  119.  
  120.          FOR n_Cntr2 = 1 TO LEN( a_Values )
  121.             _DICTFLD->( FieldPut( n_Cntr2, a_Values[n_Cntr2] ) )
  122.          NEXT n_Cntr2
  123.  
  124.       NEXT n_Cntr
  125.  
  126.  
  127.  
  128.       *══ Indices ═══════════════════════════════════════════════*
  129.  
  130.       *****
  131.       * Get the structure
  132.       *****
  133.       _DICTNTX->( dbSeek( c_CurrDbf ) )
  134.       
  135.       a_Struct := {}
  136.  
  137.       DO WHILE .NOT. _DICTNTX->( EOF() )
  138.  
  139.          IF _DICTNTX->DBF_NAME <> c_CurrDbf
  140.             EXIT
  141.          ENDIF
  142.  
  143.          a_Values := {}
  144.  
  145.          FOR n_Cntr = 1 TO _DICTNTX->( FCount() )
  146.  
  147.             AADD( a_Values, _DICTNTX->( FieldGet(n_Cntr) ) )
  148.  
  149.             IF ALLTRIM( _DICTNTX->( FieldName(n_Cntr) ) ) == "DBF_NAME"
  150.                a_Values[n_Cntr] = c_NewDbf
  151.             ENDIF
  152.  
  153.          NEXT n_Cntr
  154.  
  155.          AADD( a_Struct, a_Values )
  156.  
  157.          _DICTNTX->( dbSkip() )
  158.  
  159.       ENDDO
  160.  
  161.       *****
  162.       * Create the new records
  163.       *****
  164.       FOR n_Cntr = 1 TO LEN( a_Struct )
  165.  
  166.          IF .NOT. _DICTNTX->( VS_AddRec() )
  167.             BREAK
  168.          ENDIF
  169.  
  170.          a_Values = a_Struct[n_Cntr]
  171.  
  172.          FOR n_Cntr2 = 1 TO LEN( a_Values )
  173.             _DICTNTX->( FieldPut( n_Cntr2, a_Values[n_Cntr2] ) )
  174.          NEXT n_Cntr2
  175.  
  176.       NEXT n_Cntr
  177.  
  178.       *══════════════════════════════════════════════════════════*
  179.       
  180.    END SEQUENCE
  181.  
  182.    dbUnlockAll()
  183.            
  184. RETURN(NIL)
  185. *** EOF: C_Dbf() ************************************************************
  186.  
  187.  
  188.