REM Dichiarazione del tipo di dati necessario per le chiamate agli interrupt
TYPE RegTypeX
   AX    AS INTEGER
   BX    AS INTEGER
   CX    AS INTEGER
   DX    AS INTEGER
   BP    AS INTEGER
   SI    AS INTEGER
   DI    AS INTEGER
   Flags AS INTEGER
   DS    AS INTEGER
   ES    AS INTEGER
END TYPE
DIM SHARED Reg AS RegTypeX

REM Dichiarazione delle subroutine e delle funzioni utilizzate
DECLARE SUB Interrupt (IntNum AS INTEGER, InReg AS RegTypeX, OutReg AS RegTypeX)
DECLARE SUB InterruptX (IntNum AS INTEGER, InReg AS RegTypeX, OutReg AS RegTypeX)
DECLARE FUNCTION Environment$ ()
DECLARE FUNCTION CounterTime& ()
DECLARE SUB EnvList (FileName AS STRING)
DECLARE FUNCTION CDVer% (Drive AS INTEGER)
DECLARE SUB GetDriveInfo (Drive AS INTEGER)
DECLARE FUNCTION Group$ (Value AS STRING)
DECLARE FUNCTION Env$ ()
DECLARE FUNCTION BootRead$ (Drive AS INTEGER)
DECLARE FUNCTION DriveParameterBlock$ (Drive AS INTEGER)
DECLARE SUB DPBParse (DPB AS STRING)
DECLARE FUNCTION Transform$ (Address AS STRING)
DECLARE SUB FATRead (Drive AS INTEGER)
DECLARE FUNCTION RootRead$ (Drive AS INTEGER)
DECLARE FUNCTION ExePath$ ()
DECLARE FUNCTION GetFileCount& (FileSpec AS STRING)
DECLARE FUNCTION CMOSImage$ ()
DECLARE FUNCTION TSRRead$ ()
DECLARE FUNCTION Conteggio% (Token AS STRING)
DECLARE SUB SuddividiStringa (Token AS STRING)
DECLARE FUNCTION Sort$ (Token AS STRING, Dir AS INTEGER)
DECLARE FUNCTION MemoryType$ ()
DECLARE FUNCTION CirrusLogicMemorySize% ()
DECLARE FUNCTION PSPCommand$ ()
DECLARE FUNCTION Mirror$ (Token AS STRING)
DECLARE SUB PermutazioneCiclica (Cycl AS INTEGER)
DECLARE FUNCTION Mul$ (F1 AS STRING, F2 AS STRING)
DECLARE FUNCTION Code$ (Expr AS STRING)
DECLARE FUNCTION Decode$ (Expr AS STRING)
DECLARE SUB PaletteRotate (Dir AS INTEGER, Times AS INTEGER)
DECLARE SUB FadeOut (Delay AS INTEGER)

REM Analisi del sistema operativo
PRINT Environment$

REM Lettura del contatore dell'ora
PRINT "Sono trascorsi"; Group$(STR$(CounterTime&)); "multipli interi di 1/18.2 secondi dalla mezzanotte."

REM Lettura delle variabili d'ambiente
EnvList Env$ + "Environ.Img"

REM Lettura di alcuni dati del drive specificato
10 INPUT "Specifica un drive: ", Drive$
IF LEN(Drive$) <> 2 THEN 10
IF ASC(RIGHT$(Drive$, 1)) <> 58 THEN 10
IF ASC(UCASE$(Drive$)) < 65 THEN 10
IF ASC(UCASE$(Drive$)) > 92 THEN 10
GetDriveInfo ASC(UCASE$(Drive$)) - 64 + 26 * CDVer%(ASC(UCASE$(Drive$)) - 65)
OPEN Env$ + LEFT$(Drive$, 1) + "Boot.Img" FOR OUTPUT AS #1
   PRINT #1, BootRead$(ASC(UCASE$(Drive$)) - 65);
CLOSE
IF CDVer%(ASC(UCASE$(Drive$)) - 65) = 0 THEN
   DPB$ = DriveParameterBlock$(ASC(UCASE$(Drive$)) - 64)
   DPBParse DPB$
   FATRead ASC(UCASE$(Drive$)) - 65
   OPEN Env$ + LEFT$(Drive$, 1) + "Root.Img" FOR OUTPUT AS #1
      PRINT #1, RootRead$(ASC(UCASE$(Drive$)) - 65);
   CLOSE
END IF

REM Specificazione del percorso del file eseguibile
Check$ = ExePath$
PRINT "Percorso del file eseguibile: "; Check$

REM Conteggio dei files presenti nella directory corrente
FileSpec$ = "*.*"
PRINT GetFileCount&(FileSpec$); "files presenti nella directory corrente"

REM Copia del contenuto della CMOS in un file
OPEN Env$ + "CMOS.IMG" FOR OUTPUT AS #1
   PRINT #1, CMOSImage$;
