home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / data / pdsdb40a.lzh / DBUTIL01.SRC < prev    next >
Text File  |  1989-02-15  |  8KB  |  127 lines
  1. |2005 DIM ST(10,10),C$(|06)
  2. |2010 FOR J=1 TO |02
  3. 2015 IF ZS%(J,1)=2 OR ZS%(J,4)=0 THEN GOTO 2040
  4. 2020 FOR K=2 TO ZS%(J,4)+1
  5. |2025 FOR L=J+1 TO |02
  6. 2030 IF ZS$(J,K)=ZS$(L,1) THEN ST(J,K-1)=L
  7. 2035 NEXT L:NEXT K
  8. 2040 NEXT 'J
  9. |2110 CLS:PRINT TAB(21)"PDS*BASE Data Base Utility Program For":PRINT:PRINT TAB(INT((80-LEN("|11"))/2));"|11":PRINT
  10. 2120 PRINT TAB(17);"Main Menu"
  11. *23 2130 PRINT:PRINT "1 - Reset Detail 'Next Vacant Record' Pointers"
  12. 2140 PRINT:PRINT "2 - Reset Master 'Quantity Assigned' Records"
  13. *23 2150 PRINT:PRINT "3 - Verify Master/Detail Relationships For Broken Detail Chains"
  14. 2155 PRINT:PRINT "4 - Serial Print The Files"
  15. 2160 PRINT:PRINT "5 - Hard Modify A Record"
  16. 2165 PRINT:PRINT "    Enter Code ? ";:ZQ$=INPUT$(1):PRINT ZQ$:ZK=VAL(ZQ$):IF ZK=0 THEN GOTO 400
  17. 2170 IF ZK < 0 OR ZK > 5 THEN GOTO 2110
  18. *28 2175 IF ZK=1 OR ZK=3 THEN GOTO 2110
  19. 2180 ON ZK GOTO 2200,2300,2400,3000,3500
  20. *28 2200 GOTO 2110 'No Detail Files
  21. *23 2200 ' reset detail vacant record pointers
  22. *23 2205 PRINT:PRINT "File * Record * Last Vacant":PRINT:PRINT
  23. *23 |2210 FOR ZA=1 TO |02:IF ZS%(ZA,1)<>2 THEN GOTO 2280
  24. *23 2220 ZL=ZS%(ZA,2)+1:Y2=0:FOR ZR=ZS%(ZA,2) TO 1 STEP -1
  25. *23 2225 LOCATE ,2,1:PRINT ZA;TAB(9)ZR;" ";
  26. *23 2230 GOSUB 600:Y11=0:FOR ZJ=1 TO ZS%(ZA,7):IF Y$(ZJ,ZA)<>STRING$(ZSIZE%(ZA,ZJ),32) THEN Y11=1
  27. *23 2240 NEXT:IF Y11=1 THEN Y2=Y2+1:GOTO 2260
  28. *23 2250 ZF=ZL:GOSUB 700:ZL=ZR 'set the forward pointer to the next higher vacant record
  29. *23 2255 LOCATE ,2,1:PRINT ZA;TAB(9)ZR;SPC(1);TAB(20)ZL;" ";:ZL=ZR
  30. *23 2260 NEXT ZR:PRINT:PRINT
  31. *23 2270 ZS%(ZA,6)=Y2:ZS%(ZA,8)=ZL 'reset the housekeeping pointers
  32. *23 2280 NEXT 'ZA
  33. *23 2290 GOTO 2375
  34. 2300 'RESET THE MASTER QUANTITY ASSIGNED
  35. 2305 PRINT:PRINT "File * Record * Active Records":PRINT:PRINT
  36. |2310 FOR ZA=1 TO |02:IF ZS%(ZA,1)<>1 THEN GOTO 2370
  37. 2320 Y22=0:FOR ZR=1 TO ZS%(ZA,2)
  38. 2330 ZZ=1:GOSUB 610:IF ZL$<>STRING$(ZSIZE%(ZA,1),32) THEN Y22=Y22+1
  39. 2340 LOCATE ,2,1:PRINT ZA;TAB(9)ZR;TAB(20);Y22;
  40. 2350 NEXT ZR:PRINT:PRINT
  41. 2360 ZS%(ZA,6)=Y22 'update records assigned
  42. 2370 NEXT 'ZA
  43. 2375 PRINT:PRINT TAB(25)"(Press any key to continue) ";:ZQ$=INPUT$(1):PRINT
  44. 2380 GOTO 2110
  45. *28 2400 GOTO 2110 'no detail files
  46. *23 2400 'check for broken detail chains
  47. *23 2410 BEEP:PRINT "Turn On The Printer For Error List"
  48. *23 |2420 FOR Y11=1 TO |02:IF ZS%(Y11,1)<>1 OR ZS%(Y11,4)=0 THEN GOTO 2500
  49. *23 2430 Y3=0:FOR Y2=1 TO ZS%(Y11,2)
  50. *23 2440 ZZ=1:ZR=Y2:GOSUB 610
  51. *23 2450 IF ZL$=STRING$(VAL(MID$(ZN$(ZA,1,2),3)),32) THEN 2480
  52. *23 2460 Y3=Y3+1:FOR Y4=1 TO ZS%(Y11,4):IF ZH(Y4)<>0 THEN GOSUB 2600 'check the chain head
  53. *23 2470 NEXT 'Y4
  54. *23 2480 NEXT 'Y2
  55. *23 2490 ZS%(Y11,6)=Y3 'reset assigned records counter
  56. *23 2500 NEXT 'Y11
  57. *23 2510 GOTO 2110
  58. *23 2520 '
  59. *23 2600 'Subroutine to check out the chain for MASTER Y2 and the Y4th associated set
  60. *23 2610 ZA=ST(Y11,Y4):ZR=ZH(Y4):GOSUB 600 'read chain head record
  61. *23 2620 IF ZH(Y4)=0 AND ZE(Y4)=0 AND ZB=0 AND ZF=0 THEN RETURN ' 1 Detail - all ok
  62. *23 2630 IF ZB=0 THEN GOTO 2670
  63. *23 2640 '
  64. *23 2650 LPRINT:LPRINT "Master File ";Y11;"  Record ";Y2;"  Detail File ";ZA;"  Record ";ZR:LPRINT "1st Detail has ";ZB;" as backward pointer"
  65. *23 2670 IF ZF>0 THEN GOTO 2710
  66. *23 2690 LPRINT:LPRINT "Master File ";Y11;"  Record ";Y2;"  Detail File ";ZA;"  Record ";ZR:LPRINT "1st Detail has zero forward ptr but chain end in master not the same number"
  67. *23 2710 IF ZF=0 THEN RETURN
  68. *23 2720 Y5=ZR:ZR=ZF:GOSUB 600 'read next Detail
  69. *23 2730 IF ZB=Y5 THEN GOTO 2770 'back ptr=last record number
  70. *23 2750 LPRINT:LPRINT "Master File ";Y11;"  Record ";Y2;"  Detail File ";ZA;"  Record ";ZR:LPRINT "Backward pointer not equal last Detail record number (broken chain)"
  71. *23 2760 RETURN
  72. *23 2770 IF ZF>0 THEN GOTO 2720
  73. *23 2780 IF ZE(Y4)=ZR THEN RETURN 'reached chain end and it is = chain end in master
  74. *23 2800 LPRINT:LPRINT "Master file ";Y11;"  Record ";Y2;"  Detail file ";ZA;"  Record ";ZR:LPRINT "Last in chain not equal to chain end in Master (broken chain)"
  75. *23 2810 RETURN
  76. 3000 'Serial list the files
  77. *36 3010 CLS:PRINT "File List Menu":PRINT:PRINT "File #   File Name      Records":PRINT
  78. *37 3010 CLS:PRINT "File Listing For ";ZS$(1,1):PRINT:ZA=1:GOTO 3045
  79. *36 |3020 FOR ZJ=1 TO |02:PRINT TAB(2)ZJ;TAB(10)ZS$(ZJ,1);TAB(26)ZS%(ZJ,2):PRINT:NEXT:PRINT
  80. *36 3030 INPUT "Enter File Number ";ZQ$:IF ZQ$="" GOTO 2110
  81. *36 |3040 ZA=VAL(ZQ$):IF ZA<0 OR ZA>|02 THEN GOTO 3000
  82. 3045 ZBLK=1:IF ZS%(ZA,1)<>1 THEN 3050 ELSE PRINT "Do you wish to print blank records ? ";:COLOR 0,7:PRINT "N";:LOCATE ,POS(0)-1,1:ZANS$="":WHILE ZANS$="":ZANS$=INKEY$:WEND
  83. 3047 PRINT ZANS$;:COLOR 7,0:PRINT:IF ZANS$<>"Y" AND ZANS$<>"y" THEN ZBLK=0
  84. 3050 PRINT:PRINT "Turn on the printer - Strike any key when ready - Esc=STOP printing":ZQ$=INPUT$(1):PRINT
  85. 3060 LPRINT "Serial (Raw) Listing Of The '";ZS$(ZA,1);" File.":LPRINT:LPRINT "Record":LPRINT
  86. 3070 FOR ZJ=1 TO ZS%(ZA,2)
  87. 3075 ZQ$=INKEY$:IF ZQ$<>"" THEN IF ASC(ZQ$)=27 THEN ZJ=ZS%(ZA,2):GOTO 3130
  88. 3080 ZR=ZJ:ZZ=1:GOSUB 610
  89. 3082 IF ZBLK=0 AND Y$(1,ZA)=STRING$(ZSIZE%(ZA,1),32) THEN 3130
  90. 3085 LPRINT USING "######";ZR;:LPRINT SPC(2);
  91. 3090 IF ZS%(ZA,1)=1 THEN LPRINT ZC;ZP;ZN;:IF ZS%(ZA,4)>0 THEN FOR ZK=1 TO ZS%(ZA,4):LPRINT ZH(ZA);ZE(ZA);:NEXT 'ZK
  92. 3100 IF ZS%(ZA,1)=2 THEN LPRINT ZB;ZF;
  93. 3120 FOR ZK=1 TO ZS%(ZA,7):LPRINT Y$(ZK,ZA);:NEXT:LPRINT
  94. 3130 NEXT 'ZJ
  95. *36 3140 GOTO 3000
  96. *37 3140 GOTO 2110
  97. 3500 'Hard modify a record
  98. 3510 CLS:PRINT "Section 5 To Hard Modify A Record.":PRINT:PRINT "You can modify both the data and the pointers in any record.":PRINT
  99. *36 |3520 FOR ZJ=1 TO |02:PRINT:PRINT ZJ;" - ";ZS$(ZJ,1):NEXT:PRINT:INPUT "    Enter File Number ";ZQ$:ZA=VAL(ZQ$):IF ZA=0 THEN GOTO 2110
  100. *37 3520 ZA=1
  101. *36 |3530 IF ZA<1 OR ZA >|02 THEN GOTO 3510
  102. 3540 PRINT:INPUT "    Enter Record Number ";ZR$:ZR=VAL(ZR$):IF ZR=0 THEN GOTO 2110
  103. 3550 IF ZR<1 OR ZR>ZS%(ZA,2) THEN BEEP:PRINT:PRINT "Record number greater than the record capacity of ";ZS%(ZA,2);" for this file.":PRINT:GOTO 3520
  104. 3555 ZCHGFLAG(ZA)=1 'change the Date/Time stamp for the file
  105. 3560 PRINT:PRINT "Code**Field Type**Value":PRINT
  106. 3570 ZZ=1:GOSUB 610 'read the selected record
  107. 3580 IF ZS%(ZA,1)=2 THEN PRINT " BP -  BACK PTR. = ";ZB:PRINT:PRINT " FP -  FOWD PTR. = ";ZF:GOTO 3610
  108. 3590 PRINT " AR -  ADDR RECS = ";ZC:PRINT " PR -  PREV REC. = ";ZP:PRINT " NR -  NEXT REC. = ";ZN
  109. 3600 IF ZS%(ZA,4)>0 THEN FOR ZJ=1 TO ZS%(ZA,4):PRINT "CH";ZJ;" -  CHAIN HEAD= ";ZH(ZJ):PRINT "CE";ZJ;" -  CHAIN END = ";ZE(ZJ):NEXT
  110. 3610 PRINT:PRINT "Do you wish to see the data ? ";:COLOR 0,7:PRINT "N";:COLOR 7,0:LOCATE ,POS(0)-1,1
  111. 3620 ZQ$=INPUT$(1)
  112. 3630 PRINT ZQ$:PRINT:IF ZQ$<>"Y" AND ZQ$<>"y" THEN GOTO 3650
  113. 3640 FOR ZJ=1 TO ZS%(ZA,7):PRINT ZJ;" - ";ZN$(ZA,ZJ,1);" = ";Y$(ZJ,ZA):NEXT
  114. 3650 PRINT:INPUT "Enter Feild Num. Or Pointer Code ";ZQ$:IF ZQ$="" THEN GOSUB 700:GOTO 3540
  115. 3660 ZJ=VAL(ZQ$):IF ZJ>0 THEN PRINT:PRINT "Enter New ";ZN$(ZA,ZJ,1);:INPUT ZI$(ZJ,ZA):LSET Y$(ZJ,ZA)=ZI$(ZJ,ZA):GOTO 3580
  116. 3670 IF ZQ$="BP" OR ZQ$="bp" THEN INPUT "Enter New Backward Pointer ";ZQ$:ZB=VAL(ZQ$):GOTO 3580
  117. 3680 IF ZQ$="FP" OR ZQ$="fp" THEN INPUT "Enter New Forward Pointer ";ZQ$:ZF=VAL(ZQ$):GOTO 3580
  118. 3690 IF ZQ$="AR" OR ZQ$="ar" THEN INPUT "Enter New Quan Of Masters With This Calculated Record Number ";ZQ$:ZC=VAL(ZQ$):GOTO 3580
  119. 3700 IF ZQ$="PR" OR ZQ$="pr" THEN INPUT "Enter New Previous Master Num. ";ZQ$:ZP=VAL(ZQ$):GOTO 3580
  120. 3710 IF ZQ$="NR" OR ZQ$="nr" THEN INPUT "Enter New Next Record Number ";ZQ$:ZN=VAL(ZQ$):GOTO 3580
  121. 3720 IF LEN(ZQ$)<>3 THEN GOTO 3580
  122. 3730 ZJ=VAL(RIGHT$(ZQ$,1)):IF ZJ < 1 OR ZJ > ZS%(ZA,4) THEN GOTO 3580
  123. 3740 IF LEFT$(ZQ$,2) = "CH" OR LEFT$(ZQ$,2)="ch" THEN PRINT "Enter New Chain Head ";ZJ;:INPUT ZQ$:ZH(ZJ)=VAL(ZQ$):GOTO 3580
  124. 3750 IF LEFT$(ZQ$,2) = "CE" OR LEFT$(ZQ$,2)="ce" THEN PRINT "Enter New Chain End ";ZJ;:INPUT ZQ$:ZE(ZJ)=VAL(ZQ$):GOTO 3580
  125. 3760 BEEP:PRINT No such code or number":FOR ZJ=1 TO 1000:NEXT:PRINT:GOTO 3580
  126. *31 Copyright 1987 by PRO DEV Software
  127.