|
DECLARE SUB copieur ()
DECLARE SUB niveau (niv%)
DECLARE SUB cadre (v%, h%, l%, nli%, C%)
DECLARE SUB centre (v%, coul%, ph$)
DECLARE SUB efface ()
DECLARE SUB entree ()
DECLARE SUB fleches (v%, h%, w$(), np%, r%, coul%, drap%, v2%, h3%)
DECLARE SUB getinvi (rr%)
DECLARE SUB lecdir (ncl%)
DECLARE SUB quitter (x%, y%)
DECLARE SUB restoreclasse ()
DECLARE SUB sauveclasse ()
DECLARE SUB titre ()
DECLARE SUB attendre (tx!)
DECLARE SUB pleineligne (m$, np%, v%, h%, re$)
DECLARE SUB ouinon (r$)
DECLARE SUB choixdisquedur (p$(), drivedestination$)
DECLARE SUB choixlecteur (driveorigine$)
DECLARE SUB test (p$(), nd%)
DECLARE SUB nouveauchemin (p$())
'installe pour version 720 ko 1.4 ===
'clerc daniel
'24/6/97
'les fichiers sont sur la racine sur les 3 disquettes ===
DEFINT A-Z
'variables globales
COMMON SHARED couleur, rt$, li$, titr$, drivedestination$,
driveorigine$, gg$, prog$, prog2$, noir, bleu, vert, rouge, marron,
blanc, vertclair, cyanclair, rougeclair, jaune, blancbrill
' Inclut les fichiers contenant les déclarations relatives aux
procédures appelées.
'$INCLUDE: 'MOUSE.BI'
'$INCLUDE: 'VBDOS.BI'
CONST FALSE = 0
CONST TRUE = NOT FALSE
' Vérifie que le gestionnaire de souris est installé.
MouseInit
' Affiche le pointeur de la souris.
MouseShow
DIM dd$(3), ligne$(5), z(20), p$(4), niv$(5)
DATA college,element,segpa,imp,cap
FOR i = 1 TO 5: READ niv$(i): NEXT
couleur = 1
noir = 0: bleu = 1: vert = 2: rouge = 4: marron = 6: blanc = 7:
vertclair = 10: cyanclair = 11: rougeclair = 12: jaune = 14:
blancbrill = 15
COLOR , noir: CLS
prog2$ = "'PRIMAIRE'" '===
bat$ = "AAS" '===
p$(1) = "C:": p$(2) = "D:": p$(3) = "E:"
ON ERROR GOTO erreur '===
rt$ = CHR$(17) + CHR$(196) + CHR$(217)
gg$ = CHR$(24) + " " + CHR$(25) + " puis " + rt$
li$ = SPACE$(80)
flag = 0
titr$ = "Installation " + prog2$
erreur = 0
SCREEN 0: KEY OFF: LOCATE , , 0
'présentation
COLOR , bleu, 0
CLS
CALL cadre(8, 15, 50, 10, rouge)
COLOR , rouge
CALL centre(10, 15, "INSTALLATION")
CALL centre(12, 11, prog2$)
COLOR , 0
SLEEP 3
'trouve le lecteur actif
driveorigine$ = LEFT$(CURDIR$, 3)
IF driveorigine$ <> "A:\" AND driveorigine$ <> "B:\" THEN
CALL choixlecteur(driveorigine$)
END IF
CHDIR driveorigine$
prog$ = "AAS" '===
drivedestination$ = "C:\"
insta10:
CALL titre
CALL cadre(8, 16, 50, 2, rouge)
COLOR , rouge
CALL centre(9, blancbrill, "'Chemin d'accès' pour installer le
logiciel")
CALL cadre(12, 16, 50, 2, blanc)
COLOR , blanc
CALL centre(13, noir, drivedestination$ + prog$)
COLOR blanc, noir
CALL centre(23, blanc, rt$ + " = Valider [*] = Personnaliser")
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
souris = 0
DO
r$ = INKEY$
' Obtient l'emplacement de la souris et l'état des boutons.
MousePoll v_mouse, h_mouse, lButton, rButton
'LOCATE 22, 1: PRINT v_mouse, h_mouse
IF lButton THEN
IF v_mouse = 23 AND (h_mouse >= 40 AND h_mouse <= 58) THEN
'étoile
s = 42
CALL attendre(.3)
souris = 1: EXIT DO
ELSE
'entree
s = 13
CALL attendre(.3)
souris = 1: EXIT DO
END IF
END IF
LOOP WHILE r$ = ""
IF souris = 0 AND LEN(r$) < 2 THEN
s = ASC(r$)
ELSEIF souris = 0 THEN
s = ASC(RIGHT$(r$, 1))
END IF
SELECT CASE s
CASE 42, 36, 56, 230, 43
CALL nouveauchemin(p$())
CASE 27
CALL quitter(noir, noir)
CASE ELSE
IF driveorigine$ = drivedestination$ + prog$ + "\" THEN
CALL titre
BEEP
CALL cadre(8, 20, 40, 6, rouge)
COLOR , rouge
CALL centre(9, blancbrill, "Attention !")
CALL centre(11, blancbrill, "Les deux 'chemins' sont identiques")
CALL centre(13, jaune, driveorigine$)
CALL entree
GOTO insta10
END IF
'créer c:\aas
MKDIR drivedestination$ + prog$
END SELECT
CALL titre
CALL lecdir(ncl)
IF ncl <> 0 THEN
flag = 1
titr$ = "installation " + prog2$ + " sur " + drivedestination$
CALL titre
BEEP
CALL cadre(4, 10, 60, 8, marron)
COLOR , marron
CALL centre(6, 15, "Une ancienne version de")
CALL centre(8, 15, prog2$)
CALL centre(10, 15, "est déjà présente sur votre disque dur.")
CALL cadre(13, 10, 60, 2, vert)
COLOR , vert
CALL centre(14, 15, "On sauve les anciens fichiers (élèves et
textes) ?")
p2$(1) = "oui"
p2$(2) = "non"
COLOR , noir
CALL centre(23, blanc, gg$)
CALL fleches(17, 38, p2$(), 2, r, rouge, 1, 23, 35)
SELECT CASE r
CASE 0
CALL quitter(noir, noir)
CASE 1
flag = 1
CALL sauveclasse
CALL efface
CASE 2
flag = 0
END SELECT
END IF
CALL copieur
IF flag = 0 THEN
CALL niveau(niv)
CALL titre
'renommer les fichier txt en fonction de niv
LOCATE 4, 1
SHELL "copy " + drivedestination$ + prog$ + "\" + niv$(niv) + "1.txt
" + drivedestination$ + prog$ + "\" + "fichier1.txt"
SHELL "copy " + drivedestination$ + prog$ + "\" + niv$(niv) + "2.txt
" + drivedestination$ + prog$ + "\" + "fichier2.txt"
END IF
CALL titre
LOCATE 4, 1
'écrire le bat en fonction de prog$
OPEN "C:\" + bat$ + ".bat" FOR OUTPUT AS #1
PRINT #1, "@echo off"
PRINT #1, drivedestination$
PRINT #1, "cd \"
PRINT #1, "cd " + prog$
PRINT #1, "menu"
PRINT #1, "cd \"
CLOSE
IF drivedestination$ <> "C:\" THEN
OPEN drivedestination$ + bat$ + ".bat" FOR OUTPUT AS #1
PRINT #1, "@echo off"
PRINT #1, drivedestination$
PRINT #1, "cd \"
PRINT #1, "cd " + prog$
PRINT #1, "menu"
PRINT #1, "cd \"
CLOSE
END IF
IF flag = 1 THEN CALL restoreclasse
titr$ = prog2$
CALL titre
CALL cadre(8, 10, 60, 6, rouge)
COLOR , rouge
CALL centre(10, 15, "L'installation est terminée.")
CALL centre(12, 15, "Tapez " + bat$ + " pour lancer le programme.")
CHDIR drivedestination$
SHELL drivedestination$
CALL entree
CLS
END
erreur:
IF ERR = 75 OR ERR = 53 OR ERR = 76 THEN 'mkdir ou rmdir ou kill
'erreur = erreur + 1
RESUME NEXT
END IF
programme$ = "installe"
SCREEN 0
COLOR , bleu: CLS
BEEP
CALL cadre(8, 5, 70, 9, rouge)
COLOR , rouge
CALL centre(10, blanc, "ATTENTION")
SELECT CASE ERR
CASE 68, 0
CALL centre(11, blancbrill, "Périphérique absent")
CASE 71
CALL centre(12, blancbrill, "Disque non prêt")
CASE 70
CALL centre(12, blancbrill, "Disquette protégée")
CASE 53, 57, 72
CALL centre(12, blancbrill, "Problème sur le disque")
CASE 61
CALL centre(12, blancbrill, "Disque plein")
CASE ELSE
CALL centre(12, blancbrill, "Erreur système n°" + LTRIM$(STR$(ERR)))
CALL centre(14, blancbrill, "Essayez de relancez le programme.")
CLOSE
w$ = INPUT$(1)
COLOR , noir: CLS
END
END SELECT
CALL centre(14, blancbrill, "Corrigez puis tapez " + rt$ + " [Echap]
= Fin")
CALL getinvi(r)
IF r = 27 THEN COLOR , noir: CLS : END
COLOR , bleu: CLS : RUN programme$
DEFINT A-Z
SUB attendre (tx!)
tx! = tx! * 2
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
debut! = TIMER
DO
fin! = TIMER
IF INKEY$ <> "" THEN EXIT DO
LOOP WHILE fin! - debut! < tx!
tx! = tx! / 2
END SUB
DEFINT A-Z
SUB cadre (v%, h%, l%, nli%, C)
'c est l'intérieur
'le fond écran est bleu
v2 = v
'cadre
COLOR C, bleu
LOCATE v2, h
PRINT STRING$(l + 2, 220)
FOR i = 1 TO nli - 1
v2 = v2 + 1: LOCATE v2, h
PRINT STRING$(l + 2, 219)
NEXT
COLOR , bleu
LOCATE v2 + 1, h: PRINT CHR$(223)
COLOR , noir
LOCATE v + 1
FOR i = 1 TO nli
LOCATE , h + l + 2
PRINT " "
NEXT
LOCATE v2 + 1, h + 1
PRINT STRING$(l + 1, 223)
COLOR blancbrill
END SUB
DEFINT A-Z
SUB centre (v, coul, ph$)
COLOR coul
LOCATE v, INT(41 - LEN(ph$) / 2)
PRINT ph$
COLOR 15
END SUB
DEFINT A-Z
SUB choixdisquedur (p$(), drivedestination$)
CALL test(p$(), nd)
IF nd = 1 THEN drivedestination$ = "C:\": EXIT SUB
CALL titre
CALL cadre(5, 10, 60, 6, blanc)
COLOR , blanc
CALL centre(7, noir, "Choisissez le DISQUE DUR")
CALL centre(9, noir, "où le programme va être installé.")
CALL fleches(14, 39, p$(), nd, r, rouge, 1, 23, 35)
drivedestination$ = p$(r) + "\"
END SUB
DEFINT A-Z
SUB choixlecteur (driveorigine$)
CALL titre
DIM p2$(4)
p2$(1) = "A:": p2$(2) = "B:": p2$(3) = CURDIR$
l = LEN(p2$(3))
nf = 3
IF l > 70 THEN
nf = 2
h = 39
ELSEIF l < 4 THEN
nf = 2
h = 39
ELSE
h = INT(41 - l / 2)
END IF
CALL cadre(5, 10, 60, 6, blanc)
COLOR , blanc
CALL centre(7, noir, "Indiquez le lecteur")
CALL centre(9, noir, "où se trouve le programme " + prog2$)
CALL fleches(15, h, p2$(), nf, r, rouge, 1, 23, 35)
driveorigine$ = p2$(r) + "\"
END SUB
DEFINT A-Z
SUB copieur ()
titr$ = "Installation " + prog2$ + " sur " + drivedestination$
'1° disquette
CALL titre
LOCATE 4, 1
SHELL "copy " + driveorigine$ + "*.* " + drivedestination$ + prog$
'2° disquette
CALL titre
CALL cadre(7, 10, 60, 8, rouge)
BEEP
COLOR , rouge
CALL centre(9, blancbrill, "Introduisez la disquette n°2")
CALL centre(11, blancbrill, "dans le lecteur " + driveorigine$)
CALL centre(13, blancbrill, "puis tapez la touche 'ENTREE'")
CALL entree
CALL titre
LOCATE 5, 1
SHELL "copy " + driveorigine$ + "*.* " + drivedestination$ + prog$
'3° disquette
CALL titre
CALL cadre(7, 10, 60, 8, rouge)
BEEP
COLOR , rouge
CALL centre(9, blancbrill, "Introduisez la disquette n°3")
CALL centre(11, blancbrill, "dans le lecteur " + driveorigine$)
CALL centre(13, blancbrill, "puis tapez la touche 'ENTREE'")
CALL entree
CALL titre
LOCATE 5, 1
SHELL "copy " + driveorigine$ + "*.* " + drivedestination$ + prog$
END SUB
DEFINT A-Z
SUB efface ()
CHDIR drivedestination$
KILL drivedestination$ + prog$ + "\*.*"
CHDIR driveorigine$
SLEEP 2
END SUB
DEFINT A-Z
SUB entree ()
COLOR , 0
LOCATE 23, 37: PRINT rt$: CALL getinvi(rr)
IF rr = 27 THEN CALL quitter(noir, noir)
END SUB
DEFINT A-Z
SUB fleches (v, h, w$(), np, r, coul, drap, v2, h3)
'v2 et h3 sont la ligne colonne des fleches
DIM p$(np)
LOCATE , , 0
FOR i = 1 TO np: p$(i) = w$(i): NEXT
l2 = 0
FOR i = 1 TO np
l1 = LEN(p$(i)): IF l2 < l1 THEN l2 = l1
NEXT
FOR i = 1 TO np
p$(i) = p$(i) + SPACE$(l2 - LEN(p$(i)))
NEXT
COLOR blanc, noir
LOCATE v2, h3: PRINT gg$
'souris
v_mini = v: v_maxi = v_mini + np - 1
h_mini = h - 1: h_maxi = LEN(p$(1)) + h_mini + 1
'LOCATE 22, 1: PRINT v_mini, v_maxi, h_mini, h_maxi '===
'cadre
IF drap = 1 THEN
CALL cadre(v - 1, h - 3, l2 + 4, np + 1, coul)
END IF
COLOR blancbrill, coul
LOCATE v
FOR i = 1 TO np
LOCATE , h - 1: PRINT " "; p$(i); " "
NEXT
vt = v - 1
LOCATE v, h - 1
IF couleur = 1 THEN COLOR coul, blanc ELSE COLOR noir, blanc
PRINT " "; p$(1); " "
COLOR blancbrill, coul
DO
DEF SEG = 0
POKE &H417, (PEEK(&H417) AND &H9F)'non numérique
POKE 1050, PEEK(1052)
DEF SEG
souris = 0
DO
r$ = INKEY$
' Obtient l'emplacement de la souris et l'état des boutons.
MousePoll v_mouse, h_mouse, lButton, rButton
'LOCATE 21, 1: PRINT "Position de la souris : "; v_mouse; ", ";
h_mouse '===
IF lButton THEN
IF v_mouse >= v_mini AND v_mouse <= v_maxi THEN
IF h_mouse >= h_mini AND h_mouse <= h_maxi THEN
LOCATE v_mini
FOR i = 1 TO np
LOCATE , h_mini: PRINT " "; p$(i); " "
NEXT
calcul = v_mouse - v_mini + 1
LOCATE v_mouse, h_mini
COLOR coul, blancbrill
PRINT " "; p$(calcul); " "
CALL attendre(.3)
r = calcul
EXIT SUB
ELSE
BEEP
END IF
ELSEIF v_mouse = v2 AND h_mouse = h3 THEN
rr = 72 'fleche haut
souris = 1
CALL attendre(.2)
EXIT DO
ELSEIF v_mouse = v2 AND h_mouse = h3 + 2 THEN
rr = 80 'fleche bas
souris = 1
CALL attendre(.2)
EXIT DO
ELSEIF v_mouse = v2 AND (h_mouse >= h3 + 9 AND h_mouse <= h3 + 11)
THEN
rr = 13
souris = 1
CALL attendre(.3)
EXIT DO
ELSE
BEEP
END IF
END IF
LOOP WHILE r$ = ""
IF souris = 0 THEN
IF LEN(r$) < 2 THEN
rr = ASC(r$)
ELSE
rr = ASC(RIGHT$(r$, 1))
END IF
END IF
IF rr = 27 THEN
CALL quitter(noir, noir)
END IF
LOCATE v, h - 1: PRINT " "; p$(v - vt); " "
IF rr = 72 THEN v = v - 1: IF v = vt THEN v = vt + np
IF rr = 80 THEN v = v + 1: IF v = vt + np + 1 THEN v = vt + 1
LOCATE v, h - 1
IF couleur = 1 THEN COLOR coul, blanc ELSE COLOR noir, blanc
PRINT " "; p$(v - vt); " "
COLOR blancbrill, coul
LOOP WHILE rr <> 13
r = v - vt
COLOR blancbrill
END SUB
DEFINT A-Z
SUB getinvi (rr%)
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
DO
r$ = INKEY$
' Obtient l'emplacement de la souris et l'état des boutons.
MousePoll v_mouse, h_mouse, lButton, rButton
IF lButton THEN
r$ = CHR$(13)
CALL attendre(.5)
END IF
LOOP WHILE r$ = ""
IF LEN(r$) < 2 THEN rr = ASC(r$) ELSE rr = ASC(RIGHT$(r$, 1))
END SUB
DEFINT A-Z
SUB lecdir (ncl)
DIM ligne$(500), pointeur(5), mot$(5)
'6/5/95
'dans le répertoire spécifié, on cherche si "fichier.dat" existe
fichier$ = "FICHIER"'===
SHELL "DIR " + drivedestination$ + prog$ + " > c:\catalog.dat"
OPEN "c:\catalog.dat" FOR INPUT AS #1
i = 1
DO UNTIL EOF(1)
INPUT #1, ligne$(i)
i = i + 1
LOOP
CLOSE
nl = i - 1
ncl = 0
FOR i = 1 TO nl
ligne$(i) = LTRIM$(ligne$(i))
ligne$(i) = UCASE$(RTRIM$(ligne$(i)))
NEXT
f = 0: f2 = 0
FOR i = 1 TO nl
'on cherche les <ctrl I> dans la ligne
l = LEN(ligne$(i))
FOR kk = 1 TO l
IF ASC(MID$(ligne$(i), kk, 1)) = 9 THEN
f = 1
END IF
NEXT kk
IF f = 1 THEN EXIT FOR
NEXT i
IF f = 0 THEN
'directory en liste
FOR i = 1 TO nl
ligne$(i) = RTRIM$(MID$(ligne$(i), 1, 8))
IF LEFT$(ligne$(i), LEN(fichier$)) = fichier$ THEN
ncl = 1
EXIT FOR
END IF
NEXT i
ELSE
'dir /w
FOR ii = 1 TO nl
'on cherche les <ctrl I> dans la ligne
l = LEN(ligne$(ii))
jj = 1: flag = 0
FOR kk = 1 TO l
IF ASC(MID$(ligne$(ii), kk, 1)) = 9 THEN
jj = jj + 1: flag = 1
pointeur(jj) = kk + 1
pointeur = ii
END IF
NEXT
's'il y a des ctrl I on affecte les mots
IF flag = 1 THEN
mot$(1) = MID$(ligne$(ii), 1, 12)
FOR kk = 2 TO jj
mot$(kk) = MID$(ligne$(ii), pointeur(kk), 12)
NEXT kk
'on cherche le sous répertoire
FOR j = 1 TO jj
IF MID$(mot$(j), 1, LEN(fichier$)) = fichier$ THEN
ncl = 1
EXIT FOR
ELSEIF MID$(mot$(j), 1, LEN(fichier$) + 2) = "[" + fichier$ + "]"
THEN
ncl = 1
EXIT FOR
END IF
NEXT j
'si c'est la ligne suivante avec un seul mot on l'affecte
ELSEIF ii = pointeur + 1 THEN
mot$(1) = MID$(ligne$(ii), 1, 12)
IF MID$(mot$(1), 1, LEN(fichier$)) = fichier$ THEN
ncl = 1
EXIT FOR
END IF
END IF
NEXT ii
END IF
KILL "catalog.dat"
END SUB
DEFINT A-Z
SUB niveau (niv)
DIM p$(10)
p$(1) = "Collège"
p$(2) = "Elémentaire"
p$(3) = "E.R.E.A. - S.E.G.P.A"
p$(4) = "I.M.P. - I.M.Pro."
p$(5) = "Lycée Prof. (C.A.P.)"
CALL titre
CALL cadre(6, 10, 60, 3, blanc)
COLOR , blanc
CALL centre(7, noir, "Sélectionnez le niveau")
CALL centre(8, noir, "(textes dans l'activité LECTURE)")
CALL fleches(13, 30, p$(), 5, niv, rouge, 1, 23, 35)
END SUB
DEFINT A-Z
SUB nouveauchemin (p$())
DIM mot$(30), p2$(2)
insta1:
prog$ = "AAS" '===
drivedestination$ = "C:\"
CALL titre
COLOR , noir
CALL centre(23, blanc, "Tapez " + rt$ + " pour valider")
CALL cadre(8, 16, 50, 2, rouge)
COLOR blancbrill, rouge
LOCATE 9, 20: PRINT "Tapez le 'chemin d'accès'"
CALL cadre(12, 16, 50, 2, blanc)
m$ = drivedestination$ + prog$
DO
DEF SEG = 0
'POKE &H417, (PEEK(&H417) AND &H9F)'non numérique
'POKE &H417, (PEEK(&H417) AND &HBF) 'minus
POKE &H417, (PEEK(&H417) OR &H40)'MAJ
POKE &H417, (PEEK(&H417) OR &h30)'numérique
DEF SEG
COLOR noir, blanc
CALL pleineligne(m$, 40, 13, 20, r$)
IF r$ = CHR$(27) THEN CALL quitter(noir, noir)
LOOP WHILE r$ = CHR$(27)
reponse$ = LTRIM$(RTRIM$(UCASE$(m$)))
IF reponse$ = "" THEN
BEEP
COLOR , noir
CALL centre(23, rougeclair, "Vous devez taper le nom d'un
dossier...")
CALL getinvi(w)
GOTO insta1
END IF
IF reponse$ = drivedestination$ + prog$ THEN
MKDIR drivedestination$ + prog$
EXIT SUB
ELSEIF LEFT$(reponse$, 3) <> "C:\" AND LEFT$(reponse$, 3) <> "D:\"
AND LEFT$(reponse$, 3) <> "E:\" THEN
'traiter le disque dur
CALL choixdisquedur(p$(), drivedestination$)
prog$ = reponse$
ELSE
drivedestination$ = LEFT$(reponse$, 3)
CALL test(p$(), nd)
SELECT CASE nd
CASE 1
drivedestination$ = "C:\"
CASE 2
IF drivedestination$ <> "C:\" AND drivedestination$ <> "D:\" THEN
CALL choixdisquedur(p$(), drivedestination$)
END IF
CASE 3
IF drivedestination$ <> "C:\" AND drivedestination$ <> "D:\" AND
drivedestination$ <> "E:\" THEN
CALL choixdisquedur(p$(), drivedestination$)
END IF
END SELECT
prog$ = MID$(reponse$, 4)
END IF
'vérifier si les chemins origine et destination ne sont pas
identiques
IF driveorigine$ = drivedestination$ + prog$ + "\" THEN
CALL titre
BEEP
CALL cadre(8, 20, 40, 6, rouge)
COLOR , rouge
CALL centre(9, blancbrill, "Attention !")
CALL centre(11, blancbrill, "Les deux 'chemins' sont identiques")
CALL centre(13, jaune, driveorigine$)
CALL entree
GOTO insta1
END IF
'analyser la réponse prog$
s = INSTR(prog$, ":")
IF s <> 0 THEN
BEEP
COLOR , noir
CALL centre(23, rougeclair, "Le nom du 'chemin d'accès' est
incorrect...")
CALL getinvi(w)
GOTO insta1
END IF
FOR i = 1 TO 3
IF LEFT$(prog$, 1) = "\" THEN
prog$ = MID$(prog$, 2)
END IF
IF LEFT$(prog$, 1) = ":" THEN
prog$ = MID$(prog$, 2)
END IF
IF RIGHT$(prog$, 1) = "\" THEN
prog$ = MID$(prog$, 1, LEN(prog$) - 1)
END IF
NEXT
IF prog$ = "" THEN
BEEP
COLOR , noir
CALL centre(23, rougeclair, "Vous devez taper le nom d'un
dossier...")
CALL getinvi(w)
GOTO insta1
END IF
jl = 1: mm$ = "": m$ = prog$ + "\"
FOR il = 1 TO LEN(m$)
mm$ = mm$ + MID$(m$, il, 1)
IF MID$(m$, il, 1) = "\" THEN
mot$(jl) = MID$(mm$, 1, LEN(mm$) - 1)
mm$ = "": jl = jl + 1
END IF
NEXT
nm = jl - 1
FOR i = 1 TO nm
IF LEN(mot$(i)) > 8 THEN
BEEP
COLOR , noir
CALL centre(23, rougeclair, "Huit caractères maximum pour le nom
d'un dossier...")
CALL getinvi(w)
GOTO insta1
END IF
NEXT
CALL titre
CALL cadre(8, 16, 50, 2, rouge)
COLOR , rouge
CALL centre(9, blancbrill, "'Chemin d'accès' pour installer le
logiciel")
CALL cadre(12, 16, 50, 2, blanc)
COLOR , blanc
CALL centre(13, noir, drivedestination$ + prog$)
COLOR blanc, noir
p2$(1) = "oui"
p2$(2) = "non"
COLOR , noir
CALL centre(23, blanc, gg$)
CALL fleches(17, 38, p2$(), 2, r, rouge, 1, 23, 35)
SELECT CASE r
CASE 0, 2
GOTO insta1
END SELECT
'créer les sous répertoires
CALL titre
w$ = drivedestination$ + mot$(1)
FOR i = 1 TO nm
MKDIR w$
w$ = w$ + "\" + mot$(i + 1)
NEXT
END SUB
DEFINT A-Z
SUB ouinon (r$)
h = POS(0)
v = CSRLIN
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
LOCATE v, h
COLOR blanc: PRINT "["; : COLOR jaune: PRINT "O"; : COLOR blanc:
PRINT "]ui ou ["; : COLOR jaune: PRINT "N"; : COLOR blanc: PRINT
"]on ?"
DO
r$ = ""
DO
r$ = INKEY$
' Obtient l'emplacement de la souris et l'état des boutons.
MousePoll v_mouse, h_mouse, lButton, rButton
IF lButton THEN
IF v_mouse = v AND (h_mouse >= h AND h_mouse <= h + 5) THEN
r$ = "o"
CALL attendre(.3)
ELSEIF v_mouse = v AND (h_mouse >= h + 10 AND h_mouse <= h + 14)
THEN
r$ = "n"
CALL attendre(.3)
ELSE
BEEP
END IF
END IF
LOOP WHILE r$ = ""
r$ = UCASE$(r$)
LOOP UNTIL r$ = "O" OR r$ = "N" OR r$ = CHR$(27) OR r$ = CHR$(13)
END SUB
DEFINT A-Z
SUB pleineligne (m$, np, v, h, re$)
DEF SEG = 0
POKE 1050, PEEK(1052)
DEF SEG
'spécifique à installe
h3 = h
f = 0: 'recouvrement
ple1:
IF NOT f THEN LOCATE v, h, 1, 0, 7 ELSE LOCATE v, h, 1, 7
IF h < h3 THEN h = h3
IF h > np + h3 THEN h = np + h3
IF h - h3 > LEN(m$) THEN h = LEN(m$) + h3
LOCATE v, h3 - 1, 0: PRINT SPACE$(np + 1)
LOCATE v, h3: PRINT m$
lc = h - (h3 - 1)
LOCATE v, h, 1
DO
re$ = INKEY$
LOOP WHILE re$ = ""
IF re$ = CHR$(27) OR re$ = CHR$(13) THEN
LOCATE , , 0, 7: EXIT SUB
END IF
IF LEN(re$) = 2 THEN GOTO plecaet
r2 = ASC(re$)
IF (r2 >= 48 AND r2 <= 58) OR (r2 >= 65 AND r2 <= 122) THEN
IF LEN(m$) >= np THEN
BEEP
IF f THEN m$ = MID$(m$, 1, LEN(m$) - 1)
END IF
IF f THEN
m$ = MID$(m$, 1, lc - 1) + re$ + MID$(m$, lc)
ELSE
m$ = MID$(m$, 1, lc - 1) + re$ + MID$(m$, lc + 1)
END IF
h = h + 1
IF h > np + h3 THEN h = np + h3
GOTO ple1
END IF
IF r2 = 8 THEN 'delete
IF h <> h3 THEN m$ = MID$(m$, 1, lc - 2) + MID$(m$, lc): h = h - 1
GOTO ple1
END IF
plecaet:
'carac étendu
r2 = ASC(RIGHT$(re$, 1))
SELECT CASE r2
CASE 77
h = h + 1 'droite
CASE 71
h = h3 'home
CASE 79
h = np + h3 'end
CASE 75
h = h - 1 'gauche
CASE 82
f = NOT f 'ins
CASE 83
m$ = MID$(m$, 1, lc - 1) + MID$(m$, lc + 1) 'suppr
END SELECT
GOTO ple1
END SUB
DEFINT A-Z
SUB quitter (x, y)
'31/5/95
DIM C(80), x$(80)
f = 0
'on mémorise la zone quitter
LOCATE 23, 1, 0
COLOR blanc, x
FOR i = 1 TO 80
x$(i) = CHR$(SCREEN(23, i))
C(i) = SCREEN(23, i, 1): IF C(i) > 15 THEN f = 1 'erreur à cause du
fond
NEXT
LOCATE 23, 1: PRINT SPACE$(80)
MouseShow
LOCATE 23, 28
COLOR blanc
BEEP: PRINT "Quitter ";
CALL ouinon(r$)
IF r$ = "O" OR r$ = CHR$(13) THEN
CALL titre
CALL cadre(9, 10, 60, 6, rouge)
COLOR , rouge
CALL centre(12, blancbrill, "Installation annulée")
COLOR , noir
CALL centre(23, blanc, rt$)
CALL getinvi(w)
END
END IF
'on restitue la zone quitter
LOCATE 23, 1
FOR i = 1 TO 80
IF f = 0 THEN
COLOR C(i)
END IF
PRINT x$(i);
NEXT
PRINT
COLOR 15, y
END SUB
DEFINT A-Z
SUB restoreclasse ()
titr$ = "Restauration des fichiers"
CALL titre
' CALL cadre(9, 10, 60, 4, rouge)
' COLOR , rouge
'CALL centre(11, blancbrill, "Restauration des anciens fichiers")
LOCATE 6
SHELL "copy c:\temp_aas\fichier*.* " + drivedestination$ + prog$
KILL "c:\temp_aas\*.*"
RMDIR "c:\temp_aas"
SLEEP 2
END SUB
DEFINT A-Z
SUB sauveclasse ()
titr$ = "Sauvegarde du fichier sur " + drivedestination$
CALL titre
'CALL cadre(9, 10, 60, 4, rouge)
'COLOR , rouge
'CALL centre(11, blancbrill, "Sauvegarde des fichiers")
LOCATE 6
MKDIR "c:\temp_aas"
SHELL "copy " + drivedestination$ + prog$ + "\fichier*.* " +
"c:\temp_aas"
END SUB
DEFINT A-Z
SUB test (p$(), nd)
ON LOCAL ERROR GOTO erreurdisque
nd = 0: f = 0
FOR i = 1 TO 3
CHDIR p$(i) + "\"
IF nd > 0 THEN EXIT FOR
NEXT
IF f = 0 THEN
nd = 3
ELSE
nd = nd - 1
END IF
EXIT SUB
erreurdisque:
IF ERR = 76 OR ERR = 71 THEN
nd = i: f = 1
RESUME NEXT
END IF
END SUB
DEFINT A-Z
SUB titre ()
w$ = titr$
COLOR , noir: CLS
FOR i = 1 TO LEN(w$)
IF MID$(w$, i, 1) = "é" OR MID$(w$, i, 1) = "è" THEN
w$ = MID$(w$, 1, i - 1) + "E" + MID$(w$, i + 1)
END IF
NEXT
COLOR , vert
LOCATE 2, 1: PRINT SPACE$(80)
CALL centre(2, noir, UCASE$(w$))
LOCATE 21, 1: PRINT SPACE$(80)
VIEW PRINT 3 TO 20: COLOR blancbrill, bleu: CLS 2: VIEW PRINT
END SUB
|