CLOSE

REM Elencazione in ordine alfabetico dei TSR presenti in memoria in un file
Counter% = Conteggio%(TSRRead$)
DIM SHARED Argument(1 TO Counter%) AS STRING
OPEN Env$ + "Memory.Img" FOR OUTPUT AS #1
   PRINT #1, Sort$(TSRRead$, 1);
CLOSE
ERASE Argument$

REM Visualizza la stringa identificativa del tipo di memoria installata
PRINT "Tipo di memoria installata: "; MemoryType$

REM Lettura di alcune informazioni dalla scheda grafica Cirrus Logic
PRINT CirrusLogicMemorySize%; "KB di memoria video presenti sulla scheda grafica"

REM Autotest per le stampanti Hewlett Packard DeskJet
PRINT "Vuoi eseguire l'autotest della stampante? _";
Answer$ = INPUT$(1)
IF LCASE$(Answer$) = CHR$(115) THEN LPRINT MKI$(31259)
PRINT

REM Controllo di omogeneit… di una stringa
INPUT "Immetti una stringa di cui verificare l'omogeneit…: ", Omog$
IF LEN(Omog$) THEN
   IF Omog$ = STRING$(LEN(Omog$), ASC(Omog$)) THEN
      PRINT "La stringa Š omogenea"
   ELSE
      PRINT "La stringa Š disomogenea"
   END IF
END IF

REM Immissione della stringa da suddividere se la linea di comando non soddisfa i parametri richiesti
IF LEN(LTRIM$(PSPCommand$)) THEN
   Token$ = MID$(PSPCommand$, 2)
   PRINT "Token$= "; Token$
ELSE
   INPUT "Immetti la stringa da suddividere: ", Token$
END IF

REM Creazione del vettore contenente gli argomenti della stringa Token$
Counter% = Conteggio%(Token$)
IF Counter% THEN
   DIM SHARED Argument(1 TO Counter%) AS STRING
   SuddividiStringa Token$
   PRINT LEN(Token$); "caratteri e"; Counter%; "argomenti"
   PRINT "Mirror$= "; Mirror$(Token$)
END IF

REM Permutazione ciclica oraria o antioraria degli argomenti
IF Counter% THEN
   INPUT "Valore della permutazione ciclica: ", Cycl%
   PermutazioneCiclica Cycl%
END IF

REM Stampa su schermo degli argomenti eventualmente permutati
FOR Index% = 1 TO Counter%
   PRINT Argument$(Index%)
NEXT

REM Moltiplicazione di 2 numeri interi codificati come stringhe (eventualmente con un punto ogni 3 cifre)
DO
   INPUT "Immetti un primo numero intero lungo a piacere: ", F1$
LOOP UNTIL LEN(F1$) <> 0
INPUT "Immetti la sua eventuale parte frazionaria (anche nulla): ", Frac1$
DO
   INPUT "Immetti un secondo numero: ", F2$
LOOP UNTIL LEN(F2$) <> 0
INPUT "Immetti la sua eventuale parte frazionaria (anche nulla): ", Frac2$
IF LEN(Frac1$) THEN F1$ = F1$ + CHR$(44) + Frac1$
IF LEN(Frac2$) THEN F2$ = F2$ + CHR$(44) + Frac2$
Prod$ = Mul$(F1$, F2$)
PRINT Prod$
PRINT "Vuoi salvare il contenuto del calcolo in un file? _";
Answer$ = INPUT$(1)
IF ASC(UCASE$(Answer$)) = 83 THEN
   OPEN Env$ + "Moltipl.Dat" FOR OUTPUT AS #1
      PRINT #1, "Primo fattore: "; F1$
      PRINT #1, "Secondo fattore: "; F2$
      PRINT #1, "Prodotto:"; Prod$
      PRINT #1, "Prodotto codificato:"; Code$(Prod$)
      PRINT #1, "Prodotto codificato e ridecodificato:"; Decode$(Code$(Prod$))
   CLOSE
END IF
PRINT

REM Rotazione della palette e diminuzione dell'intensit… dei colori fino al nero
INPUT "Valore per la rotazione della palette: ", Value%
PaletteRotate SGN(Value%), ABS(Value%)
INPUT "Immetti un valore intero per il ritardo durante il fading: ", Delay%
IF Delay% = 0 THEN Delay% = 400
FadeOut Delay%
SCREEN 1

FUNCTION BootRead$ (Drive AS INTEGER)

REM Legge il boot sector del drive specificato

IF CDVer%(Drive%) = 0 THEN
   Temp$ = SPACE$(512)
   Packet$ = MKL$(0) + MKI$(1) + MKL$(SSEGADD(Temp$))
   Reg.AX = Drive%
   Reg.CX = &HFFFF
   Reg.DS = SSEG(Packet$)
   Reg.BX = SADD(Packet$)
   InterruptX &H25, Reg, Reg
