home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / disk_20.zip / DIFOUT.ZIP / DIFOUT.PRG next >
Text File  |  1985-11-11  |  3KB  |  149 lines
  1. * Obtained from the July, 1985 issue of Data Based Advisor, page 22.
  2. *
  3. *DIF FILE OUTPUT ROUTINE
  4. *
  5. *    <DIFOUT>
  6. *
  7. CLOSE DATABASES
  8. SET TALK OFF
  9. SET ECHO OFF
  10. filename=' :'+SPACE(8)
  11. indxname=filename
  12. dblquot=CHR(34)+CHR(34)
  13. bot='BOT'
  14. CLEAR
  15. ? 'DIF FILE UTILITY ROUTINE'
  16. @ 5,0 SAY 'Enter database filename ' GET filename
  17. @ 6,0 SAY 'Enter index filename    ' GET indxname
  18. READ
  19. CLEAR GETS
  20. difile=TRIM(filename)+'.DIF'
  21. @ 8,0 SAY 'Enter DIF filename      ' GET difile
  22. READ
  23. IF FILE(TRIM(filename)+'.dbf') .AND. FILE(TRIM(indxname)+'.ndx')
  24. SELECT A
  25. USE &filename INDEX &indxname
  26. ? CHR(10)+'Stand by:  Creating DIF file'
  27. *
  28. * Get file structure for field names,types,lens,decs
  29. *
  30. * modify drive designation for your system
  31. COPY TO c:FLDSTRUC STRUCTURE EXTENDED
  32. SELECT B
  33. USE FLDSTRUC
  34. COUNT TO vec
  35. IF vec<10
  36.    len=1
  37. ELSE
  38.    IF vec<100
  39.       len=2
  40.    ELSE
  41.       len=3
  42.    ENDIF vec<100
  43. ENDIF vec<10
  44. vectors=STR(vec,len)
  45. SELECT A
  46. COUNT TO tmp FOR .NOT. DELETED ()
  47. tmp=tmp+1
  48. IF tmp<10
  49.    len=1
  50. ELSE
  51.    IF tmp<100
  52.       len=2
  53.    ELSE
  54.       IF tmp<1000
  55.          len=3
  56.       ELSE
  57.          len=4
  58.       ENDIF 1000
  59.    ENDIF 100
  60. ENDIF 10
  61. tuples=STR(tmp,len)
  62. SELECT B
  63. GO TOP
  64. SET ALTERNATE TO &difile
  65. *
  66. * Turn on alternate, turn off screen, then print standard
  67. * header information.  Vectors=fields/rec, Tuples=records in
  68. * file + 1 for field names
  69. *
  70. SET CONSOLE OFF
  71. SET ALTERNATE ON
  72. ?? 'TABLE'
  73. ? '0 , 1'
  74. ? dblquot
  75. ? 'VECTORS'
  76. ? '0 ,  '+ vectors
  77. ? dblquot
  78. ? 'TUPLES'
  79. ? '0 ,  '+tuples
  80. ? dblquot
  81. ? 'DATA'
  82. ? '0 , 0'
  83. ? dblquot
  84. ? '-1 , 0'
  85. ? bot
  86. *
  87. * Save field data (name,type,len,& decimals) in variable
  88. * array
  89. *
  90. DO WHILE .NOT. EOF()
  91.    ? '1 , 0'
  92.    ? CHR(34)+TRIM(FIELD_NAME)+CHR(34)
  93.    rec=STR(1000-RECNO(),3)
  94.    fldtyp_&rec=FIELD_TYPE
  95.    fldnam_&rec=FIELD_NAME
  96.    fldlen_&rec=FIELD_LEN
  97.    flddec_&rec=FIELD_DEC
  98.    SKIP
  99. ENDDO EOF()
  100. SELECT A
  101. GO TOP
  102. *
  103. * Retrieve each non-deleted record from file A and print in
  104. * DIF format
  105. *
  106. DO WHILE .NOT. EOF()
  107.    IF .NOT. DELETED()
  108.       ? '-1 , 0'
  109.       ? bot
  110.       this_rec=0
  111.       DO WHILE this_rec<vec
  112.          rec=STR(999-this_rec,3)
  113.          temp=fldnam_&rec
  114.          IF fldtyp_&rec='D'
  115.             item=DTOC(&temp)
  116.          ELSE
  117.             item=&temp
  118.          ENDIF fldtyp
  119.          IF fldtyp_&rec='N'
  120.             strval='V'
  121.             datline='0 ,  '+STR(item,fldlen_&rec,flddec_&rec)
  122.          ELSE
  123.             datline='1 , 0'
  124.             strval=CHR(34)+TRIM(item)+CHR(34)
  125.          ENDIF fldtyp
  126.          ? datline
  127.          ? strval
  128.          this_rec=this_rec+1
  129.       ENDDO this_rec
  130.    ENDIF .NOT. DELETED
  131.    SKIP
  132. ENDDO EOF
  133. ? '-1, 0'
  134. ? 'EOD'
  135. SET ALTERNATE OFF
  136. SET ALTERNATE TO
  137. SET CONSOLE ON
  138. CLOSE DATABASES
  139. * change drive designation to match your system
  140. ERASE C:FLDSTRUC.DBF
  141. ? 'DONE'+CHR(7)
  142. ELSE
  143. *
  144. * If file is not on disk. . .
  145. *
  146. ?CHR(7)+'Invalid File Name - routine cancelled'
  147. ENDIF FILE
  148. RETURN
  149.