home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 176-200 / apd176 / dbm_sys / dbm-clrdbm.amos / dbm-clrdbm.amosSourceCode
AMOS Source Code  |  1991-03-11  |  5KB  |  173 lines
  1. '
  2. ' Database Master Clear All Data Fields by Steve (25/02/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. CHAIN_PROG$=PROGRAMS$+"DBM-MASTER.AMOS"
  16. Dim DBFN$(50)
  17. Dim DBFL$(50)
  18. Dim INFO$(50)
  19. Dim DBRPW$(50)
  20. Dim DBWPW$(50)
  21. BEGIN:
  22. Doke ADATA+38,22
  23. Curs Off 
  24. Paper 0
  25. Cls 
  26. Curs Off 
  27. Wind Open 1,1,1,79,5,1
  28. Paper 4 : Pen 3 : Clw 
  29. Locate 18,2 : Print "    D A T A B A S E  M A S T E R    "
  30. Wind Open 2,1,33,79,28,14
  31. Paper 6 : Pen 5 : Clw 
  32. '
  33. If Not Exist("RAM:DBMCHAIN.DAT")
  34.    Cls 
  35.    Print "Chain file missing return to main menu.  C/R to Recover."
  36.    Wait Key 
  37.    Goto EX_PROG
  38. End If 
  39. Open In 9,"RAM:DBMCHAIN.DAT"
  40. Input #9,FILENAME$
  41. Close 9
  42. '
  43. Open Out 9,"RAM:DBMLINK.DAT"
  44. Print #9,"By pass the select database option. Database - ";FILENAME$
  45. Close 9
  46. '
  47. Gosub OPEN_FILES
  48. '------------------------------------------------------------------------- 
  49. '
  50. SEL_SCR:
  51. Clw : Pen 2 : Locate 27,1 : Print Border$("** CLEAR FIELDS **",1) : Pen 5
  52. Print At(3,5);"ARE YOU SURE YOU WANT TO CLEAR"
  53. Print At(34,5);DBNAME$
  54. Print At(3,7);"YES or NO :     "
  55. Input At(15,7);YESNO$
  56. If Upper$(YESNO$)="YES" : Goto CLR_DBM : End If 
  57. Goto EX_PROG
  58. '
  59. ' Clear Database 
  60. '
  61. CLR_DBM:
  62. DBUSE$="000000" : DBDEL$="000000" : IDXMAX$="000000"
  63. MENU1PW$="" : MENU2PW$="" : MENU3PW$="" : MENU4PW$="" : MENU5PW$=""
  64. SYSSEARCH$="1" : COUNT$="1"
  65. Put 1,1
  66. Close 
  67. FILNAM$=FILENAME$+"D"
  68. Kill FILNAM$
  69. FILNAM$=FILENAME$+"I"
  70. Kill FILNAM$
  71. Print At(5,11);"** ALL DATA FIELDS CLEAR **   C/R For Main Menu"
  72. Wait Key 
  73. Goto EX_PROG
  74. '
  75. '========================================================================
  76. '
  77. OPEN_FILES:
  78. '
  79. 'open header file
  80. '
  81. FILNAM$=FILENAME$
  82. Open Random 1,FILNAM$
  83. 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$
  84. Get 1,1
  85. '
  86. 'open field file 
  87. '
  88. FILNAM$=FILENAME$+"F"
  89. Open Random 2,FILNAM$
  90. Field 2,20 As FLDN$,3 As FLDL$,10 As FLRPW$,10 As FLWPW$,21 As FLFILLER$
  91. For LP=1 To 50
  92.    Get 2,LP
  93.    DBFN$(LP)=FLDN$
  94.    DBFL$(LP)=FLDL$
  95.    DBRPW$(LP)=FLRPW$
  96.    DBWPW$(LP)=FLWPW$
  97. Next LP
  98. For LP=1 To 50
  99.    If DBFL$(LP)="" : DBFL$(LP)="1" : End If 
  100. Next LP
  101. A=Val(DBFL$(1))
  102. B=Val(DBFL$(2))
  103. C=Val(DBFL$(3))
  104. D=Val(DBFL$(4))
  105. E=Val(DBFL$(5))
  106. F=Val(DBFL$(6))
  107. G=Val(DBFL$(7))
  108. H=Val(DBFL$(8))
  109. I=Val(DBFL$(9))
  110. J=Val(DBFL$(10))
  111. K=Val(DBFL$(11))
  112. L=Val(DBFL$(12))
  113. M=Val(DBFL$(13))
  114. N=Val(DBFL$(14))
  115. O=Val(DBFL$(15))
  116. P=Val(DBFL$(16))
  117. Q=Val(DBFL$(17))
  118. R=Val(DBFL$(18))
  119. S=Val(DBFL$(19))
  120. T=Val(DBFL$(20))
  121. '
  122. ' open data file 
  123. '
  124. FILNAM$=FILENAME$+"D"
  125. Open Random 3,FILNAM$
  126. 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$
  127. '
  128. 'Open Index file 
  129. '
  130. If Val(SYSSEARCH$)=1 : STORE$=A$ : STORE_VALUE=A : End If 
  131. If Val(SYSSEARCH$)=2 : STORE$=B$ : STORE_VALUE=B : End If 
  132. If Val(SYSSEARCH$)=3 : STORE$=C$ : STORE_VALUE=C : End If 
  133. If Val(SYSSEARCH$)=4 : STORE$=D$ : STORE_VALUE=D : End If 
  134. If Val(SYSSEARCH$)=5 : STORE$=E$ : STORE_VALUE=E : End If 
  135. If Val(SYSSEARCH$)=6 : STORE$=F$ : STORE_VALUE=F : End If 
  136. If Val(SYSSEARCH$)=7 : STORE$=G$ : STORE_VALUE=G : End If 
  137. If Val(SYSSEARCH$)=8 : STORE$=H$ : STORE_VALUE=H : End If 
  138. If Val(SYSSEARCH$)=9 : STORE$=I$ : STORE_VALUE=I : End If 
  139. If Val(SYSSEARCH$)=10 : STORE$=J$ : STORE_VALUE=J : End If 
  140. If Val(SYSSEARCH$)=11 : STORE$=K$ : STORE_VALUE=K : End If 
  141. If Val(SYSSEARCH$)=12 : STORE$=L$ : STORE_VALUE=L : End If 
  142. If Val(SYSSEARCH$)=13 : STORE$=M$ : STORE_VALUE=M : End If 
  143. If Val(SYSSEARCH$)=14 : STORE$=N$ : STORE_VALUE=N : End If 
  144. If Val(SYSSEARCH$)=15 : STORE$=O$ : STORE_VALUE=O : End If 
  145. If Val(SYSSEARCH$)=16 : STORE$=P$ : STORE_VALUE=P : End If 
  146. If Val(SYSSEARCH$)=17 : STORE$=Q$ : STORE_VALUE=Q : End If 
  147. If Val(SYSSEARCH$)=18 : STORE$=R$ : STORE_VALUE=R : End If 
  148. If Val(SYSSEARCH$)=19 : STORE$=S$ : STORE_VALUE=S : End If 
  149. If Val(SYSSEARCH$)=20 : STORE$=T$ : STORE_VALUE=T : End If 
  150. If Val(SYSSEARCH$)<1 or Val(SYSSEARCH$)>20 : STORE$=A$ : STORE_VALUE=A : End If 
  151. FILNAM$=FILENAME$+"I"
  152. Open Random 4,FILNAM$
  153. Field 4,6 As RECIDX$,STORE_VALUE As AIDX$
  154. '
  155. ' open and write to chain file 
  156. '
  157. Open Out 9,"RAM:DBMCHAIN.DAT"
  158. Print #9,FILENAME$
  159. Close 9
  160. '
  161. Return 
  162. '======================================================================= 
  163. '
  164. EROR:
  165. Cls 
  166. Print "ERROR! Return to main program - C/R to Recover."
  167. Wait Key 
  168. If Exist("RAM:DBMLINK.DAT") Then Kill "RAM:DBMLINK.DAT"
  169. '
  170. EX_PROG:
  171. Print At(1,23);"Loading Menu, Please Wait....."
  172. Close 
  173. Run CHAIN_PROG$