ELSE
   Temp$ = SPACE$(2048)
   Reg.AX = &H1508
   Reg.ES = SSEG(Temp$)
   Reg.BX = SADD(Temp$)
   Reg.CX = Drive%
   Reg.SI = &H0
   Reg.DI = &H10
   Reg.DX = &H1
   InterruptX &H2F, Reg, Reg
END IF
IF Reg.Flags AND 1 THEN
   BootRead$ = "Errore" + STR$(Reg.AX MOD 256)
ELSE
   BootRead$ = Temp$
END IF

END FUNCTION

FUNCTION CDVer% (Drive AS INTEGER)

REM Rileva se il drive specificato Š un CD-ROM

Reg.AX = &H1500
Reg.BX = &H0
InterruptX &H2F, Reg, Reg
FOR Index% = 0 TO Reg.BX - 1
   IF Reg.CX + Index% = Drive% THEN
      CDVer% = 1
      EXIT FOR
   END IF
NEXT

END FUNCTION

FUNCTION CirrusLogicMemorySize%

REM Acquisisce la quantit… di memoria a bordo di una scheda grafica Cirrus Logic

Reg.AX = &H1200
Reg.BX = &H85
Interrupt &H10, Reg, Reg
CirrusLogicMemorySize% = ((Reg.AX AND &HFFFF&) MOD 256) * 64

END FUNCTION

FUNCTION CMOSImage$

REM Legge il contenuto della CMOS

Temp$ = SPACE$(128)
FOR Index% = 0 TO &H7F
   OUT &H70, Index%
   MID$(Temp$, Index% + 1, 1) = CHR$(INP(&H71))
NEXT
CMOSImage$ = Temp$

END FUNCTION

FUNCTION Code$ (Expr AS STRING)

REM Codifica una stringa numerica dimezzandone le dimensioni

FOR I% = 1 TO LEN(Expr$) STEP 2
   V1% = VAL(MID$(Expr$, I%, 1))
   SELECT CASE ASC(MID$(Expr$, I%, 1))
      CASE 46: V1% = 10
      CASE 44: V1% = 11
      CASE 32: V1% = 12
      CASE 45: V1% = 13
   END SELECT
   IF I% <> LEN(Expr$) THEN
      V2% = VAL(MID$(Expr$, I% + 1, 1))
      SELECT CASE ASC(MID$(Expr$, I% + 1, 1))
         CASE 46: V2% = 10
         CASE 44: V2% = 11
         CASE 32: V2% = 12
         CASE 45: V2% = 13
      END SELECT
   ELSE
      V2% = 15
   END IF
   Temp$ = Temp$ + CHR$(V1% + V2% * 16)
NEXT
Code$ = Temp$

END FUNCTION

FUNCTION Conteggio% (Token AS STRING)

REM Conteggio del numero degli argomenti

Flag% = 1
FOR Index% = 1 TO LEN(Token$)
   IF MID$(Token$, Index%, 1) = CHR$(32) THEN Flag% = 1
   IF MID$(Token$, Index%, 1) <> CHR$(32) AND Flag% = 1 THEN
      Counter% = Counter% + 1
      Flag% = 0
   END IF
NEXT
Conteggio% = Counter%

END FUNCTION

FUNCTION CounterTime&

DEF SEG = 0
   CounterTime& = PEEK(&H46E) * 65536 + PEEK(&H46D) * 256& + PEEK(&H46C)
DEF SEG

END FUNCTION

FUNCTION Decode$ (Expr AS STRING)

REM Decodifica un numero cifrato

FOR I! = 1 TO LEN(Expr$) + .5 STEP .5
   IF INT(I!) <> I! THEN
      V% = ASC(MID$(Expr$, INT(I!))) \ 16
   ELSE
      V% = ASC(MID$(Expr$, I!)) MOD 16
   END IF
   IF V% > 9 THEN
      SELECT CASE V%
         CASE 10: Temp$ = Temp$ + CHR$(46)
         CASE 11: Temp$ = Temp$ + CHR$(44)
         CASE 12: Temp$ = Temp$ + CHR$(32)
         CASE 13: Temp$ = Temp$ + CHR$(45)
         CASE ELSE:
            IF V% <> 15 OR I! <> LEN(Expr$) + .5 THEN
               Decode$ = CHR$(7) + "Codice non valido" + CHR$(13) + "Errore irreversibile"
               EXIT FUNCTION
            END IF
      END SELECT
   ELSE
      Temp$ = Temp$ + CHR$(V% + 48)
   END IF
NEXT
Decode$ = Temp$

END FUNCTION

SUB DPBParse (DPB AS STRING)

REM Interpreta il drive parameter block byte per byte

