1 REM Ins{nd av Kristoffer Eriksson <5357>    1988-09-01 19.18.07 (KERMIT)
  10 ! save ARCLIST
  20 ! Av Kristoffer Eriksson <5357>, 1988-09-01 17.45 (08-14)
  30 ! F|r ABC-Basic-II & BasicII/PC & DNIX-Basic-V.
  40 ! Listar inneh}ll i ARC-filer fr}n PC-v{rlden, {ven kommentarer.
  50 ! F}r fritt kopieras i ickekommersiella syften.
  60 ! 
  70 ! Vid |verf|ring till PC, se till att ][\ |vers{tts. Vid inladdning i
  80 ! BasicII/PC, blir det felmeddelande p} en rad med "REQUEST", men det
  90 ! g|r inget. Bara strunta i det. Den raden anv{nds inte p} PC.
 100 ! 
 110 ! F|r DNIX, kan man avkommentera "LONG INT" h{r nedan, och "MODE 0" p}
 120 ! OPEN n}gpt l{ngre ned, men det {r inget krav att s} sker.
 130 ! 
 140 ! Ytterligare omkonfigurering f|r icke-ABC kan g|ras i FNArc: {ndra
 150 ! blockstorlek (variablerna Bl och I$). I FNComment kan man |ka
 160 ! s|kavst}ndet f|r arkiv- och filkommentarer med variablerna B och I$.
 170 ! 
 180 INTEGER : EXTEND : ! NO RESUME
 190 ! LONG INT
 200 ! 
 210 ! Identifiera system. ARGV$ {r en inbyggd funktion i D-Basic-V. Vi f|rut-
 220 ! s{tter att den anv{nds p} DNIX. Minnesm{ngden SYS(2) i BasicII/PC {r
 230 ! st|rre {n vad den kan vara i ABC, men blir negativ eftersom bara 16-bits
 240 ! heltal anv{nds. Annars antar vi det {r en ABC.
 250 IF ARGV$(1)<>"" THEN Sdnix=-1 ELSE IF SYS(2)<0 THEN Smsdos=-1 ELSE Sabc=-1
 260 ! 
 270 ! 
 280 ; "-*---- Lista inneh}ll i PC ARC-fil ----*-"
 290 INPUT "Filnamn: " F$
 300 IF F$="" THEN 410 ! END
 310 IF INSTR(1,F$,".")=0 THEN F$=F$+".arc"
 320 IF NOT Sdnix THEN F$=FNCaps$(F$)
 330 ON ERROR GOTO 350 : OPEN F$ AS FILE 1 ! MODE 0%
 340 WHILE 0
 350   IF ERRCODE=21 OR ERRCODE=2 THEN ; F$ " finns inte." ELSE ; "Felkod" ERRCODE "p} " F$ "."
 360   GOTO 290
 370 WEND
 380 ;
 390 Z=FNArclist(1,F$,7)
 400 CLOSE 1
 410 END
 420 ! 
 430 ! Lista arkiv. Vilka: bit 0 = arkivkommentar, 1 = fil-kom, 2 = fildata.
 440 DEF FNArclist(F,F$,Vilka) LOCAL V
 450   ON ERROR GOTO 570
 460   ; "Unders|ker: " F$;
 470   WHILE Vilka AND 3
 480     V=FNComment(F,FNFillen.(F,F$))
 490     IF V AND 1 GET #F I$ COUNT 32 : IF Vilka AND 1 ; " - " FNFilter$(I$);
 500     IF V THEN GET #F I$ COUNT 32
 510     IF 0 WEND
 520   ;
 530   IF (Vilka AND 4)=0 THEN RETURN 0
 540   ;
 550   RETURN FNArc(F,Vilka AND (4 OR V))
 560   ! 
 570   IF ERRCODE=34 OR ERRCODE=38 OR ERRCODE=50 THEN ; "F|r tidigt slut p} filen." ELSE ; "Felkod" ERRCODE
 580   RETURN 0
 590 FNEND
 600 ! 
 610 ! Lista uppgifter enligt Vilka: bit 1 = filkommentarer, bit 2 = fildata.
 620 DEF FNArc(F,Vilka) LOCAL Cpos.,Hopp.,P,Pack,Nam$=13,Csize.,Osize.,Csizes.,Osizes.,Datum,Tid,Crc,Filer,Rader,Soeker,Bl,I$=253
 630   ! 
 640   Bl=253 ! Maskinkonstant: L{mplig blockl{ngd
 650   ; "Filnamn          L{ngd  Packning  Storl nu  Krympt   Datum      Tid     CRC"
 660   ; "------------     -----  --------  --------  ------  --------  --------  ----"
 670   Rader=4
 680   Cpos.=POSIT(F) ! Aktuell pos = pos f|r ev filkommentarer
 690   POSIT #F,0
 700   ! 
 710   WHILE 1
 720     Z=INT((POSIT(F)+Bl)/Bl)*Bl-POSIT(F) ! Synka med sektorer p} ABC. P} andra kan Z=Bl anv{ndas om man vill.
 730     GET #F I$ COUNT Z
 740     IF FNAvbryt THEN ; "-Avbrutet-" : RETURN 0
 750     Rader=FNSida(Rader) : IF Rader<0 THEN ; "-Avbrutet-   " : RETURN 0
 760     P=INSTR(1,I$,CHR$(26))
 770     ! 
 780     WHILE P<>1
 790       WHILE Soeker=0
 800         IF POSIT(F)=Bl THEN ; "Sj{lvuppackande eller f";ELSE ; "F";
 810         ; "elaktigt arkiv. S|ker..." : Rader=Rader+1
 820         IF 0 WEND
 830       IF Soeker>30 THEN ; "Nu ger jag upp!" : RETURN 0
 840       Hopp.=0
 850       WHILE P=0
 860         Hopp.=Hopp.+LEN(I$)
 870         GET #F I$ COUNT Bl
 880         P=INSTR(1,I$,CHR$(26))
 890         Soeker=Soeker+1
 900       WEND
 910       Soeker=Soeker+1
 920       ; "Hoppade |ver" Hopp.+P "bytes." : Rader=Rader+1
 930       IF 0 WEND
 940     ! 
 950     POSIT #F,POSIT(F)-LEN(I$)+P
 960     GET #F I$
 970     Pack=ASCII(I$)
 980     IF Pack>13 THEN ; "Ok{nd packning:" ASCII(I$) : Rader=Rader+1 : GOTO 720
 990     ! 
1000     WHILE Pack=0 ! Slut
1010       ; "------------     -----            --------  ------"
1020       ; NUM$(Filer) " filer" SPACE$(6-LEN(NUM$(Filer)));
1030       ; FNHjust$(NUM$(Osizes.),10) FNHjust$(NUM$(Csizes.),20) FNHjust$(NUM$(FNRatio(Csizes.,Osizes.)),6) "%"
1040       RETURN 0
1050       IF 0 WEND
1060     ! 
1070     Soeker=0
1080     GET #F I$ COUNT 23
1090     Nam$=MID$(I$,1,13)
1100     P=INSTR(1,Nam$,CHR$(0)) : IF P THEN Nam$=LEFT$(Nam$,P-1)
1110     Nam$=FNFilter$(Nam$)
1120     Csize.=FNCvtl.(MID$(I$,14,4))
1130     Datum=FNCvti(MID$(I$,18,2))
1140     Tid=FNCvti(MID$(I$,20,2))
1150     Crc=FNCvti(MID$(I$,22,2))
1160     ! 
1170     IF Pack=1 THEN Osize.=Csize. ELSE GET #F I$ COUNT 4 : Osize.=FNCvtl.(I$)
1180     Csizes.=Csizes.+Csize.
1190     Osizes.=Osizes.+Osize.
1200     Filer=Filer+1
1210     ! 
1220     RESTORE 1470
1230     Z=1 : WHILE Z<=Pack AND Z<=10 : READ Pack$ : Z=Z+1 : WEND
1240     ! 
1250     WHILE Vilka AND 4
1260       ; Nam$ SPACE$(13-LEN(Nam$));
1270       ; FNHjust$(NUM$(Osize.),9) "  " Pack$ FNHjust$(NUM$(Csize.),10) "   " FNHjust$(NUM$(FNRatio(Csize.,Osize.)),3) "%   ";
1280       IF Datum<>0 THEN ; FNZ$((SWAP%(Datum) AND 255)/2+80) "-" FNZ$((Datum AND 480)/32) "-" FNZ$(Datum AND 31) "  ";ELSE ; "          ";
1290       IF Tid<>0 THEN ; FNZ$((SWAP%(Tid) AND 248)/8) ":" FNZ$((Tid AND 2016)/32) ":" FNZ$((Tid AND 31)*2) "  ";ELSE ; "          ";
1300       ; FNZ4$(HEX$(Crc AND 65535))
1310       Rader=Rader+1
1320       IF 0 WEND
1330     ! 
1340     Hopp.=POSIT(F)+Csize.
1350     WHILE Vilka AND 2
1360       POSIT #F,Cpos. : GET #F I$ COUNT 32 ! Filkommentar
1370       WHILE I$<>SPACE$(32)
1380         IF Vilka AND 4 THEN ; SPACE$(17);ELSE ; Nam$ SPACE$(17-LEN(Nam$));
1390         ; FNFilter$(I$) : Rader=Rader+1
1400         IF 0 WEND
1410       Cpos.=Cpos.+32.
1420       IF 0 WEND
1430     POSIT #F,Hopp.
1440   WEND
1450   ! 
1460   ! eller DATA " Stored ", " Stored ", ...
1470   DATA "   --   ", "   --   ", " Packed ", "Squeezed", "crunched"
1480   DATA "crunched", "crunched", "Crunched", "Squashed", " Ok{nt  "
1490 FNEND
1500 ! 
1510 ! 
1520 ! Hitta punkten mellan arkivkommentaren och filkommentarerna, om det
1530 ! finns. Kolla vilka kommentarer som finns, och g|r POSIT till den f|rsta
1540 ! av dessa. PKPAK accepterar max 1024 bytes skr{p, vilket kr{ver l{sning
1550 ! av 1024+8 bytes i s|kningen.
1560 ! Returnera 0 = Inga, 1 = arkiv, 2 = fil, 3 = b}da.
1570 DEF FNComment(F,Length.) LOCAL I$=1032,B,Last,Synk,Synk$=4
1580   ON ERROR GOTO 1740
1590   IF Length.<=0. THEN RETURN 0
1600   B=1032 : IF B>Length. THEN B=Length.
1610   POSIT #F,Length.-B : GET #F,I$ COUNT B
1620   Synk$="PK"+CHR$(170,85)
1630   Last=LEN(I$)-6
1640   WHILE 1
1650     Z=0 : WHILE 1
1660       Synk=Z
1670       Z=INSTR(Synk+1,I$,Synk$)
1680       IF Z AND Z<Last WEND
1690     IF Synk=0 THEN RETURN 0 ! Ge upp
1700     Last=Synk
1710     Z=FNChecksynk(F,Length.-B+Synk-1.,FNCvtl.(MID$(I$,Synk+4,4)))
1720     IF Z THEN RETURN Z ! Hittat
1730   WEND
1740   RETURN 0 ! Fel
1750 FNEND
1760 ! 
1770 DEF FNChecksynk(F,Synkpos.,Ptr.) LOCAL I$=32,Vilka
1780   ON ERROR GOTO 1910
1790   IF Ptr.>Synkpos.-32. THEN RETURN 0
1800   IF Ptr.<Synkpos.-16000. THEN RETURN 0 ! Knappast > 500 kommentarer
1810   IF Ptr.<2. THEN RETURN 0
1820   POSIT #F,Ptr. : GET #F I$ COUNT 32
1830   IF RIGHT$(I$,5)<>SPACE$(28) THEN RETURN 0 ! Detta {r jag os{ker p}
1840   Z=ASCII(RIGHT$(I$,4)) : IF ASCII(I$)=1 AND (Z=32 OR Z=0) THEN Vilka=2 ! MID$(I$,2,3) {r os{kra
1850   IF Vilka=0 IF LEFT$(I$,4)<>"   "+CHR$(0) THEN RETURN 0
1860   POSIT #F,Ptr.-2. : GET #F I$ COUNT 2
1870   IF I$=CHR$(26,0) THEN RETURN Vilka ! Ingen arkiv-kom
1880   IF Ptr.<34. THEN RETURN 0
1890   POSIT #F,Ptr.-34. : GET #F I$ COUNT 2
1900   IF I$=CHR$(26,0) THEN RETURN Vilka OR 1 ! Arkiv-kom
1910   RETURN 0
1920 FNEND
1930 ! 
1940 DEF FNRatio(C.,O.) LOCAL R.
1950   IF O.>0. THEN R.=(O.-C.)/O.*100. ELSE RETURN 0
1960   IF INT(R.)<R. THEN RETURN INT(R.)+1. ELSE RETURN INT(R.)
1970 FNEND
1980 ! 
1990 DEF FNCvtl.(S$)=ASCII(S$)+256.*(ASCII(RIGHT$(S$,2))+256.*(ASCII(RIGHT$(S$,3))+256.*ASCII(RIGHT$(S$,4))))
2000 DEF FNCvti(S$)=ASCII(S$)+SWAP%(ASCII(RIGHT$(S$,2)))
2010 DEF FNZ$(N)=STRING$(1 AND N<10,48)+NUM$(N)
2020 DEF FNZ4$(S$)=STRING$(4-LEN(S$),48)+S$
2030 DEF FNUs.(N) : IF N<0 THEN RETURN 65536.+N ELSE RETURN N
2040 FNEND
2050 ! 
2060 DEF FNHjust$(S$,N)
2070   IF LEN(S$)<N THEN RETURN SPACE$(N-LEN(S$))+S$ ELSE RETURN S$
2080 FNEND
2090 ! 
2100 DEF FNFilter$(S$) LOCAL T$=32,P,K,L,I$=10,O$=11
2110   WHILE Smsdos
2120     ! BasicII/PC
2130     T$=S$
2140     P=LEN(T$) : WHILE P
2150       K=ASCII(RIGHT$(T$,P))
2160       IF K<32 OR K>254 THEN MID$(T$,P,1)="."
2170       IF K<>32 AND L=0 THEN L=P
2180       P=P-1 : WEND
2190     RETURN LEFT$(T$,L)
2200   WEND
2210   ! 7-bittars-system, dvs ABC eller DNIX
2220   I$=CHR$(134,132,148,130,129,143,142,153,144,154)
2230   O$=CHR$(46,125,123,124,96,126,93,91,92,64,94)
2240   T$=S$
2250   P=LEN(T$) : WHILE P
2260     K=ASCII(RIGHT$(T$,P))
2270     IF K<32 OR K>126 THEN Z=INSTR(1,I$,CHR$(K)) : MID$(T$,P,1)=MID$(O$,Z+1,1)
2280     IF K<>32 AND L=0 THEN L=P
2290     P=P-1 : WEND
2300   RETURN LEFT$(T$,L)
2310 FNEND
2320 ! 
2330 DEF FNCaps$(S$) LOCAL T$=160,P,K
2340   T$=S$
2350   P=LEN(T$) : WHILE P
2360     K=ASCII(RIGHT$(T$,P))
2370     IF K>=96 AND K<=126 THEN MID$(T$,P,1)=CHR$(K-32)
2380     P=P-1 : WEND
2390   RETURN T$
2400 FNEND
2410 ! 
2420 DEF FNAvbryt LOCAL G$=1
2430   WHILE SYS(5)>127
2440     GET G$ : IF INSTR(1,CHR$(192,3,4,15,27),G$) THEN RETURN -1
2450   WEND
2460   RETURN 0
2470 FNEND
2480 ! 
2490 DEF FNSida(Rader) LOCAL G$=1
2500   IF Rader<21 THEN RETURN Rader
2510   ; "Tryck RETURN ";
2520   GET G$
2530   ; CHR$(13);
2540   IF ASCII(G$)=9 OR G$=" " THEN RETURN Rader
2550   IF ASCII(G$)=13 OR ASCII(G$)=10 THEN RETURN 0
2560   RETURN -1
2570 FNEND
2580 ! 
2590 ! Synnerligen maskinberoende.
2600 DEF FNFillen.(F,F$) LOCAL Length.,X$=40,F2$=256
2610   WHILE Sdnix
2620     ! DBASIC-V, DNIX
2630     F2$=F$+CHR$(0)
2640     X$=STRING$(40,0)
2650     Z=REQUEST(18,VARPTR(F2$),VARPTR(X$)) ! stat()
2660     IF Z=-1 THEN RETURN 0.
2670     RETURN CVT$%(MID$(X$,15,4))
2680   WEND
2690   WHILE Smsdos
2700     ! BasicII/PC
2710     Z=FNGetlu(F)
2720     IF PEEK(Z+19)=0 THEN RETURN 0. ! Ingen MSDOS-handle
2730     Length.=FNUs.(PEEK2(Z+15))+65536.*FNUs.(PEEK2(Z+17))
2740     RETURN Length.
2750   WEND
2760   ! ABC
2770   ! (F|r monitorn: Vet vi redan var FILEID-sektorn ligger, s} anv{nd den
2780   ! uppgiften i st{llet, men r{kna inte med den sektorn.)
2790   ! Jag n|jer mig med att ge l{ngden f|r senast anv{nda DOS-fil.
2800   Length.=253.*FNUs.(PEEK2(64778))
2810   ! Kolla att det verkligen funkar p} denna DOS-version.
2820   ON ERROR GOTO 2850 : POSIT #F,Length. : GET #F X$
2830   ; "DOS-trubbel. PEEK2(64778) ger inte filens l{ngd."
2840   RETURN 0.
2850   RETURN Length.
2860 FNEND
2870 ! 
2880 DEF FNGetlu(F) LOCAL A
2890   A=PEEK2(65344)
2900   WHILE A : IF PEEK(A+2)=F THEN RETURN A ELSE A=PEEK2(A) : WEND
2910   RETURN -1
2920 FNEND