home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / xbase / library / dbase / duplicat / dupe_chk.prg < prev    next >
Encoding:
Text File  |  1988-12-19  |  3.3 KB  |  155 lines
  1. *
  2. *************************** Dupe_Chk ***********************************
  3. * This program will check for duplicate fields
  4. * DATE: 12/17/88
  5. * AUTHOR: Ron Lane   ,BBS: Ron's ROS  (817) 540-4183
  6. * Uses no special code, can be used as a Stand alone program or a PROC
  7. * Will not change the DBF in any way
  8. *
  9.  
  10.   IF ISCOLOR()
  11. SET COLOR TO "GR+/B,W+/R,B,N,R+/W"
  12.   ENDI
  13.  
  14. CLEA
  15.  
  16. L_dbf   = SPACE(8)
  17. L_field = SPACE(10)
  18. @  1,29 SAY "Duplicate Field Checker"
  19.  
  20. @  2,0 TO 8,79 DOUBLE
  21. @  4,10 SAY "Database NAME " GET L_dbf   PICT "@!"
  22. @  6,10 SAY "Field Name    " GET L_field PICT "@!"
  23. READ
  24.  
  25.  
  26. * --- do we have a DBF
  27.   IF ! FILE("&L_dbf..DBF")
  28. ?? CHR(7)
  29. @ 10,10 SAY "No DBF  &L_dbf"
  30. INKEY(2)
  31. SET COLOR TO
  32. CLEA
  33. QUIT
  34.   ENDI
  35.  
  36. USE &L_dbf
  37.  
  38. * --- no go on memo or logical
  39.   IF TYPE(L_field) = "M" .OR. TYPE(L_field) = "L"
  40. ?? CHR(7)
  41. @ 12,10 SAY "Can not Dupe Ck a MEMO or LOGICAL field"
  42. INKEY(2)
  43. SET COLOR TO
  44. CLEA
  45. QUIT
  46.   ENDI
  47.  
  48.  
  49. * --- good fieldname
  50. L_error = .T.
  51. FOR i = 1 TO FCOUNT()
  52. L_ckfor = FIELD(i)
  53. L_fldck = TRIM(L_field)
  54.  
  55.   IF L_ckfor = L_fldck
  56. L_error = .F.
  57. EXIT
  58.   ENDI
  59.  
  60. NEXT
  61.  
  62.   IF L_error
  63. ?? CHR(7)
  64. @ 12,10 SAY "No Field  &L_field"           && no such field
  65. INKEY(2)
  66. SET COLOR TO
  67. CLEA
  68. QUIT
  69.   ENDI
  70.  
  71. @ 10,10 SAY "Indexing, One Moment Please"
  72.  
  73. * --- get our DBF in order of field
  74. INDEX ON &L_field to DUPE
  75. USE &L_dbf INDEX dupe
  76.  
  77. CLEA
  78. @  5,5 SAY "Checking for Duplicate Fields in &L_dbf, if any found read DUPE.LST"
  79. INKEY(2)
  80.  
  81. * --- our output file
  82. SET ALTE TO DUPE.LST
  83. SET ALTE ON
  84. L_head = .T.                           && start with header true
  85.  
  86. GO TOP
  87. DO WHIL ! EOF()                       && do whole file
  88. L_ckfield = &L_field
  89. L_retn    = RECNO()                   && start marker
  90.  
  91. L_ckone = .T.                         && set our checker
  92. DO WHIL L_ckfield == &L_field         && how many match
  93. SKIP
  94.  
  95.   IF L_ckone
  96. L_dupe = IF(L_ckfield == &L_field,.T.,.F.)     && set our print OK
  97. L_ckone = .F.                                  && once is all we need
  98.   ENDI
  99.  
  100. L_goto = RECNO()                       && last record checked
  101. ENDD * --- checking
  102.  
  103.   IF L_dupe                            && found some, print them
  104. DO PRINT_IT WITH L_head
  105.   ENDI
  106.  
  107. GOTO L_goto                            && goto where we stoped
  108. ENDD * --- eof
  109.  
  110. CLOS ALL
  111. ERASE DUPE.NTX                         && clean up
  112. CLEA
  113. ?? CHR(7)
  114. @ 10,36 SAY "All Done"
  115. INKEY(2)
  116. SET COLOR TO
  117. CLEA
  118. QUIT
  119.  
  120. *****************************************************************
  121. * --- we print our dupes
  122. PROC PRINT_IT
  123. PARA L_first                            && first time here
  124.  
  125. * --- what type field are we working with
  126.   IF TYPE("&L_field") = "N"
  127. L_out = STR(&L_field)
  128. L_len = LEN(STR(&L_field)) - 8
  129. ELSEIF TYPE("&L_field") = "D"
  130. L_out = DTOC(&L_field)
  131. L_len = 2
  132. ELSE
  133. L_out = &L_field
  134. L_len = LEN(&L_field) - 8
  135.   ENDI
  136.  
  137.   IF L_first                             && print our header
  138. ?
  139. ? SPACE(2),"List date ",DATE()
  140. ? SPACE(2),L_field,SPACE(L_len),"Record Num."
  141. ?
  142. L_head = .F.
  143.   ENDI
  144.  
  145. GOTO L_retn                                && go to first dupe
  146. DO WHIL RECNO() != L_goto                  && stay till printed all of them
  147. ? SPACE(2),L_out,SPACE(2),LTRIM(STR(RECNO()))
  148. SKIP
  149. ENDD * --- recno
  150. ?
  151. RETU                                       && done here, continue
  152.  
  153. * --- eof dupe_chk
  154.  
  155.