OPEN Env$ + CHR$(ASC(LEFT$(DPB$, 1)) + 65) + "DPBDesc.Img" FOR OUTPUT AS #1
   PRINT #1, "Numero del drive:"; ASC(LEFT$(DPB$, 1))
   PRINT #1, "Numero dell'unit… equipaggiata con device driver:"; ASC(MID$(DPB$, 2, 1))
   PRINT #1, "Numero di bytes per settore:"; CVI(MID$(DPB$, 3, 2))
   PRINT #1, "Massimo settore in un cluster:"; ASC(MID$(DPB$, 5, 1))
   PRINT #1, "Shift count per convertire i clusters in settori:"; ASC(MID$(DPB$, 6, 1))
   PRINT #1, "Numero di settori riservati all'inizio del drive:"; CVI(MID$(DPB$, 7, 2))
   PRINT #1, "Numero di FAT:"; ASC(MID$(DPB$, 9, 1))
   PRINT #1, "Numero massimo di files accettati nella root:"; CVI(MID$(DPB$, 10, 2))
   PRINT #1, "Primo settore contenente dati dell'utente:"; CVI(MID$(DPB$, 12, 2))
   PRINT #1, "Massimo cluster, ovvero numero dei clusters di dati incrementato di un'unit…:"; CVI(MID$(DPB$, 14, 2)) AND &HFFFF&
   PRINT #1, "Numero di settori per FAT:"; CVI(MID$(DPB$, 16, 2))
   PRINT #1, "Primo settore della root:"; CVI(MID$(DPB$, 18, 2))
   PRINT #1, "Indirizzo dell'intestazione del device driver: "; Transform$(MID$(DPB$, 20, 4))
   PRINT #1, "Identificatore del dispositivo:"; ASC(MID$(DPB$, 24, 1))
   IF ASC(MID$(DPB$, 25, 1)) = 0 THEN
      PRINT #1, "Dispositivo accessibile"
   ELSE
      PRINT #1, "Dispositivo non accessibile"
   END IF
   PRINT #1, "Puntatore al Drive Parameter Block successivo: "; Transform$(MID$(DPB$, 26, 4))
   PRINT #1, "Cluster dal quale iniziare la ricerca di spazio libero per la scrittura, di solito equivalente all'ultimo cluster allocato:"; CVI(MID$(DPB$, 30, 2)) AND &HFFFF&
   PRINT #1, "Numero dei cluster liberi sul drive:";
   IF CVI(RIGHT$(DPB$, 2)) <> &HFFFF THEN
      PRINT #1, CVI(RIGHT$(DPB$, 2)) AND &HFFFF&
   ELSE
      PRINT #1, " Sconosciuto"
   END IF
CLOSE

END SUB

FUNCTION DriveParameterBlock$ (Drive AS INTEGER)

REM Legge la struttura del drive specificato

Reg.AX = &H3200
Reg.DX = Drive%
InterruptX &H21, Reg, Reg
IF Reg.AX MOD 256 = 0 THEN
   Temp$ = SPACE$(33)
   OffSet% = Reg.BX
   DEF SEG = Reg.DS
      FOR Index% = 1 TO 33
         MID$(Temp$, Index%, 1) = CHR$(PEEK(OffSet% + Index% - 1))
      NEXT
   DEF SEG
   DriveParameterBlock$ = Temp$
ELSE
   DriveParameterBlock$ = ""
END IF

END FUNCTION

FUNCTION Env$

REM Costruisce il percorso da utilizzare come directory di lavoro

IF LEN(ENVIRON$("TEMP")) THEN
   Temp$ = RIGHT$(ENVIRON$("TEMP"), 1)
   IF Temp$ <> CHR$(92) AND Temp$ <> CHR$(58) THEN Env$ = ENVIRON$("TEMP") + CHR$(92)
ELSE
   Env$ = ""
END IF

END FUNCTION

FUNCTION Environment$

REM Legge le informazioni relative al sistema operativo in funzione

Reg.AX = &H4680
Interrupt &H2F, Reg, Reg
IF Reg.AX = 0 THEN
   Environment$ = "Ambiente grafico Microsoft Windows eseguito in modalit… reale o standard"
ELSE
   Reg.AX = &H1600
   Interrupt &H2F, Reg, Reg
   IF Reg.AX AND &HFF THEN
      Environment$ = "Ambiente grafico Microsoft Windows eseguito in modalit… avanzata"
   ELSE
      Reg.AX = &H3000
      Interrupt &H21, Reg, Reg
      DosVersion$ = STR$(Reg.AX AND &HFF) + CHR$(46) + STRING$(3 - LEN(STR$((Reg.AX \ 256) AND &HFF)), 48) + MID$(STR$((Reg.AX \ 256) AND &HFF), 2)
      Environment$ = "Ambiente operativo Microsoft DOS versione" + DosVersion$
   END IF
END IF

END FUNCTION

SUB EnvList (FileName AS STRING)

