1 REM Ins{nd av Kristoffer Eriksson <5357>    1988-12-12 21.57.09 (KERMIT)
10 ! save VIDEOTX3,  1985-03-28 15.20
20 EXTEND : INTEGER : OPTION BASE 0
30 COMMON K$=36,K2$=93,K22$=93,K3$=32,K4$=320,V24$=16,Login$=160,Alth,Nrh
40 COMMON Skala,Sv{rta,Abc,Fwid,Printer,Vmarg,F{rg$=16,Sparf$=16,Prbak
50 COMMON Prk$(15)=15,Printer$=30,Namn$(19,1)=20,Tele$(19)=160,Chain$=16,Dv$=4
60 ! 
70 LET Chain$="VIDEOTXA.BAC" ! Huvudprogrammet
80 ! 
90 IF PEEK(39)=4 THEN Abc=806 ELSE Abc=802
100 Skala=0 : Sv{rta=0 ! Markera f|r huvudprogramet att initiering ej gjorts
120 Z=FNTermopt("NOCOMMON.BAS") ! Kolla att TERMOPT finns om n|dv{ndigt
130 ! 
140 Dv$=""
150 ON ERROR GOTO 250
160 PREPARE "RAM:ASEJKFG\.K7E" AS FILE 1
170 ON ERROR GOTO 
180 CLOSE 
190 KILL "RAM:ASEJKFG\.K7E"
200 IF FNCopy("","RAM:",Chain$)<>0 THEN 250
210 IF FNCopy("","RAM:","VIDEOTXB.BAC")<>0 THEN 250
220 Dv$="RAM:"
230 LET Chain$=Dv$+Chain$
240 ! 
250 ON ERROR GOTO 280 : CHAIN Chain$
260 RESUME 270
270 ON ERROR GOTO 
280 IF ERRCODE<>21 THEN ; "Fel vid l{sning av '" Chain$ "': "; : Z=FNFel(ERRCODE) : STOP 
290 ; CHR$(7) "Kan inte hitta '" Chain$ "'!"
300 IF Dv$="RAM:" THEN STOP 
310 ; "S{tt i skivan med '" Chain$ "' och tryck p} RETURN ...";
320 A$="" : WHILE A$<>CHR$(13) : GET A$ : WEND 
330 GOTO 250
340 ! 
350 ! _____
360 DEF FNCopy(D1$,D2$,F$) LOCAL X,S,Eof,N$=8096,S$=253
370   N$=" " : POKE VAROOT(N$)+4,8096,SWAP%(8096)
380   IF INSTR(1,F$,".Ufd") THEN 540
390   ; "Kopierar '" D1$+F$ "' till '" D2$ "'."
400   X=LEN(F$) : WHILE MID$(F$,X,1)=" " : X=X-1 : WEND 
410   ON ERROR GOTO 580 : OPEN D1$+LEFT$(F$,X) AS FILE 1
420   ON ERROR GOTO 590 : PREPARE D2$+LEFT$(F$,X) AS FILE 2
430   WHILE NOT Eof
440     ON ERROR GOTO 550
450     S=1 : WHILE S<8096
460       GET #1 S$ COUNT 253
470       MID$(N$,S,253)=S$
480     S=S+253 : WEND 
490     ON ERROR GOTO 570 : PUT #2 LEFT$(N$,S-1)
500   WEND 
510   CLOSE 1,2
520   RETURN 0
530   ! __
540   ; : ; "Kan inte kopiera underbibliotek. (" F$ ")"; : X=-1 : GOTO 620
550   IF INSTR(1,CHR$(34,38),CHR$(ERRCODE)) THEN Eof=-1 : RESUME 490
560   ; "Fel vid l{sning av '" D1$+F$ "': " : GOTO 600
570   ; "Fel vid skrivning p} '" D2$+F$ "': "; : GOTO 600
580   ; "Fel vid |ppning av '" D1$+F$ "': "; : GOTO 600
590   ; "Fel n{r '" D2$+F$ "' skulle skapas: "; : GOTO 600
600   X=ERRCODE : RESUME 610
610   CLOSE 
620   ; CHR$(7) ". ";
630   RETURN FNFel(X)
640 FNEND 
650 ! 
660 DEF FNFel(X) LOCAL S$=1
670   ; CHR$(7);
680   IF X<0 THEN 800
690   IF X=48 THEN ; "Fel i biblioteket."; : GOTO 800
700   IF X=35 THEN ; "Kontrollsummafel vid l{sning."; : GOTO 800
710   IF X=36 THEN ; "Kontrollsummafel vid skrivning."; : GOTO 800
720   IF X=39 THEN ; "Filen skrivskyddad."; : GOTO 800
730   IF X=40 THEN ; "Filen raderskyddad."; : GOTO 800
740   IF X=41 THEN ; "Skivan {r full."; : GOTO 800
750   IF X=42 THEN ; "Enheten ej klar."; : GOTO 800
760   IF X=42 THEN ; "Skivan skrivskyddad."; : GOTO 800
770   IF X=52 THEN ; "G}r inte p} denna enhet."; : GOTO 800
780   IF X=51 THEN ; "Enheten upptagen."; : GOTO 800
790   ; "ERROR" ERRCODE ".";
800   ! 
810   RETURN X
820 FNEND 
830 ! 
840 DEF FNTermopt(Chain$) LOCAL I
850   IF Abc<>806 THEN RETURN 0
860   IF PEEK(PEEK2(116)+3)<>195 THEN 880
870   IF PEEK2(PEEK2(116)+4)<>0 THEN RETURN 0
880   I=1 : WHILE I<=LEN(Chain$)+1
890     POKE 64512+I,ASCII(MID$(Chain$+CHR$(255),I,1))
900   I=I+1 : WEND 
910   ON ERROR GOTO 950 : OPEN "ADDTERM.ABS" AS FILE 1 : CLOSE 
920   ON ERROR GOTO 930 : CHAIN "TERMOPT"
930   ; "Kan inte hitta programmet TERMOPT.BAC"
940   STOP 
950   ; "Kan inte hitta programmet ADDTERM.ABS"
960   STOP 
970 FNEND