10 ! save ZIPLIST
20 ! Av Kristoffer Eriksson <5357>, 1989-04-06 00.42
30 ! F|r ABC-Basic-II & BasicII/PC & DNIX-Basic-V.
40 ! Listar inneh}ll i ZIP-filer fr}n PC-v{rlden, {ven kommentarer.
50 ! F}r fritt kopieras i ickekommersiella syften.
60 ! 
61 ! Tabellen med metodnamn uppdaterad 1993-03-13. Jan-Olof Svensson <6057>
62 ! 
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}got l{ngre ned, men det {r inget krav att s} sker.
130 ! 
140 ! Ytterligare omkonfigurering f|r icke-ABC kan g|ras i FNZip med variabeln
150 ! Bl f|r blockstorlek i vissa funktioner. FNFdisp och FNFilter arbetar
160 ! med en godtycklig maxl{ngd p} delstr{ngar.
170 ! 
180 ! En brist {r att FNFdisp inte kontrollerar n{r sidan blir full, vid
190 ! utskrift av v{ldigt l}nga str{ngar.
200 ! 
210 INTEGER : EXTEND : ! NO RESUME
220 ! LONG INT
230 ! 
240 ! Identifiera system. ARGV$ {r en inbyggd funktion i D-Basic-V. Vi f|rut-
250 ! s{tter att den anv{nds p} DNIX. Minnesm{ngden SYS(2) i BasicII/PC {r
260 ! st|rre {n vad den kan vara i ABC, men blir negativ eftersom bara 16-bits
270 ! heltal anv{nds. Annars antar vi det {r en ABC.
280 IF Argv$(1)<>"" THEN Sdnix=-1 ELSE IF SYS(2)<0 THEN Smsdos=-1 ELSE Sabc=-1
290 ! 
300 ! 
310 ; "-*---- Lista inneh}ll i ZIP-arkiv ----*-"
320 INPUT "Filnamn: "F$
330 IF F$="" THEN 440 ! END
340 IF INSTR(1,F$,".")=0 THEN F$=F$+".zip"
350 IF NOT Sdnix THEN F$=FNCaps$(F$)
360 ON ERROR GOTO 380 : OPEN F$ AS FILE 1 ! MODE 0%
370 WHILE 0
380   IF ERRCODE=21 OR ERRCODE=2 THEN ; F$ " finns inte." ELSE ; "Felkod" ERRCODE "p} " F$ "."
390   GOTO 320
400 WEND 
410 ; 
420 Z=FNZiplist(1,F$,7)
430 CLOSE 1
440 END 
450 ! 
460 ! Lista arkiv. Vilka: bit 0 = arkivkommentar, 1 = fil-kom, 2 = fildata.
470 DEF FNZiplist(F,F$,Vilka) LOCAL Dir.,Coml,I$=22,Tomt
480   ON ERROR GOTO 660
490   ; "Unders|ker: " F$;
500   Dir.=FNZcendir.(F,FNFillen.(F,F$))
510   IF Dir.=-2. THEN ; : ; "-Avbrutet-" : RETURN 0
520   IF Dir.<0. THEN ; : ; "Hittar ingen filf|rteckning i arkivet." : RETURN 0
530   Tomt=Dir.=POSIT(F)
540   WHILE Vilka AND 1
550     GET #F I$ COUNT 22
560     Coml=FNCvti(MID$(I$,21,2))
570     ; " - "; : IF FNFdisp(F,Coml) THEN RETURN 0
580   IF 0 WEND 
590   ; 
600   IF (Vilka AND 6)=0 THEN RETURN 0
610   ; 
620   IF Tomt THEN ; "Arkivet {r tomt." : RETURN 0
630   POSIT #F,Dir.
640   RETURN FNZip(F,Vilka)
650   ! 
660   IF ERRCODE=34 OR ERRCODE=38 OR ERRCODE=50 THEN ; "F|r tidigt slut p} filen." ELSE ; "Felkod" ERRCODE
670   RETURN 0
680 FNEND 
690 ! 
700 ! Lista uppgifter enligt Vilka: bit 1 = filkommentarer, bit 2 = fildata.
710 DEF FNZip(F,Vilka) LOCAL Pack,Naml,Coml,Extl,Csize.,Osize.,Csizes.,Osizes.,Datum,Tid,Filer,Rader,I$=46
720   ! 
730   ; "L{ngd    Metod   Storl nu Krympt  Datum     Tid   Namn"
740   ; "-------  ------  -------- ------ --------  -----  ----------"
750   Rader=4
760   ! 
770   WHILE 1
780     IF FNAvbryt THEN ; "-Avbrutet-" : RETURN 0
790     Rader=FNSida(Rader) : IF Rader<0 THEN ; "-Avbrutet-   " : RETURN 0
800     GET #F I$ COUNT 4
810     POSIT #F,POSIT(F)-LEN(I$)
820     ! 
830     WHILE I$<>"PK"+CHR$(1,2)
840       WHILE I$="PK"+CHR$(5,6) ! Slut
850         ; "-------          --------  ----                   ----------"
860         ; FNHjust$(NUM$(Osizes.),7) FNHjust$(NUM$(Csizes.),18) FNHjust$(NUM$(FNRatio(Csizes.,Osizes.)),5) "%" SPACE$(19) NUM$(Filer) " filer"
870         RETURN 0
880       WEND 
890       IF FNZscan(F) THEN RETURN 0 ELSE Rader=Rader+2 : GOTO 770
900     WEND 
910     ! 
920     GET #F I$ COUNT 46
930     Pack=FNCvti(MID$(I$,11,2))
940     Tid=FNCvti(MID$(I$,13,2))
950     Datum=FNCvti(MID$(I$,15,2))
960     Csize.=FNCvtl.(MID$(I$,21,4))
970     Osize.=FNCvtl.(MID$(I$,25,4))
980     Naml=FNCvti(MID$(I$,29,2))
990     Extl=FNCvti(MID$(I$,31,2))
1000     Coml=FNCvti(MID$(I$,33,2))
1010     ! 
1020     Csizes.=Csizes.+Csize.
1030     Osizes.=Osizes.+Osize.
1040     Filer=Filer+1
1050     ! 
1060     IF NOT Vilka AND 4 THEN POSIT #F,POSIT(F)+FNUs.(Naml)
1070     WHILE Vilka AND 4
1080       ! Fildata
1090       RESTORE 1310
1100       Z=0 : WHILE Z<=Pack AND Z<=9 : READ I$ : Z=Z+1 : WEND 
1110       ! 
1120       ; FNHjust$(NUM$(Osize.),7) "  " I$ FNHjust$(NUM$(Csize.),16-LEN(I$)) FNHjust$(NUM$(FNRatio(Csize.,Osize.)),5) "%  ";
1130       IF Datum<>0 THEN ; FNZ$((SWAP%(Datum) AND 255)/2+80) "-" FNZ$((Datum AND 480)/32) "-" FNZ$(Datum AND 31) "  "; ELSE ; "          ";
1140       ; FNZ$((SWAP%(Tid) AND 248)/8) ":" FNZ$((Tid AND 2016)/32) "  ";
1150       IF FNFdisp(F,Naml) THEN RETURN 0
1160       ; 
1170       Rader=Rader+1+FIX((FNUs.(Naml)+49.)/80.)
1180     IF 0 WEND 
1190     ! 
1200     POSIT #F,POSIT(F)+FNUs.(Extl)
1210     IF NOT Vilka AND 2 THEN POSIT #F,POSIT(F)+FNUs.(Coml)
1220     WHILE Vilka AND 2 AND Coml<>0
1230       ! Filkommentar
1240       IF Vilka AND 4 THEN ; SPACE$(9);
1250       IF FNFdisp(F,Coml) THEN RETURN 0
1260       ; 
1270       Rader=Rader+1+FIX((FNUs.(Coml)+((Vilka AND 4)<>0 AND 9))/80.)
1280     IF 0 WEND 
1290   WEND 
1300   ! 
1310   DATA "   --", "Shrunk", "Reduce1", "Reduce2", "Reduce3"
1320   DATA "Reduce4", "Implode", "Token", "Deflate", "??"
1330 FNEND 
1340 ! 
1350 ! Hitta resten av dir, vid fel. Kanske inte s} n|dv{ndigt. Blir 0 om ok.
1360 DEF FNZscan(F) LOCAL I$=253,J$=3,Hopp.,P,Bl
1370   ; "Trasigt arkiv. S|ker..."
1380   Bl=253
1390   Hopp.=0.
1400   WHILE Hopp.<5000. ! T}lamodsgr{ns
1410     IF FNAvbryt THEN ; "-Avbrutet-" : RETURN 2
1420     Z=INT((POSIT(F)+Bl)/Bl)*Bl-POSIT(F) ! Synka med sektorer p} ABC. P} andra kan Z=Bl anv{ndas om man vill.
1430     IF Z<4 THEN Z=4
1440     GET #F I$ COUNT Z
1450     P=0 : WHILE 1
1460       P=INSTR(P+1,J$+I$,"PK")
1470       IF P AND P+3<=LEN(I$)+LEN(J$) THEN IF INSTR(1,CHR$(1,2,5,6),MID$(J$+I$,P+2,2)) AND 1 THEN 1540
1480     IF P WEND 
1490     Hopp.=Hopp.+LEN(I$)
1500     J$=RIGHT$(I$,LEN(I$)-2)
1510   WEND 
1520   ; "Nu ger jag upp!" : RETURN 1
1530   ! 
1540   ; "Hoppade |ver" Hopp.+P-LEN(J$)-1 "bytes."
1550   POSIT #F,POSIT(F)-LEN(I$)-LEN(J$)+P-1
1560   RETURN 0
1570 FNEND 
1580 ! 
1590 ! 
1600 ! Hitta central directory. Returnera dess startposition, och positionera
1610 ! till b|rjan av slutposten. (274=253+22-1)
1620 DEF FNZcendir.(F,Length.) LOCAL I$=274,J$=21,Bl,Last,Synk,Synk$=4,Dir.,Pos.
1630   ON ERROR GOTO 1860
1640   Pos.=Length.
1650   Bl=253
1660   Synk$="PK"+CHR$(5,6)
1670   WHILE Pos.>0. AND Length.-Pos.<66000. ! Max avslutande arkivkommentar
1680     IF FNAvbryt THEN RETURN -2.
1690     IF LEN(I$) THEN J$=LEFT$(I$,21)
1700     IF Pos.>=Bl THEN Pos.=Pos.-Bl ELSE Bl=Pos. : Pos.=0.
1710     POSIT #F,Pos. : GET #F,I$ COUNT Bl
1720     I$=I$+J$
1730     Last=LEN(I$)-22+2
1740     WHILE 1
1750       Z=0 : WHILE 1
1760         Synk=Z
1770         Z=INSTR(Synk+1,I$,Synk$)
1780       IF Z AND Z<Last WEND 
1790       WHILE Synk
1800         Last=Synk
1810         Dir.=FNCvtl.(MID$(I$,Synk+16,4))
1820         IF FNZchecksynk(F,Pos.+Synk-1.,Dir.,FNCvtl.(MID$(I$,Synk+12,4))) THEN RETURN Dir.
1830       IF 0 WEND 
1840     IF Synk THEN WEND 
1850   WEND 
1860   RETURN -1. ! Fel
1870 FNEND 
1880 ! 
1890 DEF FNZchecksynk(F,Synkpos.,Ptr.,Size.) LOCAL I$=46
1900   ON ERROR GOTO 2000
1910   WHILE Ptr.<>Synkpos. OR Size.<>0. ! Tomt beh|ver inte testas mer
1920     IF Ptr.>Synkpos.-46. OR Ptr.<0. THEN RETURN 0
1930     IF Ptr.+Size.<>Synkpos. THEN RETURN 0 ! Kan {ndras till bara "<", f|r friare s|kning
1940     POSIT #F,Ptr. : GET #F I$ COUNT 46
1950     IF LEFT$(I$,4)<>"PK"+CHR$(1,2) THEN RETURN 0
1960     IF FNUs.(FNCvti(MID$(I$,29,2)))+FNUs.(FNCvti(MID$(I$,31,2)))+FNUs.(FNCvti(MID$(I$,33,2)))+46.>Size. THEN RETURN 0
1970   IF 0 WEND 
1980   POSIT #F,Synkpos.
1990   RETURN 1
2000   RETURN 0
2010 FNEND 
2020 ! 
2030 DEF FNRatio(C.,O.) LOCAL R.
2040   IF O.>0. THEN R.=(O.-C.)/O.*100. ELSE RETURN 0
2050   IF INT(R.)<R. THEN RETURN INT(R.)+1. ELSE RETURN INT(R.)
2060 FNEND 
2070 ! 
2080 DEF FNFdisp(F,L) LOCAL I$=50,Bl
2090   Bl=50
2100   WHILE L>Bl OR L<0
2110     GET #F I$ COUNT Bl : ; FNFilter$(I$,0);
2120     IF FNAvbryt THEN ; "-Avbrutet-" : RETURN -1
2130   L=L-Bl : WEND 
2140   GET #F I$ COUNT L : ; FNFilter$(I$,1);
2150   RETURN 0
2160 FNEND 
2170 ! 
2180 DEF FNCvtl.(S$)=ASCII(S$)+256.*(ASCII(RIGHT$(S$,2))+256.*(ASCII(RIGHT$(S$,3))+256.*ASCII(RIGHT$(S$,4)))) 
2190 DEF FNCvti(S$)=ASCII(S$)+SWAP%(ASCII(RIGHT$(S$,2))) 
2200 DEF FNZ$(N)=STRING$(1 AND N<10,48)+NUM$(N) 
2210 DEF FNZ4$(S$)=STRING$(4-LEN(S$),48)+S$ 
2220 DEF FNUs.(N) : IF N<0 THEN RETURN 65536.+N ELSE RETURN N
2230 FNEND 
2240 ! 
2250 DEF FNHjust$(S$,N)
2260   IF LEN(S$)<N THEN RETURN SPACE$(N-LEN(S$))+S$ ELSE RETURN S$
2270 FNEND 
2280 ! 
2290 DEF FNFilter$(S$,Strip) LOCAL T$=50,P,K,L,I$=10,O$=11
2300   T$=S$
2310   IF Strip=0 THEN L=LEN(T$)
2320   WHILE Smsdos
2330     ! BasicII/PC
2340     P=LEN(T$) : WHILE P
2350       K=ASCII(RIGHT$(T$,P))
2360       IF K<32 OR K>254 THEN MID$(T$,P,1)="."
2370       IF K<>32 AND L=0 THEN L=P
2380     P=P-1 : WEND 
2390     RETURN LEFT$(T$,L)
2400   WEND 
2410   ! 7-bittars-system, dvs ABC eller DNIX
2420   I$=CHR$(134,132,148,130,129,143,142,153,144,154)
2430   O$=CHR$(46,125,123,124,96,126,93,91,92,64,94)
2440   P=LEN(T$) : WHILE P
2450     K=ASCII(RIGHT$(T$,P))
2460     IF K<32 OR K>126 THEN Z=INSTR(1,I$,CHR$(K)) : MID$(T$,P,1)=MID$(O$,Z+1,1)
2470     IF K<>32 AND L=0 THEN L=P
2480   P=P-1 : WEND 
2490   RETURN LEFT$(T$,L)
2500 FNEND 
2510 ! 
2520 DEF FNCaps$(S$) LOCAL T$=160,P,K
2530   T$=S$
2540   P=LEN(T$) : WHILE P
2550     K=ASCII(RIGHT$(T$,P))
2560     IF K>=96 AND K<=126 THEN MID$(T$,P,1)=CHR$(K-32)
2570   P=P-1 : WEND 
2580   RETURN T$
2590 FNEND 
2600 ! 
2610 DEF FNAvbryt LOCAL G$=1
2620   WHILE SYS(5)>127
2630     GET G$ : IF INSTR(1,CHR$(192,3,4,15,27),G$) THEN RETURN -1
2640   WEND 
2650   RETURN 0
2660 FNEND 
2670 ! 
2680 DEF FNSida(Rader) LOCAL G$=1
2690   IF Rader<21 THEN RETURN Rader
2700   ; "Tryck RETURN ";
2710   GET G$
2720   ; CHR$(13);
2730   IF ASCII(G$)=9 OR G$=" " THEN RETURN Rader
2740   IF ASCII(G$)=13 OR ASCII(G$)=10 THEN RETURN 0
2750   RETURN -1
2760 FNEND 
2770 ! 
2780 ! Synnerligen maskinberoende.
2790 DEF FNFillen.(F,F$) LOCAL Length.,X$=40,F2$=256
2800   WHILE Sdnix
2810     ! DBASIC-V, DNIX
2820     F2$=F$+CHR$(0)
2830     X$=STRING$(40,0)
2840     Z=Request(18,VARPTR(F2$),VARPTR(X$)) ! stat()
2850     IF Z=-1 THEN RETURN 0.
2860     RETURN CVT$%(MID$(X$,15,4))
2870   WEND 
2880   WHILE Smsdos
2890     ! BasicII/PC
2900     Z=FNGetlu(F)
2910     IF PEEK(Z+19)=0 THEN RETURN 0. ! Ingen MSDOS-handle
2920     Length.=FNUs.(PEEK2(Z+15))+65536.*FNUs.(PEEK2(Z+17))
2930     RETURN Length.
2940   WEND 
2950   ! ABC
2960   ! (F|r monitorn: Vet vi redan var FILEID-sektorn ligger, s} anv{nd den
2970   ! uppgiften i st{llet, men r{kna inte med den sektorn.)
2980   ! Jag n|jer mig med att ge l{ngden f|r senast anv{nda DOS-fil.
2990   Length.=253.*FNUs.(PEEK2(64778))
3000   ! Kolla att det verkligen funkar p} denna DOS-version.
3010   ON ERROR GOTO 3040 : POSIT #F,Length. : GET #F X$
3020   ; "DOS-trubbel. PEEK2(64778) ger inte filens l{ngd."
3030   RETURN 0.
3040   RETURN Length.
3050 FNEND 
3060 ! 
3070 DEF FNGetlu(F) LOCAL A
3080   A=PEEK2(65344)
3090   WHILE A : IF PEEK(A+2)=F THEN RETURN A ELSE A=PEEK2(A) : WEND 
3100   RETURN -1
3110 FNEND