home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a067 / 1.img / GRUMP501.EXE / FOTOCOPY.PRG < prev    next >
Encoding:
Text File  |  1991-04-23  |  2.3 KB  |  87 lines
  1. /*
  2.    Function: FOTOCOPY()
  3.    System: GRUMPFISH LIBRARY
  4.    Author: Greg Lief
  5.    Copyright (c) 1988-90, Greg Lief
  6.    Clipper 5.01 Version
  7.    Compile instructions: clipper fotocopy /n/w/a
  8.    Inspired by Gary Van Slyke, Minneapolis, MN
  9. */
  10.  
  11. //───── begin preprocessor directives
  12.  
  13. #include "dbstruct.ch"
  14.  
  15. //───── end preprocessor directives
  16.  
  17. //───── begin global declarations
  18.  
  19. static fields_ := {}
  20.  
  21. //───── end global declarations
  22.  
  23. /*
  24.    Function: FotoCopy()
  25.    Purpose: get the ball rolling
  26. */
  27. function fotocopy(calias1, calias2, calias3, calias4)
  28. local num_files := pcount(), ret_val := 0, xx
  29. fields_ := dbstruct()      // dump current .dbf structure to array
  30. for xx = 1 to num_files
  31.    ret_val += loopdloop(if(xx == 1, calias1, if(xx == 2, calias2, ;
  32.                         if(xx == 3, calias3, calias4))))
  33. next
  34. return ret_val
  35.  
  36. * end function FotoCopy()
  37. *--------------------------------------------------------------------*
  38.  
  39.  
  40. /*
  41.    Function: LoopDLoop()
  42.    Purpose: Main loop to copy record into each database
  43. */
  44. static function loopdloop(calias)
  45. local fields2_ := {}, firstloop := .t., xx, ret_val := 1, element, ;
  46.       wk_area := select(), had2open := .f., num_flds, cfield
  47. //───── determine whether target database is already open
  48. select(select(calias))
  49. if fcount() == 0
  50.    if ! file(calias + '.dbf')
  51.       ret_val := 0
  52.    else
  53.       use (calias)
  54.       had2open := .t.
  55.    endif
  56. endif
  57. if ret_val == 1
  58.    num_flds := fcount()
  59.    fields2_ := dbstruct()
  60.    for xx = 1 to num_flds
  61.       // check if this field is in the source database
  62.       if (element := ascan(fields_, ;
  63.               { |a| a[DBS_NAME] == fields2_[xx][DBS_NAME] } )) > 0
  64.          // verify they are of the same type!
  65.          if fields2_[xx][DBS_TYPE] == fields_[element][DBS_TYPE]
  66.             if firstloop
  67.                append blank
  68.                firstloop := .f.
  69.             endif
  70.             cfield := fields2_[xx][DBS_NAME]
  71. *            eval( fieldblock(cfield) , eval( fieldwblock(cfield, wk_area) ) )
  72.             fieldput(fieldpos(cfield), (wk_area)->(fieldget(fieldpos(cfield))))
  73.          endif
  74.       endif
  75.    next
  76.    if had2open
  77.       use
  78.    endif
  79. endif
  80. select(wk_area)
  81. return ret_val
  82.  
  83. * end static function LoopDLoop()
  84. *--------------------------------------------------------------------*
  85.  
  86. * eof fotocopy.prg
  87.