DataMuseum.dk

top - metrics - download

    Length: 1929 (0x789)
    Notes: Mikados TextFile, Mikados_K
    Names: »RENAME80«

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

Text

0100 // PNM 05.09.1980, COMAL80 VERSION 24.04.1982
0110 // PURGE80
0120 DIM NAVN$ OF 18,DREVN$ OF 9,FILNAVN$ OF 9,FILTYPE$ OF 1
0130 DIM FILNA$ OF 9,SIDSTECHAR$ OF 1
0140 INTEGER FLAG,FOREVER,Y,INDEX
0150 PRINT 
0160 PRINT "RENAME80 - AENDRING AF FILNAVN"
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 INPUT "INDTAST DET NUVAERENDE FILNAVN (MED ETIKETTE): ":NAVN$
0230 EXEC KONVERTOGMOVE(NAVN$,INDEX,DREVN$,SIDSTECHAR$,FLAG)
0240 IF SIDSTECHAR$<>":" OR INDEX>9 OR INDEX=1 THEN FLAG:=1
0250 INDEX:=INDEX+1
0260 EXEC KONVERTOGMOVE(NAVN$,INDEX,FILNAVN$,SIDSTECHAR$,FLAG)
0270 IF LEN(FILNAVN$)>8 OR LEN(FILNAVN$)<1 OR NAVN$(18)<>"" THEN FLAG:=1
0280 IF SIDSTECHAR$=":" THEN FLAG:=1
0290 UNTIL FLAG=0
0300 REPEAT 
0310 PRINT "INDTAST FILTYPE ";
0320 INPUT "(K FOR PROGRAM-/DATAFILER, B FOR BINAERFILER): ":FILTYPE$
0330 UNTIL FILTYPE$="K" OR FILTYPE$="B"
0340 REPEAT 
0350 FLAG:=0;NAVN$:="";FILNA$:=""
0360 INPUT "INDTAST DET NYE FILNAVN (UDEN ETIKETTE): ":NAVN$
0370 INDEX:=1
0380 EXEC KONVERTOGMOVE(NAVN$,INDEX,FILNA$,SIDSTECHAR$,FLAG)
0390 IF LEN(FILNA$)>8 OR LEN(FILNA$)<1 THEN FLAG:=1
0400 UNTIL FLAG=0
0410 EXEC RENAME
0420 UNTIL FOREVER
0430 PROC RENAME
0440 CALL "SYSPROG:OMDØB"
0450 IF FLAG<>0 THEN 
0460 PRINT "RENAME MISLYKKEDES. FEJLKODE ";FLAG
0470 STOP 
0480 ELSE 
0490 PRINT DREVN$;":";FILNAVN$;" ER OMDØBT TIL ";DREVN$;":";FILNA$
0500 ENDIF 
0510 ENDPROC RENAME
0520 PROC KONVERTOGMOVE(NFRA$,REF I,REF NTIL$,REF CH$,REF F)
0530 Y:=1
0540 REPEAT 
0550 CH$:=NFRA$(I)
0560 IF CH$=>"a" AND CH$<="å" THEN CH$:=CHR$(ORD(CH$)-32)
0570 IF CH$<>":" THEN 
0580 IF (CH$=>"0" AND CH$<="9") OR (CH$=>"A" AND CH$<="Å") OR CH$="_" THEN 
0590 NTIL$(Y):=CH$;Y:=Y+1;I:=I+1
0600 ELSE 
0610 IF CH$<>"" THEN 
0620 F:=1
0630 // EXIT ;ULOVLIGT TEGN
0640 ENDIF 
0650 ENDIF 
0660 ENDIF 
0670 UNTIL Y=LEN(NFRA$)+1 OR CH$=":" OR CH$="" OR LEN(NTIL$)=>9 OR I=>18
0680 ENDPROC KONVERTOGMOVE