REM Elenca tutte le variabili d'ambiente nel file specificato dal parametro

OPEN FileName$ FOR OUTPUT AS #1
   DO
      J = J + 1
      PRINT #1, ENVIRON$(J)
   LOOP UNTIL ENVIRON$(J) = ""
CLOSE

END SUB

FUNCTION ExePath$

REM Legge il percorso del file eseguibile richiamato nell'ambiente DOS all'indirizzo specificato alle posizioni 2CH e 2DH del PSP

Reg.AX = &H6200
Interrupt &H21, Reg, Reg
DEF SEG = Reg.BX
   Addr& = PEEK(&H2C) + PEEK(&H2D) * 256&
   PRINT "PSP Segment ="; Addr&
DEF SEG = Addr&
   DO
      Scan$ = CHR$(PEEK(Index%)) + CHR$(PEEK(Index% + 1)) + CHR$(PEEK(Index% + 2)) + CHR$(PEEK(Index% + 3))
      Index% = Index% + 1
   LOOP UNTIL Scan$ = MKL$(65536)
   Init% = Index% + 3: Index% = Index% + 3
   DO
      Index% = Index% + 1
   LOOP UNTIL PEEK(Index%) = 0
   Alt% = Index% - 1
   Temp$ = SPACE$(Alt% - Init% + 1)
   FOR Index% = Init% TO Alt%
      MID$(Temp$, Index% - Init% + 1, 1) = CHR$(PEEK(Index%))
   NEXT
   FOR Index% = 1 TO LEN(Temp$)
      IF MID$(Temp$, LEN(Temp$) - Index% + 1, 1) = CHR$(92) THEN EXIT FOR
   NEXT
   Temp$ = LEFT$(Temp$, LEN(Temp$) - Index%)
   IF LEN(Temp$) = 2 THEN Temp$ = Temp$ + CHR$(92)
DEF SEG
ExePath$ = Temp$

END FUNCTION

SUB FadeOut (Delay AS INTEGER)

REM Sfuma l'intero schermo fino al nero

DIM Temp(1 TO 768) AS INTEGER
FOR I% = 1 TO 64
   FOR J% = 1 TO Delay%
      FOR K% = 1 TO Delay%: NEXT
   NEXT
   OUT &H3C7, 0
   FOR J% = 1 TO 768
      Temp%(J%) = INP(&H3C9)
      IF Temp%(J%) > 0 THEN Temp%(J%) = Temp%(J%) - 1
   NEXT
   OUT &H3C8, 0
   FOR J% = 1 TO 768
      OUT &H3C9, Temp%(J%)
   NEXT
NEXT

END SUB

SUB FATRead (Drive AS INTEGER)

REM Copia in un file la prima o l'unica FAT di un certo dispositivo

DPB$ = DriveParameterBlock$(Drive% + 1)
ByPerSect% = CVI(MID$(DPB$, 3, 2))
HowMany& = CVI(MID$(DPB$, 16, 2))
FAT$ = SPACE$(16384)
Cycle% = ByPerSect% * HowMany& \ 16384 + SGN(ByPerSect% * HowMany& MOD 16384)
Num% = FREEFILE
OPEN Env$ + CHR$(Drive% + 65) + "FAT.Img" FOR OUTPUT AS #Num%
   FOR Index% = 1 TO Cycle%
      Packet$ = MKL$(16384 / ByPerSect% * (Index% - 1) + 1) + MKI$(16384 / ByPerSect%) + MKL$(SSEGADD(FAT$))
      Reg.AX = Drive%
      Reg.CX = &HFFFF
      Reg.DS = SSEG(Packet$)
      Reg.BX = SADD(Packet$)
      InterruptX &H25, Reg, Reg
      IF Reg.Flags AND 1 THEN
         PRINT #Num%, "Errore" + STR$(Reg.AX MOD 256);
         EXIT FOR
      END IF
      IF Index% <> Cycle% AND SGN(ByPerSect% * HowMany& MOD 16384) <> 0 THEN
         PRINT #Num%, FAT$;
      ELSE
         PRINT #Num%, LEFT$(FAT$, ByPerSect% * HowMany& MOD 16384);
      END IF
   NEXT
CLOSE

END SUB

SUB GetDriveInfo (Drive AS INTEGER)

REM Acquisisce alcuni dati sul tipo di supporto specificato

Reg.DX = Drive% MOD 26
Reg.AX = &H3600
Interrupt &H21, Reg, Reg
PRINT Reg.CX; "bytes per settore e"; Reg.AX; "settore/i per cluster"
IF Drive% \ 26 = 0 THEN
   PRINT Reg.DX AND &HFFFF&; "cluster totali sul dispositivo di cui"; Reg.BX AND &HFFFF&; "liberi"
   Size@ = Reg.AX * Reg.CX * (Reg.DX AND &HFFFF&)
   Free@ = Reg.AX * Reg.CX * (Reg.BX AND &HFFFF&)
   PRINT Group$(STR$(Size@)); "bytes complessivi sul dispositivo"
   PRINT Group$(STR$(Free@)); "bytes disponibili sul dispositivo"
