|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 59648 (0xe900)
Types: TextFile
Names: »FORMAT.BAS«
└─⟦f51bd807e⟧ Bits:30005981/disk5.imd Turn Key Data Entry System/Datenerfassungspaket - Vers. 1.90
└─⟦this⟧ »FORMAT.BAS«
1 REM ************************************************** 2 REM * * 3 REM * MODULE : FORMAT .BAS (TKDES/RC700) * 4 REM * DATE : 01.02.82 * 5 REM * BY : ASE GMBH , 6472 ALTENSTADT * 6 REM * VERSION: 1.90 * 7 REM * * 8 REM ************************************************** 9 REM 10 REM *********************************************************************** 11 REM * SET ERROR-HANDLING POINTER AND READ WORKNO. FROM CHAININF-FILE * 12 REM *********************************************************************** 13 ON ERROR GOTO 10000 : GOSUB 22200 REM *** READ WORK-NO. 14 IF VAL(ARBNR$) < 1 OR VAL(ARBNR$) > 11 GOTO 16 ELSE GOTO 1010 16 REM *********************************************************************** 17 REM * READ MENUE FROM DEP-FORM-FILE * 18 REM *********************************************************************** 20 ERRFLAG% = 0 : DEPFORM% = 0 : ARBSTATOPEN% = 0 : ARBSTATWRITE% = 0 21 USRFORMFOPEN% = 0 : FORMCHAINERROR% = 0 25 CLOSE REM *** CLOSE ALL FILES 30 FORMNAME$ = "DEPFORM .DEP" : FILENAME$ = FORMNAME$ 40 GOSUB 9280 REM *** OPEN FORM-FILE 50 GOSUB 9580 REM *** INIT FORMBUFFER-FIELD 55 FORMNR% = 6 : GOSUB 9674 REM *** READ FORMAR-REC. 60 IF FORMBYTES$ = "#&" THEN 70 63 REM *********************************************************************** 64 REM * NO DEP FORMAT ID. !!! PRINT ERRMSG AND STOP THE SYSTEM * 65 REM *********************************************************************** 66 ERRMSGNR% = 11 : GOSUB 20000 68 GOTO 68 REM *** ILLEGAL DISK 1 !! NO DEP-FORMAT !! 69 REM *********************************************************************** 70 REM * INIT AND CALL DEP TO PRINT MENUE ON CRT * 71 REM *********************************************************************** 72 GOSUB 9100 REM *** OPEN ASBSTAT-FILE 74 GOSUB 9150 REM *** INIT ARBSTAT-FIELD 80 FIELDNO$ = "000" : MODE$ = "00" : SPECMOD$ = "000" 85 LSET FLN$ = FIELDNO$ : LSET MO$ = MODE$ : LSET SM$ = SPECMOD$ 90 F% = VARPTR(#2) : Z% = VARPTR(#1) : CALL INIT(F%,Z%) 100 GOSUB 7240 REM *** TEST GENERAL DEP-STATUS 110 ON PRIMST% GOTO 130,90,90,90,90,90,90,7280,90,90,90,90,90,90 120 GOSUB 7280 : GOTO 16 REM *** PRINT ERRMSG. (DEP-ERROR) 130 ERRFLAG% = 0 : CLOSE REM *** CLOSE ALL FILES 131 REM *********************************************************************** 132 REM * INPUT WORKNO. * 133 REM *********************************************************************** 134 ARBSTATOPEN% = 0 : USRFORMFOPEN% = 0 135 ARBNR$ = SPACE$(2) 152 PRINT CHR$(13);CHR$(6);CHR$(80);CHR$(53);"..";CHR$(8);CHR$(8); 170 ARBNR1$=INPUT$(1) 175 IF ASC(ARBNR1$) = 12 GOTO 135 180 IF ASC(ARBNR1$) < 48 OR ASC(ARBNR1$) > 57 GOTO 170 ELSE 190 190 MID$(ARBNR$,1,1)=ARBNR1$:PRINT ARBNR1$; 200 ARBNR2$=INPUT$(1) 310 IF ASC(ARBNR2$) = 13 GOTO 360 320 IF ASC(ARBNR2$) = 12 GOTO 650 330 IF ASC(ARBNR2$) = 8 THEN PRINT CHR$(8); : GOTO 170 350 IF ASC(ARBNR2$) < 48 OR ASC(ARBNR2$) > 57 GOTO 200 360 MID$(ARBNR$,2,1) = ARBNR2$ : PRINT ARBNR2$; 365 IF VAL(ARBNR$) = 12 OR VAL(ARBNR$) = 13 THEN GOSUB 400 : GOTO 135 370 IF VAL(ARBNR$) < 1 OR VAL(ARBNR$) > 15 THEN GOSUB 400 : GOTO 135 ELSE 500 400 REM *********************************************************************** 402 REM * SUB.: PRINT ERRMSG. IN LINE 25 * 404 REM *********************************************************************** 410 ERRMSGNR% = 1 : GOSUB 20000 : GOSUB 1000 420 RETURN 490 REM *********************************************************************** 495 REM * INPUT 'WORKNO. OK ?' * 500 REM *********************************************************************** 505 ARBNROK$ = SPACE$(1) 510 ON VAL(ARBNR$) GOSUB 520,525,530,535,540,545,550,555,560,565,570,132,132,574,577 511 IF ARBNROK$ = "N" GOTO 135 512 ARBNROK$=INPUT$(1) 514 IF ARBNROK$ = "J" THEN PRINT ARBNROK$; : GOTO 1010 515 IF ARBNROK$ = "N" GOTO 510 516 PRINT CHR$(7); : GOTO 512 517 REM *********************************************************************** 518 REM * SET / RESET INVERSE MODE ON CRT * 519 REM *********************************************************************** 520 PRINT CHR$(6);CHR$(75);CHR$(37);CHR$(128); CHR$(6);CHR$(55);CHR$(37); 523 GOSUB 800 524 RETURN 525 PRINT CHR$(6);CHR$(76);CHR$(38);CHR$(128); CHR$(6);CHR$(55);CHR$(38); 528 GOSUB 800 529 RETURN 530 PRINT CHR$(6);CHR$(74);CHR$(39);CHR$(128); CHR$(6);CHR$(55);CHR$(39); 533 GOSUB 800 534 RETURN 535 PRINT CHR$(6);CHR$(86);CHR$(40);CHR$(128); CHR$(6);CHR$(55);CHR$(40); 538 GOSUB 800 539 RETURN 540 PRINT CHR$(6);CHR$(75);CHR$(41);CHR$(128); CHR$(6);CHR$(55);CHR$(41); 543 GOSUB 800 544 RETURN 545 PRINT CHR$(6);CHR$(72);CHR$(42);CHR$(128); CHR$(6);CHR$(55);CHR$(42); 548 GOSUB 800 549 RETURN 550 PRINT CHR$(6);CHR$(84);CHR$(43);CHR$(128);CHR$(6);CHR$(55);CHR$(43); 553 GOSUB 800 554 RETURN 555 PRINT CHR$(6);CHR$(73);CHR$(44);CHR$(128); CHR$(6);CHR$(55);CHR$(44); 558 GOSUB 800 559 RETURN 560 PRINT CHR$(6);CHR$(67);CHR$(45);CHR$(128); CHR$(6);CHR$(55);CHR$(45); 563 GOSUB 800 564 RETURN 565 PRINT CHR$(6);CHR$(77);CHR$(46);CHR$(128); CHR$(6);CHR$(54);CHR$(46); 568 GOSUB 800 569 RETURN 570 PRINT CHR$(6);CHR$(73);CHR$(47);CHR$(128); CHR$(6);CHR$(54);CHR$(47); 571 GOSUB 800 572 RETURN 574 PRINT CHR$(6);CHR$(75);CHR$(50);CHR$(128); CHR$(6);CHR$(54);CHR$(50); 575 GOSUB 800 576 RETURN 577 PRINT CHR$(6);CHR$(82);CHR$(51);CHR$(128); CHR$(6);CHR$(54);CHR$(51); 578 GOSUB 800 579 RETURN 580 REM *********************************************************************** 585 REM * REPLACE DATA-FLOPPY IN DRIVE 1 * 590 REM *********************************************************************** 600 FILENAME$ = "RESET" : RESET REM *** WRITE CP/M DIR. ON DISK 620 ERRMSGNR% = 14 : GOSUB 20000 630 GOSUB 1000 642 RESET REM *** INIT THE NEW DISK 644 GOTO 16 645 REM *********************************************************************** 646 REM * CALL CP/M (WARM BOOT) * 647 REM *********************************************************************** 650 SYSTEM 790 REM *********************************************************************** 795 REM * SUB.: IF ARBNROK$ = N THEN RESET INVERSE VIDEO ELSE SET INVERSE VID.* 800 REM *********************************************************************** 802 IF ARBNROK$ = "N" THEN INVERS% = 128 ELSE INVERS% = 144 804 PRINT CHR$(INVERS%) 810 PRINT CHR$(6);CHR$(81);CHR$(55); 820 RETURN 900 REM *********************************************************************** 902 REM * CHAIN TO USER-PROGRAMM * 904 REM *********************************************************************** 906 XPOS% = 1 : YPOS% = 25 : GOSUB 1990 908 PRINT " BITTE PROGRAMMNAME EINGEBEN : .......... "; 910 XPOS% = 33 : YPOS% = 25 : GOSUB 1990 912 ONE% = 1 : PROGNAME$ = SPACE$(10) 920 FOR I% = ONE% TO 10 925 KEYINPUT$ = INPUT$(1) 930 IF KEYINPUT$ = CHR$(8) THEN GOTO 950 932 IF KEYINPUT$ = CHR$(24) THEN GOTO 960 934 IF KEYINPUT$ = CHR$(13) THEN GOTO 970 936 IF ASC(KEYINPUT$) < 32 OR ASC(KEYINPUT$) > 122 THEN GOTO 925 938 PRINT KEYINPUT$; 940 MID$(PROGNAME$,I%,1) = KEYINPUT$ 942 NEXT I% 944 I% = 10 : PRINT CHR$(8); : ONE% = 8 : GOTO 920 950 REM --- CURSOR BWD --- 952 IF I% = 1 THEN GOTO 925 954 PRINT KEYINPUT$; 956 I% = I% - 1 : GOTO 925 960 REM --- CURSOR FWD --- 962 IF I% = 10 THEN GOTO 925 964 PRINT KEYINPUT$; 966 I% = I% + 1 : GOTO 925 970 REM --- CR KEY --- 972 PROGNAME$ = PROGNAME$ + ".COM" 974 CHAIN PROGNAME$ 976 REM *********************************************************************** 977 REM * PRINT ERRMSG. IN LINE 25 NO CHAIN-MODUL !! * 978 REM *********************************************************************** 980 ERRMSGNR% = 20 : GOSUB 20000 : GOSUB 1000 : GOTO 10 990 REM ********************************************************************** 995 REM * SUB.: (ESC) INPUT AFTER A ERRMSG. * 1000 REM ********************************************************************** 1002 PRINT CHR$(7);:ESCINPUT$ = INPUT$(1):IF ASC(ESCINPUT$) <> 27 GOTO 1002 1004 PRINT SPACE$(76); : RETURN 1006 REM ********************************************************************** 1008 REM * RESET ALL INPUT-BUFFER AND CHAINGE TO SEL. PROGRAMM * 1010 REM ********************************************************************** 1011 NEXTFORMFLAG% = 0 1012 IF VAL(ARBNR$) < 3 OR VAL(ARBNR$) = 9 OR VAL(ARBNR$) = 11 OR VAL(ARBNR$) = 14 THEN PRINT CHR$(12) 1013 OVERWRITE% = 0:FIELDINPUT$ = SPACE$(8):FORMNAME$ = SPACE$(12):FORMNR$ = SPACE$(3):DATANAME$ = SPACE$(12) 1014 ON VAL(ARBNR$) GOTO 1080,2050,3886,3886,3886,3886,3886,3886,4536,3886,4565,16,16,900,600 1015 REM ********************************************************************** 1016 REM * SUB.: MOVE TEXT TO TEXTBUFFER * 1020 REM ********************************************************************** 1021 FORMERFTEXT$ = "Nr. des Formats mit dem Sie beginnen wollen ? ..." 1022 GOSUB 1972 REM *** POS. CURSOR AND PRINT TEXTBUFFER 1024 RETURN 1040 REM ********************************************************************** 1045 REM * SUB.: MOVE TEXT TO TEXTBUFFER * 1050 REM ********************************************************************** 1052 FORMERFTEXT$ = "Nr. des næchsten Formats oder CTRL/Q ? ..." 1054 GOSUB 1972 REM *** POS. CURSOR AND PRINT TEXTBUFFER 1056 FORMNR$ = SPACE$(3) 1058 RETURN 1070 REM ********************************************************************** 1075 REM * PRINT HEADER ON CRT * 1080 REM ********************************************************************** 1082 PRINT CHR$(12) : XPOS% = 53:YPOS% = 4:GOSUB 1990 1085 PRINT CHR$(128); 1090 XPOS% = 28 : YPOS% = 4 : GOSUB 1990 1095 PRINT CHR$(144); 1100 PRINT "*** Format erfassen ***" 1102 IF NEXTFORMFLAG% THEN GOSUB 1050 : GOTO 1982 ELSE GOSUB 1020 : GOTO 1110 1104 REM ********************************************************************** 1106 REM * PRINT TEXT ON CRT * 1108 REM ********************************************************************** 1110 XPOS% = 2:YPOS% = 10:GOSUB 1990 1120 PRINT "Bitte den Namen der Format-Datei eingeben. ........" 1121 REM ********************************************************************** 1122 REM * POS. CURSOR AND SET INPUT-COUNTER * 1123 REM ********************************************************************** 1125 XPOS% = 46 : YPOS% = 10 : GOSUB 1990 1127 NKEYINP% = 8 1130 GOTO 3130 1440 REM ********************************************************************** 1445 REM * FIELD BWD KEY * 1450 REM ********************************************************************** 1451 IF NEXTFORMFLAG% GOTO 1452 ELSE 1454 1452 XPOS% = 51 : YPOS% = 14 : GOSUB 1990 1453 NKEYINP% = 3 : GOTO 3130 1454 IF NKEYINP% = 8 GOTO 1125 1455 MID$(FORMNR$,1,3) = MID$(FIELDINPUT$,1,3) 1460 MID$(FIELDINPUT$,1,8) = MID$(FORMNAME$,1,8) : GOTO 1125 1760 REM ********************************************************************** 1762 REM * FORMAT-NAME OR FORMAT-NO. ERROR * 1764 REM ********************************************************************** 1766 IF NKEYINP% = 8 GOTO 3800 ELSE 1920 1772 REM ********************************************************************** 1775 REM * INPUT NEXT FIELD OR CHAIN TO SEL. PROGRAMM * 1779 REM ********************************************************************** 1780 IF NKEYINP% = 8 GOTO 1785 ELSE 1787 1785 MID$(FORMNAME$,1,8) = MID$(FIELDINPUT$,1,8) : MID$(FORMNAME$,9,4) = ".FRM" : GOTO 1982 1787 IF VAL(FIELDINPUT$) < 1 GOTO 1920 1790 MID$(FORMNR$,1,3)=MID$(FIELDINPUT$,1,3):FORMNR%=VAL(FORMNR$) 1791 IF VAL(ARBNR$) = 2 AND NEXTFORMFLAG% GOTO 6160 1792 IF VAL(ARBNR$) = 2 GOTO 6010 1794 IF NEXTFORMFLAG% GOTO 5470 ELSE 5000 1870 REM ********************************************************************** 1872 REM * SUB.: PRINT ERRMSG. IN LINE 25 AND SET INPUT-BUFFER * 1873 REM ********************************************************************** 1876 ERRMSGNR% = 3 : GOSUB 20000 : GOSUB 1000 1878 FORMNAME$ = SPACE$(12) 1880 FIELDINPUT$ = SPACE$(8) 1882 RETURN 1916 REM ********************************************************************** 1918 REM * PRINT BAD FORMAT-NO. MSG IN LINE 25 AND POS. CURSOR * 1920 REM ********************************************************************** 1922 ERRMSGNR% = 18 : GOSUB 20000 1930 GOSUB 1000 1950 LET XPOS% = 51 + CRBLANK% - 2 : YPOS% = 14 1960 GOSUB 1990 1970 LET I% = CRBLANK% - 1 : GOTO 3140 1971 REM ********************************************************************** 1972 REM * SUB.: PRINT TEXT-BUFFER ON CRT * 1973 REM ********************************************************************** 1974 XPOS% = 2 : YPOS% = 14 1976 GOSUB 1990 1978 PRINT FORMERFTEXT$ 1980 RETURN 1981 REM ********************************************************************** 1982 REM * POS. CURSOR AND ALLOW FORMAT-NO. INPUT * 1983 REM ********************************************************************** 1984 XPOS% = 51 : YPOS% = 14 : GOSUB 1990 1988 NKEYINP% = 3 : FIELDINPUT$ = SPACE$(8) : MID$(FIELDINPUT$,1,3) = MID$(FORMNR$,1,3) : GOTO 1130 1989 REM ********************************************************************** 1990 REM * SUB.: POS. CURSOR * 1991 REM ********************************************************************** 1992 PRINT CHR$(13); 1994 PRINT CHR$(6);CHR$(XPOS%+31);CHR$(YPOS%+31); 1996 RETURN 2000 REM ********************************************************************** 2050 REM * PRINT HEADER ON CRT * 2055 REM ********************************************************************** 2060 PRINT CHR$(12) : XPOS% = 53 : YPOS% = 4 : GOSUB 1990 2070 PRINT CHR$(128); : XPOS% = 27 : YPOS% = 4 : GOSUB 1990 2080 PRINT CHR$(144);"*** Format verændern ***" 2090 IF NEXTFORMFLAG% THEN GOSUB 1050 : GOTO 1982 ELSE GOSUB 1020 : GOTO 1110 2095 REM ********************************************************************** 2100 REM * SUB.: PRINT ERRMSG IN LINE 25 * 2105 REM ********************************************************************** 2110 ERRMSGNR% = 5 : GOSUB 20000 : GOSUB 1000 2120 RETURN 3100 REM ********************************************************************** 3102 REM * PRINT TEXT ON CRT AND SET INPUT-BUFFER * 3104 REM ********************************************************************** 3106 GOSUB 3972 REM *** POS. CURSOR AND PRINT TEXT 3110 XPOS% = 2:YPOS% = 10:GOSUB 1990 3120 PRINT "Bitte den Namen der Format-Datei eingeben. ........" 3125 XPOS% = 46 : YPOS% = 10 : GOSUB 1990 3127 NKEYINP% = 8 : FORMNAMEINPFLAG% = 1 3130 ONE% = 1 3131 REM ********************************************************************** 3132 REM * TEST THE KEYBOARD-INPUT KEY'S. ARE THE KEY'S OK PRINT IT ON CRT * 3133 REM ********************************************************************** 3136 FOR I% = ONE% TO NKEYINP% 3140 KEYINPUT$ = INPUT$(1) 3150 IF KEYINPUT$ = "<" GOTO 3140 3160 IF KEYINPUT$ = ">" GOTO 3140 3170 IF KEYINPUT$ = "." GOTO 3140 3180 IF KEYINPUT$ = "," GOTO 3140 3190 IF KEYINPUT$ = ";" GOTO 3140 3200 IF KEYINPUT$ = ":" GOTO 3140 3210 IF KEYINPUT$ = "=" GOTO 3140 3220 IF KEYINPUT$ = "?" GOTO 3140 3230 IF KEYINPUT$ = "*" GOTO 3140 3240 IF KEYINPUT$ = "Æ" GOTO 3140 3250 IF KEYINPUT$ = "Å" GOTO 3140 3260 IF KEYINPUT$ = " " GOTO 3400 3262 IF ASC(KEYINPUT$) = 26 GOTO 3140 3264 IF ASC(KEYINPUT$) = 10 GOTO 3140 3266 IF ASC(KEYINPUT$) = 127 GOTO 3420 3268 IF ASC(KEYINPUT$) = 12 GOTO 1013 3270 IF ASC(KEYINPUT$) = 8 GOTO 3500 3280 IF ASC(KEYINPUT$) = 24 GOTO 3600 3290 IF ASC(KEYINPUT$) = 5 GOTO 3450 3300 IF ASC(KEYINPUT$) = 9 GOTO 3470 3305 IF ASC(KEYINPUT$) = 6 GOTO 3700 3310 IF ASC(KEYINPUT$) = 13 GOTO 3700 3315 IF ASC(KEYINPUT$) = 27 GOTO 3140 3316 IF ASC(KEYINPUT$) = 17 THEN IF VAL(ARBNR$) <= 2 GOTO 5650 ELSE GOTO 16 3317 IF ASC(KEYINPUT$) <= 31 GOTO 3140 3318 IF NKEYINP% = 8 GOTO 3320 3319 IF ASC(KEYINPUT$) < 48 OR ASC(KEYINPUT$) > 57 GOTO 3140 3320 PRINT KEYINPUT$; 3330 MID$(FIELDINPUT$,I%,1) = KEYINPUT$ 3340 NEXT I% 3350 I% = NKEYINP% : PRINT CHR$(8); : IF NKEYINP% = 8 THEN ONE% = 8 : GOTO 3132 3352 ONE% = 3 : GOTO 3132 3390 REM 3392 REM --- SPACE KEY --- 3394 REM 3400 IF MID$(FIELDINPUT$,I%,1) = " " GOTO 3140 ELSE 3320 3420 REM 3422 REM --- RUB-OUT KEY --- 3424 REM 3430 IF I% = 1 GOTO 3446 3435 MID$(FIELDINPUT$,I%,1) = " " : LET I% = I% -1 3445 PRINT " "; : PRINT CHR$(8);CHR$(8); : GOTO 3140 3446 MID$(FIELDINPUT$,I%,1) = " " 3447 PRINT " "; : PRINT CHR$(8); : GOTO 3140 3448 REM 3450 REM --- FIED BACKWARD KEY --- 3451 REM 3452 IF VAL(ARBNR$) <= 2 GOTO 1450 3454 IF FORMNAMEINPFLAG% GOTO 3125 3455 MID$(DATANAME$,1,8) = MID$(FIELDINPUT$,1,8) 3460 MID$(FIELDINPUT$,1,8) = MID$(FORMNAME$,1,8) : GOTO 3125 3465 REM 3470 REM --- FIELD FORWARD KEY --- 3475 REM 3480 IF FORMNAMEINPFLAG% OR NKEYINP% = 8 GOTO 3700 ELSE 3140 3485 REM 3490 REM --- CURSOR BACKWARD KEY --- 3495 REM 3500 IF I% = 1 GOTO 3140 3510 PRINT KEYINPUT$; 3520 LET I% = I% - 1 3530 GOTO 3140 3590 REM 3595 REM --- CURSOR FORWARD KEY --- 3600 REM 3610 IF I% = NKEYINP% GOTO 3140 3620 FOR BLANKTEST% = I% TO NKEYINP% 3630 IF MID$(FIELDINPUT$,BLANKTEST%,1) = " " GOTO 3640 ELSE 3660 3640 NEXT BLANKTEST% 3650 GOTO 3140 3660 PRINT KEYINPUT$; 3670 LET I% = I% + 1 3680 GOTO 3140 3690 REM 3695 REM --- CR KEY --- 3700 REM 3705 BLANKF% = 0 3710 FOR CRBLANK% = 1 TO NKEYINP% 3720 IF MID$(FIELDINPUT$,CRBLANK%,1) = " " THEN BLANKF% = 1:GOTO 3740 3730 IF BLANKF% = 1 GOTO 3760 3740 NEXT CRBLANK% 3741 REM 3742 REM --- ONLY SPACE IN A FIELD ? --- 3743 REM 3744 FOR SPACE% = 1 TO NKEYINP% 3746 IF MID$(FIELDINPUT$,SPACE%,1) <> " " GOTO 3766 3748 NEXT SPACE% 3750 IF FORMNAMEINPFLAG% AND VAL(ARBNR$) = 3 GOTO 3125 3752 IF FORMNAMEINPFLAG% = 0 AND VAL(ARBNR$) => 3 GOTO 3982 3754 IF VAL(ARBNR$) <= 2 AND NKEYINP% = 8 GOTO 1125 3756 IF VAL(ARBNR$) <= 2 AND NKEYINP% = 3 GOTO 1982 3757 GOTO 3982 3758 REM ********************************************************************** 3759 REM * FORMNAME OR DATANAME INPUT ERROR * 3760 REM ********************************************************************** 3762 IF VAL(ARBNR$) <= 2 THEN GOTO 1760 ELSE IF FORMNAMEINPFLAG% GOTO 3800 ELSE 3982 3763 REM ********************************************************************** 3764 REM * INPUT NEXT FIELD OR CHAIN TO SEL. PROGRAMM / MODUL * 3765 REM ********************************************************************** 3766 IF VAL(ARBNR$) <= 2 GOTO 1780 3780 IF FORMNAMEINPFLAG% = 0 GOTO 3790 3785 MID$(FORMNAME$,1,8) = MID$(FIELDINPUT$,1,8) : MID$(FORMNAME$,9,4) = ".FRM" 3787 IF MID$(FORMNAME$,1,1) <> " " AND VAL(ARBNR$) = 9 OR VAL(ARBNR$) = 11 THEN GOTO 3795 ELSE GOTO 3982 3790 MID$(DATANAME$,1,8) = MID$(FIELDINPUT$,1,8) : MID$(DATANAME$,9,4) = ".DAT" 3795 IF VAL(ARBNR$) = 11 GOTO 20710 3796 IF VAL(ARBNR$) = 9 GOTO 4590 ELSE 16 3798 REM ********************************************************************** 3800 REM * PRINT ERRMSG. IN LINE 25 AND POS. CURSOR * 3810 REM ********************************************************************** 3818 ERRMSGNR% = 2 : GOSUB 20000 : GOSUB 1000 3850 LET XPOS% = 46 + CRBLANK% -2 : YPOS% = 10 3860 GOSUB 1990 3870 LET I% = CRBLANK% - 1: GOTO 3140 3871 REM ********************************************************************** 3872 REM * SUB.: PRINT ERRMSG. IN LINE 25 AND POS. CURSOR * 3873 REM ********************************************************************** 3874 ERRMSGNR% = 5 : GOSUB 20000 3880 GOSUB 1000 3882 FORMNAME$ = SPACE$(12) 3884 FIELDINPUT$ = SPACE$(8) : RETURN 3885 REM ********************************************************************** 3886 REM * WRITE CHAININFO TO CHAININF-FILE AND CHAIN TO PROGRAMM * 3887 REM ********************************************************************** 3888 ERRFLAG% = 0 : FILENAME$ = "CHAININF.DEP" 3890 OPEN "R",#5,FILENAME$,26 3894 FIELD #5,12 AS CHAININFO1$,12 AS CHAININFO2$,2 AS CHAININFO3$ 3895 LSET CHAININFO1$ = SPACE$(12) : LSET CHAININFO2$ = SPACE$(12) : LSET CHAININFO3$ = SPACE$(2) 3896 LSET CHAININFO1$ = FORMNAME$ : LSET CHAININFO2$ = DATANAME$ : LSET CHAININFO3$ = ARBNR$ 3898 ERRFLAG% = 0 : PUT #5,1 3904 ON VAL(ARBNR$) GOTO 3905,3906,3907,3908,3909,3911,3912,3913,3914,3915,3916 3905 GOTO 16 3906 GOTO 16 3907 CHAIN "B:ENTRYME.COM" 3908 CHAIN "B:ENTRYME.COM" 3909 CHAIN "B:ENTRYME.COM" 3911 CHAIN "B:ENTRYME.COM" 3912 CHAIN "B:ENTRYME.COM" 3913 CHAIN "B:ENTRYME.COM" 3914 GOTO 4590 3915 CHAIN "B:ENTRYME.COM" 3916 GOTO 20710 3917 REM ********************************************************************** 3918 REM * SUB.: PRINT ERRMSG. IN LINE 25 AND POS. CURSOR * 3919 REM ********************************************************************** 3920 ERRMSGNR% = 6 : GOSUB 20000 3930 GOSUB 1000 3950 LET XPOS% = 46 + CRBLANK% - 2 : YPOS% = 14 3960 GOSUB 1990 3970 LET I% = CRBLANK% - 1 : RETURN 3971 REM ********************************************************************** 3972 REM SUB.: PRINT TEXT ON CRT AND POS. CURSOR * 3973 REM ********************************************************************** 3974 XPOS% = 2 : YPOS% = 14 3976 GOSUB 1990 3978 PRINT "Bitte den Namen der Arbeitsdatei eingeben. ........" 3979 RETURN 3980 REM ********************************************************************** 3981 REM * POS. CURSOR AND SET INPUT-FIELDS TO ENTER THE DATANAME * 3982 REM ********************************************************************** 3983 XPOS% = 46 : YPOS% = 14 3984 GOSUB 1990 3988 FORMNAMEINPFLAG% = 0 : MID$(FIELDINPUT$,1,8) = MID$(DATANAME$,1,8) : GOTO 3130 4090 REM ********************************************************************** 4095 REM * PRINT ERRMSG. IN LINE 25 AND SET INPUT-BUFFER * 4100 REM ********************************************************************** 4110 ERRMSGNR% = 7 : GOSUB 20000 4140 GOSUB 1000 4160 DATANAME$ = SPACE$(12) 4170 FIELDINPUT$ = SPACE$(8) : GOSUB 3972 4180 RETURN 4530 REM ********************************************************************** 4534 REM * PRINT HEADER ON CRT * 4535 REM ********************************************************************** 4536 XPOS% = 48 : YPOS% = 4 : GOSUB 1990 4538 PRINT CHR$(128); : XPOS% = 32 : YPOS% = 4 : GOSUB 1990 4540 PRINT CHR$(144);"*** KATALOG *** 4542 GOTO 3102 4555 REM ********************************************************************** 4560 REM * PRINT HEADER ON CRT * 4562 REM ********************************************************************** 4565 XPOS% = 50 : YPOS% = 4 : GOSUB 1990 4570 PRINT CHR$(128); : XPOS% = 27 : YPOS% = 4 : GOSUB 1990 4575 PRINT CHR$(146);"*** Datei løschen ***" 4580 PRINT CHR$(7);CHR$(7);CHR$(7); : GOTO 3102 4585 REM ********************************************************************** 4590 REM * DISPLAY ARBSTAT-RECORD ON CRT * 4591 REM ********************************************************************** 4592 IF ARBSTATOPEN% GOTO 4596 ELSE GOSUB 9100 REM *** OPEN ARBSTAT-FILE 4596 GOSUB 9180 REM *** READ ARBSTAT-DIR. 4602 IF MID$(DATANAME$,1,1) = " " GOTO 4612 4603 IF DATANAME$ = "KATALOG .DAT" GOTO 4800 4604 FILENAME$ = DATANAME$ : FORMNR% = 1 4606 GOSUB 7410 REM *** FILE IN ARBSTAT-DIR ? 4608 IF FILEINDIR% GOTO 4620 ELSE GOSUB 4110 : GOTO 3982 4612 IF MID$(FORMNAME$,1,1) = " " GOTO 1013 4613 IF FORMNAME$ = "KATALOG .FRM" GOTO 4800 4614 FILENAME$ = FORMNAME$ : FORMNR% = 3 4616 GOSUB 7410 REM *** FILE IN ARBSTAT-DIR ? 4618 IF FILEINDIR% GOTO 4620 ELSE GOSUB 3873 : GOTO 3110 4620 R1$ = MID$(NAME$,13,4) : R1% = VAL(R1$) 4622 GOSUB 9150 : GOSUB 9564 REM *** INIT ARBSTAT-FIELD 4625 FORMCHAIN$ = FC$ : OMODE$ = MO$ : STATUS$ = ST$ : PSTATUS$ = SP$ 4626 DRECCOUNT$ = SPACE$(6) : MID$(DRECCOUNT$,1,3) = SM$ : MID$(DRECCOUNT$,4,3) = WF$ 4627 PRECCOUNT$ = SPACE$(6) : MID$(PRECCOUNT$,1,4) = VA$ : MID$(PRECCOUNT$,5,2) = MID$(PC$,1,2) 4628 CRECCOUNT$ = SPACE$(6) : MID$(CRECCOUNT$,1,2) = MID$(PC$,3,2) : MID$(CRECCOUNT$,3,4) = FL$ 4629 REM ********************************************************************** 4630 REM * READ ARBSTAT-FORMAT AND CALL DEP TO PRINT IT ON CRT * 4631 REM ********************************************************************** 4632 FORMNAME$ = "DEPFORM .DEP" : FILENAME$ = FORMNAME$ 4634 GOSUB 9280 REM *** OPEN FORMAT-FILE 4636 GOSUB 9580 REM *** INIT FORMAT-BUFFER 4638 GOSUB 9674 REM *** READ FORMAT-REC. 4642 IF FORMBYTES$ <> "#&" THEN GOSUB 4770 : GOTO 16 4644 FIELDNO$ = "000" : MODE$ = "00" : SPECMOD$ = "000" 4646 LSET FLN$ = FIELDNO$ : LSET MO$ = MODE$ : LSET SM$ = SPECMOD$ 4647 REM ********************************************************************** 4648 REM * CALL THE DEP * 4649 REM ********************************************************************** 4650 F% = VARPTR(#2) : Z% = VARPTR(#1) : CALL INIT(F%,Z%) 4652 REM ********************************************************************** 4654 GOSUB 7240 REM *** TEST DEP GENERAL-STATUS 4656 ON PRIMST% GOTO 4680,4650,4650,4650,4650,4650,4650,16,4650,4650,4650,4650,4650,4650 4658 GOSUB 7280 REM *** PRINT ERRMSG. (DEP-ERROR) 4660 GOTO 16 4680 IF ARBSTAT% GOTO 4812 4681 XPOS% = 3:YPOS% = 2:GOSUB 1990:PRINT MID$(NONZ$,3,8);:XPOS% = 15:YPOS% = 2:GOSUB 1990:PRINT MID$(NONZ$,11,8);CHR$(13); 4682 XPOS% = 30:YPOS% = 2:GOSUB 1990:PRINT MID$(NONZ$,23,3);CHR$(13); 4683 XPOS% = 41:YPOS% = 2:GOSUB 1990:PRINT MID$(NONZ$,26,3);:XPOS% = 52:YPOS% = 2:GOSUB 1990:PRINT MID$(NONZ$,29,1); 4684 XPOS% = 63:YPOS% = 2:GOSUB 1990:PRINT MID$(NONZ$,30,3);:XPOS% = 73:YPOS% = 2:GOSUB 1990:PRINT MID$(NONZ$,33,3); 4685 XPOS% = 28:YPOS% = 7:GOSUB 1990: 4686 FOR N%=1 TO 6:IF MID$(NONZ$,38+N%,1)=" " THEN PRINT "0"; ELSE PRINT MID$(NONZ$,38+N%,1); 4687 NEXT N% 4688 XPOS% = 61:YPOS% = 7:GOSUB 1990:PRINT PRECCOUNT$;:XPOS% = 72:YPOS% = 7:GOSUB 1990:PRINT CRECCOUNT$; 4691 XPOS% = 25:YPOS% = 10:GOSUB 1990:PRINT MID$(NONZ$,51,4);:XPOS% = 25:YPOS% = 12:GOSUB 1990:PRINT MID$(NONZ$,19,4); 4692 XPOS% = 23:YPOS% = 14:GOSUB 1990:PRINT DRECCOUNT$;CHR$(13); 4693 XPOS% = 25:YPOS% = 16:GOSUB 1990:PRINT FORMCHAIN$;CHR$(13); 4697 XPOS% = 21:YPOS% = 22:GOSUB 1990:PRINT MID$(PSTATUS$,1,2);" ";:PRINT MID$(PSTATUS$,3,5); 4698 XPOS% = 8:YPOS% = 24:GOSUB 1990:PRINT OMODE$;:XPOS% = 19:YPOS% = 24:GOSUB 1990 4700 PRINT MID$(STATUS$,1,2);:XPOS% = 23:YPOS% = 24:GOSUB 1990:PRINT MID$(STATUS$,3,2); 4710 XPOS% = 27:YPOS% = 24:GOSUB 1990:PRINT MID$(STATUS$,5,2);CHR$(13); 4711 IF FORMNR% = 3 THEN GOSUB 4871 : GOTO 4748 4712 XPOS% = 28:YPOS% = 4:GOSUB 1990:PRINT KE$;:XPOS% = 40:YPOS% = 4:GOSUB 1990:PRINT KV$; 4714 XPOS% = 51:YPOS% = 4:GOSUB 1990:PRINT EC$;:XPOS% = 28:YPOS% = 5:GOSUB 1990:PRINT EE$; 4716 XPOS% = 40:YPOS% = 5:GOSUB 1990:PRINT VE$;:XPOS% = 40:YPOS% = 6:GOSUB 1990:PRINT VK$; 4718 XPOS% = 51:YPOS% = 6:GOSUB 1990:PRINT FK$; 4720 XPOS% = 40 : YPOS% = 7 : GOSUB 1990 4721 FOR N% = 1 TO 6 4722 IF MID$(NONZ$,44+N%,1) = " " THEN PRINT "0"; ELSE PRINT MID$(NONZ$,44+N%,1); 4723 NEXT N% 4724 P1% = 36 : P2% = 10 : XPOS% = P1% : YPOS% = P2% : GOSUB 1990 4726 FOR F% = 1 TO 211 STEP 15 4728 PRINT MID$(ADDR$,F%,15); 4730 XPOS% = P1% : P2% = P2% + 1 : YPOS% = P2% : GOSUB 1990 4732 NEXT F% 4734 P1% = 60 : P2% = 10 : XPOS% = P1% : YPOS% = P2% : GOSUB 1990 4736 FOR F% = 1 TO 121 STEP 15 4738 PRINT MID$(SUBR$,F%,15); 4740 XPOS% = P1% : P2% = P2% + 1 : YPOS% = P2% : GOSUB 1990 4742 NEXT F% 4744 XPOS% = 60 : YPOS% = 22 : GOSUB 1990 : PRINT MR$; 4748 XPOS% = 1:YPOS% = 25:GOSUB 1990:PRINT SPACE$(76);CHR$(13);" *** (ESC) *** ";CHR$(13); 4749 GOSUB 1000 : GOSUB 8210 REM *** CLOSE FORMAT-FILE 4755 IF VAL(ARBNR$) <= 2 AND FORMCHAINERROR% THEN GOTO 16 ELSE GOTO 1012 4758 REM ********************************************************************** 4760 REM * PRINT ERRMSG. IN LINE 25 * 4765 REM ********************************************************************** 4770 ERRMSGNR% = 9 : GOSUB 20000 4790 GOSUB 1000 : RETURN 4795 REM ********************************************************************** 4800 REM * PRINT ARBSTAT-DIR DATA ON CRT * 4805 REM ********************************************************************** 4810 FORMNR% = 2 : ARBSTAT% = 1 : GOSUB 9150 : GOTO 4630 REM *** INIT ARBSTAT-FIELD 4811 REM ***************** PRINT ARBSTAT-DIR ********************************** 4812 GOSUB 9180 REM *** READ ARBSTAT-DIR 4814 ID$ = "FRM" : P1% = 2 : P2% = 2 4815 FOR F% = 1 TO 2 4816 XPOS% = P1% : YPOS% = P2% : GOSUB 1990 4820 FOR I% = 15 TO 127 STEP 16 4825 IF MID$(ARBSTATDIR1$,I%+9,3) = ID$ THEN PRINT MID$(ARBSTATDIR1$,I%,8); 4827 XPOS% = P1% + 10:P1% = XPOS%:YPOS% = P2%:GOSUB 1990 4830 NEXT I% 4832 P1% = 2:XPOS% = P1%:YPOS% = P2% + 1:GOSUB 1990 4834 FOR I% = 143 TO 239 STEP 16 4836 IF MID$(ARBSTATDIR1$,I%+9,3) = ID$ THEN PRINT MID$(ARBSTATDIR1$,I%,8); 4837 XPOS% = P1% + 10:P1% = XPOS%:YPOS% = P2% + 1:GOSUB 1990 4838 NEXT I% 4840 XPOS% = 72:YPOS% = P2% + 1:GOSUB 1990 4842 IF MID$(ARBSTATDIR2$,10,3) = ID$ THEN PRINT MID$(ARBSTATDIR2$,1,8); 4844 P1% = 2:XPOS% = P1%:YPOS% = P2% + 2:GOSUB 1990 4846 FOR I% = 17 TO 129 STEP 16 4850 IF MID$(ARBSTATDIR2$,I%+9,3) = ID$ THEN PRINT MID$(ARBSTATDIR2$,I%,8); 4851 XPOS% = P1% + 10:P1% = XPOS%:YPOS% = P2% + 2:GOSUB 1990 4852 NEXT I% 4854 P1% = 12:XPOS% = P1%:YPOS% = P2% + 3:GOSUB 1990 4856 FOR I% = 145 TO 225 STEP 16 4860 IF MID$(ARBSTATDIR2$,I%+9,3) = ID$ THEN PRINT MID$(ARBSTATDIR2$,I%,8); 4861 XPOS% = P1% + 10:P1% = XPOS%:YPOS% = P2% + 3:GOSUB 1990 4862 NEXT I% 4864 P1% = 2 : P2% = 8 : ID$ = "DAT" 4866 NEXT F% 4867 ARBSTAT% = 0 : XPOS% = 68 : YPOS% = 24 : GOSUB 1990 : PRINT "1"; : GOTO 4748 4868 REM ********************************************************************** 4869 REM * PRINT FORMAT-NO. AND FORMAT-CHAIN-KEY ON CRT * 4870 REM ********************************************************************** 4871 P1% = 25 : P2% = 10 : I1% = 1 : I2% = 21 : F1% = 1 4872 FOR I% = 1 TO 8 4874 FOR F% = I1% TO I2% STEP 4 4875 XPOS% = P1% + 8 : YPOS% = P2% : P1% = XPOS% : GOSUB 1990 4876 IF MID$(ADDR$,F%,4) = " " GOTO 4880 4878 PRINT MID$(ADDR$,F%+1,3); : IF MID$(ADDR$,F%,1) = "*" THEN PRINT MID$(ADDR$,F%,1); ELSE PRINT CHR$(24); 4879 PRINT MID$(SUBR$,F1%,3); 4880 F1% = F1% + 3 4881 NEXT F% 4882 ON I% GOTO 4886,4888,4890,4892,4894,4896,4898 4884 RETURN 4886 P1% = 25 : P2% = 12 : I1% = 25 : I2% = 45 : GOTO 4900 4888 P1% = 25 : P2% = 14 : I1% = 49 : I2% = 69 : GOTO 4900 4890 P1% = 25 : P2% = 16 : I1% = 73 : I2% = 93 : GOTO 4900 4892 P1% = 25 : P2% = 18 : I1% = 97 : I2% = 117 : GOTO 4900 4894 P1% = 25 : P2% = 20 : I1% = 121 : I2% = 141 : GOTO 4900 4896 P1% = 25 : P2% = 22 : I1% = 145 : I2% = 165 : GOTO 4900 4898 P1% = 25 : P2% = 24 : I1% = 169 : I2% = 177 : GOTO 4900 4900 NEXT I% 5000 REM 5002 REM 5008 REM ********************************************************************** 5009 REM * OPEN A NEW FORMFILE * 5010 REM ********************************************************************** 5012 REM 5014 REM 5020 GOSUB 9100 REM *** OPEN ARBSTAT-FILE 5030 GOSUB 9170 REM *** READ ARBSTAT-DIR 5041 FILENAME$ = FORMNAME$ 5042 GOSUB 7410 REM *** FILE IN ARBSTAT-DIR ? 5044 IF FILEINDIR% THEN GOSUB 8170 : GOSUB 1873 : GOTO 1110 ELSE 5050 5050 GOSUB 7000 REM *** SPACE FOR MORE FILES IN ARBSTAT 5060 IF NOSPACEFLAG% THEN GOSUB 9220 ELSE GOSUB 9280 : GOTO 5110 5070 GOSUB 8170 : GOTO 16 REM *** CLOSE ARBSTAT 5110 REM ********************************************************************** 5112 REM * INIT. A NEW ARBSTAT-RECORD * 5114 REM ********************************************************************** 5120 NONZ50$ = SPACE$(54) 5130 MID$(NONZ50$,11,8) = MID$(FORMNAME$,1,8) 5140 MID$(NONZ50$,19,4) = "0000" : MID$(NONZ50$,23,3) = "S.." : MID$(NONZ50$,26,3) = "..." 5150 MID$(NONZ50$,29,1) = "N" 5170 MID$(NONZ50$,39,6) = "000000" 5175 GOSUB 5486 REM *** WRITE NEW START-FORMAT 5180 MID$(NONZ50$,45,6) = "000000" : SP$ = SPACE$(8) 5200 MODE$ = "03" : FIELDNO$ = "000" 5210 SPECMOD$ = "000" 5275 GOSUB 5310 : GOTO 5420 REM *** WRITE NEW FILENAME TO ARBSTAT-DIR 5280 REM ********************************************************************** 5282 REM * WRITE NEW ARBSTAT-DIR. POINTER * 5285 REM ********************************************************************** 5310 IF DIR2% = 1 GOTO 5380 5320 MID$(ARBSTATDIR1$,RELPOS1%,12) = MID$(FILENAME$,1,12) 5340 RELPOS1% = RELPOS1% +12 5350 MID$(ARBSTATDIR1$,RELPOS1%,4) = STR$(R1%) 5360 GOTO 5412 5380 MID$(ARBSTATDIR2$,RELPOS2%,12) = MID$(FILENAME$,1,12) 5400 RELPOS2% = RELPOS2% + 12 5410 MID$(ARBSTATDIR2$,RELPOS2%,4) = STR$(R1%) 5412 ARBSTATRECCOUNT$ = MID$(ARBSTATDIR1$,11,4) : ARBSTATRECCOUNT% = VAL(ARBSTATRECCOUNT$) 5414 ARBSTATRECCOUNT% = ARBSTATRECCOUNT% + 1 : ARBSTATRECCOUNT$ = STR$(ARBSTATRECCOUNT%) 5416 NARBSTATRECCOUNT$ = SPACE$(4) : RSET NARBSTATRECCOUNT$ = ARBSTATRECCOUNT$ 5418 MID$(ARBSTATDIR1$,11,4) = NARBSTATRECCOUNT$ 5419 RETURN 5420 GOSUB 9370 REM *** WRITE ARBSTAT-DIR 5440 GOSUB 9150 : GOSUB 9450 : GOSUB 7220 REM *** INIT ARBSTAT-FIELD/INIT A NEW ARBSTAT-ENTRY 5450 GOSUB 9550 REM *** WRITE ARBSTAT 5462 GOSUB 9570 REM *** INIT FORMAT-BUFFER 5470 GOSUB 6535 REM *** IF FORMAT-NR. IN FORMAT-DIR 5475 IF FORMNRUSE% THEN SFORMNR% = FORMNR% : FORMNR% = RFORMNR% : GOTO 6585 5480 IF FORMNRSP% THEN SFORMNR% = FORMNR% : FORMNR% = RSFORMNR% : GOTO 5530 ELSE GOTO 6610 5481 REM ********************************************************************** 5482 REM * SUB.: WRITE A NEW START-FORMAT-POINTER * 5485 REM ********************************************************************** 5486 FORMNR$ = STR$(FORMNR%) : NFORMNR$ = SPACE$(4) : RSET NFORMNR$ = FORMNR$ 5490 MID$(NONZ50$,51,4) = NFORMNR$ : RETURN 5500 REM ********************************************************************** 5510 REM * CALL THE DEP * 5520 REM ********************************************************************** 5530 F% = VARPTR(#2) : Z% = VARPTR(#1) : CALL INIT(F%,Z%) 5540 REM ********************************************************************** 5542 REM * RETURN FROM THE DEP / CHECK DEP-STATUS * 5544 REM ********************************************************************** 5550 GOSUB 7240 REM *** TEST DEP-STATUS 5560 ON PRIMST% GOTO 5530,5530,5580,5570,5570,5725,5530,5630,5530,5530,5530,5530,5530,5530 5570 GOSUB 7280 : GOTO 5650 REM *** PRINT ERRMSG. (DEP-ERROR) 5580 GOSUB 9640 REM *** WRITE FORMAT-REC. 5585 FORMNR% = SFORMNR% 5595 IF ASC(KEYINPUT$) = 6 THEN GOSUB 5486 5600 IF VAL(ARBNR$) = 1 AND OVERWRITE% = 1 GOTO 5616 5610 IF VAL(ARBNR$) <> 2 OR ADDFORM% = 1 THEN GOSUB 9680 ELSE GOTO 5616 5612 GOSUB 6490 REM *** WRITE FORMAT-NR. TO FORMAT-DIR. 5614 IF FORMNRWR% = 0 GOTO 6610 ELSE 5620 5616 GOSUB 6492 : IF FORMNRWR% = 0 GOTO 6610 REM *** OVERWRITE FORMAT-NR. IN FORMAT-DIR. 5620 GOSUB 7340 REM *** CALCULATE MAX. VARIABLE 5630 NEXTFORMFLAG% = 1 : GOTO 1012 5640 REM ********************************************************************** 5642 REM * USER EXIT * 5644 REM ********************************************************************** 5650 FORMNR% = SFORMNR% : IF ARBSTATOPEN% = 0 GOTO 5710 5653 RECCOUNT$ = MID$(NONZ50$,39,6) : IF VAL(RECCOUNT$) <= 0 THEN RECCOUNT% = 0 : GOTO 5658 ELSE RECCOUNT% = 1 5655 FORMNR$ = MID$(NONZ50$,51,4) : FORMNR% = VAL(FORMNR$) : GOSUB 6535 : IF FORMNRUSE% = 0 THEN GOSUB 6340 : GOTO 5630 5658 GOSUB 8210 REM *** CLOSE FORMAT-FILE 5665 IF RECCOUNT% = 0 THEN FORMNAME$ = FILENAME$ : GOTO 20710 5670 GOSUB 7500 REM *** TEST FORMAT-CHAIN-KEY 5675 GOSUB 8240 REM *** UPDATE THE ARBSTAT 5685 IF FORMCHAINERROR% THEN FORMNAME$ = FILENAME$ : ERRMSGNR% = 4 : GOSUB 20000 : GOSUB 1000 : GOTO 4592 5690 GOSUB 8170 REM *** CLOSE ARBSTAT-FILE 5710 GOTO 16 5720 REM ********************************************************************** 5721 REM * DELETE A FORMAT * 5722 REM ********************************************************************** 5725 F% = 1 : F1% = 1 5730 FOR FP% = 1 TO 45 5735 OFORMNR$ = MID$(ADDR$,F%+1,3) 5736 IF VAL(OFORMNR$) = SFORMNR% THEN MID$(ADDR$,F%,4) = SPACE$(4):MID$(SUBR$,F1%,3) = SPACE$(3):GOTO 5750 5740 F% = F% + 4 : F1% = F1% + 3 5742 NEXT FP% 5745 GOTO 5630 5750 GOSUB 6625 : GOTO 5630 REM *** DECREMENT RECORD-COUNTER 6000 REM ********************************************************************** 6002 REM * FORMAT UPDATE-MODE * 6004 REM ********************************************************************** 6010 GOSUB 9100 REM *** OPEN ARBSTAT-FILE 6030 GOSUB 9170 REM *** READ ARBSTAT-DIR. 6035 FILENAME$ = FORMNAME$ 6040 GOSUB 7410 REM *** FILE IN ARBSTAT-DIR ? 6050 IF FILEINDIR% = 0 THEN GOSUB 8170 : GOSUB 2110 : GOTO 1882 6055 R1$ = MID$(NAME$,13,4) : R1% = VAL(R1$) 6060 GOSUB 9150 : GOSUB 9564 REM *** INIT ARBSTAT-FIELD 6080 IF MID$(NONZ$,23,3) = "ERR" THEN GOSUB 6460 6090 IF MID$(NONZ$,11,8) <> MID$(FORMNAME$,1,8) THEN GOSUB 6410 : GOTO 5690 6100 NONZ50$ = NONZ$ : MID$(NONZ50$,23,3) = "S.." 6140 GOSUB 9280 REM *** OPEN FORMAT-FILE 6155 GOSUB 9580 REM *** INIT FORMAT-BUFFER 6160 ADDFORM% = 0 : GOSUB 6535 REM *** FORMAT-NR. IN FORMAT-DIR. ? 6162 IF FORMNRUSE% THEN SFORMNR% = FORMNR% : FORMNR% = RFORMNR% : GOTO 6166 6164 IF FORMNRSP% = 0 GOTO 6610 ELSE SFORMNR% = FORMNR% : FORMNR% = RSFORMNR% : GOTO 6360 6166 GOSUB 9674 REM *** READ FORMAT-REC. 6180 IF FORMBYTES$ <> "#&" THEN GOSUB 6334 : GOTO 5650 6190 MODE$ = "04" : SPECMOD$ = "000" 6200 GOSUB 9150 : GOSUB 9450 : GOSUB 9550 REM *** INIT ARBSTAT-FIELD AND WRITE ARBSTAT 6220 GOTO 5530 6331 REM ********************************************************************** 6332 REM * SUB.: PRINT ERRMSG. IN LINE 25 * 6333 REM ********************************************************************** 6334 ERRMSGNR% = 10 : GOSUB 20000 6338 GOSUB 1000 : RETURN 6339 REM ********************************************************************** 6340 REM * SUB.: PRINT ERRMSG. IN LINE 25 * 6341 REM ********************************************************************** 6342 ERRMSGNR% = 15 : GOSUB 20000 6345 GOSUB 1000 : RETURN 6350 REM ********************************************************************** 6352 REM * ADD A NEW FORMAT TO FORMAT-FILE IN FORMAT-UPDATE-MODE * 6354 REM ********************************************************************** 6360 XPOS% = 1 : YPOS% = 25 : GOSUB 1990 6370 PRINT CHR$(144);"*** NEUES FORMAT ?? JA = (J) / NEIN = (ESC) ***";CHR$(128);CHR$(13); 6380 PRINT CHR$(7); : ESCINPUT$ = INPUT$(1) : IF ESCINPUT$ = "J" GOTO 6392 6390 IF ASC(ESCINPUT$) = 27 GOTO 5630 ELSE 6380 6392 MODE$ = "03" : ADDFORM% = 1 6394 PRINT SPACE$(76); : GOTO 6200 6400 REM ********************************************************************** 6402 REM * SUB.: PRINT ERRMSG. IN LINE 25 * 6404 REM ********************************************************************** 6410 ERRMSGNR% = 12 : GOSUB 20000 6430 GOSUB 1000 : RETURN 6440 REM ********************************************************************** 6445 REM * PRINT ERRMSG. IN LINE 25 * 6450 REM ********************************************************************** 6460 ERRMSGNR% = 13 : GOSUB 20000 6480 GOSUB 1000 : RETURN 6482 REM ********************************************************************** 6485 REM * SUB.: WRITE FORM NR. TO ARBSTAT-RECORD * 6488 REM ********************************************************************** 6490 F% = 1 : F1% = 1 : NEWFORMNR% = 1 : FORMNRWR% = 0 : FORMNR$ = STR$(FORMNR%):NFORMNR$=SPACE$(4):RSET NFORMNR$ = FORMNR$ 6491 UFORMNR$ = SPACE$(3) : GOTO 6495 6492 F% = 1 : F1% = 1 : NEWFORMNR% = 0 : FORMNRWR% = 0 : FORMNR$ = STR$(FORMNR%) 6493 NFORMNR$ = SPACE$(4) : RSET NFORMNR$ = FORMNR$ 6495 FOR FP% = 1 TO 45 6500 IF NEWFORMNR% = 1 THEN IF MID$(ADDR$,F%+1,3) = UFORMNR$ GOTO 6520 ELSE GOTO 6505 6502 OFORMNR$ = MID$(ADDR$,F%+1,3) : IF VAL(OFORMNR$) = FORMNR% GOTO 6520 6505 F% = F% + 4 : F1% = F1% + 3 6510 NEXT FP% 6515 FORMNRWR% = 0 : RETURN 6520 MID$(ADDR$,F%,4) = NFORMNR$ : MID$(SUBR$,F1%,3) = MID$(FC$,1,3) : FORMNRWR% = 1 : RETURN 6525 REM ********************************************************************** 6530 REM * SUB.: FORM NR. IN ARBSTAT ? / SPACE FOR A NEW FORMNR ? * 6532 REM ********************************************************************** 6535 F% = 1 : FORMNRUSE% = 0 : FORMNRSP% = 0 6540 FOR FP% = 1 TO 45 6545 OFORMNR$ = MID$(ADDR$,F%+1,3) : IF VAL(OFORMNR$) = FORMNR% GOTO 6570 6550 IF MID$(ADDR$,F%,4) = " " GOTO 6575 6555 F% = F% + 4 6560 NEXT FP% 6565 RETURN 6570 FORMNRUSE% = 1 : RFORMNR% = FP% : GOTO 6555 6575 IF FORMNRSP% THEN GOTO 6555 ELSE RSFORMNR% = FP% : FORMNRSP% = 1 : GOTO 6555 6578 REM ********************************************************************** 6580 REM * FORMNR IN USE ! OVERWRITE ? * 6582 REM ********************************************************************** 6585 XPOS% = 1 : YPOS% = 25 : GOSUB 1990 : OVERWRITE% = 0 6590 PRINT CHR$(144)"* FORMAT NR. BELEGT !! UEBERSCHREIBEN = (J) / NEUE FORMAT NR. = (ESC) *";CHR$(128);CHR$(13); 6595 PRINT CHR$(7);:ESCINPUT$ = INPUT$(1):IF ESCINPUT$ = "J" THEN OVERWRITE% = 1 : GOTO 5530 6600 IF ASC(ESCINPUT$) = 27 GOTO 1012 ELSE 6595 6602 REM ********************************************************************** 6605 REM * PRINT ERRMSG. IN LINE 25 * 6608 REM ********************************************************************** 6610 ERRMSGNR% = 19 : GOSUB 20000 6616 GOSUB 1000 : GOTO 5630 6618 REM ********************************************************************** 6620 REM * SUB.: DECREMENT RECORD-COUNTER * 6622 REM ********************************************************************** 6625 RECCOUNT$ = MID$(NONZ50$,39,6) : RECCOUNT% = VAL(RECCOUNT$) 6630 RECCOUNT% = RECCOUNT% - 1 : RECCOUNT$ = STR$(RECCOUNT%) 6635 NRECCOUNT$ = SPACE$(6) : RSET NRECCOUNT$ = RECCOUNT$ 6640 MID$(NONZ50$,39,6) = NRECCOUNT$ : RETURN 6690 REM ********************************************************************** 6695 REM * SUB.: IF SPACE FOR MORE FILES IN ARBSTAT ? * 7000 REM ********************************************************************** 7010 R1% = 1 : DIR2% = 0 7020 FOR RELPOS1% = 15 TO 239 STEP 16 7030 R1% = R1% + 1 7040 IF MID$(ARBSTATDIR1$,RELPOS1%,1) = " " GOTO 7120 7050 NEXT RELPOS1% 7060 DIR2% = 1 7070 FOR RELPOS2% = 1 TO 225 STEP 16 7080 R1% = R1% + 1 7090 IF MID$(ARBSTATDIR2$,RELPOS2%,1) = " " GOTO 7120 7100 NEXT RELPOS2% 7110 NOSPACEFLAG% = 1 : RETURN 7120 NOSPACEFLAG% = 0 : RETURN 7200 REM ********************************************************************** 7205 REM * SUB.: CLEAR ADD/SUB/MUL. REG TO USE IT AS FORMATNO. - DIR. * 7210 REM ********************************************************************** 7220 MID$(MR$,1,15) = SPACE$(15) : MID$(ADDR$,1,225) = SPACE$(225) : MID$(SUBR$,1,135) = SPACE$(135) 7230 RETURN 7232 REM ********************************************************************** 7234 REM * SUB.: CHECK GENERAL-STATUS (DEP) * 7240 REM ********************************************************************** 7250 GENERALST$ = MID$(ST$,1,2) : PRIMST$ = MID$(ST$,3,2) : SEKST$ = MID$(ST$,5,2) 7260 GENERALST% = VAL(GENERALST$) : PRIMST% = VAL(PRIMST$) : SEKST% = VAL(SEKST$) 7270 ON GENERALST% GOTO 7330,7320,7320,7320,7320,7320,7320 7280 ERRMSGNR% = 21 : GOSUB 20000 7300 GOSUB 1000 : RETURN 7310 REM ********************************************************************** 7320 PRIMST% = 8 : RETURN 7330 RETURN 7332 REM ********************************************************************** 7334 REM * SUB.: CALCULATE THE MAX. VARIABLE POS. IN A FORMAT * 7340 REM ********************************************************************** 7350 VARPOS$ = MID$(NONZ50$,19,4) 7360 IF VAL(VA$) > VAL(VARPOS$) THEN VARPOS$ = VA$ 7362 NVARPOS$ = SPACE$(4) : RSET NVARPOS$ = VARPOS$ 7370 MID$(NONZ50$,19,4) = NVARPOS$ : RETURN 7380 REM ********************************************************************** 7390 REM * SUB.: FILE IN ARBSTAT-DIR ? * 7400 REM ********************************************************************** 7410 FILEINDIR% = 0 : DIR2% = 0 : NAME$ = SPACE$(16) 7412 FOR I% = 15 TO 239 STEP 16 7420 IF MID$(ARBSTATDIR1$,I%,12) = FILENAME$ GOTO 7480 7430 NEXT I% 7435 DIR2% = 1 7440 FOR I% = 1 TO 225 STEP 16 7450 IF MID$(ARBSTATDIR2$,I%,12) = FILENAME$ GOTO 7480 7460 NEXT I% 7470 FILEINDIR% = 0 : RETURN 7480 IF DIR2% = 1 THEN NAME$ = MID$(ARBSTATDIR2$,I%,16) ELSE NAME$ = MID$(ARBSTATDIR1$,I%,16) 7485 FILEINDIR% = 1 : RETURN 7490 REM ********************************************************************** 7495 REM * TEST THE FORM-CHAIN-KEY * 7500 REM ********************************************************************** 7510 ERRMSGNR% = 8 : GOSUB 20000 7520 F% = 1 : F1% = 1 : FORMCHAINERROR% = 0 7530 FOR FP% = 1 TO 45 7550 FORMNR$ = MID$(ADDR$,F%+1,3) : FORMCHAINKEY$ = MID$(SUBR$,F1%,3) 7555 IF VAL(FORMCHAINKEY$) <> VAL(FORMNR$) THEN GOTO 7570 7560 GOTO 7602 7570 F% = F% + 4 7580 NEXT FP% 7590 F2% = F1% + 2 : F2% = F2% Ø 3 : F2% = F2% * 4 - 3 7600 MID$(ADDR$,F2%,1) = "*" : FORMCHAINERROR% = 1 : GOTO 7610 7602 F2% = F1% + 2 : F2% = F2% Ø 3 : F2% = F2% * 4 - 3 7604 MID$(ADDR$,F2%,1) = " " 7610 IF F1% = 133 THEN RETURN ELSE F% = 1 : F1% = F1% + 3 : GOTO 7530 7990 REM ********************************************************************** 7995 REM * PRINT ERRMSG. IN LINE 25 * 8000 REM ********************************************************************** 8010 ERRMSGNR% = 16 : GOSUB 20000 8030 GOSUB 1000 : GOTO 5650 8050 REM ******************* FATAL SYSTEM ERROR ******************************* 8060 GOTO 8270 8100 REM ******************* DISC I/O ERROR *********************************** 8110 GOTO 8270 8120 REM ******************* DISC FULL **************************************** 8130 GOTO 5650 8140 REM ******************* CP/M DIR FULL ************************************ 8150 GOTO 8270 8160 REM ******************** CLOSE ARBSTAT *********************************** 8170 ERRFLAG% = 0 : CLOSE #1 8190 ARBSTATOPEN% = 0 : ARBSTATWRITE% = 0 : RETURN 8200 REM **************************** CLOSE FORMFILE ************************** 8210 ERRFLAG% = 0 : USRFORMFOPEN% = 0 8220 CLOSE #2 : RETURN 8222 REM ********************************************************************** 8224 REM * SUB.: UPDATE THE ARBSTAT-RECORD * 8230 REM ********************************************************************** 8240 IF FORMCHAINERROR% THEN ENTRYSTAT$ = "U.." ELSE ENTRYSTAT$ = "K.." 8245 MID$(NONZ50$,23,3) = ENTRYSTAT$ : LSET NONZ$ = NONZ50$ 8246 LSET SM$ = SPACE$(3) : LSET WF$ = SPACE$(3) : LSET VA$ = SPACE$(4) 8247 LSET PC$ = SPACE$(4) : LSET FL$ = SPACE$(4) 8250 GOSUB 9550 : RETURN 8252 REM ********************************************************************** 8254 REM * ERROR !!! WRITE ERROR NO. TO ARBSTAT * 8260 REM ********************************************************************** 8270 IF ARBSTATOPEN% = 0 AND ARBSTATWRITE% = 0 THEN GOTO 8330 8280 MID$(SP$,1,2) = STR$(ERR) 8290 MID$(SP$,3,5) = STR$(ERL) 8300 MID$(NONZ50$,23,3) = "ERR" : LSET NONZ$ = NONZ50$ 8310 GOSUB 9550 REM *** WRITE ARBSTAT 8330 GOTO 16 9000 REM ************************** OPEN ARBSTAT ****************************** 9100 FILENAME$ = "ARBSTAT.DEP" 9120 ERRFLAG% = 0 : OPEN "R",#1,FILENAME$,512 9125 ARBSTATOPEN% = 1 9130 RETURN 9140 REM ************************ SET ARBSTST-FIELD *************************** 9150 FIELD #1,54 AS NONZ$,8 AS SP$,2 AS MO$,3 AS FLN$,3 AS SM$,6 AS ST$,3 AS WF$,4 AS VA$,4 AS FC$,4 AS PC$,4 AS FL$,6 AS EE$,6 AS VE$,6 AS KE$,6 AS KV$,6 AS EC$,6 AS FK$,6 AS VK$,15 AS MR$,225 AS ADDR$,135 AS SUBR$ 9160 RETURN 9170 REM ************************* READ ARBSTAT DIR *************************** 9180 FIELD #1,255 AS ARBSTATDIR1$,255 AS ARBSTATDIR2$,2 AS NOTUSED$ 9200 ERRFLAG% = 0 : GET #1,1 9202 IF MID$(ARBSTATDIR1$,1,10) = "ARBSTATDIR" THEN RETURN 9210 ERRFLAG% = 8 : RETURN 9212 REM ********************************************************************** 9214 REM * SUB.: PRINT ERRMSG. IN LINE 25 * 9220 REM ********************************************************************** 9230 ERRMSGNR% = 17 : GOSUB 20000 9250 GOSUB 1000 : RETURN 9270 REM **************************** OPEN FORM FILE ************************ 9280 USRFORMFOPEN% = 1 9340 ERRFLAG% = 0 : OPEN "R",#2,FORMNAME$,1922 9350 RETURN 9360 REM ************************ WRITE ARBSTAT-DIR. ************************** 9370 FIELD #1,255 AS ARBSTATDIR1$,255 AS ARBSTATDIR2$,2 AS NOTUSED$ 9410 ERRFLAG% = 0 : PUT #1,1 9420 RETURN 9430 REM ************************ INIT A NEW ARBSTAT ************************** 9450 LSET NONZ$ = NONZ50$ 9470 LSET MO$ = MODE$ : LSET FLN$ = FIELDNO$ : LSET SM$ = SPECMOD$ 9530 RETURN 9540 REM ************************ WRITE ARBSTAT ******************************* 9550 ERRFLAG% = 0 : PUT #1,R1% 9555 ARBSTATWRITE% = 1 9560 RETURN 9562 REM ************************ READ ARBSTAT ******************************** 9564 ERRFLAG% = 0 9566 GET #1,R1% : RETURN 9570 REM ************************ INIT FORMATBUFFER-FIELD********************** 9580 FIELD #2,2 AS FORMBYTES$,255 AS FORMREC1$,255 AS FORMREC2$,255 AS FORMREC3$,255 AS FORMREC4$,255 AS FORMREC5$,255 AS FORMREC6$,255 AS FORMREC7$,135 AS FORMREC8$ 9585 RETURN 9640 REM ************************ WRITE FORMREC ******************************* 9650 ERRFLAG% = 0 9655 FORMBYTES1$ = "#&" : LSET FORMBYTES$ = FORMBYTES1$ 9660 PUT #2,FORMNR% 9670 RETURN 9672 REM ************************* READ FORMREC ******************************* 9674 ERRFLAG% = 0 9676 GET #2,FORMNR% 9678 RETURN 9680 REM ************************* INCREMENT RECCORD-COUNTER ****************** 9690 RECCOUNT$ = MID$(NONZ50$,39,6) : RECCOUNT% = VAL(RECCOUNT$) 9700 RECCOUNT% = RECCOUNT% + 1 : RECCOUNT$ = STR$(RECCOUNT%) 9705 NRECCOUNT$ = SPACE$(6) : RSET NRECCOUNT$ = RECCOUNT$ 9710 MID$(NONZ50$,39,6) = NRECCOUNT$ : RETURN 9900 REM ************************* ON ERROR HANDLING ************************** 9910 ON ERRFLAG% GOTO 8060,8060,8060,8060,8110,8130,8150,8010 9920 GOTO 16 10000 REM ************************ E R R O R ********************************** 10010 REM 10020 REM errflag% = 1 = "file not found" 10030 REM errflag% = 2 = "file already exists" 10040 REM errflag% = 3 = "bad filename" 10050 REM errflag% = 4 = "fatal error" 10060 REM errflag% = 5 = "disc i/o error" 10070 REM errflag% = 6 = "disc full" 10080 REM errflag% = 7 = "cp/m dir full" 10085 REM errflag% = 8 = "no arbstatdir" 10090 IF ERR < 50 OR ERR > 67 GOTO 10110 10100 ON ERR-49 GOTO 10110,10110,10110,10310,10110,10110,10110,10160,10310,10110,10110,10210,10110,10110,10310,10110,10110,10290 10110 GOSUB 10340 : ERRFLAG% = 4 : RESUME 9900 10160 ERRMSGNR% = 22 : GOSUB 20000 10190 GOSUB 1000 : ERRFLAG% = 5 : RESUME 9900 10210 ERRMSGNR% = 23 : GOSUB 20000 10240 GOSUB 1000 : ERRFLAG% = 6 : RESUME 9900 10290 GOSUB 10340 : ERRFLAG% = 7 : RESUME 9900 10310 ERRFLAG% = 1 : IF VAL(ARBNR$) = 11 THEN GOSUB 10380 : RESUME 20810 10312 IF VAL(ARBNR$) = 14 THEN RESUME 980 10314 RESUME 9900 10320 ERRFLAG% = 2 : RESUME 9900 10330 ERRFLAG% = 3 : RESUME 9900 10332 REM ********************************************************************* 10334 REM * SUB.: PRINT ERRMSG. IN LINE 25 * 10340 REM ********************************************************************* 10350 XPOS% = 1 : YPOS% = 25 : GOSUB 1990 10360 PRINT CHR$(144);" *** FEHLER #";ERR;"/";ERL;" DATEI: ";FILENAME$;" (ON ERR) !! (ESC) ***";CHR$(128);CHR$(30);CHR$(13); 10370 GOSUB 1000 : RETURN 10372 REM ********************************************************************* 10374 REM * PRINT ERRMSG. IN LINE 25 * 10380 REM ********************************************************************* 10390 ERRMSGNR% = 24 : GOSUB 20000 10410 GOSUB 1000 : RETURN 20000 REM ********************************************************************* 20001 REM * READ AND PRINT ERROR-MSG. ON CRT * 20002 REM ********************************************************************* 20070 XPOS% = 1 : YPOS% = 25 : GOSUB 1990 20080 PRINT CHR$(144);" *** "; 20090 ON ERRMSGNR% GOSUB 20120,20130,20140,20150,20160,20170,20180,20190,20200,20210,20220,20230,20240,20250,20260,20270,20280,20290,20300,20310,20320,20330,20340,20350 20092 IF ERRMSGNR% = 8 THEN PRINT " !! *** ";CHR$(128);CHR$(30);CHR$(13); : RETURN 20095 PRINT " !! (ESC) *** ";CHR$(128);CHR$(30);CHR$(13); 20115 RETURN 20120 PRINT "ARBEITS NR. FALSCH"; : RETURN REM *** MSG. 01 20130 PRINT "FORMATNAME FALSCH"; : RETURN REM *** MSG. 02 20140 PRINT "FORMATNAME BEREITS VORHANDEN"; : RETURN REM *** MSG. 03 20150 PRINT "VERKETTUNGSFEHLER"; : RETURN REM *** MSG. 04 20160 PRINT "FORMAT-DATEI NICHT VORHANDEN"; : RETURN REM *** MSG. 05 20170 PRINT "NAME DER ARBEITSDATEI FALSCH"; : RETURN REM *** MSG. 06 20180 PRINT "ARBEITSDATEI NICHT VORHANDEN"; : RETURN REM *** MSG. 07 20190 PRINT "FORMATVERKETTUNG ! BITTE WARTEN"; : RETURN REM *** MSG. 08 20200 PRINT "KEINE SYSTEM-FORMAT FÅR DIE ARBEITS-STATUS-DATEI"; : RETURN REM *** MSG. 09 20210 PRINT "FORMAT OHNE FORMATKENNUNG GELESEN"; : RETURN REM *** MSG. 10 20220 PRINT "KEINE SYSTEM-FORMATE"; : RETURN REM *** MSG. 11 20230 PRINT "LESEFEHLER IN DER ARBEITS-STATUS-DATEI"; : RETURN REM *** MSG. 12 20240 PRINT "ACHTUNG !! FORMAT-DATEI MIT FEHLER"; : RETURN REM *** MSG. 13 20250 PRINT "NEUE DISKETTE IN LAUFWERK 1 EINLEGEN"; : RETURN REM *** MSG. 14 20260 PRINT "FORMAT-DATEI OHNE START-FORMAT"; : RETURN REM *** MSG. 15 20270 PRINT "ARBEITS-STATUS-DATEI NICHT VORHANDEN"; : RETURN REM *** MSG. 16 20280 PRINT "ARBEITS-STATUS-DATEI VOLL"; : RETURN REM *** MSG. 17 20290 PRINT "FORMAT NR. FALSCH"; : RETURN REM *** MSG. 18 20300 PRINT "FORMAT NR. -BEREICH BELEGT !! MAX. 45 FORMATE"; : RETURN REM *** MSG. 19 20310 PRINT "KEIN PROGRAMM ";MID$(PROGNAME$,1,10); : RETURN REM *** MSG. 20 20320 PRINT "DEP FEHLER-STATUS"; : RETURN REM *** MSG. 21 20330 PRINT "SCHREIB- ODER LESEFEHLER AUF DER DISKETTE"; : RETURN REM *** MSG. 22 20340 PRINT "DISKETTE VOLL"; : RETURN REM *** MSG. 23 20350 PRINT "DATEI NICHT IN DER CP/M DATEIVERWALTUNG"; REM *** MSG. 24 20700 REM ********************************************************************* 20702 REM * DELETE A FILE * 20704 REM ********************************************************************* 20710 IF ARBSTATOPEN% GOTO 20730 ELSE GOSUB 9100 REM *** OPEN ARBSTAT-FILE 20730 XPOS% = 1 : YPOS% = 25 : GOSUB 1990 : PRINT SPACE$(76); 20735 GOSUB 9180 REM *** READ ARBSTAT-DIR 20750 IF MID$(DATANAME$,1,1) = " " GOTO 20760 20755 FILENAME$ = DATANAME$ : GOTO 20770 20760 IF MID$(FORMNAME$,1,1) = " " GOTO 1013 20765 FILENAME$ = FORMNAME$ 20770 GOSUB 7410 REM *** FILE IN ARBSTAT-DIR ? 20780 IF FILEINDIR% THEN GOTO 20790 ELSE IF MID$(DATANAME$,1,1) = " " THEN GOSUB 3873 : GOTO 3110 ELSE GOSUB 4110 : GOTO 3982 20790 ERRFLAG% = 0 : KILL FILENAME$ REM *** KILL THE CP/M FILE 20810 IF DIR2% GOTO 20840 20820 MID$(ARBSTATDIR1$,I%,16) = SPACE$(16) 20830 GOTO 20841 20840 MID$(ARBSTATDIR2$,I%,16) = SPACE$(16) 20841 GOSUB 21020 REM *** DECREMENT ARBSTAT-RECORD-COUNTER 20842 GOSUB 9370 REM *** WRITE ARBSTAT-DIR 20850 XPOS% = 1 : YPOS% = 25 : GOSUB 1990 20860 PRINT CHR$(144);"*** ";MID$(FILENAME$,1,8);" GELØSCHT !!! "; 20870 IF VAL(ARBNR$) = 11 THEN PRINT "***";CHR$(128);CHR$(13);CHR$(7); : GOTO 1013 20880 PRINT "ANZAHL SÆTZE = 00 !! (ESC) ";CHR$(128);CHR$(13);CHR$(7); : GOSUB 1000 : GOTO 16 21000 REM ********************************************************************* 21005 REM * SUB.: DECREMENT ARBSTAT-RECORD-COUNTER * 21010 REM ********************************************************************* 21020 ARBSTATRECCOUNT$ = MID$(ARBSTATDIR1$,11,4) : ARBSTATRECCOUNT% = VAL(ARBSTATRECCOUNT$) 21030 ARBSTATRECCOUNT% = ARBSTATRECCOUNT% - 1 : ARBSTATRECCOUNT$ = STR$(ARBSTATRECCOUNT%) 21040 NARBSTATRECCOUNT$ = SPACE$(4) : RSET NARBSTATRECCOUNT$ = ARBSTATRECCOUNT$ 21050 MID$(ARBSTATDIR1$,11,4) = NARBSTATRECCOUNT$ 21060 RETURN 22190 REM ********************************************************************* 22195 REM * READ FROM CHAININF-FILE THE WORKNO. * 22200 REM ********************************************************************* 22210 ERRFLAG% = 0 : FILENAME$ = "CHAININF.DEP" 22220 OPEN "R",#5,FILENAME$,26 22240 FIELD #5,12 AS CHAININFO1$,12 AS CHAININFO2$,2 AS CHAININFO3$ 22250 ERRFLAG% = 0 : GET #5,1 22270 FORMNAME$ = CHAININFO1$ : DATANAME$ = CHAININFO2$ : ARBNR$ = CHAININFO3$ 22280 ERRFLAG% = 0 : CLOSE 22290 RETURN «eof»