home *** CD-ROM | disk | FTP | other *** search
/ Phoenix CD 2.0 / Phoenix_CD.cdr / 01e / mem2dbf.zip / MEM2DBF.PRG
Text File  |  1988-02-22  |  6KB  |  222 lines
  1. *
  2. *  Program: mem_rep.PRG
  3. *  For    : Clipper Summer '87
  4. *  Author : Tony Kirk
  5. *  Date   : 02/19/88
  6. *  Purpose: Automates writing code segments which read field list and create
  7. *           matching memory variables.  Writes the code to create the memory
  8. *           variables, and the code to replace the memory variables into the
  9. *           dbf.  In other words, "dbf->fields TO m->fields TO dbf->fields"
  10. *
  11. *  Notes  : I know there are routines/functions "out there" that perform the
  12. *           routine globally, using macros.  In a large dbf (many fields), a
  13. *           performance degradation will occur.  MEM_REP.PRG  will create as
  14. *           many of these routines as you wish, all hard coded to work  with
  15. *           the one data file only.  Creates a completely new file which can
  16. *           later be merged with other prgs/procs.
  17. *
  18. *  *******  I can't say this proc is perfect.  Make a separate directory with
  19. *  NOTICE!  MEM_REP.EXE, your DBF file, and any associated DBT file.  Then I
  20. *  *******  recommend you experiment with it for a while.  (See MEM_DEMO.PRG)
  21. *
  22. *  Details: 1  Ignores MEMO fields.
  23. *           2  Performs the routine on logical fields, but the bugs in the
  24. *                Summer '87 version of Clipper may prohibit correct use of a
  25. *                logical field, as of 02/19/88 (see anomaly report #5).
  26. *           3  Notice necessary parameters in created proc (xxx_2MEM).
  27. *           4  To be a standalone program.  Variable names may need changed if
  28. *                it is to be merged with another program.
  29. *           5  Due to use of "setcolor", requires EXTEND.LIB.
  30. *           6  If using "blank" memvars, must use pict clause in editing
  31. *
  32.  
  33. save scre to oldscrn
  34.  
  35. if iscolor()
  36.   oldcolor=setcolor('w+/b,bg+/n,b,,bg+/b')
  37. else
  38.   oldcolor=setcolor('w+,i,,,u')
  39. endif
  40.  
  41. clear screen
  42.  
  43. @ 1,35 say 'MEM_DBF'
  44. @ 2,21 say 'Press ^W to finish entry, Esc to exit'
  45.  
  46. @ 4,10 to 16,70 double
  47.  
  48. dbfname=space(12)                       && dbf file name
  49. dbfpre ='          '                    && dbf    alias    prefix
  50. mempre ='M->'                           && memory variable prefix
  51. prgpre ='   '                           && procedure name  prefix
  52. prgname=space(12)                       && proc file name
  53. pubstr =''                              && public variable string
  54. numstr =''                              && numeric (store 0 to..)
  55.  
  56. do while .t.
  57.   @  6,20 say 'DBF file name to use   :' get dbfname pict '@K !!!!!!!!.dbf' valid is_dbf(dbfname)
  58.   @  7,20 say 'PRG file name to create:' get prgname pict '@K !!!!!!!!.prg' valid no_prg(prgname)
  59.   @  9,20 say 'DBF field alias prefix :' get dbfpre pict '@K@!'
  60.   @ 10,20 say 'MEM variable prefix    :' get mempre pict '@K@!'
  61.   @ 11,20 say 'PRG procname prefix    :' get prgpre pict '@K@!'
  62.   @ 13,15 say '1)  DBF file must exist.  '
  63.   @ 14,15 say '2)  PRG procname prefix - "xxx"=procname prefix:'
  64.   @ 15,15 say '    dbf -> mem: xxx_2mem    mem -> dbf: xxx_2dbf'
  65.   read
  66.   if lastkey() = 18 .or. lastkey() = 3
  67.     loop
  68.   endif
  69.   if lastkey() = 27
  70.     set alte off
  71.     set alte to
  72.     close all
  73.     setcolor(oldcolor)
  74.     rest scre from oldscrn
  75.     return
  76.   endif
  77.   @ 22,0 say ''
  78.   op=' '
  79.   wait 'Press [Enter] to begin, any other key to return.' to op
  80.   if lastkey()<>13
  81.     @ 22,0 clear
  82.     loop
  83.   endif
  84.   @ 22,0 clear
  85.   dbfpre=ltrim(trim(dbfpre))
  86.   mempre=ltrim(trim(mempre))
  87.   prgpre=ltrim(trim(prgpre))
  88.   use (dbfname)
  89.   cnt=fcount()
  90.   set cons off
  91.   set alte to &prgname
  92.   set alte on
  93.   ? '********************'
  94.   ? '*  Function &prgpre._2MEM'
  95.   ? '*'
  96.   ? '*  Parameter : Numeric - where 1 equates memvars to contents of fields'
  97.   ? '*                        and   0 equates memvars to empty fields'
  98.   ? '********************'
  99.   ? '*  Date : '+dtoc(date())
  100.   ? ''
  101.   ? 'func &prgpre._2mem'
  102.   ? 'para in_mem'
  103.   ? ''
  104.   for i=1 to cnt
  105.     fld=fieldname(i)
  106.     vtype=type('&fld')
  107.     if vtype<>'M'
  108.       if len(pubstr)>0
  109.         pubstr=pubstr+','
  110.       endif
  111.       pubstr=pubstr+'&fld'
  112.       if len(pubstr)>70
  113.         ? 'publ '+pubstr
  114.         pubstr=''
  115.       endif
  116.     endif
  117.   next i
  118.   if len(pubstr)<>0
  119.     ? 'publ '+pubstr
  120.   endif
  121.   ? ''
  122.   for i=1 to cnt
  123.     fld=fieldname(i)
  124.     vtype=type('&fld')
  125.     if vtype<>'M'
  126.       mem=mempre+fieldname(i)
  127.       dbf=dbfpre+fieldname(i)
  128.       do case
  129.        case vtype='C'
  130.          ? '&mem = iif(in_mem=1,&dbf,spac(len(&dbf)))'
  131.        case vtype='D'
  132.          ? '&mem = iif(in_mem=1,&dbf,ctod("  /  /  "))'
  133.        case vtype='L'
  134.          ? '&mem = iif(in_mem=1,&dbf,.f.)'
  135.        case vtype='N'
  136.          ? '&mem = iif(in_mem=1,&dbf,0)'
  137.       endcase
  138.     endif
  139.   next i
  140.   ? ''
  141.   ? 'return (.t.)'
  142.   ? ''
  143.   ? ''
  144.   ? ''
  145.   ? '********************'
  146.   ? '*  Function &mempre._2DBF'
  147.   ? '********************'
  148.   ? '*  Date : '+dtoc(date())
  149.   ? ''
  150.   ? 'func &prgpre._2dbf'
  151.   ? ''
  152.   for i=1 to cnt
  153.     fld=fieldname(i)
  154.     vtype=type('&fld')
  155.     if vtype<>'M'
  156.       mem=mempre+fieldname(i)
  157.       dbf=dbfpre+fieldname(i)
  158.       ? 'repl &dbf with &mem'
  159.     endif
  160.   next i
  161.   ? ''
  162.   ? 'return (.t.)'
  163.   set alte off
  164.   set alte to
  165.   set cons on
  166.   use
  167.   dbfname=space(12)                       && dbf file name
  168.   dbfpre ='          '                    && dbf    alias    prefix
  169.   mempre ='m->'                           && memory variable prefix
  170.   prgpre ='   '                           && procedure name  prefix
  171.   prgname=space(12)                       && proc file name
  172.   pubstr=''                               && public var declaration string
  173. enddo
  174.  
  175.  
  176. *************
  177. *
  178. *  is_dbf
  179. *
  180. *************
  181.  
  182.  
  183. func is_dbf
  184.  
  185. para db
  186.  
  187. if file('&db')
  188.   return (.t.)
  189. else
  190.   ?? chr(7)
  191.   return (.f.)
  192. endif
  193.  
  194.  
  195. *************
  196. *
  197. *  no_prg
  198. *
  199. *************
  200.  
  201. func no_prg
  202.  
  203. para pr
  204.  
  205. if ! file('&pr')
  206.   return (.t.)
  207. else
  208.   junk=savescreen(20,5,22,75)
  209.   @ 20,5 to 22,75
  210.   @ 21,10 say '&PR exists.  Overwrite? '
  211.   @ 21,50 prom ' No '
  212.   @ 21,58 prom ' Yes '
  213.   menu to no_op
  214.   if no_op=2
  215.     no_op=(.t.)
  216.   else
  217.     no_op=(.f.)
  218.   endif
  219.   restscreen(20,5,22,75,junk)
  220.   return no_op
  221. endif
  222.