ELSE
   PRINT "L'unit… specificata Š un CD-ROM"
END IF

END SUB

FUNCTION GetFileCount& (FileSpec AS STRING)

REM Conta il numero di files del tipo specificato nella directory corrente

DIM FileCount AS LONG
IF LEN(DIR$(FileSpec$)) = 0 THEN
   FileCount& = 0
ELSE
   FileCount& = 1
   DO WHILE LEN(DIR$) > 0
      FileCount& = FileCount& + 1
   LOOP
END IF
GetFileCount = FileCount&

END FUNCTION

FUNCTION Group$ (Value AS STRING)

REM Aggiunge un punto ogni tre cifre ad un numero immesso come parametro

FOR Index% = LEN(Value$) TO 2 STEP -1
   Temp$ = MID$(Value$, Index%, 1) + Temp$
   Frac! = (LEN(Value$) - Index% + 1) / 3 - INT((LEN(Value$) - Index% + 1) / 3)
   IF Index% <> 2 AND Frac! = 0 THEN Temp$ = CHR$(46) + Temp$
NEXT
Group$ = LEFT$(Value$, 1) + Temp$ + CHR$(32)

END FUNCTION

FUNCTION MemoryType$

REM Legge il nome del gestore di memoria

Temp$ = SPACE$(8)
DEF SEG = 0
   Segment% = CVI(CHR$(PEEK(414)) + CHR$(PEEK(415)))
   IF Segment% THEN
      DEF SEG = Segment%
      FOR Index% = 1 TO 8
         MID$(Temp$, Index%, 1) = CHR$(PEEK(Index% + 9))
      NEXT
      Reg.AX = &HFFA5
      Interrupt &H67, Reg, Reg
      IF Reg.AX = &H845A THEN
         Desc$ = SPACE$(37)
         FOR I% = 1 TO LEN(Desc$)
            MID$(Desc$, I%, 1) = CHR$(PEEK(I% + 19))
         NEXT
      END IF
      Reg.AX = &H3F00
      Reg.CX = &H5145
      Reg.DX = &H4D4D
      Interrupt &H67, Reg, Reg
      IF Reg.AX \ 256 = 0 THEN
         Desc$ = SPACE$(39)
         FOR I% = 1 TO LEN(Desc$)
            MID$(Desc$, I%, 1) = CHR$(PEEK(I% + 19))
         NEXT
      END IF
      Reg.AX = &H1E00
      Interrupt &H67, Reg, Reg
      IF Reg.AX \ 256 = 0 THEN Desc$ = "386Max installed."
      MemoryType$ = Temp$ + CHR$(13) + Desc$
   ELSE
      MemoryType$ = "Non ci sono gestori di memoria installati."
   END IF
DEF SEG

END FUNCTION

FUNCTION Mirror$ (Token AS STRING)

REM Capovolge la stringa passata come argomento

Temp$ = SPACE$(LEN(Token$))
FOR Index% = 1 TO LEN(Token$)
   MID$(Temp$, LEN(Token$) - Index% + 1, 1) = MID$(Token$, Index%, 1)
NEXT
Mirror$ = Temp$

END FUNCTION

FUNCTION Mul$ (F1 AS STRING, F2 AS STRING)

REM Moltiplicazione di 2 numeri codificati in stringhe lunghi a piacere

DO
   IF I% = 0 THEN
      Entry$ = LTRIM$(F1$)
   ELSE
      Entry$ = LTRIM$(F2$)
   END IF
   IF ASC(Entry$) = 45 THEN
      Sign% = 1 - Sign%
      Entry$ = MID$(Entry$, 2)
   END IF
   FOR J% = 1 TO LEN(Entry$)
      IF ASC(MID$(Entry$, J%)) = 44 THEN Dec% = Dec% + LEN(Entry$) - J%
      IF ASC(MID$(Entry$, J%)) <> 44 AND ASC(MID$(Entry$, J%)) <> 46 THEN Temp$ = Temp$ + MID$(Entry$, J%, 1)
   NEXT
   IF I% = 0 THEN
      F1Temp$ = Temp$
   ELSE
      F2Temp$ = Temp$
   END IF
   I% = I% + 1: Temp$ = ""
LOOP UNTIL I% = 2
IF Sign% THEN
   Add$ = CHR$(45)
ELSE
   Add$ = CHR$(32)
