home *** CD-ROM | disk | FTP | other *** search
/ Run Magazine ReRun 1986 January & February / rerun-1986-01-02.d64 / dfrestructure (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  5KB  |  168 lines
  1. 4600 rem  datafile utility program dfrestructure (c)1985 by mike konshak
  2. 4602 poke53280,7:poke53281,0:print"[158]":goto4620
  3. 4604 rem--get
  4. 4606 geta$:ifa$=""then4606
  5. 4608 return
  6. 4610 rem--disk error
  7. 4612 input#15,en,em$,et,es:if(en<20)or(en=62)thenet=0:return
  8. 4614 print" [150]disk error[146]"en"[157], "em$","et"[157],"es"[158]":et=8
  9. 4616 print" press any key[146] to return to menu":gosub4606:close5:close15:return
  10. 4618 rem----start menu
  11. 4620 clr:print"[147]      datafile restructure program     "
  12. 4622 print" this program will alter the structure"
  13. 4624 print" of a sequential record file created by"
  14. 4626 print" the datafile[146] database management"
  15. 4628 print" system, written by mike konshak."
  16. 4630 print" the following options are possible:"
  17. 4632 print"   *  change the name of a field"
  18. 4634 print"   *  change the length of a field"
  19. 4636 print"   *  add a field "
  20. 4638 print"   *  delete a field "
  21. 4640 print" option 2 will increase or decrease"
  22. 4642 print" the total number of records in a file."
  23. 4644 print" option 3 will decrease the number of"
  24. 4646 print" records and some existing records may"
  25. 4648 print" be lost.  option 4 will increase the"
  26. 4650 print" total number of records, eliminating"
  27. 4652 print" the data found in the chosen field."
  28. 4654 print" press c[146]ontinue, $[146] directory or q[146]uit"
  29. 4656 gosub4606:ifa$="q"thenend
  30. 4658 ifa$="$"thengosub4896:goto4620
  31. 4660 ifa$<>"c"then4656
  32. 4662 rem----open file - read structure
  33. 4664 print"[147]        change datafile structure      [146]"
  34. 4666 print" insert a disk containing the datafile"
  35. 4668 print" file to be restructured. press return[146]"
  36. 4670 print" without an entry to exit."
  37. 4672 input" name of datafile ";nf$:ifnf$=""then4654
  38. 4674 open15,8,15:open5,8,5,"0:df] "+nf$+",s,r":gosub4612:ifet=8then4654
  39. 4676 ifen=62thengosub4614:goto4654
  40. 4678 input#5,r,f,x:gosub4612:ifet=8then4654
  41. 4680 dim f$(f+2),l%(f+2),rec$(x+1,f+2),k%(x+1)
  42. 4682 forn=1tof:input#5,f$(n),l%(n):nextn:gosub4612:ifet=8then4654
  43. 4684 close5:close15:goto4710
  44. 4686 rem----print field info for reference
  45. 4688 print"[147] field name(length) for "+nf$+"[158]"
  46. 4690 oe=1:if(f/2)=int(f/2)thenoe=0
  47. 4692 of=int(f/2):fori=1toof+oe
  48. 4694 print" "i"[146]"f$(i)l%(i);
  49. 4696 ifoe=1then4700
  50. 4698 printtab(19)""i+of"[146]"f$(i+of)l%(i+of):goto4702
  51. 4700 ifi+of<fthenprinttab(19)""i+of+1"[146]"f$(i+of+1)l%(i+of+1)
  52. 4702 nexti:print
  53. 4704 printr"records are possible in file"
  54. 4706 printx"records are currently present":return
  55. 4708 rem----choose option
  56. 4710 gosub4688:print" change n[146]ame of field"
  57. 4712 print"        l[146]ength of field"
  58. 4714 print"     or a[146]dd another field"
  59. 4716 print"        d[146]elete a field"
  60. 4718 print"        $[146] disk directory"
  61. 4720 print"        e[146]xit to beginning"
  62. 4722 print"      press the appropriate key        "
  63. 4724 print"   only one option may be performed    "
  64. 4726 k=0:gosub4606:ifa$="e"then4620
  65. 4728 ifa$="$"thengosub4896:goto4710
  66. 4730 ifa$="n"thenk=1
  67. 4732 ifa$="l"thenk=2
  68. 4734 ifa$="a"thenk=3
  69. 4736 ifa$="d"thenk=4
  70. 4738 onkgoto4742,4754,4766,4778:goto4726
  71. 4740 rem----change field name
  72. 4742 gosub4688:input" change name of field # ? 0[157][157][157]";cf:ifcf=<0then4710
  73. 4744 ifcf>fthenprint"[145]":goto4742
  74. 4746 print" enter new field name:":print" ? ";f$(cf)
  75. 4748 input"[145]";f$:iff$=f$(cf)then4710
  76. 4750 ft=f:goto4784
  77. 4752 rem----change field length
  78. 4754 gosub4688:input" change length of field # ? 0[157][157][157]";cf:ifcf=<0then4710
  79. 4756 ifcf>fthenprint"[145]":goto4754
  80. 4758 print" enter new field length:":print" ?";l%(cf)
  81. 4760 input"[145]";l%:ifl%=l%(cf)then4710
  82. 4762 l%(cf)=l%:ft=f:goto4784
  83. 4764 rem----add new field
  84. 4766 gosub4688:print" add new field #";f+1
  85. 4768 print" title of new field":print" ? >":input"[145]";f$
  86. 4770 print" length of new field":print" ? 0":input"[145]";l%
  87. 4772 ifl%=0then4710
  88. 4774 ft=f+1:cf=f+1:goto4784
  89. 4776 rem----delete existing field
  90. 4778 gosub4688:input" delete which field? 0[157][157][157]";cf:ifcf=0then4710
  91. 4780 ft=f-1
  92. 4782 rem----calculate # records
  93. 4784 mem=29293:rl=0
  94. 4786 forj=0tof:ifk=4andj=cfthen4790
  95. 4788 rl=rl+l%(j)
  96. 4790 nextj:ifk=3thenrl=rl+l%
  97. 4792 rl=rl+3*(ft+1)+5
  98. 4794 nr=int((mem-12*(ft+1)-2100)/rl)
  99. 4796 print" your selections will allow approx"
  100. 4798 printnr;"records.  a[146]ccept or r[146]eject?"
  101. 4800 gosub4606:ifa$="r"then4710
  102. 4802 ifa$<>"a"then4800
  103. 4804 rem----load file
  104. 4806 open15,8,15:open5,8,5,"0:df] "+nf$+",s,r":gosub4612:ifet=8then4710
  105. 4808 ifen=62thengosub4614:goto4710
  106. 4810 input#5,r,f,x:gosub4612:ifet=8then4710
  107. 4812 forn=1tof:input#5,f$(n),l%(n):nextn:gosub4612:ifet=8then4710
  108. 4814 fori=1tox:print" reading record #";i;"[145][145]"
  109. 4816 forn=1tof:input#5,rec$(i,n):nextn:nexti:print:gosub4612:ifet=8then4710
  110. 4818 fori=1tox:print" reading pointers";i;"[145][145]":input#5,k%(i):nexti
  111. 4820 s=st:ifs<>0then4824
  112. 4822 input#5,e$:gosub4612
  113. 4824 close5:close15
  114. 4826 rem----save restructured file
  115. 4828 ifk=1thenf$(cf)=f$
  116. 4830 ifk=2thenl%(cf)=l%
  117. 4832 cr$=chr$(13):print"[147] insert the disk to receive the file."
  118. 4834 print" enter name of restructured file to be"
  119. 4836 print" saved (12 characters max). if the old"
  120. 4838 print" file name is chosen, the old file"
  121. 4840 print" will be renamed with !old."
  122. 4842 print"  ";nf$:input"[145]";nf$:ifnf$=""then4710
  123. 4844 open15,8,15:print#15,"s0:df] "+left$(nf$,8)+"!old"
  124. 4846 gosub4612:ifet=8then4710
  125. 4848 print#15,"r0:df] "+left$(nf$,8)+"!old=df] "+nf$:gosub4612:ifet=8then4710
  126. 4850 open5,8,5,"0:df] "+nf$+",s,w":gosub4612:ifet=8then4710
  127. 4852 ifx>nrthenx=nr
  128. 4854 print#5,nr;cr$;ft;cr$;x
  129. 4856 forn=1tof:ifk=4andn=cfthen4860
  130. 4858 print#5,f$(n);cr$;l%(n)
  131. 4860 nextn:ifk=3thenprint#5,f$;cr$;l%
  132. 4862 gosub4612:ifet=8then4710
  133. 4864 fori=1tox:print" saving record #";i;"[145][145]"
  134. 4866 forn=1tof:ifk=4andn=cfthen4870
  135. 4868 print#5,rec$(k%(i),n)
  136. 4870 nextn:ifk=3thenprint#5,">"
  137. 4872 nexti:print:gosub4612:ifet=8then4710
  138. 4874 fori=1tox:print" saving pointers";i;"[145][145]":print#5,i:nexti
  139. 4876 print#5,"eof":gosub4612:ifet=8then4710
  140. 4878 close5:close15
  141. 4880 ifx>nrthenprint"the last"x-nr"records were deleted"
  142. 4882 rem--reread new structure
  143. 4884 open15,8,15:open5,8,5,"0:df] "+nf$+",s,r":gosub4612:ifet=8then4710
  144. 4886 ifen=62thengosub4614:goto4710
  145. 4888 input#5,r,f,x:gosub4612:ifet=8then4710
  146. 4890 forn=1tof:input#5,f$(n),l%(n):nextn:gosub4612:ifet=8then4710
  147. 4892 close5:close15:goto4710
  148. 4894 rem--directory
  149. 4896 open15,8,15:open5,8,0,"$0":print"[147]":gosub4612:ifet=8thenreturn
  150. 4898 get#5,a1$,a2$
  151. 4900 get#5,a1$,a2$
  152. 4902 get#5,a1$,a2$
  153. 4904 ifa1$<>""thena0=asc(a1$)
  154. 4906 ifa2$<>""thena0=a0+asc(a2$)*256
  155. 4908 printmid$(str$(a0),2);tab(3);
  156. 4910 get#5,a2$:ifst<>0then4928
  157. 4912 ifa2$<>chr$(34)then4910
  158. 4914 get#5,a2$:ifa2$<>chr$(34)thenprint""a2$"[146]";:goto4914
  159. 4916 get#5,a2$:ifa2$=chr$(32)then4916
  160. 4918 printtab(20);:a3$=""
  161. 4920 a3$=a3$+a2$:get#5,a2$:ifa2$<>""then4920
  162. 4922 printleft$(a3$,3)
  163. 4924 geta$:ifa$<>""thengosub4932
  164. 4926 ifst=0then4900
  165. 4928 print" blocks free";:a0=0
  166. 4930 close5:close15:printtab(25)"press any key[146]":gosub4606:return
  167. 4932 gosub4606:return
  168.