Pomocou ARJ zabalí a zahesluje adresár, pascal

{ 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');
 
 s:=tread(38,2,10,'kniha');
 farba(blue,yellow);
 gotoxy(38,2);write(s,'          ');
 
 z:=tread(38,3,20,'');
 farba(blue,yellow);
 gotoxy(38,3);write(z,'                    ');
 
 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.