home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1993 #2
/
Image.iso
/
clipper
/
bcklib2.zip
/
BVUPDATE.PRG
< prev
next >
Wrap
Text File
|
1993-01-16
|
5KB
|
220 lines
/*
The source code contained within this file is protected under the
laws of the United States of America and by International Treaty.
Unless otherwise noted, the source contained herein is:
Copyright (c)1990, 1991, 1992 BecknerVision Inc - All Rights Reserved
Written by John Wm Beckner THIS NOTICE MUST NOT BE REMOVED
BecknerVision Inc
PO Box 11945 DISTRIBUTE ONLY WITH SHAREWARE
Winston-Salem NC 27116 VERSION OF THIS PRODUCT.
Fax: 919/760-1003
*/
/* THIS FILE HAS NOT BEEN SET TO BECKNERVISION'S CLIPPER 5 STANDARD */
#include "beckner.inc"
* BecknerVision Update Creator v1.0
proc bvupdate
para f___name,n2,n3,n4,n5,n6,n7,n8,n9,n10,n11,n12,n13,n14,n15,n16,n17,n18
vmm_init()
main_parms=pcount()
if main_parms>1
for x=2 to main_parms
a=ltrim(str(x))
if !fExtension(n&a.)
n&a.=n&a.+'.DBF'
endi
next
endi
sysversion='v1.1'
if iscolor()
set colo to bg,b/w
endi
clea
@ 1,0 say 'BecknerVision DBF/FRM/LBL Integrity Check/Update Procedure '+sysversion
@ 2,0 say 'Copyright (c)1990 John Wm Beckner - All Rights Reserved'
if pcount()=0
f___name='*.dbf'
endi
if !'.'$f___name
f___name=f___name+'.dbf'
endi
if file('b$v$$.DBF')
eras b$v$$.dbf
endi
do whil .y.
clea
opt := vMenu('T/Create new/Integrity verification/Browse/Quit')
do case
case opt=2
pUpdate('bvupdate')
case opt=1
do create
case opt=3
fNoShare('bvupdate')
save scre
browse()
rest scre
use
case opt=4
exit
endc
endd
clea
quit
proc create
if !file('bvupdate.dbf')
fCreateDBF('BVUPDATE/DESC/M/FILENAME/M/INDEX_NAME/M/INDEX_EXPR/M/FIELD_LIST/M')
endi
fNoShare('bvupdate','system')
zap
no__files=adir(f___name)
z=no__files
if main_parms>1
for x=2 to main_parms
a=ltrim(str(x))
no__files=no__files+adir(n&a.)
next
endi
if no__files>0
decl dbf[no__files]
adir(f___name,dbf)
if main_parms>1
for x=2 to main_parms
a=ltrim(str(x))
y=adir(n&a.)
if y>0
decl tempa[y]
adir(n&a.,tempa)
ctr=1
for zz=z+1 to z+y
dbf[zz]=tempa[ctr]
ctr=ctr+1
next
z=z+y
endi
rele tempa
next
endi
for x=1 to m->no__files
if dbf[x]='BVUPDATE.DBF' .or. "$"$dbf[x]
loop
endi
if fExtName(dbf[x])!='DBF'
different()
loop
endi
sele 0
fShare(dbf[x],'source')
if empty(alias())
?
? 'WARNING:',dbf[x],'is not found to be a valid DBF file!!!'
?
pBeep()
inkey(60)
loop
endi
y=fcount()
decl s_fld[y],s_type[y],s_len[y],s_dec[y]
afields(s_fld,s_type,s_len,s_dec)
flds=''
? dbf[x]
for y=1 to len(s_fld)
flds=flds+'/'+s_fld[y]+'/'+s_type[y]
if s_type[y]$'CN'
flds=flds+'/'+ltrim(str(s_len[y]))
endi
if s_type[y]='N'
flds=flds+'/'+ltrim(str(s_dec[y]))
endi
next
use
rele all like s_*
sele system
appe blan
repl filename with dbf[x],field_list with substr(flds,2)
next
rele dbf
endi
clos data
eras b$v$$.dbf
retu
proc icheck
pUpdate('BVUPDATE')
retu
func wcolor
retu 0
func different
xext=fExtName(dbf[x])
if xext='FRM'
h=fopen(dbf[x])
buff=space(1990)
z=fread(h,@buff,1990)
fclose(h)
if z!=1990
?
? 'WARNING:',dbf[x],'is not a valid FRM file'
?
pBeep()
inkey(60)
retu 0
endi
? dbf[x]
sele system
appe blan
tstr=''
for z=1 to 1990
if substr(buff,z,1)=chr(0)
tstr=tstr+chr(255)
else
tstr=tstr+substr(buff,z,1)
endi
next
repl filename with dbf[x],field_list with chr(255)+tstr
retu 0
endi
if xext='LBL'
h=fopen(dbf[x])
buff=space(1034)
z=fread(h,@buff,1034)
fclose(h)
if z!=1034
?
? 'WARNING:',dbf[x],'is not a valid LBL file'
?
pBeep()
inkey(60)
retu 0
endi
? dbf[x]
sele system
appe blan
tstr=''
for z=1 to 1034
if substr(buff,z,1)=chr(0)
tstr=tstr+chr(255)
else
tstr=tstr+substr(buff,z,1)
endi
next
repl filename with dbf[x],field_list with chr(254)+tstr
retu 0
endi
? dbf[x],'discarded! Not a valid DBF, FRM or LBL fExtName'
retu 0
func vmm_init
local cDummy
cDummy := space(4000)
return nil