home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 6 / 06.iso / b / b007 / 2.ddi / AMISG / DBFS.PRG < prev    next >
Encoding:
Text File  |  1990-09-18  |  2.2 KB  |  128 lines
  1. ******  ▓·╔·▒φ═╖╩²╛▌╧ε┐Γ(DIS.DBF)│╠╨≥ DBFS.PRG  ******
  2. ******  DO DBFS ( FN,LM )                       ******
  3. ******  ╚δ┐┌▓╬╩²: FN:╬─╝■├√.                    ******
  4. ******  │÷┐┌▓╬╩²: LM:▒φ═╖╩²╛▌╧ε▒φ               ******
  5. ******            DIS.DBF:▒φ═╖╩²╛▌╧ε┐Γ.         ******
  6. ******     S1,S2,S3,S4,S5:▒φ═╖╕±╩╜▒Σ┴┐.         ******
  7. SELE 1
  8. USE FILE INDE FILE
  9. SEEK FN
  10. FNO=F_NO
  11. USE DBD INDE DBD
  12. SELE 2
  13. USE DIS
  14. DO WHILE .T.
  15. SELE 2
  16. ZAP
  17. S2='|'
  18. SS=1
  19. SELE 1
  20. CLEAR
  21. SET FILTER TO F_NO=FNO
  22. GO TOP
  23. I=1
  24. J=1
  25. DO WHILE .NOT. EOF()
  26. N=0
  27. DO WHILE .NOT. EOF() .AND. N<5
  28. @ I,N*15 SAY STR(J,2)+'.'+C_NAME
  29. N=N+1
  30. J=J+1
  31. SKIP
  32. ENDDO
  33. I=I+1
  34. ENDDO
  35. NUM=J-1
  36. ? ":╟δ╤í╘±╥¬╧╘╩╛╡─╩²╛▌╧ε,╕≈╩²╛▌╧ε╨≥║┼╙├╢║║┼(,)╕⌠┐¬:"
  37. ACCE ":╓╗╩Σ╚δ 0 ╘≥▒φ╩╛╤í╘±╦∙╙╨╩²╛▌╧ε:" TO D
  38. ? '╧╡═│╒²╘┌╘╦╨╨,╟δ─·╔╘║≥╞¼┐╠...'
  39. IF D='0'
  40. D='1'
  41. I=2
  42. DO WHILE I<=NUM
  43. IF I<10
  44. STOR D+','+STR(I,1) TO D
  45. ELSE
  46. STOR D+','+STR(I,2) TO D
  47. ENDIF
  48. I=I+1
  49. ENDDO
  50. ENDIF
  51. LM=''
  52. DO WHILE .T.
  53. STOR VAL(D) TO N
  54. IF N>=1 .AND. N<=NUM
  55. SELE 1
  56. GO TOP
  57. SKIP N-1
  58. FNL=LEN(TRIM(C_NAME))
  59. FOL=FIELD_LEN
  60. NT=TRIM(NOTE)
  61. FM=LEN
  62. IF LEN<>0
  63. FOL=LEN
  64. ENDIF
  65. IF FNL>FOL
  66. MAX=FNL
  67. ELSE
  68. MAX=FOL
  69. ENDIF
  70. SP1=INT((MAX-FNL)/2)
  71. SP2=MAX-FNL-SP1
  72. L1=STR(INT((MAX-FOL)/2),2)
  73. L2=STR(MAX-FOL-&L1,2)
  74. NAME=TRIM(C_NAME)
  75. LM=LM+STR(N,2)+'.'+NAME+' '
  76. NAME1=TRIM(FIELD_NAME)
  77. S2=S2+SPACE(SP1)+NAME+SPACE(SP2)+"|"
  78. FL=STR(MAX,3)
  79. FD=STR(FIELD_DEC,3)
  80. T=FIELD_TYPE
  81. SELE 2
  82. APPE BLANK
  83. DO CASE
  84. CASE T="N"
  85. REPL ITEM WITH "STR(&NAME1,&FL,&FD.)"
  86. CASE T='C'
  87. REPL ITEM WITH "SPACE(&L1.)+&NAME1+SPACE(&L2.)"
  88. IF A->CODE='1'
  89. LN=STR(A->LEN,2)
  90. REPL ITEM WITH "SPACE(&L1.)+SUBSTR('&NT',AT(&NAME1,'&NT')+2,&LN.)+SPACE(&L2.)"
  91. ENDIF
  92. CASE T='D'
  93. REPL ITEM WITH 'SPACE(&L1.)+DTOC(&NAME1.)+SPACE(&L2.)'
  94. CASE T='L'
  95. REPL ITEM WITH "SPACE(&L1.)+IIF(&NAME1,'T','F')+SPACE(&L2.)"
  96. CASE T='M'
  97. REPL ITEM WITH "SPACE(&L1.)+'   MEMO   '+SPACE(&L2.)"
  98. ENDCASE
  99. REPL C_NAME WITH NAME,WIDTH WITH MAX,START WITH SS
  100. SS=SS+MAX+1
  101. IF AT(",",D)=0 .OR. AT(",",D)=LEN(D)
  102. ERR=0
  103. EXIT
  104. ENDIF
  105. D=SUBSTR(D,AT(",",D)+1,LEN(D)-AT(",",D))
  106. ELSE
  107. ? D
  108. ? '^---------╤í╘±└╕├√╨≥║┼┤φ'
  109. ? '┤≥╚╬║╬╝ⁿ╘≥╝╠╨° '
  110. WAIT
  111. ERR=1
  112. EXIT
  113. ENDIF
  114. ENDDO
  115. IF ERR=1
  116. LOOP
  117. ENDIF
  118. SELE 2
  119. APPE BLAN
  120. REPL START WITH SS
  121. LM=SUBS(LM,1,LEN(LM)-1)
  122. USE
  123. SELE 1
  124. USE
  125. RETU
  126. ENDDO
  127. ** END OF DBFS.PRG **
  128.