10 ! LIST LIBFIL.BAS
20 ! **********************************************************************
30 ! Program          LIBRUTIN.BAS     Utg}va  1.01     1986-05-04
40 ! av Bo Kullmar
50 ! Ins{nd av Bo Kullmar SYSOP <1789>    1986-05-04 23.34.15
60 ! F|r ABC800M ABC800C ABC802 ABC806
70 ! F|r disk med UFD-DOS
80 ! Testad p} ABC806/802
90 ! LIB-rutin f|r UFD-DOS. Klarar olika MFD s}v{l som UFD. Ej avsett f|r
100 ! LUX-NET DOS. Enbart testad p} MF-drive.
109 ! --------------------------------------------------------------------
111 ! Det var just det jag ville ha. Ett LIB-program som kunde skicka ut
112 ! inneh}llet p} fil, med filnamn och storlek i en kolumn.
113 ! Rutinen LIBRUTIN.BAS inneh|ll en bra stomme som jag {ndrade litet i
114 ! 1988-11-05.0957 <2776> Bengt Sandgren.
120 ! --------------------------------------------------------------------
1000 ! Initiering -----------------------------------
1010 INTEGER : EXTEND 
1020 ! 
1030 ! Huvudrutin -----------------------------------
1040 Dummy=FNIngress
1050 Dummy=FNInit
1060 END 
1070 ! 
2000 DEF FNInit
2010   DIM Dosbuff$=0 : POKE VAROOT(Dosbuff$),0,1,0,245,0,1
2020   IF PEEK(24688)<>0 ; 'Programmet {r ENBART avsett f|r UFD-DOS!' : STOP 
2030   INPUT 'Ange inputenhet: 'Enhet$
2040   Drive=FNEnhcs(FNVersal$(Enhet$))
2050   IF Drive=-1 ; 'Disken ' Enhet$ ' finns ej!' CHR$(7) : GOTO 2030
2060   INPUT 'Ange utenhet: 1 f|r CON: -  2 f|r fil 'Utenh$
2070   IF VAL(Utenh$)=2 Utf=99 ELSE Utf=0
2080   IF Utf=0 OPEN "CON:" AS FILE Utf ELSE PREPARE "libfil.txt" AS FILE Utf
2090   IF FNReadlib(Drive) ; 'Avbrytes p} grund av fel!'
2100   RETURN 0
2110 FNEND 
2120 ! 
3000 DEF FNReadsec(Disk,Sec)
3010   ! L{s en sektor till Dosbuff 0 vilken man sedan kan kolla }t i Dosbuff$
3020   POKE SYS(10)-511,Disk
3030   Dummy=CALL(24678,Sec)
3040   IF FNDiscerror RETURN -1
3050   RETURN 0
3060 FNEND 
3070 ! 
4000 DEF FNDiscerror LOCAL I
4010   RESTORE 4080
4020   WHILE I<4
4030     READ Kod,Text$
4040     IF (PEEK(SYS(10)-491) AND Kod) ; CHR$(7) Text$ : RETURN -1
4050     I=I+1
4060   WEND 
4070   RETURN 0
4080   DATA 8, 'Checksummafel'
4090   DATA 16, 'D}lig disk'
4100   DATA 64, 'Skivan skrivskyddad'
4110   DATA 128,'Luckan |ppen'
4120 FNEND 
4130 ! 
5000 DEF FNReadlib(Drive) LOCAL Rec,Fil,Libsec,Bitmap0$=16,Bitmap1$=16,Ufd
5010   IF Drive>=0 AND Drive<=3 Drive=PEEK(PEEK2(24683))+Drive ! Ta reda p} enhet om DRX anges
5020   IF Drive>=12 AND Drive<=15 Sec=6 ELSE Sec=14 ! Bitkartan f|r MO = 6 f|r |vriga 14
5030   IF Drive=30 Drive=PEEK(65529) : Ufd=-1 : Sec=PEEK2(65527)-1 : IF Sec=-1 ; 'UFD-bibliotek {r ej aktivt!' CHR$(7) : RETURN -1
5040   ! Om drive=30 {r det ett UFD: kolla adressen till det och om det {r aktivt
5050   Rec=Sec : Libsec=1
5060   Ec=FNReadsec(Drive,Rec) : Bitmap0$=MID$(Dosbuff$,240,16) : Rec=Rec+1 : IF Ec RETURN Ec
5070   IF Ufd Bitmap1$=STRING$(16,0) ELSE Ec=FNReadsec(Drive,Rec) : Bitmap1$=MID$(Dosbuff$,240,16) : Rec=Rec+1 : IF Ec RETURN Ec
5080   IF Drive>=12 AND Drive<=15 AND NOT Ufd Rec=Rec+8
5090   ! L{s bitkartorna och kolla i vilka sektor som det finns filer
5100   WHILE Rec<Sec+17
5110     WHILE ASCII(MID$(Bitmap0$,Libsec,1))-ASCII(MID$(Bitmap1$,Libsec,1))<>0
5120       Ec=FNReadsec(Drive,Rec) : IF Ec RETURN Ec
5130       Fil=0
5140       WHILE Fil<16
5150         WHILE MID$(Dosbuff$,Fil*16+5,1)<>CHR$(255) AND MID$(Dosbuff$,Fil*16+5,1)<>CHR$(0)
5160           ; #Utf,MID$(Dosbuff$,Fil*16+5,8)+"."+MID$(Dosbuff$,Fil*16+13,3);
5170           ; #Utf USING '_   ###' CVT$%(MID$(Dosbuff$,Fil*16+3,2)) : R{kna=R{kna+1
5180         IF 0 WEND 
5190         Fil=Fil+1
5200       WEND 
5210     IF 0 WEND 
5220     Rec=Rec+1 : Libsec=Libsec+1
5230   WEND 
5240   RETURN 0
5250 FNEND 
5260 ! 
6000 DEF FNVersal$(In$) LOCAL Y,Ord$=160
6010   Y=1 : Ord$=In$
6020   IF In$='' RETURN ''
6030   WHILE Y<=LEN(Ord$)
6040     IF ASCII(MID$(Ord$,Y,1))>95 AND ASCII(MID$(Ord$,Y,1))<127 MID$(Ord$,Y,1)=CHR$(ASCII(MID$(Ord$,Y,1)) AND 223)
6050     Y=Y+1
6060   WEND 
6070   RETURN Ord$
6080 FNEND 
6090 ! 
7000 DEF FNEnhcs(Drive$) LOCAL Adrenhl,Enh$=4,Dselect
7010   ! Ta read p} cs f|r en diskenhet. Anges default s} g{ller den som {r DRX
7020   Adrenhl=PEEK2(SYS(10)+123) : IF Drive$='' RETURN PEEK(PEEK2(24683))
7030   WHILE Adrenhl<>0
7040     Enh$=CHR$(PEEK(Adrenhl+2),PEEK(Adrenhl+3),PEEK(Adrenhl+4),58)
7050     IF Enh$='CON:' OR Enh$='NUL:' OR Enh$='PR:' OR Enh$='V24:' Enh$=''
7060     Dselect=PEEK(Adrenhl+7)
7070     IF Enh$=Drive$ RETURN Dselect
7080     Adrenhl=PEEK2(Adrenhl)
7090     I=I+1
7100   WEND 
7110   RETURN -1
7120 FNEND 
7130 ! 
8000 DEF FNIngress
8010   ; CHR$(12)
8020   ; 'LIBFIL.BAC - Skriv ut filnamn och filstorlek p} sk{rm eller fil.'
8030   ; 
8040   RETURN Dummy
8050 FNEND 
8060 !