home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1993 #2
/
Image.iso
/
clipper
/
err52b.zip
/
ERR1210.PRG
next >
Wrap
Text File
|
1993-07-24
|
2KB
|
89 lines
FIELD tape_show
FIELD t_producer
PROCEDURE err1210(sortf)
LOCAL subpass
LOCAL passnum
LOCAL mt_producer
SET UNIQUE OFF
IF .NOT. sortf==NIL
?"Sort & Reindex the Database"
i_s_mast()
ENDIF
FOR passnum:=0 TO 5
?"Test Pass "+LTRIM(STR(passnum,3,0))
SELECT 1
USE i_tape ALIAS i_tape EXCLUSIVE
SET INDEX TO i_tape,i_tapep
GO TOP
FOR subpass:=0 to 2
?"Test Pass "+LTRIM(STR(passnum,3,0))+", SubPass "+LTRIM(STR(subpass,3,0))
RLOCK()
mt_producer:=t_producer
chgfield(@mt_producer,passnum,subpass)
REPLACE t_producer WITH mt_producer
@24,45 SAY LTRIM(STR(LEN(mt_producer)))+" "+mt_producer
SKIP
NEXT
CLOSE DATABASES
NEXT
RETURN
STATIC PROCEDURE chgfield(fld,passnum,subpass)
LOCAL x
LOCAL which:=(passnum+subpass)
DO CASE
CASE which==0
x:="SSS"
CASE which==1
x:="AAA"
CASE which==2
x:="TTT"
CASE which==3
x:="BBB"
CASE which==4
x:="XXX"
CASE which==5
x:="CCC"
CASE which==6
x:="AAA"
CASE which==7
x:="SSS"
END CASE
fld:=STUFF(fld,1,3,x)
RETURN
STATIC PROCEDURE i_s_mast
SELECT 1
USE i_tape ALIAS i_tape EXCLUSIVE
mfilesize:=((RECCOUNT() * RECSIZE()) + 8000)
IF DISKSPACE() < (mfilesize*2)
?"Not enough disk for sort"
QUIT
ELSE
ERASE I_Temp.dbf
SORT TO I_Temp.dbf ON tape_show FOR .NOT. DELETED()
CLOSE DATABASES
ERASE I_tape.dbf
RENAME I_temp.dbf TO I_tape.dbf
USE i_tape ALIAS i_tape EXCLUSIVE
ERASE I_tape.ntx
INDEX ON tape_show TO i_tape
// INDEX ON tape_show TO i_tape for .T.
ERASE i_tapep.ntx
INDEX ON t_producer TO i_tapep
// INDEX ON t_producer TO i_tapep for .T.
CLOSE DATABASES
ENDIF
RETURN