Précédente Accueil Remonter Suivante

INSTALLE

Visual Basic for MS-DOS

 

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%, h2%)
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, h2)
'v2 et h2 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, h2: 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 = h2 THEN
rr = 72 'fleche haut
souris = 1
CALL attendre(.2)
EXIT DO
ELSEIF v_mouse = v2 AND h_mouse = h2 + 2 THEN
rr = 80 'fleche bas
souris = 1
CALL attendre(.2)
EXIT DO
ELSEIF v_mouse = v2 AND (h_mouse >= h2 + 9 AND h_mouse <= h2 + 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 &H20)'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
h2 = h
f = 0: 'recouvrement

ple1:
IF NOT f THEN LOCATE v, h, 1, 0, 7 ELSE LOCATE v, h, 1, 7
IF h < h2 THEN h = h2
IF h > np + h2 THEN h = np + h2
IF h - h2 > LEN(m$) THEN h = LEN(m$) + h2
LOCATE v, h2 - 1, 0: PRINT SPACE$(np + 1)
LOCATE v, h2: PRINT m$
lc = h - (h2 - 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 + h2 THEN h = np + h2
GOTO ple1
END IF

IF r2 = 8 THEN 'delete
IF h <> h2 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 = h2 'home
CASE 79
h = np + h2 '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
 

 

Précédente Accueil Remonter Suivante