home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 176-200 / apd176 / dbm_sys / dbm-srtidx.amos / dbm-srtidx.amosSourceCode
AMOS Source Code  |  1991-03-11  |  7KB  |  240 lines
  1. '
  2. ' Database Master Sort Index by Steve (19/2/91)  
  3. '
  4. Set Buffer 100
  5. Close Workbench 
  6. FLD_SETUP:
  7. Screen Open 0,640,260,16,Hires
  8. ''Break Off  
  9. On Error Goto EROR
  10. Global FILENAME$,ICON$,DISK$,PIC$,REC_COUNT,PROGRAMS$
  11. '
  12. Open In 9,"DBM_SYS:DBMPROG.DAT"
  13. Input #9,DISK$
  14. Input #9,ACCOUNT$
  15. Close 9
  16. PROGRAMS$=DISK$+ACCOUNT$
  17. CHAIN_PROG$=PROGRAMS$+"DBM-MASTER.AMOS"
  18. Dim DBFN$(50)
  19. Dim DBFL$(50)
  20. Dim DBRPW$(50)
  21. Dim DBWPW$(50)
  22. BEGIN:
  23. Doke ADATA+38,22
  24. Curs Off 
  25. Paper 0
  26. Cls 
  27. Curs Off 
  28. Wind Open 1,1,1,79,5,1
  29. Paper 4 : Pen 3 : Clw 
  30. Locate 18,2 : Print "    D A T A B A S E  M A S T E R    "
  31. Wind Open 2,1,33,79,28,14
  32. Paper 6 : Pen 5 : Clw 
  33. Pen 4 : Locate 26,1 : Print Border$("S O R T   I N D E X",1) : Pen 5
  34. '
  35. If Not Exist("RAM:DBMCHAIN.DAT")
  36.    Cls 
  37.    Print "Chain file missing return to main menu.  C/R to Recover."
  38.    Wait Key 
  39.    Goto EX_PROG
  40. End If 
  41. Open In 9,"RAM:DBMCHAIN.DAT"
  42. Input #9,FILENAME$
  43. Close 9
  44. '
  45. Open Out 9,"RAM:DBMLINK.DAT"
  46. Print #9,"By pass the select database option. Database - ";FILENAME$
  47. Close 9
  48. '--------------------------------------------------------------------
  49. '
  50. ' Rebuild Index  
  51. '
  52. BUILD_IDX:
  53. Gosub OPEN_FILES
  54. Pen 5
  55. Curs Off 
  56. Print At(1,23);Val(DBUSE$);" Records in Use.   ";Chip Free;" Chip Memory.    ";Fast Free;" Fast Memory"
  57. Print At(2,5);"                  "
  58. Print At(2,5);"Rebuild Index"
  59. Pen 4
  60. For LP=1 To Val(DBUSE$)
  61.    Print At(2,7);"Building Index Record : ";LP
  62.    Get 3,LP
  63.    '
  64.    If Val(SYSSEARCH$)=1 : STORE$=A$ : STORE_VALUE=A : End If 
  65.    If Val(SYSSEARCH$)=2 : STORE$=B$ : STORE_VALUE=B : End If 
  66.    If Val(SYSSEARCH$)=3 : STORE$=C$ : STORE_VALUE=C : End If 
  67.    If Val(SYSSEARCH$)=4 : STORE$=D$ : STORE_VALUE=D : End If 
  68.    If Val(SYSSEARCH$)=5 : STORE$=E$ : STORE_VALUE=E : End If 
  69.    If Val(SYSSEARCH$)=6 : STORE$=F$ : STORE_VALUE=F : End If 
  70.    If Val(SYSSEARCH$)=7 : STORE$=G$ : STORE_VALUE=G : End If 
  71.    If Val(SYSSEARCH$)=8 : STORE$=H$ : STORE_VALUE=H : End If 
  72.    If Val(SYSSEARCH$)=9 : STORE$=I$ : STORE_VALUE=I : End If 
  73.    If Val(SYSSEARCH$)=10 : STORE$=J$ : STORE_VALUE=J : End If 
  74.    If Val(SYSSEARCH$)=11 : STORE$=K$ : STORE_VALUE=K : End If 
  75.    If Val(SYSSEARCH$)=12 : STORE$=L$ : STORE_VALUE=L : End If 
  76.    If Val(SYSSEARCH$)=13 : STORE$=M$ : STORE_VALUE=M : End If 
  77.    If Val(SYSSEARCH$)=14 : STORE$=N$ : STORE_VALUE=N : End If 
  78.    If Val(SYSSEARCH$)=15 : STORE$=O$ : STORE_VALUE=O : End If 
  79.    If Val(SYSSEARCH$)=16 : STORE$=P$ : STORE_VALUE=P : End If 
  80.    If Val(SYSSEARCH$)=17 : STORE$=Q$ : STORE_VALUE=Q : End If 
  81.    If Val(SYSSEARCH$)=18 : STORE$=R$ : STORE_VALUE=R : End If 
  82.    If Val(SYSSEARCH$)=19 : STORE$=S$ : STORE_VALUE=S : End If 
  83.    If Val(SYSSEARCH$)=20 : STORE$=T$ : STORE_VALUE=T : End If 
  84.    If Val(SYSSEARCH$)<1 or Val(SYSSEARCH$)>20 : STORE$=A$ : STORE_VALUE=A : End If 
  85.    RECIDX$=Str$(LP) : AIDX$=STORE$
  86.    Put 4,LP
  87. Next LP
  88. IDXMAX$=DBUSE$
  89. Put 1,1
  90. '------------------------------------------------------------------------- 
  91. Dim INDEX_FILE$(Val(DBUSE$))
  92. '
  93. ' Read index file
  94. '
  95. Pen 5
  96. Print At(2,9);"                    "
  97. Print At(2,9);"Reading Index File  "
  98. Pen 4
  99. For LP=1 To Val(DBUSE$)
  100.    Print At(2,11);"Index Record : ";LP
  101.    Get 4,LP
  102.    INDEX_FILE$(LP)=AIDX$+RECIDX$
  103. Next LP
  104. '
  105. ' Sort array of index file 
  106. '
  107. Pen 5
  108. Print At(2,13);"                    "
  109. Print At(2,13);"Sorting File        "
  110. Pen 4
  111. Sort INDEX_FILE$(0)
  112. '
  113. ' Write records back 
  114. '
  115. Pen 5
  116. Print At(2,15);"                    "
  117. Print At(2,15);"Writing Index File  "
  118. Pen 4
  119. For LP=1 To Val(DBUSE$)
  120.    Print At(2,17);"Index Record : ";LP
  121.    INDEX_RECORD$=INDEX_FILE$(LP)
  122.    AIDX$=Mid$(INDEX_RECORD$,STORE_VALUE+7)
  123.    RECIDX$=Mid$(INDEX_RECORD$,1,6)
  124.    Put 4,LP
  125. Next LP
  126. '
  127. ' Exit 
  128. '
  129. Print At(1,23);"** ALL COMPLETE **, C/R for Main Menu.                                                        "
  130. Wait Key 
  131. Print At(1,23);"                                      "
  132. Goto EX_PROG
  133. '========================================================================
  134. '
  135. OPEN_FILES:
  136. '
  137. 'open header file
  138. '
  139. FILNAM$=FILENAME$
  140. Open Random 1,FILNAM$
  141. 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$
  142. If NEW_DB$="Y"
  143.    DBUSE$="000000" : DBDEL$="000000" : IDXMAX$="000000"
  144.    DBNAME$=THE_NAME$
  145.    FLD_USE$=Str$(REC_COUNT)
  146.    SYSSEARCH$="1" : CREATEDATE$="12/10/90" : COUNT$="1" : DBM_VERSION$="2.0(100)"
  147.    Put 1,1
  148. End If 
  149. Get 1,1
  150. '
  151. 'open field file 
  152. '
  153. FILNAM$=FILENAME$+"F"
  154. Open Random 2,FILNAM$
  155. Field 2,20 As FLDN$,3 As FLDL$,10 As FLRPW$,10 As FLWPW$,21 As FLFILLER$
  156. For LP=1 To 50
  157.    Get 2,LP
  158.    DBFN$(LP)=FLDN$
  159.    DBFL$(LP)=FLDL$
  160.    DBRPW$(LP)=FLRPW$
  161.    DBWPW$(LP)=FLWPW$
  162. Next LP
  163. For LP=1 To 50
  164.    If DBFL$(LP)="" : DBFL$(LP)="1" : End If 
  165. Next LP
  166. A=Val(DBFL$(1))
  167. B=Val(DBFL$(2))
  168. C=Val(DBFL$(3))
  169. D=Val(DBFL$(4))
  170. E=Val(DBFL$(5))
  171. F=Val(DBFL$(6))
  172. G=Val(DBFL$(7))
  173. H=Val(DBFL$(8))
  174. I=Val(DBFL$(9))
  175. J=Val(DBFL$(10))
  176. K=Val(DBFL$(11))
  177. L=Val(DBFL$(12))
  178. M=Val(DBFL$(13))
  179. N=Val(DBFL$(14))
  180. O=Val(DBFL$(15))
  181. P=Val(DBFL$(16))
  182. Q=Val(DBFL$(17))
  183. R=Val(DBFL$(18))
  184. S=Val(DBFL$(19))
  185. T=Val(DBFL$(20))
  186. '
  187. ' open data file 
  188. '
  189. FILNAM$=FILENAME$+"D"
  190. Open Random 3,FILNAM$
  191. 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$
  192. '
  193. 'Open Index file 
  194. '
  195. If Val(SYSSEARCH$)=1 : STORE$=A$ : STORE_VALUE=A : End If 
  196. If Val(SYSSEARCH$)=2 : STORE$=B$ : STORE_VALUE=B : End If 
  197. If Val(SYSSEARCH$)=3 : STORE$=C$ : STORE_VALUE=C : End If 
  198. If Val(SYSSEARCH$)=4 : STORE$=D$ : STORE_VALUE=D : End If 
  199. If Val(SYSSEARCH$)=5 : STORE$=E$ : STORE_VALUE=E : End If 
  200. If Val(SYSSEARCH$)=6 : STORE$=F$ : STORE_VALUE=F : End If 
  201. If Val(SYSSEARCH$)=7 : STORE$=G$ : STORE_VALUE=G : End If 
  202. If Val(SYSSEARCH$)=8 : STORE$=H$ : STORE_VALUE=H : End If 
  203. If Val(SYSSEARCH$)=9 : STORE$=I$ : STORE_VALUE=I : End If 
  204. If Val(SYSSEARCH$)=10 : STORE$=J$ : STORE_VALUE=J : End If 
  205. If Val(SYSSEARCH$)=11 : STORE$=K$ : STORE_VALUE=K : End If 
  206. If Val(SYSSEARCH$)=12 : STORE$=L$ : STORE_VALUE=L : End If 
  207. If Val(SYSSEARCH$)=13 : STORE$=M$ : STORE_VALUE=M : End If 
  208. If Val(SYSSEARCH$)=14 : STORE$=N$ : STORE_VALUE=N : End If 
  209. If Val(SYSSEARCH$)=15 : STORE$=O$ : STORE_VALUE=O : End If 
  210. If Val(SYSSEARCH$)=16 : STORE$=P$ : STORE_VALUE=P : End If 
  211. If Val(SYSSEARCH$)=17 : STORE$=Q$ : STORE_VALUE=Q : End If 
  212. If Val(SYSSEARCH$)=18 : STORE$=R$ : STORE_VALUE=R : End If 
  213. If Val(SYSSEARCH$)=19 : STORE$=S$ : STORE_VALUE=S : End If 
  214. If Val(SYSSEARCH$)=20 : STORE$=T$ : STORE_VALUE=T : End If 
  215. If Val(SYSSEARCH$)<1 or Val(SYSSEARCH$)>20 : STORE$=A$ : STORE_VALUE=A : End If 
  216. FILNAM$=FILENAME$+"I"
  217. Open Random 4,FILNAM$
  218. Field 4,6 As RECIDX$,STORE_VALUE As AIDX$
  219. '
  220. ' open and write to chain file 
  221. '
  222. Open Out 9,"RAM:DBMCHAIN.DAT"
  223. Print #9,FILENAME$
  224. Close 9
  225. '
  226. Return 
  227. '======================================================================= 
  228. '
  229. EROR:
  230. Cls 
  231. Print "Low on Memory!!  - Rebuild Index File Before Using Database Again."
  232. Print 
  233. Print "ERROR! Return to main program - C/R to Recover."
  234. Wait Key 
  235. If Exist("RAM:DBMLINK.DAT") Then Kill "RAM:DBMLINK.DAT"
  236. '
  237. EX_PROG:
  238. Print At(1,23);"Loading Menu, Please Wait....."
  239. Close 
  240. Run CHAIN_PROG$