FUNCTION PBMAIN

'--------------------------------------------------------------------------------------------------------------------

' THIS IS THE POWERBASIC SOURCE CODE FOR Alvo by Ribeiro Alvo

'--------------------------------------------------------------------------------------------------------------------

FUNCTION PBMAIN

COLOR ,7

CONSOLE SET SCREEN 25, 80

CONSOLE NAME "Alvo"

LOCAL t,n,t2,y AS QUAD

LOCAL x,a,b,al,bl,xl,xll,am,xi AS EXT

LOCAL u,lim,mfp,us,pav,col,lin AS INTEGER

LOCAL p,q,mtp,m,pi,f,i,tico,ini,pap,pcp,mostra AS LONG

LOCAL fap,os,ost,nst,keyi,keyp,keyq,keyu,keys,k,ky,men,oldname,newname,kv,z AS STRING

y=&H7FFFFFFFFFFF0000

tico=5000000

mtp=2000

pap=1

pav=1

DIM w(1 TO mtp) AS LONG

DIM filesdisco(1 TO mtp) AS STRING, filescreen(1 TO mtp) AS STRING, frase(25) AS STRING, tabela(2) AS STRING

tabela(0)=CHR$(196)

tabela(1)=CHR$(185,186,187,188,200,201,202,203,204,205,206)

tabela(2)="0123456789ABCDEFGHIJKLMNOPQRSTUWVXYZ"

frase(3)=SPACE$(40)

frase(5)=frase(3)

frase(21)=frase(3)

frase(22)=frase(3)

frase(23)=frase(3)

'converts cp windows 1252 to cp 850

ost=CHR$(231,245,225,193,227,195,243,211,199,224,192,210,213,242,160,244,212,226,194,237,205,236,204,233,201,234,202,232,200,250,218,251,254,249,217)

nst=CHR$(128,229,181,181,199,199,224,224,128,183,183,227,229,227,181,226,226,182,182,214,214,222,222,144,144,210,210,212,212,233,233,234,234,235,235)

'-------------------------------------------------------------------------

findfiles:

CURSOR OFF

fap=DIR$ ("*.*" ONLY 0)

DO WHILE NOT fap=""

IF UCASE$(fap)<>"ALVO.EXE" THEN

INCR mfp

filesdisco(mfp)=UCASE$(fap)

END IF

fap=DIR$(NEXT)

LOOP

IF mfp<8 THEN lim=mfp-1 ELSE lim=7

ARRAY SORT filesdisco() FOR mfp

FOR i=1 TO mfp

fap=UCASE$(filesdisco(i))

IF MID$(fap,LEN(fap)-10,2)=" [" AND RIGHT$(fap,1)="]" THEN

w(i)=1

fap=LEFT$(fap,LEN(fap)-11)

END IF

IF LEN(fap)=<73 THEN filescreen(i)=LEFT$(fap,73)

IF LEN(fap)>73 THEN filescreen(i)=LEFT$(fap,69)+"..."

REPLACE ANY ost WITH nst IN filescreen(i)

IF mfp=0 THEN verfile

pav=0

'-------------------------------------------------------------------------

novo:

COLOR ,15

IF ini=pav THEN k=" P":ky="P":GOTO andar

GOSUB lista

novo2:

CLOSE 1

CURSOR OFF

GOSUB wait

novo1:

IF k=CHR$(27) AND men="" THEN COLOR 15,0:CLS:CURSOR ON:LOCATE ,:END

men=""

pav=pap

IF k="+" THEN tico+=1000000

IF k="-" THEN tico-=1000000

IF tico>10000000 THEN tico=10000000

IF tico<1000000 THEN tico=1000000

IF LEN(k)=2 THEN

kv=""

ky=RIGHT$(k,1)

IF ky="S" THEN GOSUB DELETA

IF ky="H" THEN DECR pap

IF ky="P" THEN INCR pap

IF ky="G" THEN pap=1:ky="H"

IF ky="O" THEN pap=mfp:ky="P"

IF ky="I" THEN pap=pap-lim:ky="H"

IF ky="Q" THEN pap=pap+lim:ky="P"

IF pap>mfp THEN pap=mfp

IF pap<1 THEN pap=1

END IF

IF ASC(k)>31 AND ASC(k)<127 AND kv<>k THEN

k=UCASE$(k)

GOSUB ALFA

END IF

andar:

IF ini<>pap THEN GOSUB LISTA:ini=pap

IF k=CHR$(13) THEN

GOSUB verfile

os=""

x=FRAC(TIMER)

a=x^x/2

IF w(pap)=0 THEN

FOR i=1 TO 8

a+=x

x=(a*x+a) MOD 1

os=os+MID$(tabela(2),INT(x*LEN(tabela(2)))+1,1)

END IF

os=" ["+os+"]"

IF w(pap)=1 THEN os=MID$(filesdisco(pap),LEN(filesdisco(pap))-10,11)

GOTO CHAVE

END IF

LOOP

'-------------------------------------------------------------------------

