home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / clipper / bcklib2.zip / BVUPDATE.PRG < prev    next >
Encoding:
Text File  |  1993-01-16  |  4.7 KB  |  220 lines
  1. /*
  2.     The source code contained within this file is protected under the
  3.     laws of the United States of America and by International Treaty.
  4.     Unless otherwise noted, the source contained herein is:
  5.  
  6.     Copyright (c)1990, 1991, 1992 BecknerVision Inc - All Rights Reserved
  7.  
  8.     Written by John Wm Beckner        THIS NOTICE MUST NOT BE REMOVED
  9.     BecknerVision Inc
  10.     PO Box 11945                      DISTRIBUTE ONLY WITH SHAREWARE
  11.     Winston-Salem NC 27116            VERSION OF THIS PRODUCT.
  12.     Fax: 919/760-1003
  13.  
  14. */
  15.  
  16. /* THIS FILE HAS NOT BEEN SET TO BECKNERVISION'S CLIPPER 5 STANDARD */
  17.  
  18. #include "beckner.inc"
  19.  
  20. * BecknerVision Update Creator v1.0
  21.  
  22. proc bvupdate
  23. para f___name,n2,n3,n4,n5,n6,n7,n8,n9,n10,n11,n12,n13,n14,n15,n16,n17,n18
  24. vmm_init()
  25. main_parms=pcount()
  26. if main_parms>1
  27.    for x=2 to main_parms
  28.       a=ltrim(str(x))
  29.       if !fExtension(n&a.)
  30.          n&a.=n&a.+'.DBF'
  31.       endi
  32.    next
  33. endi
  34. sysversion='v1.1'
  35. if iscolor()
  36.    set colo to bg,b/w
  37. endi
  38. clea
  39. @ 1,0 say 'BecknerVision DBF/FRM/LBL Integrity Check/Update Procedure '+sysversion
  40. @ 2,0 say 'Copyright (c)1990 John Wm Beckner - All Rights Reserved'
  41. if pcount()=0
  42.    f___name='*.dbf'
  43. endi
  44. if !'.'$f___name
  45.    f___name=f___name+'.dbf'
  46. endi
  47. if file('b$v$$.DBF')
  48.    eras b$v$$.dbf
  49. endi
  50. do whil .y.
  51.    clea
  52.    opt := vMenu('T/Create new/Integrity verification/Browse/Quit')
  53.    do case
  54.       case opt=2
  55.          pUpdate('bvupdate')
  56.       case opt=1
  57.          do create
  58.       case opt=3
  59.          fNoShare('bvupdate')
  60.          save scre
  61.          browse()
  62.          rest scre
  63.          use
  64.       case opt=4
  65.          exit
  66.    endc
  67. endd
  68. clea
  69. quit
  70.  
  71. proc create
  72. if !file('bvupdate.dbf')
  73.    fCreateDBF('BVUPDATE/DESC/M/FILENAME/M/INDEX_NAME/M/INDEX_EXPR/M/FIELD_LIST/M')
  74. endi
  75. fNoShare('bvupdate','system')
  76. zap
  77. no__files=adir(f___name)
  78. z=no__files
  79. if main_parms>1
  80.    for x=2 to main_parms
  81.       a=ltrim(str(x))
  82.       no__files=no__files+adir(n&a.)
  83.    next
  84. endi
  85. if no__files>0
  86.    decl dbf[no__files]
  87.    adir(f___name,dbf)
  88.    if main_parms>1
  89.       for x=2 to main_parms
  90.          a=ltrim(str(x))
  91.          y=adir(n&a.)
  92.          if y>0
  93.             decl tempa[y]
  94.             adir(n&a.,tempa)
  95.             ctr=1
  96.             for zz=z+1 to z+y
  97.                dbf[zz]=tempa[ctr]
  98.                ctr=ctr+1
  99.             next
  100.             z=z+y
  101.          endi
  102.          rele tempa
  103.       next
  104.    endi
  105.    for x=1 to m->no__files
  106.       if dbf[x]='BVUPDATE.DBF' .or. "$"$dbf[x]
  107.          loop
  108.       endi
  109.       if fExtName(dbf[x])!='DBF'
  110.          different()
  111.          loop
  112.       endi
  113.       sele 0
  114.       fShare(dbf[x],'source')
  115.       if empty(alias())
  116.          ?
  117.          ? 'WARNING:',dbf[x],'is not found to be a valid DBF file!!!'
  118.          ?
  119.          pBeep()
  120.          inkey(60)
  121.          loop
  122.       endi
  123.       y=fcount()
  124.       decl s_fld[y],s_type[y],s_len[y],s_dec[y]
  125.       afields(s_fld,s_type,s_len,s_dec)
  126.       flds=''
  127.       ? dbf[x]
  128.       for y=1 to len(s_fld)
  129.          flds=flds+'/'+s_fld[y]+'/'+s_type[y]
  130.          if s_type[y]$'CN'
  131.             flds=flds+'/'+ltrim(str(s_len[y]))
  132.          endi
  133.          if s_type[y]='N'
  134.             flds=flds+'/'+ltrim(str(s_dec[y]))
  135.          endi
  136.       next
  137.       use
  138.       rele all like s_*
  139.       sele system
  140.       appe blan
  141.       repl filename with dbf[x],field_list with substr(flds,2)
  142.    next
  143.    rele dbf
  144. endi
  145. clos data
  146. eras b$v$$.dbf
  147. retu
  148.  
  149. proc icheck
  150. pUpdate('BVUPDATE')
  151. retu
  152.  
  153. func wcolor
  154. retu 0
  155.  
  156. func different
  157. xext=fExtName(dbf[x])
  158. if xext='FRM'
  159.    h=fopen(dbf[x])
  160.    buff=space(1990)
  161.    z=fread(h,@buff,1990)
  162.    fclose(h)
  163.    if z!=1990
  164.       ?
  165.       ? 'WARNING:',dbf[x],'is not a valid FRM file'
  166.       ?
  167.       pBeep()
  168.       inkey(60)
  169.       retu 0
  170.    endi
  171.    ? dbf[x]
  172.    sele system
  173.    appe blan
  174.    tstr=''
  175.    for z=1 to 1990
  176.       if substr(buff,z,1)=chr(0)
  177.          tstr=tstr+chr(255)
  178.       else
  179.          tstr=tstr+substr(buff,z,1)
  180.       endi
  181.    next
  182.    repl filename with dbf[x],field_list with chr(255)+tstr
  183.    retu 0
  184. endi
  185. if xext='LBL'
  186.    h=fopen(dbf[x])
  187.    buff=space(1034)
  188.    z=fread(h,@buff,1034)
  189.    fclose(h)
  190.    if z!=1034
  191.       ?
  192.       ? 'WARNING:',dbf[x],'is not a valid LBL file'
  193.       ?
  194.       pBeep()
  195.       inkey(60)
  196.       retu 0
  197.    endi
  198.    ? dbf[x]
  199.    sele system
  200.    appe blan
  201.    tstr=''
  202.    for z=1 to 1034
  203.       if substr(buff,z,1)=chr(0)
  204.          tstr=tstr+chr(255)
  205.       else
  206.          tstr=tstr+substr(buff,z,1)
  207.       endi
  208.    next
  209.    repl filename with dbf[x],field_list with chr(254)+tstr
  210.    retu 0
  211. endi
  212. ? dbf[x],'discarded!  Not a valid DBF, FRM or LBL fExtName'
  213. retu 0
  214.  
  215. func vmm_init
  216. local cDummy
  217. cDummy := space(4000)
  218. return nil
  219. 
  220.