home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
dupe_chk.zip
/
DUPE_CHK.PRG
< prev
Wrap
Text File
|
1988-12-19
|
3KB
|
155 lines
*
*************************** Dupe_Chk ***********************************
* This program will check for duplicate fields
* DATE: 12/17/88
* AUTHOR: Ron Lane ,BBS: Ron's ROS (817) 540-4183
* Uses no special code, can be used as a Stand alone program or a PROC
* Will not change the DBF in any way
*
IF ISCOLOR()
SET COLOR TO "GR+/B,W+/R,B,N,R+/W"
ENDI
CLEA
L_dbf = SPACE(8)
L_field = SPACE(10)
@ 1,29 SAY "Duplicate Field Checker"
@ 2,0 TO 8,79 DOUBLE
@ 4,10 SAY "Database NAME " GET L_dbf PICT "@!"
@ 6,10 SAY "Field Name " GET L_field PICT "@!"
READ
* --- do we have a DBF
IF ! FILE("&L_dbf..DBF")
?? CHR(7)
@ 10,10 SAY "No DBF &L_dbf"
INKEY(2)
SET COLOR TO
CLEA
QUIT
ENDI
USE &L_dbf
* --- no go on memo or logical
IF TYPE(L_field) = "M" .OR. TYPE(L_field) = "L"
?? CHR(7)
@ 12,10 SAY "Can not Dupe Ck a MEMO or LOGICAL field"
INKEY(2)
SET COLOR TO
CLEA
QUIT
ENDI
* --- good fieldname
L_error = .T.
FOR i = 1 TO FCOUNT()
L_ckfor = FIELD(i)
L_fldck = TRIM(L_field)
IF L_ckfor = L_fldck
L_error = .F.
EXIT
ENDI
NEXT
IF L_error
?? CHR(7)
@ 12,10 SAY "No Field &L_field" && no such field
INKEY(2)
SET COLOR TO
CLEA
QUIT
ENDI
@ 10,10 SAY "Indexing, One Moment Please"
* --- get our DBF in order of field
INDEX ON &L_field to DUPE
USE &L_dbf INDEX dupe
CLEA
@ 5,5 SAY "Checking for Duplicate Fields in &L_dbf, if any found read DUPE.LST"
INKEY(2)
* --- our output file
SET ALTE TO DUPE.LST
SET ALTE ON
L_head = .T. && start with header true
GO TOP
DO WHIL ! EOF() && do whole file
L_ckfield = &L_field
L_retn = RECNO() && start marker
L_ckone = .T. && set our checker
DO WHIL L_ckfield == &L_field && how many match
SKIP
IF L_ckone
L_dupe = IF(L_ckfield == &L_field,.T.,.F.) && set our print OK
L_ckone = .F. && once is all we need
ENDI
L_goto = RECNO() && last record checked
ENDD * --- checking
IF L_dupe && found some, print them
DO PRINT_IT WITH L_head
ENDI
GOTO L_goto && goto where we stoped
ENDD * --- eof
CLOS ALL
ERASE DUPE.NTX && clean up
CLEA
?? CHR(7)
@ 10,36 SAY "All Done"
INKEY(2)
SET COLOR TO
CLEA
QUIT
*****************************************************************
* --- we print our dupes
PROC PRINT_IT
PARA L_first && first time here
* --- what type field are we working with
IF TYPE("&L_field") = "N"
L_out = STR(&L_field)
L_len = LEN(STR(&L_field)) - 8
ELSEIF TYPE("&L_field") = "D"
L_out = DTOC(&L_field)
L_len = 2
ELSE
L_out = &L_field
L_len = LEN(&L_field) - 8
ENDI
IF L_first && print our header
?
? SPACE(2),"List date ",DATE()
? SPACE(2),L_field,SPACE(L_len),"Record Num."
?
L_head = .F.
ENDI
GOTO L_retn && go to first dupe
DO WHIL RECNO() != L_goto && stay till printed all of them
? SPACE(2),L_out,SPACE(2),LTRIM(STR(RECNO()))
SKIP
ENDD * --- recno
?
RETU && done here, continue
* --- eof dupe_chk