home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 176-200 / apd176 / dbm_sys / dbm-reorg.amos / dbm-reorg.amosSourceCode
AMOS Source Code  |  1991-03-11  |  8KB  |  272 lines
  1. '========================================================================= 
  2. '
  3. ' Database Reorg by Steve (03/02/91)   
  4. '
  5. '========================================================================= 
  6. '
  7. SRT_SETUP:
  8. Screen Open 0,640,260,16,Hires
  9. Break Off 
  10. On Error Goto EROR
  11. Global FILENAME$,ICON$,DISK$,PIC$,REC_COUNT,PROGRAMS$
  12. '
  13. Open In 9,"DBM_SYS:DBMPROG.DAT"
  14. Input #9,DISK$
  15. Input #9,ACCOUNT$
  16. Close 9
  17. PROGRAMS$=DISK$+ACCOUNT$
  18. CHAIN_PROG$=PROGRAMS$+"DBM-MASTER.AMOS"
  19. Dim DBFN$(50)
  20. Dim DBFL$(50)
  21. Dim DBRPW$(50)
  22. Dim DBWPW$(50)
  23. Dim INFO$(50)
  24. BEGIN:
  25. Doke ADATA+38,22
  26. Curs Off 
  27. Paper 0
  28. Cls 
  29. Curs Off 
  30. Wind Open 1,1,1,79,5,1
  31. Paper 4 : Pen 3 : Clw 
  32. Locate 18,2 : Print "    D A T A B A S E  M A S T E R    "
  33. Wind Open 2,1,33,79,28,14
  34. Paper 6 : Pen 5 : Clw 
  35. Pen 2 : Locate 25,1 : Print Border$("SORT DATABASE - PLEASE WAIT",1) : Pen 5
  36. '
  37. If Not Exist("RAM:DBMCHAIN.DAT")
  38.    Cls 
  39.    Print "Chain file missing return to main menu.  C/R to Recover."
  40.    Wait Key 
  41.    Goto EX_PROG
  42. End If 
  43. Open In 9,"RAM:DBMCHAIN.DAT"
  44. Input #9,FILENAME$
  45. Close 9
  46. '
  47. Open Out 9,"RAM:DBMLINK.DAT"
  48. Print #9,"By pass the select database option. Database - ";FILENAME$
  49. Close 9
  50. '
  51. Gosub OPEN_FILES
  52. '
  53. ' open Temp data file  
  54. '
  55. FILNAM$=FILENAME$+"TMP"
  56. Open Random 8,FILNAM$
  57. Field 8,A As AA$,B As BB$,C As CC$,D As DD$,E As EE$,F As FF$,G As GG$,H As HH$,I As II$,J As JJ$,K As KK$,L As LL$,M As MM$,N As NN$,O As OO$,P As PP$,Q As QQ$,R As RR$,S As SS$,T As TT$
  58. '
  59. Pen 4
  60. '------------------------------------------------------------------------- 
  61. '
  62. 'Check space on disk to create temp file 
  63. '
  64. SPACE_COUNT=0
  65. SPACE_COUNT=A+B+C+D+E+F+G+H+I+J+K+L+M+N+O+P+Q+R+S+T
  66. SPACE_COUNT=SPACE_COUNT*Val(DBUSE$)
  67. If SPACE_COUNT>Dfree
  68.    Pen 5
  69.    Print At(1,22);"Disk Full - Please Transfer To Another Disk."
  70.    Print At(1,23);"Need ;";SPACE_COUNT;" Blocks Only Got ";Dfree;" Blocks"
  71.    Print At(1,24);"C/R To Recover"
  72.    Pen 4
  73.    Wait Key 
  74.    Goto EX_PROG
  75. End If 
  76. '
  77. ' Sort database into temp file then copy it back.
  78. '
  79. WCNT=0
  80. DEL_CNT=0
  81. Curs Off 
  82. Pen 5 : Print At(2,4);"Sort Database File" : Pen 4
  83. For RCNT=1 To Val(DBUSE$)
  84.    Print At(2,6);"DISK SPACE : ";Dfree;" Bytes"
  85.    Print At(2,8);"DATA SIZE  : ";SPACE_COUNT;" Bytes"
  86.    Print At(2,10);"RECORD NO  : ";RCNT
  87.    Print At(2,12);"DELETED    : ";DEL_CNT
  88.    Get 3,RCNT
  89.    If Mid$(A$,1,6)="]]]DEL" Then Inc DEL_CNT
  90.    If Mid$(A$,1,6)<>"]]]DEL"
  91.       Inc WCNT
  92.       AA$=A$
  93.       BB$=B$
  94.       CC$=C$
  95.       DD$=D$
  96.       EE$=E$
  97.       FF$=F$
  98.       GG$=G$
  99.       HH$=H$
  100.       II$=I$
  101.       JJ$=J$
  102.       KK$=K$
  103.       LL$=L$
  104.       MM$=M$
  105.       NN$=N$
  106.       OO$=O$
  107.       PP$=P$
  108.       QQ$=Q$
  109.       RR$=R$
  110.       SS$=S$
  111.       TT$=T$
  112.       Put 8,WCNT
  113.    End If 
  114. Next RCNT
  115. Close 3 : Close 8
  116. FILNAM$=FILENAME$+"D"
  117. FILNAM2$=FILENAME$+"TMP"
  118. Kill FILNAM$
  119. Rename FILNAM2$ To FILNAM$
  120. DBUSE$=Str$(WCNT)
  121. DBDEL$=Str$(0)
  122. Put 1,1
  123. Close 
  124. Pen 5
  125.    Print At(2,14);"Rebuild Index"
  126. Pen 4
  127. '--------------------------------------------------------------------
  128. '
  129. ' Rebuild Index  
  130. '
  131. BUILD_IDX:
  132. Gosub OPEN_FILES
  133. For LP=1 To Val(DBUSE$)
  134.    Print At(2,16);"BUILD INDEX RECORD : ";LP
  135.    Get 3,LP
  136.    '
  137.    If Val(SYSSEARCH$)=1 : STORE$=A$ : STORE_VALUE=A : End If 
  138.    If Val(SYSSEARCH$)=2 : STORE$=B$ : STORE_VALUE=B : End If 
  139.    If Val(SYSSEARCH$)=3 : STORE$=C$ : STORE_VALUE=C : End If 
  140.    If Val(SYSSEARCH$)=4 : STORE$=D$ : STORE_VALUE=D : End If 
  141.    If Val(SYSSEARCH$)=5 : STORE$=E$ : STORE_VALUE=E : End If 
  142.    If Val(SYSSEARCH$)=6 : STORE$=F$ : STORE_VALUE=F : End If 
  143.    If Val(SYSSEARCH$)=7 : STORE$=G$ : STORE_VALUE=G : End If 
  144.    If Val(SYSSEARCH$)=8 : STORE$=H$ : STORE_VALUE=H : End If 
  145.    If Val(SYSSEARCH$)=9 : STORE$=I$ : STORE_VALUE=I : End If 
  146.    If Val(SYSSEARCH$)=10 : STORE$=J$ : STORE_VALUE=J : End If 
  147.    If Val(SYSSEARCH$)=11 : STORE$=K$ : STORE_VALUE=K : End If 
  148.    If Val(SYSSEARCH$)=12 : STORE$=L$ : STORE_VALUE=L : End If 
  149.    If Val(SYSSEARCH$)=13 : STORE$=M$ : STORE_VALUE=M : End If 
  150.    If Val(SYSSEARCH$)=14 : STORE$=N$ : STORE_VALUE=N : End If 
  151.    If Val(SYSSEARCH$)=15 : STORE$=O$ : STORE_VALUE=O : End If 
  152.    If Val(SYSSEARCH$)=16 : STORE$=P$ : STORE_VALUE=P : End If 
  153.    If Val(SYSSEARCH$)=17 : STORE$=Q$ : STORE_VALUE=Q : End If 
  154.    If Val(SYSSEARCH$)=18 : STORE$=R$ : STORE_VALUE=R : End If 
  155.    If Val(SYSSEARCH$)=19 : STORE$=S$ : STORE_VALUE=S : End If 
  156.    If Val(SYSSEARCH$)=20 : STORE$=T$ : STORE_VALUE=T : End If 
  157.    If Val(SYSSEARCH$)<1 or Val(SYSSEARCH$)>20 : STORE$=A$ : STORE_VALUE=A : End If 
  158.    RECIDX$=Str$(LP) : AIDX$=STORE$
  159.    Put 4,LP
  160. Next LP
  161. IDXMAX$=DBUSE$
  162. Put 1,1
  163. Close 
  164. Curs On 
  165. Goto EX_PROG
  166. '========================================================================
  167. '
  168. OPEN_FILES:
  169. '
  170. 'open header file
  171. '
  172. FILNAM$=FILENAME$
  173. Open Random 1,FILNAM$
  174. Field 1,30 As DBNAME$,6 As DBUSE$,6 As DBDEL$,2 As SYSSEARCH$,8 As CREATEDATE$,6 As COUNT$,6 As MENU1PW$,6 As MENU2PW$,6 As MENU3PW$,6 As MENU4PW$,6 As MENU5PW$,6 As IDXMAX$,2 As FLD_USE$,8 As DBM_VERSION$
  175. If NEW_DB$="Y"
  176.    DBUSE$="000000" : DBDEL$="000000" : IDXMAX$="000000"
  177.    DBNAME$=THE_NAME$
  178.    FLD_USE$=Str$(REC_COUNT)
  179.    SYSSEARCH$="1" : CREATEDATE$="12/10/90" : COUNT$="1" : DBM_VERSION$="2.0(100)"
  180.    Put 1,1
  181. End If 
  182. Get 1,1
  183. '
  184. 'open field file 
  185. '
  186. FILNAM$=FILENAME$+"F"
  187. Open Random 2,FILNAM$
  188. Field 2,20 As FLDN$,3 As FLDL$,10 As FLRPW$,10 As FLWPW$,21 As FLFILLER$
  189. For LP=1 To 50
  190.    Get 2,LP
  191.    DBFN$(LP)=FLDN$
  192.    DBFL$(LP)=FLDL$
  193.    DBRPW$(LP)=FLRPW$
  194.    DBWPW$(LP)=FLWPW$
  195. Next LP
  196. For LP=1 To 50
  197.    If DBFL$(LP)="" : DBFL$(LP)="1" : End If 
  198. Next LP
  199. A=Val(DBFL$(1))
  200. B=Val(DBFL$(2))
  201. C=Val(DBFL$(3))
  202. D=Val(DBFL$(4))
  203. E=Val(DBFL$(5))
  204. F=Val(DBFL$(6))
  205. G=Val(DBFL$(7))
  206. H=Val(DBFL$(8))
  207. I=Val(DBFL$(9))
  208. J=Val(DBFL$(10))
  209. K=Val(DBFL$(11))
  210. L=Val(DBFL$(12))
  211. M=Val(DBFL$(13))
  212. N=Val(DBFL$(14))
  213. O=Val(DBFL$(15))
  214. P=Val(DBFL$(16))
  215. Q=Val(DBFL$(17))
  216. R=Val(DBFL$(18))
  217. S=Val(DBFL$(19))
  218. T=Val(DBFL$(20))
  219. '
  220. ' open data file 
  221. '
  222. FILNAM$=FILENAME$+"D"
  223. Open Random 3,FILNAM$
  224. Field 3,A As A$,B As B$,C As C$,D As D$,E As E$,F As F$,G As G$,H As H$,I As I$,J As J$,K As K$,L As L$,M As M$,N As N$,O As O$,P As P$,Q As Q$,R As R$,S As S$,T As T$
  225. '
  226. 'Open Index file 
  227. '
  228. If Val(SYSSEARCH$)=1 : STORE$=A$ : STORE_VALUE=A : End If 
  229. If Val(SYSSEARCH$)=2 : STORE$=B$ : STORE_VALUE=B : End If 
  230. If Val(SYSSEARCH$)=3 : STORE$=C$ : STORE_VALUE=C : End If 
  231. If Val(SYSSEARCH$)=4 : STORE$=D$ : STORE_VALUE=D : End If 
  232. If Val(SYSSEARCH$)=5 : STORE$=E$ : STORE_VALUE=E : End If 
  233. If Val(SYSSEARCH$)=6 : STORE$=F$ : STORE_VALUE=F : End If 
  234. If Val(SYSSEARCH$)=7 : STORE$=G$ : STORE_VALUE=G : End If 
  235. If Val(SYSSEARCH$)=8 : STORE$=H$ : STORE_VALUE=H : End If 
  236. If Val(SYSSEARCH$)=9 : STORE$=I$ : STORE_VALUE=I : End If 
  237. If Val(SYSSEARCH$)=10 : STORE$=J$ : STORE_VALUE=J : End If 
  238. If Val(SYSSEARCH$)=11 : STORE$=K$ : STORE_VALUE=K : End If 
  239. If Val(SYSSEARCH$)=12 : STORE$=L$ : STORE_VALUE=L : End If 
  240. If Val(SYSSEARCH$)=13 : STORE$=M$ : STORE_VALUE=M : End If 
  241. If Val(SYSSEARCH$)=14 : STORE$=N$ : STORE_VALUE=N : End If 
  242. If Val(SYSSEARCH$)=15 : STORE$=O$ : STORE_VALUE=O : End If 
  243. If Val(SYSSEARCH$)=16 : STORE$=P$ : STORE_VALUE=P : End If 
  244. If Val(SYSSEARCH$)=17 : STORE$=Q$ : STORE_VALUE=Q : End If 
  245. If Val(SYSSEARCH$)=18 : STORE$=R$ : STORE_VALUE=R : End If 
  246. If Val(SYSSEARCH$)=19 : STORE$=S$ : STORE_VALUE=S : End If 
  247. If Val(SYSSEARCH$)=20 : STORE$=T$ : STORE_VALUE=T : End If 
  248. If Val(SYSSEARCH$)<1 or Val(SYSSEARCH$)>20 : STORE$=A$ : STORE_VALUE=A : End If 
  249. FILNAM$=FILENAME$+"I"
  250. Open Random 4,FILNAM$
  251. Field 4,6 As RECIDX$,STORE_VALUE As AIDX$
  252. '
  253. ' open and write to chain file 
  254. '
  255. Open Out 9,"RAM:DBMCHAIN.DAT"
  256. Print #9,FILENAME$
  257. Close 9
  258. '
  259. Return 
  260. '======================================================================= 
  261. '
  262. EROR:
  263. Cls 
  264. Print "ERROR! Return to main program - C/R to Recover."
  265. Wait Key 
  266. If Exist("RAM:DBMLINK.DAT") Then Kill "RAM:DBMLINK.DAT"
  267. '
  268. EX_PROG:
  269. Pen 5
  270. Print At(1,23);"Loading Menu, Please Wait....."
  271. Close 
  272. Run CHAIN_PROG$