Program make archiv together password with ARJ in pascal
Delphi & Pascal (česká wiki)
Category: Source in Pascal
Program: Secure.pas
File exe: Secure.exe
Program: Secure.pas
File exe: Secure.exe
It just launches ARJ in a chosen file and packs it all under a previously defined password. It is able to restore, of course. The standard of the program user's interface lives up to the present requirements. Why did I use ARJ instead of ZIP? At the time of its writing, there were already the programs that could easily crack the password to get to the ZIP file. Up to this day there has been nothing above ARJ (probably because it is not used anymore).
{ 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.