Localize file www.TrSek.com/pas/secure.pas{ SECURE.PAS Copyright (c) TrSek alias Zdeno Sekerak }
{ Program pouziva arj.exe na ulozenie suboru a zakodovanie. }
{ Uzivatelsky prijemne prostredie. }
{ }
{ Datum:08.07.1993 http://www.trsek.com }
{$M 8192,0,55360}
program securite;
uses crt,dos,trsek;
const volba:array[1..3] of string=
('zakodovat','odkodovat','opustit..');
var s,z,pass:string;
i,is:integer;
procedure koniec;
begin
window(1,1,80,24);
farba(0,15);clrscr;
farba(1,14);write('SECURE Copyright (c). Software by TRSEK. All right reserved TRSEK.');
halt;
end;
function tread(x,y:integer;d:byte;s:string):string;
var s1,s2,sz:string;
st:char;
x1,i,ins:integer;
label tam;
begin
x1:=x;farba(15,0);ins:=1;kurzorZap(true);
s:=copy(s,1,d);
if length(s)<d then for i:=length(s) to d-1 do s:=s+' ';
gotoxy(x,y);write(s);sz:=s;
if (x>0) and (x<81) and (y>0) and (y<25) and(x+d<81) then
begin
gotoxy(x,y);
repeat
st:=readkey;
if (st=#27) then begin s:='';sz:='';end;
if (st=#27) or (st=#8) or (st=#0) or (st=#13) then
begin if st=#0 then
begin st:=readkey;
if st=#75 then x1:=x1-1;
if st=#77 then x1:=x1+1;
if st=#71 then x1:=x;
if st=#79 then begin i:=d+1;x1:=x+d;
repeat
i:=i-1;
s1:=copy(s,i,1);
if (s1=' ') then x1:=x+i-1;
until (i=0) or (not(s1=' '));
end;
end;
if st=#27 then begin gotoxy(x,y);write(sz);kurzorZap(false);tread:=sz;koniec;end;
if st=#8 then begin s1:=copy(s,1,x1-x-1);
s2:=copy(s,x1-x+1,d-x1+x);
s:=s1+s2+' ';
x1:=x1-1;
end;
if st=#83 then begin s1:=copy(s,1,x1-x);
s2:=copy(s,x1-x+2,d-x1+x);
s:=s1+s2+' ';
end;
if st=#82 then begin if ins=2 then ins:=1
else ins:=2;
end;
end
else begin
s1:=copy(s,1,x1-x);
s2:=copy(s,x1+ins-x,d-x1+x);
s:=s1+copy(st,1,1)+s2;
s:=copy(s,1,d);
x1:=x1+1;if (x1>x+d) then x1:=x+d;
end;
if x1<x then x1:=x;
if x1>x+d then x1:=x+d;
s:=copy(s,1,d);
gotoxy(x,y);writeln(s);gotoxy(x1,y);
until st=#13;
tread:=s;farba(0,15);kurzorZap(false);
end;
end;
procedure prikaz(s:string);
var Err:integer;
begin
SwapVectors;
Exec(GetEnv('COMSPEC'), '/C '+s);
SwapVectors;
end;
procedure DelFile(s:string);
var Sub:SearchRec;
begin
FindFirst(s, Archive or AnyFile, Sub);
if(DosError=0) then
prikaz('del '+s+'.arj >NUL');
end;
procedure koduj(s:string;i:integer);
var e:integer;
kl:char;
maz:boolean;
begin
if i=1 then begin
if(s[2]=':') then prikaz(copy(s,1,2));
DelFile(s+'.arj');
prikaz('arj a '+s+' -g'+pass+'>NUL');
open_win(22,18,62,22,'Varovanie',lightmagenta);
gotoxy(4,1);write('Vymazat ',s,'.txt');
gotoxy(16,3);write(' ano nie ');
farba(black,yellow);gotoxy(16,3);write(' ano ');
maz:=true;
repeat
kl:=readkey;
if kl=#75 then begin farba(black,yellow);
gotoxy(16,3);write(' ano ');
farba(lightmagenta,yellow);
gotoxy(22,3);write(' nie ');
maz:=true;
end;
if kl=#77 then begin farba(black,yellow);
gotoxy(22,3);write(' nie ');
farba(lightmagenta,yellow);
gotoxy(16,3);write(' ano ');
maz:=false;
end;
if kl=#27 then koniec;
until (kl=#13);
if maz then DelFile(s+'.txt');
end;
if i=2 then begin
prikaz(copy(s,1,2));
prikaz('arj e '+s+'.arj -g'+pass);
end;
end;
BEGIN
farba(black,yellow);
clrscr;
farba(blue,yellow);
gotoxy(1,1);write('SECURE Copyright (c). Software by TRSEK. All right reserved TRSEK.');
open_win(8,8,72,15,'K¢dovanie suboru ver. 1.2',blue);
gotoxy(7,2);write('Meno suboru pre (od)kodovanie: kniha');
gotoxy(21,3);write('Cesta k suborom: ');
gotoxy(31,4);write('Heslo:');
gotoxy(4,6);write(' ESC - prerusenie programu ENTER - potvrdenie prikazu');
pass:=tread(38,4,12,'');
while(pos(' ',pass) > 0) do delete(pass,pos(' ',pass),1);
if(pass='') then pass:='trsek';
farba(blue,yellow);
gotoxy(38,4);write(pass,' ');
open_win(39,12,77,16,'kontrolna otazka',red);
i:=1;
repeat
if copy(z,i,1)=' ' then delete(z,i,1)
else i:=i+1;
until (i>length(z));
if copy(z,length(z),1)='\' then s:=z+s
else s:=z+'\'+s;
i:=1;
repeat
if copy(s,i,1)=' ' then delete(s,i,1)
else i:=i+1;
until (i>length(s));
write(' subor ',s);
for i:=1 to 3 do begin
gotoxy(i*12-9,3);write(volba[i]);end;
farba(black,yellow);
gotoxy(3,3);write(volba[1]);
i:=1;is:=1;
repeat
z:=readkey;
if z=#75 then begin i:=i-1;
if i<1 then i:=3;
end;
if z=#77 then begin i:=i+1;
if i>3 then i:=1;
end;
if z=#27 then koniec;
farba(red,yellow);
gotoxy(is*12-9,3);write(volba[is]);
farba(black,yellow);
gotoxy(i*12-9,3);write(volba[i]);
is:=i;
until (z=#13);
if i=3 then koniec;
koduj(s,i);
koniec;
END.