DataMuseum.dk

top - download

    Length: 3968 (0xf80)
    Notes: Mikados TextFile, Mikados_K
    Names: »PURGE«

└─⟦57a827f90⟧ Bits:30005247 COMAL A verson 2.24 (MIKADOS)
    └─ ⟦this⟧ »PURGE« 
└─⟦85259e8f7⟧ Bits:30005248 COMAL B verson 1.19 (MIKADOS)
    └─ ⟦this⟧ »PURGE« 

Text

0100 REM PNM 05.09.1980
0110 DIM NAVN$(18),DREVN$(9),FILNAVN$(9),FILTYPE$(1),SIDSTECHAR$(1)
0120 PRINT 
0130 PRINT "PURGE - SLET EN FIL"
0140 PRINT "PROGRAMMET STOPPES VED AT TRYKKE PAA ESC"
0150 REPEAT 
0160 PRINT 
0170 REPEAT 
0180 NAVN$="";FILNAVN$="";DREVN$="";FLAG,FOREVER=0;INDEX=1
0190 PRINT "INDTAST ";
0200 INPUT "'ETIKETTE:FILNAVN' FOR DEN FIL, DER 0NSKES SLETTET: ",NAVN$
0210 EXEC KONVERTOGMOVE(NAVN$,INDEX,DREVN$,SIDSTECHAR$,FLAG)
0220 IF SIDSTECHAR$<>":" OR INDEX>9 OR INDEX=1 THEN FLAG=1
0230 EXEC KONVERTOGMOVE(NAVN$,1+INDEX,FILNAVN$,SIDSTECHAR$,FLAG)
0240 IF LEN(FILNAVN$)>8 OR LEN(FILNAVN$)<1 OR NAVN$(18)<>"" THEN FLAG=1
0250 IF SIDSTECHAR$=":" THEN FLAG=1
0260 UNTIL FLAG=0
0270 REPEAT 
0280 PRINT "INDTAST FILTYPE ";
0290 INPUT "(K FOR PROGRAM-/DATAFILER, B FOR BINAERFILER): ",FILTYPE$
0300 UNTIL FILTYPE$="K" OR FILTYPE$="B"
0310 EXEC PURGE
0320 UNTIL FOREVER
0330 PROC PURGE
0340 CALL "SYSPROG:PERGE"
0350 IF FLAG<>0 THEN 
0360 PRINT "PURGE MISLYKKEDES. FEJLKODE";FLAG
0370 STOP 
0380 ELSE 
0390 PRINT DREVN$;":";FILNAVN$;" ER NU SLETTET"
0400 ENDIF 
0410 ENDPROC 
0420 PROC KONVERTOGMOVE(NFRA,I,NTIL,CH,F)
0430 Y=1
0440 REPEAT 
0450 CH$=NFRA$(I)
0460 IF CH$=>"a" AND CH$<="å" THEN CH$=CHR(ORD(CH$)-32)
0470 IF CH$<>":" THEN 
0480 IF (CH$=>"0" AND CH$<="9") OR (CH$=>"A" AND CH$<="Å") OR CH$="_" THEN 
0490 NTIL$(Y)=CH$;Y=Y+1;I=I+1
0500 ELSE 
0510 IF CH$<>"" THEN 
0520 F=1
0530 EXIT ;ULOVLIGT TEGN
0540 ENDIF 
0550 ENDIF 
0560 ENDIF 
0570 UNTIL Y=LEN(NFRA$)+1 OR CH$=":" OR CH$="" OR LEN(NTIL$)=>9 OR I=>18
0580 ENDPROC