DataMuseum.dk

top - metrics - download

    Length: 1665 (0x681)
    Notes: Mikados TextFile, Mikados_K
    Names: »PURGE80«

└─⟦670c0171b⟧ Bits:30005246 COMAL-80 version 1.3 (MIKADOS)
    └─⟦this⟧ »PURGE80« 

Text

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