home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 176-200 / apd176 / dbm_sys / dbm-field.amos / dbm-field.amosSourceCode
AMOS Source Code  |  1991-03-11  |  11KB  |  402 lines
  1. '
  2. ' Database master field maintenance by Steve (24/1/91) 
  3. '
  4. FLD_SETUP:
  5. Screen Open 0,640,260,16,Hires
  6. ''Break Off  
  7. On Error Goto EROR
  8. Global FILENAME$,ICON$,DISK$,PIC$,REC_COUNT,PROGRAMS$
  9. '
  10. Open In 9,"DBM_SYS:DBMPROG.DAT"
  11. Input #9,DISK$
  12. Input #9,ACCOUNT$
  13. Close 9
  14. PROGRAMS$=DISK$+ACCOUNT$
  15. ''ICON$=DISK$+"DBM_SYS/DBM_ICON.info"
  16. CHAIN_PROG$=PROGRAMS$+"DBM-MASTER.AMOS"
  17. Dim DBFN$(50)
  18. Dim DBFL$(50)
  19. Dim DBRPW$(50)
  20. Dim DBWPW$(50)
  21. Dim INFO$(50)
  22. Dim TMPFL$(50)
  23. BEGIN:
  24. Doke ADATA+38,22
  25. Curs Off 
  26. Paper 0
  27. Cls 
  28. Curs Off 
  29. Wind Open 1,1,1,79,5,1
  30. Paper 4 : Pen 3 : Clw 
  31. Locate 18,2 : Print "    D A T A B A S E  M A S T E R    "
  32. Wind Open 2,1,33,79,28,14
  33. Paper 6 : Pen 5 : Clw 
  34. 'Pen 4 : Locate 2,1 : Print Border$("FIELD MAINTENANCE",1) : Pen 5 
  35. '
  36. If Not Exist("RAM:DBMCHAIN.DAT")
  37.    Cls 
  38.    Print "Chain file missing return to main menu.  C/R to Recover."
  39.    Wait Key 
  40.    Goto EX_PROG
  41. End If 
  42. Open In 9,"RAM:DBMCHAIN.DAT"
  43. Input #9,FILENAME$
  44. Close 9
  45. '
  46. Open Out 9,"RAM:DBMLINK.DAT"
  47. Print #9,"By pass the select database option. Database - ";FILENAME$
  48. Close 9
  49. '
  50. FLD_CNG$="N"
  51. Gosub OPEN_FILES
  52. For LP=1 To Val(FLD_USE$)
  53.    TMPFL$(LP)=DBFL$(LP)
  54. Next LP
  55. '------------------------------------------------------------------------- 
  56. '
  57. 'Check space on disk to create temp file 
  58. '
  59. SPACE_COUNT=0
  60. SPACE_COUNT=A+B+C+D+E+F+G+H+I+J+K+L+M+N+O+P+Q+R+S+T
  61. SPACE_COUNT=SPACE_COUNT*Val(DBUSE$)
  62. If SPACE_COUNT>Dfree
  63.    Pen 5
  64.    Print At(1,22);"Disk Full - Please Transfer To Another Disk."
  65.    Print At(1,23);"Need ;";SPACE_COUNT;" Blocks Only Got ";Dfree;" Blocks"
  66.    Print At(1,24);"C/R To Recover"
  67.    Pen 4
  68.    Wait Key 
  69.    Goto EX_PROG
  70. End If 
  71. '
  72. '------------------------------------------------------------------------- 
  73. '
  74. ST_FLD:
  75. Pen 4
  76. Print At(2,1);"NO"
  77. Print At(6,1);"FIELD"
  78. Print At(25,1);"SIZE"
  79. Print At(35,1);"READ PW"
  80. Print At(45,1);"WRITE PW"
  81. Pen 5
  82. For COUNT=1 To Val(FLD_USE$)
  83.    Print At(1,COUNT+1);COUNT;"."
  84.    Print At(6,COUNT+1);DBFN$(COUNT)
  85.    Print At(25,COUNT+1);TMPFL$(COUNT)
  86.    Print At(35,COUNT+1);DBRPW$(COUNT)
  87.    Print At(45,COUNT+1);DBWPW$(COUNT)
  88. Next COUNT
  89. Pen 4 : Print At(2,COUNT+2);"A.  Add New Field" : Pen 5
  90. JUMP_DSP:
  91. Print At(1,24);"Any Change?        "
  92. Input At(13,24);CHANGE$
  93. Pen 4 : Print At(2,COUNT+2);"                      " : Pen 5
  94. If Val(CHANGE$)>Val(FLD_USE$) Then Goto JUMP_DSP
  95. If Upper$(CHANGE$)="A" Then Goto AD_FLD
  96. Print At(1,24);"                               "
  97. If Val(CHANGE$)>0 Then Goto CHANGE_FLD
  98. Goto EX_PROG
  99. '------------------------------------------------------------------------
  100. '
  101. '
  102. CHANGE_FLD:
  103. CHANGE=Val(CHANGE$)
  104. Print At(6,CHANGE+1);"          "
  105. Input At(6,CHANGE+1);DBFN$(CHANGE)
  106. '
  107. Print At(25,CHANGE+1);"   "
  108. OLD_FLD$=TMPFL$(CHANGE)
  109. Input At(25,CHANGE+1);TMPFL$(CHANGE)
  110. If TMPFL$(CHANGE)="" Then TMPFL$(CHANGE)=OLD_FLD$
  111. If TMPFL$(CHANGE)<>OLD_FLD$ Then FLD_CNG$="Y"
  112. Print At(25,CHANGE+1);TMPFL$(CHANGE)
  113. '
  114. Print At(35,CHANGE+1);"         "
  115. Input At(35,CHANGE+1);DBRPW$(CHANGE)
  116. Print At(45,CHANGE+1);"         "
  117. Input At(45,CHANGE+1);DBWPW$(CHANGE)
  118. '
  119. Print At(1,23);"Please Wait..."
  120. For LP=1 To 50
  121.    If DBFL$(LP)="" : DBFL$(LP)="1" : End If 
  122. Next LP
  123. For LP=1 To 50
  124.    FLDN$=DBFN$(LP)
  125.    FLDL$=DBFL$(LP)
  126.    FLRPW$=DBRPW$(LP)
  127.    FLWPW$=DBWPW$(LP)
  128.    Put 2,LP
  129. Next LP
  130. For LP=1 To 50
  131.    If DBFL$(LP)="" : DBFL$(LP)="1" : End If 
  132. Next LP
  133. Print At(1,23);"                               "
  134. Goto ST_FLD
  135. '------------------------------------------------------------------------
  136. AD_FLD:
  137. '
  138. ' Add New Field
  139. '
  140. COUNT=Val(FLD_USE$)+1
  141.    Print At(1,COUNT+1);COUNT;"."
  142.    Input At(6,COUNT+1);DBFN$(COUNT)
  143.    Input At(25,COUNT+1);TMPFL$(COUNT)
  144.    Input At(35,COUNT+1);DBRPW$(COUNT)
  145.    Input At(45,COUNT+1);DBWPW$(COUNT)
  146. Print At(1,23);"Please Wait..."
  147.    If TMPFL$(COUNT)="" Then TMPFL$(COUNT)="1"
  148.    FLD_CNG$="Y"
  149.    FLD_USE$=Str$(COUNT)
  150.    Put 1,1
  151. Print At(1,23);"                "
  152. Goto ST_FLD
  153. '
  154. '------------------------------------------------------------------------
  155. '  
  156. BLD_DATA:
  157. '
  158. 'Build up new data file
  159. ' open Temp data file  
  160. '
  161. For LP=1 To 50
  162.    If TMPFL$(LP)="" : TMPFL$(LP)="1" : End If 
  163. Next LP
  164. AA=Val(TMPFL$(1))
  165. BB=Val(TMPFL$(2))
  166. CC=Val(TMPFL$(3))
  167. DD=Val(TMPFL$(4))
  168. EE=Val(TMPFL$(5))
  169. FF=Val(TMPFL$(6))
  170. GG=Val(TMPFL$(7))
  171. HH=Val(TMPFL$(8))
  172. II=Val(TMPFL$(9))
  173. JJ=Val(TMPFL$(10))
  174. KK=Val(TMPFL$(11))
  175. LL=Val(TMPFL$(12))
  176. MM=Val(TMPFL$(13))
  177. NN=Val(TMPFL$(14))
  178. OO=Val(TMPFL$(15))
  179. PP=Val(TMPFL$(16))
  180. QQ=Val(TMPFL$(17))
  181. RR=Val(TMPFL$(18))
  182. SS=Val(TMPFL$(19))
  183. TT=Val(TMPFL$(20))
  184. '
  185. FILNAM$=FILENAME$+"TMP"
  186. Open Random 8,FILNAM$
  187. Field 8,AA As AA$,BB As BB$,CC As CC$,DD As DD$,EE As EE$,FF As FF$,GG As GG$,HH As HH$,II As II$,JJ As JJ$,KK As KK$,LL As LL$,MM As MM$,NN As NN$,OO As OO$,PP As PP$,QQ As QQ$,RR As RR$,SS As SS$,TT As TT$
  188. '
  189. WCNT=0
  190. DEL_CNT=0
  191. Curs Off : Clw 
  192. Pen 2 : Locate 2,1 : Print Border$("FIELD MAINTENANCE",1) : Pen 5
  193. Pen 5 : Print At(2,4);"Sort Database File" : Pen 4
  194. For RCNT=1 To Val(DBUSE$)
  195.    Print At(2,6);"DISK SPACE : ";Dfree;" Bytes"
  196.    Print At(2,8);"DATA SIZE  : ";SPACE_COUNT;" Bytes"
  197.    Print At(2,10);"RECORD NO  : ";RCNT
  198.    Print At(2,12);"DELETED    : ";DEL_CNT
  199.    Get 3,RCNT
  200.    If Mid$(A$,1,6)="]]]DEL" Then Inc DEL_CNT
  201.    If Mid$(A$,1,6)<>"]]]DEL"
  202.       Inc WCNT
  203.       AA$=A$
  204.       BB$=B$
  205.       CC$=C$
  206.       DD$=D$
  207.       EE$=E$
  208.       FF$=F$
  209.       GG$=G$
  210.       HH$=H$
  211.       II$=I$
  212.       JJ$=J$
  213.       KK$=K$
  214.       LL$=L$
  215.       MM$=M$
  216.       NN$=N$
  217.       OO$=O$
  218.       PP$=P$
  219.       QQ$=Q$
  220.       RR$=R$
  221.       SS$=S$
  222.       TT$=T$
  223.       Put 8,WCNT
  224.    End If 
  225. Next RCNT
  226. Close 3 : Close 8
  227. FILNAM$=FILENAME$+"D"
  228. FILNAM2$=FILENAME$+"TMP"
  229. Kill FILNAM$
  230. Rename FILNAM2$ To FILNAM$
  231. DBUSE$=Str$(WCNT)
  232. DBDEL$=Str$(0)
  233. Put 1,1
  234. '
  235. 'write back new field sizes  
  236. '
  237. Print At(1,23);"Please Wait..."
  238. For LP=1 To Val(FLD_USE$)
  239.    DBFL$(LP)=TMPFL$(LP)
  240. Next LP
  241. For LP=1 To 50
  242.    If DBFL$(LP)="" : DBFL$(LP)="1" : End If 
  243. Next LP
  244. For LP=1 To 50
  245.    FLDN$=DBFN$(LP)
  246.    FLDL$=DBFL$(LP)
  247.    FLRPW$=DBRPW$(LP)
  248.    FLWPW$=DBWPW$(LP)
  249.    Put 2,LP
  250. Next LP
  251. Close 
  252. Pen 5
  253. Print At(1,23);"                  "
  254. Print At(2,14);"Rebuild Index"
  255. Pen 4
  256. '--------------------------------------------------------------------
  257. '
  258. ' Rebuild Index  
  259. '
  260. BUILD_IDX:
  261. Gosub OPEN_FILES
  262. For LP=1 To Val(DBUSE$)
  263.    Print At(2,16);"BUILD INDEX RECORD : ";LP
  264.    Get 3,LP
  265.    '
  266.    If Val(SYSSEARCH$)=1 : STORE$=A$ : STORE_VALUE=A : End If 
  267.    If Val(SYSSEARCH$)=2 : STORE$=B$ : STORE_VALUE=B : End If 
  268.    If Val(SYSSEARCH$)=3 : STORE$=C$ : STORE_VALUE=C : End If 
  269.    If Val(SYSSEARCH$)=4 : STORE$=D$ : STORE_VALUE=D : End If 
  270.    If Val(SYSSEARCH$)=5 : STORE$=E$ : STORE_VALUE=E : End If 
  271.    If Val(SYSSEARCH$)=6 : STORE$=F$ : STORE_VALUE=F : End If 
  272.    If Val(SYSSEARCH$)=7 : STORE$=G$ : STORE_VALUE=G : End If 
  273.    If Val(SYSSEARCH$)=8 : STORE$=H$ : STORE_VALUE=H : End If 
  274.    If Val(SYSSEARCH$)=9 : STORE$=I$ : STORE_VALUE=I : End If 
  275.    If Val(SYSSEARCH$)=10 : STORE$=J$ : STORE_VALUE=J : End If 
  276.    If Val(SYSSEARCH$)=11 : STORE$=K$ : STORE_VALUE=K : End If 
  277.    If Val(SYSSEARCH$)=12 : STORE$=L$ : STORE_VALUE=L : End If 
  278.    If Val(SYSSEARCH$)=13 : STORE$=M$ : STORE_VALUE=M : End If 
  279.    If Val(SYSSEARCH$)=14 : STORE$=N$ : STORE_VALUE=N : End If 
  280.    If Val(SYSSEARCH$)=15 : STORE$=O$ : STORE_VALUE=O : End If 
  281.    If Val(SYSSEARCH$)=16 : STORE$=P$ : STORE_VALUE=P : End If 
  282.    If Val(SYSSEARCH$)=17 : STORE$=Q$ : STORE_VALUE=Q : End If 
  283.    If Val(SYSSEARCH$)=18 : STORE$=R$ : STORE_VALUE=R : End If 
  284.    If Val(SYSSEARCH$)=19 : STORE$=S$ : STORE_VALUE=S : End If 
  285.    If Val(SYSSEARCH$)=20 : STORE$=T$ : STORE_VALUE=T : End If 
  286.    If Val(SYSSEARCH$)<1 or Val(SYSSEARCH$)>20 : STORE$=A$ : STORE_VALUE=A : End If 
  287.    RECIDX$=Str$(LP) : AIDX$=STORE$
  288.    Put 4,LP
  289. Next LP
  290. IDXMAX$=DBUSE$
  291. Put 1,1
  292. Close 
  293. Curs On 
  294. Return 
  295. '
  296. '========================================================================
  297. '
  298. OPEN_FILES:
  299. '
  300. 'open header file
  301. '
  302. FILNAM$=FILENAME$
  303. Open Random 1,FILNAM$
  304. 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$
  305. If NEW_DB$="Y"
  306.    DBUSE$="000000" : DBDEL$="000000" : IDXMAX$="000000"
  307.    DBNAME$=THE_NAME$
  308.    FLD_USE$=Str$(REC_COUNT)
  309.    SYSSEARCH$="1" : CREATEDATE$="12/10/90" : COUNT$="1" : DBM_VERSION$="2.0(100)"
  310.    Put 1,1
  311. End If 
  312. Get 1,1
  313. '
  314. 'open field file 
  315. '
  316. FILNAM$=FILENAME$+"F"
  317. Open Random 2,FILNAM$
  318. Field 2,20 As FLDN$,3 As FLDL$,10 As FLRPW$,10 As FLWPW$,21 As FLFILLER$
  319. For LP=1 To 50
  320.    Get 2,LP
  321.    DBFN$(LP)=FLDN$
  322.    DBFL$(LP)=FLDL$
  323.    DBRPW$(LP)=FLRPW$
  324.    DBWPW$(LP)=FLWPW$
  325. Next LP
  326. For LP=1 To 50
  327.    If DBFL$(LP)="" : DBFL$(LP)="1" : End If 
  328. Next LP
  329. A=Val(DBFL$(1))
  330. B=Val(DBFL$(2))
  331. C=Val(DBFL$(3))
  332. D=Val(DBFL$(4))
  333. E=Val(DBFL$(5))
  334. F=Val(DBFL$(6))
  335. G=Val(DBFL$(7))
  336. H=Val(DBFL$(8))
  337. I=Val(DBFL$(9))
  338. J=Val(DBFL$(10))
  339. K=Val(DBFL$(11))
  340. L=Val(DBFL$(12))
  341. M=Val(DBFL$(13))
  342. N=Val(DBFL$(14))
  343. O=Val(DBFL$(15))
  344. P=Val(DBFL$(16))
  345. Q=Val(DBFL$(17))
  346. R=Val(DBFL$(18))
  347. S=Val(DBFL$(19))
  348. T=Val(DBFL$(20))
  349. '
  350. ' open data file 
  351. '
  352. FILNAM$=FILENAME$+"D"
  353. Open Random 3,FILNAM$
  354. 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$
  355. '
  356. 'Open Index file 
  357. '
  358. If Val(SYSSEARCH$)=1 : STORE$=A$ : STORE_VALUE=A : End If 
  359. If Val(SYSSEARCH$)=2 : STORE$=B$ : STORE_VALUE=B : End If 
  360. If Val(SYSSEARCH$)=3 : STORE$=C$ : STORE_VALUE=C : End If 
  361. If Val(SYSSEARCH$)=4 : STORE$=D$ : STORE_VALUE=D : End If 
  362. If Val(SYSSEARCH$)=5 : STORE$=E$ : STORE_VALUE=E : End If 
  363. If Val(SYSSEARCH$)=6 : STORE$=F$ : STORE_VALUE=F : End If 
  364. If Val(SYSSEARCH$)=7 : STORE$=G$ : STORE_VALUE=G : End If 
  365. If Val(SYSSEARCH$)=8 : STORE$=H$ : STORE_VALUE=H : End If 
  366. If Val(SYSSEARCH$)=9 : STORE$=I$ : STORE_VALUE=I : End If 
  367. If Val(SYSSEARCH$)=10 : STORE$=J$ : STORE_VALUE=J : End If 
  368. If Val(SYSSEARCH$)=11 : STORE$=K$ : STORE_VALUE=K : End If 
  369. If Val(SYSSEARCH$)=12 : STORE$=L$ : STORE_VALUE=L : End If 
  370. If Val(SYSSEARCH$)=13 : STORE$=M$ : STORE_VALUE=M : End If 
  371. If Val(SYSSEARCH$)=14 : STORE$=N$ : STORE_VALUE=N : End If 
  372. If Val(SYSSEARCH$)=15 : STORE$=O$ : STORE_VALUE=O : End If 
  373. If Val(SYSSEARCH$)=16 : STORE$=P$ : STORE_VALUE=P : End If 
  374. If Val(SYSSEARCH$)=17 : STORE$=Q$ : STORE_VALUE=Q : End If 
  375. If Val(SYSSEARCH$)=18 : STORE$=R$ : STORE_VALUE=R : End If 
  376. If Val(SYSSEARCH$)=19 : STORE$=S$ : STORE_VALUE=S : End If 
  377. If Val(SYSSEARCH$)=20 : STORE$=T$ : STORE_VALUE=T : End If 
  378. If Val(SYSSEARCH$)<1 or Val(SYSSEARCH$)>20 : STORE$=A$ : STORE_VALUE=A : End If 
  379. FILNAM$=FILENAME$+"I"
  380. Open Random 4,FILNAM$
  381. Field 4,6 As RECIDX$,STORE_VALUE As AIDX$
  382. '
  383. ' open and write to chain file 
  384. '
  385. Open Out 9,"RAM:DBMCHAIN.DAT"
  386. Print #9,FILENAME$
  387. Close 9
  388. '
  389. Return 
  390. '======================================================================= 
  391. '
  392. EROR:
  393. Cls 
  394. Print "ERROR! Return to main program - C/R to Recover."
  395. Wait Key 
  396. If Exist("RAM:DBMLINK.DAT") Then Kill "RAM:DBMLINK.DAT"
  397. '
  398. EX_PROG:
  399. If FLD_CNG$="Y" Then Gosub BLD_DATA
  400. Print At(1,23);"Loading Menu, Please Wait....."
  401. Close 
  402. Run CHAIN_PROG$