Czy zastanawił się kiedyś ktoś z Was jak za pomocą TP7 wyświetlić strukturę katalogów/plików?
Sprawa jest prosta w Delphi - tam są odpowiednie komponenty...
Czy potrzebny jest do tego celu Assembler?
Pozdrawiam
Czy zastanawił się kiedyś ktoś z Was jak za pomocą TP7 wyświetlić strukturę katalogów/plików?
Sprawa jest prosta w Delphi - tam są odpowiednie komponenty...
Czy potrzebny jest do tego celu Assembler?
Pozdrawiam
Kiedys dawno temu, kiedy pascal był (prawie - widze wstawki asm) jedynym znanym mi jezykiem ... Ograniczenie widać na pierwszy rzut oka... 1024 katalogi.
{$A-,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X-}
Unit DiscTree;
Interface
type dirtreetype=record count:integer;data:array[0..1023]of string[25] end;
function createtree:pointer;
procedure disposedirtree(var r:pointer);
function gettree(r:pointer;nr:integer):string;
procedure savetree(r:pointer;name:string);
function loadtree(name:string):pointer;
procedure changetree(r:pointer;nr:integer);
implementation
uses dos;
function createtree;
type intype=record count:integer;data:array[0..1024]of string[25] end;
var s:searchrec;
q:string;
d:dirstr;
p:^intype;
r:^dirtreetype;
procedure writeln(s:string);
begin
with p^ do
if count<1024 then
begin
data[count]:=copy(s,2,255);
inc(count)
end
end;
procedure inside(nr:byte);
var dr:string[12];
begin
findfirst('*.*',$ff,s);
while doserror=0 do
with s do
begin
while((attr and directory=0)or(name='.')or(name='..'))and(doserror=0)do findnext(s);
if(doserror=0)and(attr and directory<>0)then
begin
dr:=name;
writeln(copy(q,1,nr*2)+#32#195#196+name);
chdir(name);
inside(nr+1);
findfirst('*.*',$ff,s);
while(doserror=0)and(name<>dr)do findnext(s)
end;
attr:=0
end;
if nr>0 then chdir('..')
end;
procedure oczysc;
var i:integer;
j:byte;
begin
with p^ do
begin
for i:=count downto 1 do
for j:=1 to byte(data[i,0])do
case data[i,j] of
#195:if not(data[i+1,j] in[#179,#195,#192])then data[i,j]:=#192;
#179:if not(data[i+1,j] in[#179,#195,#192])then data[i,j]:=#32
end
end
end;
var i:integer;
begin
new(p);
fillchar(p^,sizeof(intype),0);
getdir(0,d);
chdir('');
writeln(#32+copy(d,1,3));
q[0]:=^@;
repeat q:=q+#32#179 until q[0]=#255;
inside(0);
chdir(d);
dec(p^.count);
oczysc;
with p^ do getmem(r,count*26+28);
move(p^,r^,p^.count*26+28);
dispose(p);
createtree:=r
end;
procedure disposedirtree;
begin
with dirtreetype(r^)do freemem(r,count*26+28)
end;
function gettree;
var s:string;
i:byte;
begin
s[0]:=^@;
with dirtreetype(r^)do
begin
while nr>0 do
begin
i:=pos(#196,data[nr]);
s:=copy(data[nr],i+1,255)+#92+s;
asm dec [i] end;
repeat dec(nr) until not(data[nr,i]in[#179,#195,#192]);
end;
s:=data[0]+s
end;
asm dec byte ptr [s] end;
gettree:=s
end;
procedure savetree;
var f:file;
begin
assign(f,name);
rewrite(f,1);
blockwrite(f,r^,dirtreetype(r^).count*26+28);
close(f)
end;
function loadtree;
var s:searchrec;
f:file;
r:^dirtreetype;
c:word;
begin
findfirst(name,archive,s);
if doserror<>0 then
begin
loadtree:=createtree;
exit
end;
assign(f,name);
reset(f,1);
blockread(f,c,2);
getmem(r,c*26+28);
blockread(f,r^.data[0],c*26+26);
r^.count:=c;
close(f);
loadtree:=r
end;
procedure changetree;
var s:string;
begin
s:=gettree(r,nr);
if s[0]=^b then s:=s+#92;
chdir(s)
end;
end.
{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X-}
{$M 16384,65536,655360}
uses vga_ega,disctree;
var p:pointer;
k1,k2:char;
i,y:int;
s:string;
label lab;
procedure puttree(i,y:integer);
var j,k:int;
begin
with dirtreetype(p^)do
begin
for j:=0 to 23 do
begin
attrline(3,3+j,$1b+$5f*byte(y=j),27);
if j+i<=count then
begin
for k:=1 to byte(data[i+j,0])do e[3+j,3+k].ch:=data[i+j,k];
for k:=byte(data[i+j,0])+1 to 26 do e[3+j,3+k].ch:=#32
end
end;
charline(1,28,#32,80);
print(2,28,gettree(p,i+y)+#92)
end
end;
const endstr:string='Koniec !'^M^J'Czekolade temu , kto potrafi takie drzewo posortowac'^m^j'Norton np. nie sortuje';
begin
getdir(0,s);
singleframe;
setblinking(false);
menucolors4;
setleftrightmenu(false);
setpol(true);
setxtkeyboard;
setxy(0,0);
cls($1e,#32);
line(1,1,$20,#32,80);
line(1,28,$20,#32,80);
frame(1,2,80,27,$1e);
vercharline(31,3,#179,24);
rozjasnij(vpal);
p:=createtree;
{savetree(p,'C:\PSTREE.PST');}
if ioresult=0 then;
if s[0]=^c
then i:=0
else
with dirtreetype(p^)do
for i:=0 to count do
if gettree(p,i)=s then goto lab;
lab:
if i<23 then y:=i;
with dirtreetype(p^)do
repeat
if i+23>count then
begin
i:=count-23
end;
if i<0 then i:=0;
puttree(i,y);
getkey(k1,k2);
case k1 of
^m:changetree(p,i+y);
^@:case k2 of
#72:if y>0
then dec(y)
else dec(i);
#80:if(y<23)and(y<count)
then inc(y)
else if i+22<count then inc(i);
end
end
until k1 in[^[,^m];
disposedirtree(p);
stop(2,endstr);
end.
// Czekolada nieaktualna, wyrosłem, teraz moglbym ewebtualnie postawić piwo (gdybym nie umial ;p).
// Dopisane : Od samego początku crt mi jakoś nie leżało, wolałem swoje :]
Oh my God 8-0
Jak widzę coś takiego to mnie krew normalnie zalewa...
Czy oni nie mogli wydać jakiegoś TP8 albo i TP9 nawet... po to żeby nie męczyć się próbami zrozumienia (napisania? - ROTFL) takich modułów?!
Kurde...
A znalazłeś to gdzieś w Necie czy sam napisałeś? :)
PZDR
// Sam, przecież nie opublikowałbym cudzych okrojonych zródel bez dodatkowego info skąd, od kogo i na podstawie jakiej licencji :] Jestem zbokiem i z pascala używałem tylko podstawowych bibliotek poza crt, reszte sam tworzyłem. A moduł jest napisany jak najbardziej prawidłowo. W razie czego w download/kody zródłowe/pascal w którymś z : literki.zip/tfd2.zip/edit_pla powinna byc wersja modułu ega_vga działajaca z demkiem[mf]