END IF
DIM Sum(1 TO LEN(F2Temp$)) AS STRING
FOR I% = 1 TO LEN(F2Temp$)
   FOR J% = 1 TO LEN(F1Temp$)
      IF J% = 1 THEN Sum$(I%) = STRING$(I% - 1, 48)
      A$ = LTRIM$(STR$(VAL(MID$(F2Temp$, LEN(F2Temp$) - I% + 1, 1)) * VAL(MID$(F1Temp$, LEN(F1Temp$) - J% + 1, 1)) + Rip%))
      Carry$ = LEFT$(A$, LEN(A$) - 1)
      Rip% = VAL(Carry$)
      Sum$(I%) = RIGHT$(A$, 1) + Sum$(I%)
      IF J% = LEN(F1$) THEN Sum$(I%) = Carry$ + Sum$(I%)
   NEXT
   Rip% = 0
   IF LEN(Sum$(I%)) > Lun THEN Lun = LEN(Sum$(I%))
NEXT
FOR I% = 1 TO UBOUND(Sum$)
   Sum$(I%) = STRING$(Lun - LEN(Sum$(I%)), 48) + Sum$(I%)
NEXT
FOR I% = 1 TO Lun
   FOR J% = 1 TO LEN(F2Temp$)
      Digit% = Digit% + VAL(MID$(Sum$(J%), LEN(Sum$(J%)) - I% + 1, 1))
   NEXT
   D$ = RIGHT$(STR$(Digit%), 1)
   Carry$ = MID$(STR$(Digit%), 2, LEN(STR$(Digit%)) - 2)
   Temp$ = D$ + Temp$
   IF I% = Lun THEN
      Temp$ = Carry$ + Temp$
   ELSE
      Digit% = VAL(Carry$)
   END IF
NEXT
FOR I% = 1 TO LEN(Temp$)
   IF ASC(MID$(Temp$, I%)) <> 48 THEN EXIT FOR
NEXT
Temp$ = MID$(Temp$, I%)
IF Dec% THEN
   Sx$ = Group$(Add$ + LEFT$(Temp$, LEN(Temp$) - Dec%))
   Sx$ = LEFT$(Sx$, LEN(Sx$) - 1)
   DX$ = RIGHT$(Temp$, Dec%)
   FOR I% = LEN(DX$) TO 1 STEP -1
      IF ASC(MID$(DX$, I%)) <> 48 THEN EXIT FOR
   NEXT
   DX$ = LEFT$(DX$, I%)
   Mul$ = Sx$ + CHR$(44) + DX$ + CHR$(32)
ELSE
   Mul$ = Group$(Add$ + Temp$)
END IF

END FUNCTION

SUB PaletteRotate (Dir AS INTEGER, Times AS INTEGER)

REM Ruota ciclicamente la palette

Palette$ = SPACE$(768)
OUT &H3C7, 0
FOR Index% = 1 TO 768
   MID$(Palette$, Index%, 1) = CHR$(INP(&H3C9))
NEXT
Num% = FREEFILE
OPEN Env$ + "Palette.Img" FOR OUTPUT AS #Num%
   PRINT #Num%, Palette$;
CLOSE
FOR Index% = 1 TO Times MOD 256
   IF Dir = 1 THEN
      Palette$ = MID$(Palette$, 4) + LEFT$(Palette$, 3)
   ELSE
      Palette$ = RIGHT$(Palette$, 3) + LEFT$(Palette$, LEN(Palette$) - 3)
   END IF
NEXT
OUT &H3C8, 0
FOR Index% = 1 TO 768
   OUT &H3C9, ASC(MID$(Palette$, Index%))
NEXT

END SUB

SUB PermutazioneCiclica (Cycl AS INTEGER)

REM Permutazione ciclica oraria o antioraria del valore Cycl degli elementi del vettore Argument$

Sign% = SGN(Cycl%)
FOR Index% = 1 TO ABS(Cycl%) MOD (UBOUND(Argument$) - LBOUND(Argument$) + 1)
   IF Sign% > 0 THEN
      Temp$ = Argument$(UBOUND(Argument$))
   ELSE
      Temp$ = Argument$(LBOUND(Argument$))
   END IF
   FOR J% = LBOUND(Argument$) TO UBOUND(Argument$) - 1
      IF Sign% > 0 THEN
         Argument$(UBOUND(Argument$) - J% + 1) = Argument$(UBOUND(Argument$) - J%)
      ELSE
         Argument$(J%) = Argument$(J% + 1)
      END IF
   NEXT
   IF Sign% > 0 THEN
      Argument$(LBOUND(Argument$)) = Temp$
   ELSE
      Argument$(UBOUND(Argument$)) = Temp$
   END IF
NEXT

END SUB

FUNCTION PSPCommand$

REM Legge la riga di comando contenuta nel PSP

Reg.AX = &H6200
Interrupt &H21, Reg, Reg
DEF SEG = Reg.BX
   Temp$ = SPACE$(PEEK(128))
   FOR Index% = 1 TO LEN(Temp$)
      MID$(Temp$, Index%, 1) = CHR$(PEEK(128 + Index%))
   NEXT
