1 REM Ins{nd av Kristoffer Eriksson <5357> 1989-06-08 00.38.46 (KERMIT) 10 ! save LZHLIST 20 ! Av Kristoffer Eriksson <5357>, 1989-06-08 00:13 30 ! F|r ABC-Basic-II & BasicII/PC & DNIX-Basic-V. 40 ! Listar inneh}ll i LHARC:s LZH-filer fr}n PC-v{rlden. Fungerar {ven p} 50 ! sj{lvuppackande LHARC-arkiv. B|r {ven klara arkiv fr}n programmet LARC. 60 ! F}r fritt kopieras i ickekommersiella syften. 70 ! 80 ! Vid |verf|ring till PC, se till att ][\ |vers{tts. Vid inladdning i 90 ! BasicII/PC, blir det felmeddelande p} en rad med "REQUEST", men det 100 ! g|r inget. Bara strunta i det. Den raden anv{nds inte p} PC. 110 ! 120 ! F|r DNIX, kan man avkommentera "LONG INT" h{r nedan, och "MODE 0" p} 130 ! OPEN n}got l{ngre ned, men det {r inget krav att s} sker. 140 ! 150 ! Ytterligare omkonfigurering f|r icke-ABC kan g|ras i FNLzhscan med 160 ! variabeln Bl f|r blockstorlek. FNSdisp och FNFilter arbetar med en 170 ! viss godtycklig maxl{ngd p} delstr{ngar. 180 ! 190 ! Till skillnad mot alla andra arkiveringsprogram, rapporterar LHARC i 200 ! kolumnen "Ratio", hur stor den krympta filen {r j{mf|rt med originalet 210 ! (i procent), och dessutom med en decimal. \vriga program rapporterar hur 220 ! m}nga procent som har krympts bort i st{llet. F|r att passa ihop med de 230 ! |vriga programmen i XXXLIST-serien, visar LZHLIST krympningsgraden, och 240 ! utan decimal. 250 ! 260 ! LHARC har ocks} ett lite konstigt s{tt att lista filattributen. "A" 270 ! {r arkiverings-attributet, "s" {r systemfil, "h" {r dold fil, och "w" 280 ! {r skrivbar fil medan "o" {r skrivskyddad, normalt kallat "read-only". 290 ! 300 ! Typ-kolumnen anger packningsmetod. "-lh0-" {r ingen packning, och 310 ! "-lh1-" {r den normala packningen f|r LHARC. 320 ! 330 INTEGER : EXTEND : DIGITS 7 ! NO RESUME 340 ! LONG INT 350 ! 360 ! Identifiera system. ARGV$ {r en inbyggd funktion i D-Basic-V. Vi f|rut- 370 ! s{tter att den anv{nds p} DNIX. Minnesm{ngden SYS(2) i BasicII/PC {r 380 ! st|rre {n vad den kan vara i ABC, men blir negativ eftersom bara 16-bits 390 ! heltal anv{nds. Annars antar vi det {r en ABC. 400 IF Argv$(1)<>"" THEN Sdnix=-1 ELSE IF SYS(2)<0 THEN Smsdos=-1 ELSE Sabc=-1 410 ! 420 ! 430 ; "-*---- Lista inneh}ll i LHARC-arkiv ----*-" 440 INPUT "Filnamn: "F$ 450 IF F$="" THEN 560 ! END 460 IF INSTR(1,F$,".")=0 THEN F$=F$+".lzh" 470 IF NOT Sdnix THEN F$=FNCaps$(F$) 480 ON ERROR GOTO 500 : OPEN F$ AS FILE 1 ! MODE 0% 490 WHILE 0 500 IF ERRCODE=21 OR ERRCODE=2 THEN ; F$ " finns inte." ELSE ; "Felkod" ERRCODE "p} " F$ "." 510 GOTO 440 520 WEND 530 ; 540 Z=FNLharclist(1,F$,7) 550 CLOSE 1 560 END 570 ! 580 ! Lista arkiv. Vilka: bit 0 = arkivkommentar, 1 = fil-kom, 2 = fildata. 590 DEF FNLharclist(F,F$,Vilka) 600 ON ERROR GOTO 670 610 ; "Unders|ker: " F$ 620 IF (Vilka AND 6)=0 THEN RETURN 0 630 IF INSTR(1,F$,".COM") OR INSTR(1,F$,".EXE") THEN IF FNLzhscan(F,0) THEN ; : ; "Verkar inte vara n}got sj{lvuppackande arkiv." : RETURN 0 640 ; 650 RETURN FNLharc(F,Vilka) 660 ! 670 IF ERRCODE=34 OR ERRCODE=38 OR ERRCODE=50 THEN ; "F|r tidigt slut p} filen." ELSE ; "Felkod" ERRCODE 680 RETURN 0 690 FNEND 700 ! 710 ! Lista uppgifter enligt Vilka: bit 1 = filkommentarer, bit 2 = fildata. 720 DEF FNLharc(F,Vilka) LOCAL Naml,Attr,Crc,Csize.,Osize.,Csizes.,Osizes.,Datum,Tid,Filer,Rader,I$=255 730 WHILE 1 740 IF FNAvbryt THEN ; "-Avbrutet-" : RETURN 0 750 Rader=FNSida(Rader) : IF Rader<0 THEN ; "-Avbrutet- " : RETURN 0 760 GET #F I$ COUNT 1 770 ! 780 WHILE I$=CHR$(0) ! Slut 790 ; "------------ -------- -------- ------" 800 ; NUM$(Filer) " filer" FNHjust$(NUM$(Osizes.),16-LEN(NUM$(Filer))) FNHjust$(NUM$(Csizes.),10) FNHjust$(NUM$(FNRatio(Csizes.,Osizes.)),5) "%" 810 RETURN 0 820 WEND 830 ! 840 GET #F I$ COUNT ASCII(I$)+1 850 IF ASCII(I$)<>(FNSumstring(RIGHT$(I$,2)) AND 255) OR LEN(I$)<21 THEN 1180 860 Csize.=FNCvtl.(MID$(I$,7,4)) 870 Osize.=FNCvtl.(MID$(I$,11,4)) 880 Tid=FNCvti(MID$(I$,15,2)) 890 Datum=FNCvti(MID$(I$,17,2)) 900 Attr=FNCvti(MID$(I$,19,2)) 910 Naml=ASCII(RIGHT$(I$,21)) 920 IF Naml+23>LEN(I$) THEN 1180 930 Crc=FNCvti(MID$(I$,22+Naml,2)) 940 ! 950 Csizes.=Csizes.+Csize. 960 Osizes.=Osizes.+Osize. 970 Filer=Filer+1 980 ! 990 WHILE Filer=1 1000 ; "Namn L{ngd Storl nu Krympt Datum Tid Attr Typ CRC" 1010 ; "------------ -------- -------- ------ -------- -------- ---- ----- ----" 1020 Rader=4 1030 IF 0 WEND 1040 ! 1050 WHILE Vilka AND 4 1060 ! Fildata 1070 Z=FNSdisp(MID$(I$,22,Naml)) : IF Naml>12 THEN ; : Naml=0 : Rader=Rader+1 1080 ; FNHjust$(NUM$(Osize.),22-Naml) FNHjust$(NUM$(Csize.),10) FNHjust$(NUM$(FNRatio(Csize.,Osize.)),5) "% "; 1090 IF Datum<>0 THEN ; FNZ$((SWAP%(Datum) AND 255)/2+80) "-" FNZ$((Datum AND 480)/32) "-" FNZ$(Datum AND 31) " "; ELSE ; " "; 1100 ; FNZ$((SWAP%(Tid) AND 248)/8) ":" FNZ$((Tid AND 2016)/32) ":" FNZ$(Tid*2 AND 63) " "; 1110 ; MID$("-a",(Attr/32 AND 1)+1,1) MID$("---hs-sh",(Attr AND 6)+1,2) MID$("wo",(Attr AND 1)+1,1); 1120 ; " " FNFilter$(MID$(I$,2,5),0) " " FNZ4$(HEX$(Crc)) 1130 Rader=Rader+1 1140 IF 0 WEND 1150 POSIT #F,POSIT(F)+Csize. 1160 ! 1170 WHILE 0 ! Formatfel 1180 IF Filer=0 THEN ; "Kanske inget arkiv? S|ker..." ELSE ; "Trasigt arkiv. S|ker..." 1190 POSIT #F,POSIT(F)-LEN(I$) 1200 IF FNLzhscan(F,1) THEN RETURN 1 1210 WEND 1220 WEND 1230 FNEND 1240 ! 1250 ! S|k efter lovande header, med formen ?-lh?-. S|ker max 5 kB. 1260 ! 3 kB skulle r{cka f|r nuvarande sj{lvuppackande filer. Blir 0 om Ok. 1270 ! Ingen felhantering. Skriver meddelanden om V(erbose). 1280 DEF FNLzhscan(F,V) LOCAL I$=253,J$=6,P,Bl,Hopp. 1290 Bl=253 1300 WHILE Hopp.<5120. 1310 IF FNAvbryt THEN ; "-Avbrutet-" : RETURN 2 1320 Z=INT((POSIT(F)+Bl)/Bl)*Bl-POSIT(F) ! Synka med sektorer p} ABC. P} andra kan Z=Bl anv{ndas om man vill. 1330 IF Z<7 THEN Z=7 1340 GET #F I$ COUNT Z 1350 P=2 : WHILE P 1360 P=INSTR(P+1,J$+I$,"-lh") 1370 IF P THEN IF MID$(I$,P+4-LEN(J$),1)="-" IF ASCII(RIGHT$(J$+I$,P-2))<>0 THEN 1450 1380 WEND 1390 IF LEN(I$)>=6 THEN J$=RIGHT$(I$,LEN(I$)-5) ELSE J$=I$ 1400 Hopp.=Hopp.+LEN(I$) 1410 WEND 1420 IF V THEN ; "Nu ger jag upp!" 1430 RETURN 1 1440 ! 1450 IF V THEN ; "Hoppade |ver" Hopp.-LEN(J$)+P-3. "bytes." 1460 POSIT #F,POSIT(F)-LEN(I$)-LEN(J$)+P-3 : RETURN 0 1470 FNEND 1480 ! 1490 DEF FNSumstring(S$) LOCAL I,G 1500 I=LEN(S$) : WHILE I : G=G+ASCII(RIGHT$(S$,I)) : I=I-1 : WEND : RETURN G 1510 FNEND 1520 ! 1530 DEF FNSdisp(S$) LOCAL Bl 1540 Bl=50 : Z=1 1550 WHILE LEN(S$)-Z+1>Bl : ; FNFilter$(MID$(S$,Z,Bl),0); : Z=Z+Bl : WEND 1560 ; FNFilter$(RIGHT$(S$,Z),1); 1570 RETURN 0 1580 FNEND 1590 ! 1600 DEF FNRatio(C.,O.) LOCAL R. 1610 IF O.>0. THEN R.=(O.-C.)/O.*100. ELSE RETURN 0 1620 IF INT(R.)254 THEN MID$(T$,P,1)="." 1840 IF K<>32 AND L=0 THEN L=P 1850 P=P-1 : WEND 1860 RETURN LEFT$(T$,L) 1870 WEND 1880 ! 7-bittars-system, dvs ABC eller DNIX 1890 I$=CHR$(134,132,148,130,129,143,142,153,144,154,13,10) 1900 O$=CHR$(46,125,123,124,96,126,93,91,92,64,94,13,10) 1910 P=LEN(T$) : WHILE P 1920 K=ASCII(RIGHT$(T$,P)) 1930 IF K<32 OR K>126 THEN Z=INSTR(1,I$,CHR$(K)) : MID$(T$,P,1)=MID$(O$,Z+1,1) 1940 IF K<>32 AND L=0 THEN L=P 1950 P=P-1 : WEND 1960 RETURN LEFT$(T$,L) 1970 FNEND 1980 ! 1990 DEF FNCaps$(S$) LOCAL T$=160,P,K 2000 T$=S$ 2010 P=LEN(T$) : WHILE P 2020 K=ASCII(RIGHT$(T$,P)) 2030 IF K>=96 AND K<=126 THEN MID$(T$,P,1)=CHR$(K-32) 2040 P=P-1 : WEND 2050 RETURN T$ 2060 FNEND 2070 ! 2080 DEF FNAvbryt LOCAL G$=1 2090 WHILE SYS(5)>127 2100 GET G$ : IF INSTR(1,CHR$(192,3,4,15,27),G$) THEN RETURN -1 2110 WEND 2120 RETURN 0 2130 FNEND 2140 ! 2150 DEF FNSida(Rader) LOCAL G$=1 2160 IF Rader<21 THEN RETURN Rader 2170 ; "Tryck RETURN "; 2180 GET G$ 2190 ; CHR$(13); 2200 IF ASCII(G$)=9 OR G$=" " THEN RETURN Rader 2210 IF ASCII(G$)=13 OR ASCII(G$)=10 THEN RETURN 0 2220 RETURN -1 2230 FNEND