chave:

pcp=0

keyi="":keyp="":keyq="":keys=""

mostra=-1

COLOR 0,15

LOCATE 22,INT(20*xll)+14:STDOUT SPACE$(35);

LOCATE 22,INT(20*xll)+14:STDOUT keyi;

CURSOR ON,1

chav:

GOSUB wait

IF LEN(k)=2 AND RIGHT$(k,1)="R" THEN

mostra=mostra*-1

LOCATE 22,INT(20*xll)+14

IF mostra=-1 THEN STDOUT keyp; ELSE STDOUT keyi;

GOTO MOSTRAR

END IF

IF k=CHR$(27) THEN CLOSE 1:LOCATE 22,INT(20*xll)+14:STDOUT SPACE$(35);:CURSOR OFF:GOSUB lista:GOTO novo

IF LEN(k)=2 THEN

IF k<>CHR$(8) THEN LOCATE 22,INT(20*xll)+14:STDOUT SPACE$(35);:CLOSE 1:CURSOR OFF:GOSUB lista:GOTO novo1

END IF

IF k=CHR$(13) THEN

keys=LEFT$(keys+STRING$(34,"0"),34)

keyu=LEFT$(keys,17)

keyq=RIGHT$(keys,17)

x=(VAL(keyu)+VAL(keyq))/(2*10^17)

b=CVQ(os,3)/y

keyi="":keyu="":keyq="":keys=""

GOSUB valor

GOTO crypta

END IF

'-------------------------------------------------------------------------

mostrar:

IF ASC(k)>31 AND ASC(k)<126 AND pcp<34 THEN

keyp=keyp+CHR$(254)

keyi=keyi+k

keys=keys+RIGHT$(STR$(ASC(k) XOR pcp),1)

pcp=LEN(keyi)

LOCATE 22,INT(20*xll)+14+pcp-1

IF mostra=1 THEN STDOUT k; ELSE STDOUT CHR$(254);

END IF

IF ASC(k)=8 THEN

keyi=LEFT$(keyi,pcp-1)

keyp=LEFT$(keyp,pcp-1)

keys=LEFT$(keys,pcp-1)

pcp=LEN(keyi)

IF pcp=0 THEN h$=" "

LOCATE 22,INT(20*xll)+14+pcp:STDOUT " ";

LOCATE 22,INT(20*xll)+14+pcp:STDOUT "";

END IF

LOOP

'-------------------------------------------------------------------------

crypta:

CURSOR OFF

GOSUB valor

COLOR 0,15

LOCATE 22,INT(20*xll)+14:STDOUT SPACE$(35);

IF w(pap)=0 THEN LOCATE lin,INT(20*xll)+14

FOR n=t2 TO 0 STEP -p

SEEK 1,n

GET$ 1,p,z

IF pi<(t2-n+p)\q THEN

IF w(pap)=0 THEN

INCR col

IF col>34 THEN INCR lin:col=1:LOCATE lin,col+FIX(20*xll)+13

al+=xl

xl=(al*xl+al) MOD 1

am+=xi

xi=(am*xi+am) MOD 1

ELSE

DECR col

IF col<1 THEN DECR lin:col=34

LOCATE lin,col+FIX(20*xll)+13

END IF

pi=(t2-n+p)\q

STDOUT MID$(tabela(1-w(pap)),FIX(xi*LEN(tabela(1-w(pap))))+1,1);

END IF

a=b+1/(n+1)

FOR m=1 TO p STEP 8

a+=x

x=(a*x+a) MOD 2

MID$(z,m,8)=MKQ$(CVQ(z,m) XOR FIX(y*(x-1)))

SEEK 1,n

PUT$ 1, z

CLOSE 1

oldname=filesdisco(pap)

IF w(pap)=0 THEN

w(pap)=1

newname=oldname+os

ELSE

w(pap)=0

newname=LEFT$(oldname,LEN(oldname)-11)

END IF

NAME oldname AS newname

filesdisco(pap)=newname

COLOR ,15

LOCATE 22,INT(20*xll)+14:STDOUT SPACE$(35);

pav=0

GOTO novo:

'-------------------------------------------------------------------------

alfa:

kv=k

FOR i=1 TO mfp

IF LEFT$(filesdisco(i),1)=k THEN

pap=i

IF pap=>pav THEN k=" P":ky="P"

IF pap<=pav THEN k=" H":ky="H"

END IF

RETURN

'-------------------------------------------------------------------------

lista:

GOSUB valor

FOR u=6 TO 20

frase(u)=SPACE$(40)

FOR i=5 TO 38

al+=xl

xl=(al*xl+al) MOD 1

am+=xi

xi=(am*xi+am) MOD 1

MID$(frase(u),i)=MID$(tabela(w(pap)),INT(xi*LEN(tabela(w(pap))))+1,1)

xll=xl

frase(4)=SPACE$(4)+LEFT$((filescreen(pap)+SPACE$(34)),34)+SPACE$(2)

IF pap<>pav THEN