DEF SEG
PSPCommand$ = Temp$

END FUNCTION

FUNCTION RootRead$ (Drive AS INTEGER)

REM Legge la root di un dispositivo specificato

DPB$ = DriveParameterBlock$(Drive% + 1)
ByPerSect% = CVI(MID$(DPB$, 3, 2))
Start% = CVI(MID$(DPB$, 18, 2))
HowMany% = CVI(MID$(DPB$, 12, 2)) - Start%
Temp$ = SPACE$(ByPerSect% * HowMany%)
Packet$ = MKL$(Start%) + MKI$(HowMany%) + MKL$(SSEGADD(Temp$))
Reg.AX = Drive%
Reg.CX = &HFFFF
Reg.DS = SSEG(Packet$)
Reg.BX = SADD(Packet$)
InterruptX &H25, Reg, Reg
IF Reg.Flags AND 1 THEN
   RootRead$ = "Errore" + STR$(Reg.AX MOD 256)
ELSE
   RootRead$ = Temp$
END IF

END FUNCTION

FUNCTION Sort$ (Token AS STRING, Dir AS INTEGER)

REM Ordina alfabeticamente una stringa con vari argomenti

SuddividiStringa TSRRead$
FOR I% = 1 TO UBOUND(Argument$) - LBOUND(Argument$)
   FOR J% = LBOUND(Argument$) TO UBOUND(Argument$) - I%
      IF Dir% = 1 AND Argument$(J%) > Argument$(J% + 1) OR Dir% <> 1 AND Argument$(J%) < Argument$(J% + 1) THEN SWAP Argument$(J%), Argument$(J% + 1)
   NEXT
NEXT
FOR I% = LBOUND(Argument$) TO UBOUND(Argument$)
   Temp$ = Temp$ + CHR$(32) + Argument$(I%)
NEXT
Sort$ = Temp$

END FUNCTION

SUB SuddividiStringa (Token AS STRING)

REM Suddivisione di una stringa in argomenti

Flag% = 1
FOR Index% = 1 TO LEN(Token$)
   IF MID$(Token$, Index%, 1) = CHR$(32) THEN Flag% = 1
   IF MID$(Token$, Index%, 1) <> CHR$(32) AND Flag% = 1 THEN
      Counter% = Counter% + 1
      Flag% = 0
   END IF
   IF MID$(Token$, Index%, 1) <> CHR$(32) AND Flag% = 0 THEN Argument$(Counter%) = Argument$(Counter%) + MID$(Token$, Index%, 1)
NEXT

END SUB

FUNCTION Transform$ (Address AS STRING)

REM Trasforma un indirizzo di memoria in una stringa esadecimale

Temp$ = HEX$(CVL(Address$))
Temp$ = STRING$(8 - LEN(Temp$), 48) + Temp$
Temp$ = LEFT$(Temp$, 4) + CHR$(58) + RIGHT$(Temp$, 4)
Transform$ = Temp$

END FUNCTION

FUNCTION TSRRead$

REM Legge i TSR presenti in memoria

Reg.AX = &H5802
Interrupt &H21, Reg, Reg
UMB% = Reg.AX MOD 256
Reg.AX = &H5803
Reg.BX = 1
Interrupt &H21, Reg, Reg
Reg.AX = &H5200
InterruptX &H21, Reg, Reg
DEF SEG = Reg.ES
   Segment% = CVI(CHR$(PEEK(Reg.BX - 2)) + CHR$(PEEK(Reg.BX - 1)))
   DO
      DEF SEG = Segment%
      PSP% = CVI(CHR$(PEEK(1)) + CHR$(PEEK(2)))
      IF (PEEK(0) = 77 OR PEEK(0) = 90) AND PSP% <> 0 AND PSP% <> 8 AND PSP% = Segment% + 1 OR PEEK(0) = 68 THEN
         Index% = 0: Temp$ = Temp$ + CHR$(32)
         DO
            Temp$ = Temp$ + CHR$(PEEK(Index% + 8))
            Index% = Index% + 1
         LOOP UNTIL PEEK(Index% + 8) = 0 OR PEEK(Index% + 8) = 32 OR Index% = 8
      END IF
      IF PEEK(0) <> 77 AND PEEK(0) <> 90 OR PSP% <> 8 OR CHR$(PEEK(8)) + CHR$(PEEK(9)) <> "SD" THEN
         Segment% = Segment% + CVI(CHR$(PEEK(3)) + CHR$(PEEK(4))) + 1
      ELSE
         Segment% = Segment% + 1
      END IF
   LOOP UNTIL PEEK(0) = 90
   Reg.AX = &H5803
   Reg.BX = UMB%
   Interrupt &H21, Reg, Reg
DEF SEG
TSRRead$ = UCASE$(Temp$)

END FUNCTION