home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a040 / 2.ddi / SHRWARE4.ARC / MSAKEYS.INC < prev    next >
Encoding:
Text File  |  1988-06-03  |  2.0 KB  |  98 lines
  1. <<* APPKEYS.INC *>>
  2. <<#
  3.  
  4. procedure GenIsBlank
  5. string strg
  6. begin
  7.   forall fields
  8.     if forcount = 1
  9.       strg := ''
  10.     else
  11.       strg := 'IsBlank .OR. '
  12.     endif
  13.     if fldtyp = 'N'
  14.       genln( 'IsBlank = ',strg,'(',fixfldnam,' = 0)' )
  15.     elsif fldtyp = 'D'
  16.       genln( 'IsBlank = ',strg,'(DTOC( ',fixfldnam,' ) = "  /  /  ")' )
  17.     else
  18.       genln( 'IsBlank = ',strg,'("" = TRIM( ',fixfldnam,' ))' )
  19.     endif
  20.   endfor
  21. end GenIsBlank
  22.  
  23.  
  24. procedure GenKeysBody  <<*Assumes ndxtotal > 0 *>>
  25. string  keyexpr
  26. begin
  27.   if ndxtotal > 0
  28.     <<* Use the first index as MASTER index *>>
  29.     select index 1
  30.   endif
  31.   select fields on upper(fldnam) $ upper(ndxkey)
  32.   if fldtotal = 0
  33. #>>
  34. * ---Key expression:  {ndxkey}
  35. DO SayLine WITH PromptRow,"Key expression does not match database file."
  36. WAIT
  37. @ PromptRow,0 CLEAR
  38. <<#
  39.   else
  40.     WriteGetFlds
  41.     GenIsBlank
  42.     genln( 'expr = ',fixautomem(ndxkey) )
  43.     if ndxuni
  44.       genln( 'IsUnique = .T.' )
  45.     else
  46.       genln( 'IsUnique = .F.' )
  47.     endif
  48.   endif
  49.   select all fields
  50. end GenKeysBody
  51. #>>
  52.  
  53.  
  54. <<procedure GenKeysProc>>
  55. <<begin>>
  56.  
  57. PROCEDURE {fileprefix}_KEYS
  58. PARAMETER expr,IsBlank,IsUnique
  59.   ?? SYS(2002,1)  && TURN CURSOR ON
  60.    expr = ""
  61.    IsBlank = .F.
  62.    IsUnique = .F.
  63. <<#
  64.   if ismultials
  65.     pushmargin( 1 )
  66.     genln( 'DO CASE' )
  67.     forall databases
  68.       genln( 'CASE dbfarea = "',dbfcount,'"' )
  69.       pushmargin( 1 )
  70.       if ndxtotal = 0
  71.         genln( '* ---No index file available to check' )
  72.         genln( '* ---for BLANK or duplicate records.' )
  73.       else
  74.         GenKeysBody
  75.       endif
  76.       popmargin
  77.     endfor
  78.     genln( 'ENDCASE' )
  79.     popmargin
  80.   else
  81.     pushmargin( 1 )
  82.     select database 1
  83.     if ndxtotal = 0
  84.       genln( '* ---No index file available to check' )
  85.       genln( '* ---for BLANK or duplicate records.' )
  86.     else
  87.       GenKeysBody
  88.     endif
  89.     popmargin
  90.   endif
  91.   genln( '?? SYS(2002)    && TURN CURSOR OFF' )
  92.   genln( 'RETURN' )
  93.   genln
  94. end <<*GenKeysProc*>>
  95.  
  96. <<* EOF: MSAKEYS.INC *>>
  97. #>>
  98.