IF LEN(k)=2 AND ky="P" THEN

FOR u=1 TO 25

COLOR 0,7

SCROLL DOWN 1, 1,9,25,71

LOCATE 25,INT(20*xll)+10

COLOR ,15

STDOUT frase(u);

IF u>3 AND u<24 THEN COLOR ,8:STDOUT " ";

IF u=24 THEN LOCATE 25,INT(20*xll)+11:COLOR 8,7:STDOUT STRING$(40,223);

FOR i=1 TO tico:NEXT

END IF

IF LEN(k)=2 AND ky="H" THEN

FOR u=25 TO 1 STEP-1

COLOR 0,7

SCROLL UP 1, 1,9,25,71

LOCATE 1,INT(20*xll)+10

COLOR ,15

STDOUT frase(u);

IF u>3 AND u<24 THEN COLOR ,8:STDOUT " ";

IF u=24 THEN LOCATE 1,INT(20*xll)+11:COLOR 8,7:STDOUT STRING$(40,223);

FOR i=1 TO tico:NEXT

END IF

FOR u=1 TO 25

IF u<3 OR u>23 THEN COLOR 0,7 ELSE COLOR 0,15

LOCATE u,INT(20*xll)+10

STDOUT frase(u);

COLOR 8,7

LOCATE 3,INT(20*xll)+50:STDOUT CHR$(220);

RETURN

'-------------------------------------------------------------------------

deleta:

COLOR 12,15

LOCATE 22,INT(20*xll)+14:STDOUT SPACE$(35);

LOCATE 22,INT(20*xll)+14:STDOUT "Delete";

GOSUB wait

LOCATE 22,INT(20*xll)+14:STDOUT SPACE$(35);

IF k=CHR$(27) THEN GOTO novo

IF RIGHT$(k,1)<>"S" THEN GOSUB lista:GOTO novo1

IF RIGHT$(UCASE$(k),1)="S" THEN vai

IF k<>"" THEN LOCATE 22,INT(20*xll)+14:STDOUT SPACE$(35);:CLOSE 1:GOTO novo1

vai:

GOSUB verfile

COLOR ,15:LOCATE 22,INT(20*xll)+14:STDOUT SPACE$(35);

COLOR 0,15

col=0:lin=6

FOR n=1 TO t2 STEP p

IF pi<n\q THEN

INCR col

IF col>34 THEN INCR lin:col=1

LOCATE lin,col+INT(20*xll)+13

STDOUT " ";

pi=n\q

END IF

PUT$ 1,NUL$(p)

FOR i=6 TO 20

LOCATE i,INT(20*xll)+14

STDOUT SPACE$(34)

IF f>0 THEN PUT$ 1,SPACE$(f)

CLOSE 1

KILL filesdisco(pap)

FOR i=pap TO mfp

filesdisco(i)=filesdisco(i+1)

filescreen(i)=filescreen(i+1)

w(i)=w(i+1)

IF pap<mfp THEN k=" P":ky="P":pav=0

IF pap=mfp THEN k=" H":ky="H":DECR pap

DECR mfp

IF mfp>0 THEN GOSUB lista

IF mfp=0 THEN verfile

k="":ky=""

RETURN

'-------------------------------------------------------------------------

valor:

IF t<16384 THEN p=t ELSE p=16384

t2=INT(t/p)*p

f=t-t2

q=t2\510

pi=0

IF w(pap)=0 THEN col=0:lin=6

IF w(pap)=1 THEN col=35:lin=20

xl=.5

al=xl+pap/(mfp+1)

am=CVQ(os,6)

xi=CVQ(os,6)/(2^63-1)

RETURN

'-------------------------------------------------------------------------

verfile:

IF mfp=0 THEN men="No files":GOTO erro

OPEN filesdisco(pap) FOR BINARY AS 1 BASE =0

IF FILEATTR(1,0)=0 THEN men="File already open":GOTO erro

IF LOF(1)=0 AND k=CHR$(13) THEN men="Empty file":CLOSE 1:GOTO erro

t=LOF(1)

GOSUB VALOR

RETURN

'-------------------------------------------------------------------------

erro:

CURSOR OFF

COLOR 12,15

LOCATE 22,INT(20*xll)+14:STDOUT SPACE$(35);

LOCATE 22,INT(20*xll)+14:STDOUT men;

IF men="No files" THEN

COLOR ,7

CLS

END

END IF

GOSUB wait

LOCATE 22,INT(20*xll)+14:STDOUT SPACE$(35);:men=""

IF k=CHR$(27) THEN novo

LOCATE 22,INT(20*xll)+14:STDOUT SPACE$(35);:men="":GOTO novo1

'-------------------------------------------------------------------------

wait:

INPUT FLUSH

k=WAITKEY$

us=INSTAT

IF us=-1 THEN wait

RETURN

END FUNCTION

'--------------------------------------------------------------------------------------------------------------------

' END OF SOURCE CODE

'--------------------------------------------------------------------------------------------------------------------