{ MAIN.PAS Copyright (c) TrSek alias Zdeno Sekerak } { Cast kodu ktora sa prilinkuje k programu Tc.pas } { } { Datum:28.07.1996 http://www.trsek.com } { Zarovnava na nulu cislo ak je jedno ciferne 3->03 } function No0(w : Word) : String; var s:String; begin Str(w:0,s); if Ord(s[0])=1 then s:='0'+s; No0:=s; end; { vyrobi potrebny pocet medzier } function nothing(poc:byte):string; var noth:string; begin noth:=''; for poc:=poc downto 1 do noth:=noth+' '; nothing:=noth; end; { Vyrobi vsetky pismena velke } function UUpCase(noth:string):string; var i:byte; begin for i:=1 to ord(noth[0]) do noth[i]:=UpCase(noth[i]); UUpCase:=noth; end; { je aktivny CTRL } function ctrl_akt:boolean; begin if (mem[0:$417] and 4) > 0 then ctrl_akt:=true else ctrl_akt:=false; end; { je aktivny ALT } function alt_akt:boolean; begin if (mem[0:$417] and 8) > 0 then alt_akt:=true else alt_akt:=false; end; { Vypise na obrazovku text znaky s poziciou x,y } { attr-atribut textu } procedure writexy(x,y,attr:byte;znaky:string); var i:byte; begin for i:=1 to ord(znaky[0]) do obr^.znak_attr[y+1,x+i]:=(attr shl 8)+ord(znaky[i]); end; procedure konv_sub(meno_kon:pointer;atr:byte); { ak je subor prekonvertuje } var meno:^string; { na male pismena } i:byte; begin meno:=meno_kon; if (atr and $10)=0 then for i:=1 to ord(meno^[0]) do if (meno^[i] in ['A'..'Z']) then meno^[i]:=chr(ord(meno^[i])+32); end; { presunie medzi strukturov DTA a zozanmom } procedure presun(DTA:t_DTA;var subor:t_subor); var i,y:byte; begin subor.atr:=DTA.atr; { atribut } subor.cas:=DTA.cas; { neformatovany cas } subor.datum:=DTA.datum; { neformatovany datum } subor.size:=DTA.size; { velkost } subor.meno_kon:=''; for i:=1 to 12 do subor.meno_kon:=subor.meno_kon+' '; i:=1;y:=10; { meno.koncovka } while (not(DTA.meno_kon[i] in [#0,#46]) and (i<13)) do begin subor.meno_kon[i]:=DTA.meno_kon[i]; inc(i); end; if (DTA.meno_kon[i]<>#0) then begin inc(i); while (not(ord(DTA.meno_kon[i]) in [0]) and (i<13)) do begin subor.meno_kon[y]:=DTA.meno_kon[i]; inc(i);inc(y); end; end; { toto sa mi vobec nepaci } if (DTA.meno_kon[1]='.') then subor.meno_kon:='.. '; konv_sub(@subor.meno_kon,subor.atr); end; { Aby som nemal 2xkrat tu istu rutinu v napl_f } function t_findnext(cesta:string):byte; var Reg:Registers; begin Reg.AH:=$4f; { zisti dalsi subor rutina DOS 21 4f } Reg.DS:=Seg(cesta); { Segment ofset cesty } Reg.DX:=Ofs(cesta)+1; Intr($21,Reg); t_findnext:=Reg.AX; end; { odstran medzeri z retazca } function no_space(rret:string):string; var ret:string; begin ret:=rret; while (pos(' ',ret)>0) do delete(ret,pos(' ',ret),1); no_space:=ret; end; { uprav cestu odstran posledne lomitku atd. } procedure t_getdir(var cesta:string); begin cesta:=no_space(cesta); {$I-} chdir(cesta); {$I+} getdir(0,cesta); if (cesta[ord(cesta[0])]='\') then cesta[0]:=chr(ord(cesta[0])-1); end; { uvolni pamat po suboroch } procedure uvolni_f(subor:pointer); var p_subor,d_subor:^t_subor; begin if (subor<>NIL) then begin p_subor:=subor; while (p_subor^.zani<>p_subor) do p_subor:=p_subor^.zani; while (p_subor^.pred<>p_subor) do begin d_subor:=p_subor; p_subor:=p_subor^.pred; FreeMem(d_subor, SizeOf(t_subor)); end; FreeMem(p_subor, SizeOf(t_subor)); okno.subor:=NIL; end; end; { naplni obojsmerny zoznam menami suborov a vrati smernik na prvy z nich } { dir adresar bez posledneho \ filter napr. *.* Attr=ake atributy } { do poc vrati kolko ich nasiel } function napln_f(filter:string;Attr:word;var poc:integer):pointer; var Reg:Registers; cesta:string; DTA:t_DTA; p_subor,d_subor:^t_subor; { pomocne pre presuny } pp:pointer; begin uvolni_f(okno.subor); t_getdir(okno.cesta); Reg.AH:=$1a; { nastav DTA rutina DOS 21 1a } Reg.DS:=Seg(DTA); Reg.DX:=Ofs(DTA); Intr($21,Reg); Reg.AH:=$4e; { zisti prvy subor rutina DOS 21 4e } cesta:=okno.cesta+'\'+filter+chr(0); Reg.DS:=Seg(cesta); { Segment ofset cesty } Reg.DX:=Ofs(cesta)+1; Reg.CX:=Attr; Intr($21,Reg); Reg.AX:=t_findnext(cesta); GetMem(p_subor, SizeOf(t_subor)); { vyrob prvy .. } presun(DTA,p_subor^); p_subor^.pred:=p_subor; { predtym bolo NIL } p_subor^.zani:=p_subor; { predtym bolo NIL } napln_f:=p_subor; poc:=0; { toto mozno bude neskor vadit } pp:=p_subor; okno.p_subor:=pp; okno.k_subor:=pp; while (Reg.AX=0) do begin Reg.AX:=t_findnext(cesta); if (Reg.AX=0) then begin GetMem(d_subor, SizeOf(t_subor)); { vyrob zoznam obojsmerny } d_subor^.pred:=p_subor; d_subor^.zani:=d_subor; { predtym bolo NIL } p_subor^.zani:=d_subor; p_subor:=d_subor; p_subor^.oznac:=false; presun(DTA,p_subor^); inc(poc); end; end; okno.l_subor:=d_subor^.zani; end; { zarovnaj retazec na potrebny pocet znakov } function zarovnaj(ret:string;kolko:byte):string; begin if (ord(ret[0])>kolko) then ret[0]:=chr(kolko); if (ord(ret[0])=okno.xd) then writexy(x,y,attr,zarovnaj(ret,okno.xd-x-1)) else writexy(x,y,attr,ret); end; { vyznac pole posobnosti okna } procedure kde_text_okno(m_okno:pointer); var x,y:integer; okno:^t_okno; begin okno:=m_okno; for x:=1 to 80 do { znuluj ostatne } for y:=1 to 25 do uziv_obr[x,y]:=0; for x:=okno^.xh+1 to okno^.xd-1 do { toto je vnutro okna } for y:=okno^.yh+2 to okno^.yd-3 do uziv_obr[x,y]:=okno^.c_okna+144; for i:=okno^.xh to okno^.xd-2 do begin uziv_obr[i+1,okno^.yh]:=okno^.c_okna+16; { horny riadok } uziv_obr[i+1,okno^.yh+1]:=okno^.c_okna+128; { sipka hore } uziv_obr[i+1,okno^.yd]:=okno^.c_okna+80; { dolny riadok } uziv_obr[i+1,okno^.yd-2]:=okno^.c_okna+160; { sipka dole } uziv_obr[i+1,okno^.yd-1]:=okno^.c_okna+176; { PSP + info file } end; for i:=okno^.yh to okno^.yd-2 do begin uziv_obr[okno^.xh,i+1]:=okno^.c_okna+112; { lavy okraj } uziv_obr[okno^.xd,i+1]:=okno^.c_okna+48; { pravy okraj } end; uziv_obr[okno^.xh,okno^.yh]:=okno^.c_okna; { lavy horny } uziv_obr[okno^.xh,okno^.yd]:=okno^.c_okna+96; { lavy dolny } uziv_obr[okno^.xd,okno^.yh]:=okno^.c_okna+32; { pravy horny } uziv_obr[okno^.xd,okno^.yd]:=okno^.c_okna+64; { pravy dolny } end; { vykresli textove okno } procedure text_okno(o_full:t_full); var fi,i,p:integer; begin if (o_full=full) then okno.pocx:=trunc((okno.xd-okno.xh-2)/39) else okno.pocx:=trunc((okno.xd-okno.xh-2)/13); okno.pocy:=okno.yd-okno.yh-4; okno.poccel:=(okno.pocx+1)*okno.pocy; for i:=okno.xh to okno.xd-2 do begin writexy(i,okno.yh-1,okno.attr,''); writexy(i,okno.yd-1,okno.attr,''); uziv_obr[i+1,okno.yh]:=okno.c_okna+16; { horny riadok } uziv_obr[i+1,okno.yd]:=okno.c_okna+80; { dolny riadok } if (o_full in [brief,full]) then begin { ak to nie je obycajne okno } writexy(i,okno.yd-3,okno.attr,''); uziv_obr[i+1,okno.yh+1]:=okno.c_okna+128; { sipka hore } uziv_obr[i+1,okno.yd-2]:=okno.c_okna+160; { sipka dole } uziv_obr[i+1,okno.yd-1]:=okno.c_okna+176; { PSP + info file } end; end; for i:=okno.yh to okno.yd-2 do begin writexy(okno.xh-1,i,okno.attr,''); writexy(okno.xd-1,i,okno.attr,''); uziv_obr[okno.xh,i+1]:=okno.c_okna+112; { lavy okraj } uziv_obr[okno.xd,i+1]:=okno.c_okna+48; { pravy okraj } if (i(okno.xd-okno.xh)) then cesta:=cesta[2]+':\..'+ copy(cesta,ord(cesta[0])-okno.xd+okno.xh+6,80); writexy(okno.xh+trunc((okno.xd-okno.xh-ord(cesta[0]))/2),okno.yh-1,d_attr,cesta); end; { zo suboru vyrob riadok nazov velkost datum cas } function disp(subor:pointer;mznak:char):string; var k_subor:^t_subor; ret:string; begin k_subor:=subor; if (k_subor^.atr and $10)=$10 then ret:=chr(16)+'SUB--DIR'+chr(17) else ret:=t_istr(k_subor^.size,10); disp:=k_subor^.meno_kon+mznak+ret+mznak+ No0(k_subor^.datum and $1f)+'.'+No0((k_subor^.datum and $1e0) shr 5)+'.'+No0((k_subor^.datum shr 9)+80)+mznak+ No0((k_subor^.cas and $f800) shr 11)+':'+No0((k_subor^.cas and $7e0) shr 5)+mznak; end; { vypise do okna subor full/brief } procedure writexy_s(xh,x,y,d_attr:byte;o_full:t_full;subor:pointer); var po_subor:^t_subor; ret:string; fi:byte; begin if (subor=NIL) then if (o_full=full) then begin ret:=nothing(38); for fi:=1 to po_full do ret[ro_full[fi]+1]:=''; twritexy(xh+x*39,y,d_attr,ret) end else twritexy(xh+x*13,y,d_attr,nothing(12)) else begin po_subor:=subor; if (o_full=full) then twritexy(xh+x*39,y,d_attr,disp(po_subor,'')) else twritexy(xh+x*13,y,d_attr,po_subor^.meno_kon); end; end; { vypise do okna potrebne subory } procedure vypis_o(subor:pointer;k_subor:string;var kurx,kury:byte); var po_subor:^t_subor; pp:pointer; i,x,y:integer; begin i:=1;x:=0;y:=1; kurx:=0;kury:=1; po_subor:=subor; writexy_s(okno.xh,0,okno.yh+i,d_attr,okno.o_full,po_subor); while ( (po_subor^.zani<>po_subor) and (iokno.pocy) then begin y:=1;inc(x); end; po_subor:=po_subor^.zani; { ak sa nasiel pri vypise } if (po_subor^.meno_kon=k_subor) then begin kurx:=x;kury:=y; pp:=po_subor; { somarina, lebo Addr neviem rozchodit } okno.k_subor:=pp; end; writexy_s(okno.xh,x,okno.yh+y,d_attr,okno.o_full,po_subor); end; while (iokno.pocy) then begin y:=1;inc(x); end; writexy_s(okno.xh,x,okno.yh+y,d_attr,okno.o_full,NIL); end; if (kurx=0) and (kury=1) then okno.k_subor:=subor; disp_path(okno.cesta); path_okno(okno.cesta); end; { simuluje sipku hore } procedure si_hore(var kurx,kury:byte); begin dec(kury); if (kury<1) then begin kury:=1; if (kurx>0) then begin dec(kurx);kury:=okno.pocy;end else okno.p_subor:=okno.p_subor^.pred; end; okno.k_subor:=okno.k_subor^.pred; end; { simuluje sipku dole } procedure si_dole(var kurx,kury:byte); begin inc(kury); if (okno.k_subor^.zani=okno.k_subor) then dec(kury); if (kury>okno.pocy) then begin kury:=okno.pocy; if (kurx0) and (ako in [0,6,7]) then begin { vlavo pohni } move_leri(okno.xh,okno.xd,okno.yh,okno.yd,okno.pole_okna,true); dec(okno.xh);dec(okno.xd); end; if (x>okno.xh) and (okno.xd<80) and (ako in [0,6,7]) then begin { vpravo pohni } move_leri(okno.xh,okno.xd,okno.yh,okno.yd,okno.pole_okna,false); inc(okno.xh);inc(okno.xd); end; if (y0) and (ako in [0,1,2]) then begin { hore pohni } move_updo(okno.xh,okno.xd,okno.yh,okno.yd,okno.pole_okna,true); dec(okno.yh);dec(okno.yd); end; if (y>okno.yh) and (okno.yd<23) and (ako in [0,1,2]) then begin { dole pohni } move_updo(okno.xh,okno.xd,okno.yh,okno.yd,okno.pole_okna,false); inc(okno.yh);inc(okno.yd); end; if (xokno.xh+4) and (ako in [2,3,4]) then begin { vlavo zmens } size_left(okno.xh,okno.xd,okno.yh,okno.yd,okno.pole_okna); dec(okno.xd); text_okno(okno.o_full); vypis_o(okno.p_subor,okno.k_subor^.meno_kon,bla,bla); end; if (x>okno.xd) and (okno.xd<80) and (ako in [2,3,4]) then begin { vpravo zvacsi } size_right(okno.xh,okno.xd,okno.yh,okno.yd,okno.pole_okna); inc(okno.xd); text_okno(okno.o_full); vypis_o(okno.p_subor,okno.k_subor^.meno_kon,bla,bla); end; if (yokno.yh+5) and (ako in [4,5,6]) then begin { hore zmensi } size_up(okno.xh,okno.xd,okno.yh,okno.yd,okno.pole_okna); dec(okno.yd); text_okno(okno.o_full); vypis_o(okno.p_subor,okno.k_subor^.meno_kon,bla,bla); end; if (y>okno.yd) and (okno.yd<23) and (ako in [4,5,6]) then begin { dole zvasci } size_down(okno.xh,okno.xd,okno.yh,okno.yd,okno.pole_okna); inc(okno.yd); text_okno(okno.o_full); vypis_o(okno.p_subor,okno.k_subor^.meno_kon,bla,bla); end; until (but<>1); kde_text_okno(@okno); end; { prehodi poradie dvoch suborov } procedure change_sub(t_prvy,t_druh:pointer); var prvy,druh,tret:^t_subor; pom:pointer; begin prvy:=t_prvy;druh:=t_druh; pom:=prvy^.zani; prvy^.zani:=druh^.zani; druh^.zani:=pom; tret:=druh^.zani; tret^.pred:=druh; { ak je na konci pola } if (prvy^.zani=druh) then begin prvy^.zani:=prvy; pom:=prvy; okno.l_subor:=pom; end else begin tret:=prvy^.zani; tret^.pred:=prvy; end; pom:=prvy^.pred; prvy^.pred:=druh^.pred; druh^.pred:=pom; tret:=prvy^.pred; tret^.zani:=prvy; { ak je na zaciatku pola } if (druh^.pred=prvy) then begin druh^.pred:=druh; okno.subor:=druh; end else begin tret:=druh^.pred; tret^.zani:=druh; end; end; { nevyhovuje/vyhovuje podmienka sortovania ??? } function podmienka(prvy,druh:t_subor;ako:byte):boolean; begin podmienka:=false; if prvy.meno_kon[1]<>'.' then case ako of 1:if prvy.meno_kon>druh.meno_kon then podmienka:=true; 2:if prvy.meno_kon>druh.meno_kon then podmienka:=true; 3:if prvy.datum>druh.datum then podmienka:=true else if (prvy.datum=druh.datum) and (prvy.cas>druh.cas) then podmienka:=true; 4:if prvy.size>druh.size then podmienka:=true; 5:if prvy.meno_konprvy) do begin prvy^.meno_kon:=copy(prvy^.meno_kon,10,3)+copy(prvy^.meno_kon,1,9); prvy:=prvy^.zani; end; prvy^.meno_kon:=copy(prvy^.meno_kon,10,3)+copy(prvy^.meno_kon,1,9); end; prvy:=okno.subor; if (prvy^.meno_kon[1]='.') or (prvy^.meno_kon[4]='.') then prvy:=prvy^.zani; druh:=prvy; while (druh^.zani<>druh) do begin etal:=druh; prvy:=druh; while (prvy^.zani<>prvy) do begin prvy:=prvy^.zani; if ( ((etal^.atr and $10)<>$10) and ((prvy^.atr and $10)=$10)) then etal:=prvy else if podmienka(etal^,prvy^,ako) and ((etal^.atr and $10)=(prvy^.atr and $10)) then etal:=prvy; end; if (druh<>etal) then begin change_sub(druh,etal); druh:=etal^.zani; end else druh:=druh^.zani; end; if okno.sort in [2,6] then begin prvy:=okno.subor; while (prvy^.zani<>prvy) do begin prvy^.meno_kon:=copy(prvy^.meno_kon,4,9)+copy(prvy^.meno_kon,1,3); prvy:=prvy^.zani; end; prvy^.meno_kon:=copy(prvy^.meno_kon,4,9)+copy(prvy^.meno_kon,1,3); end; end;