ok, daję cały kod programu i kody z call stacka:
program lsdir;
{przeznaczenie programu: program pokazuje zawartosc folderu, w ktorym sie aktualnie <<znajduje>>,
pozwala na sortowanie ich ze wzgledu na date utworzenia, rozmiarów i dat,
zapisuje wyniki ostatniego wyszukiwania do katalogu programu. Po wpisaniu komendy "help" wyswietla pomoc;}
{$H+}
uses
dos, crt, sysutils;
{deklaracja modulu crt w celu uzycia komend clrscr i kolorowania tekstu,
dos w celu wykonywania operacji plikowych, sysutils dla fileexists i sortowania alfabetycznego}
type
TWskaznik = ^Tplik; {inicjowanie wskaznika}
Tplik = record {inicjowanie typu rekordu plik}
Nazwa : ansistring;
Rozmiar, Data, Atrybut : int64;
Nast : Twskaznik;
end;
function rozmiartostr(rozmiar:real):string; {funkcja zamieniajaca rozmiar pliku na string, i zaokraglajaca}
begin
rozmiar:=rozmiar/1048576;
str(rozmiar :8:2,rozmiartostr);
end;
procedure pomoc; {procedura wyswietlajaca pomoc}
begin
textcolor(12);
write('cd [argument] ');
textcolor(7);
writeln('- przejdz do...');
textcolor(12);
write('ls [-d/-n/-s] ');
textcolor(7);
writeln('- wyswietl liste - metoda sortowania(data, nazwa, rozmiar).');
textcolor(12);
write('pomoc ');
textcolor(7);
writeln(' - wyswietla te pomoc.');
textcolor(12);
write('koniec ');
textcolor(7);
writeln(' - wylacza program.');
end;
procedure czynapewno; {procedura wylaczajaca, dajaca mozliwosc powrotu do programu}
var
czy: char;
begin
czy:=' ';
writeln('Czy na pewno chcesz wyjsc z programu? t/n');
repeat
begin
delay(100);
czy:=readkey;
if czy = 't' then
begin
writeln('Bye!');
delay(1500);
halt;
end;
end;
until (czy='n')
end;
function cd(polecenie, gdzie: string):string; {funkcja ustalajaca sciezke z ktorej bedzie wyswietlana lista}
var
licznik:integer;
sciezka:string;
begin
licznik:=0;
sciezka := copy(polecenie,4,(length(polecenie)-3));
if length(polecenie)<4 then
writeln('Wpisz nazwe folderu/sciezke po poleceniu cd - <<cd nazwa_folderu/sciezka>>.')
else if copy(polecenie,4,2)= '..' then
begin
if length(gdzie)>2 then
begin
while (copy(gdzie,(length(gdzie)-licznik),1)<>'\') do
begin
inc(licznik);
end;
delete(gdzie,(length(gdzie)-licznik),licznik+1);
end;
end
else if copy(polecenie,4,1)= '.' then
begin end
else if copy(polecenie,5,2)= ':\' then
begin
if directoryexists(sciezka) then
begin
gdzie := sciezka;
end
else writeln('Podano zla sciezke, sprobuj ponownie.');
end
else if directoryexists(gdzie+'\'+sciezka) and (sciezka<>'') then
begin
gdzie := gdzie+'\'+sciezka;
end
else writeln('Nie ma takiego podfolderu, sprobuj ponownie.');
licznik:=0;
while (copy(gdzie,(length(gdzie)-licznik),1)=' ') or (copy(gdzie,(length(gdzie)-licznik),1)='/') or (copy(gdzie,(length(gdzie)-licznik),1)='\') do
begin
inc(licznik);
end;
delete(gdzie,(length(gdzie)-licznik+1),licznik);
cd:=gdzie;
end;
Procedure zapisz(Lista:Twskaznik); {procedura zapisujaca wyniki wyszukiwania do pliku}
const
NazwaPliku = 'lsdir.txt';
var
Plik : Text;
Linia : String;
i:integer;
begin
Assign (Plik, NazwaPliku);
Rewrite(Plik);
while Lista<>nil do
begin
Linia := Lista^.Nazwa;
for i:=1 to 50-length(Lista^.Nazwa) do linia:= linia+' ';
Linia := Linia+' '+DateTimeToStr(FiledateToDateTime(Lista^.Data))+' '+rozmiartostr(Lista^.Rozmiar);
for i:=1 to 8-length(rozmiartostr(Lista^.Rozmiar)) do linia:=linia+' ';
Linia := Linia+' MB';
Writeln(Plik,Linia);
Lista := Lista^.Nast;
end;
Close (Plik);
end;
procedure wyswietl(Lista:Twskaznik); {procedura wyswietajaca dynamiczna liste, koloruje nazwe folderu na zolto a pliku na jasno niebiesko}
var
i : integer;
kolor : byte;
begin
i:=0;
while Lista<>nil do
begin
if (Lista^.Atrybut=16) or (Lista^.Atrybut=17) or (Lista^.Atrybut=48) then kolor:=14
else kolor:=11;
textcolor(kolor);
Write (Lista^.Nazwa,'':45-length(Lista^.Nazwa));
textcolor(7);
Writeln(' ',DateTimeToStr(FiledateToDateTime(Lista^.Data)),' ',Lista^.Rozmiar/1048576 :9:2,' MB');
Lista := Lista^.Nast;
inc(i);
if i mod 24=0 then
begin
write('Aby wyswietlic kolejne wyniki nacisnij enter');
readln;
gotoxy(1,24);
end;
end;
end;
function dodaj(plik:Tsearchrec; lista:Twskaznik; param:char):Twskaznik; {funkcja dodajaca kolejny element do listy jednokierunkowej, sortujaca ze wzgledu na zadane kryterium}
var
E, Temp, Nast : TWskaznik;
begin
New (E);
E^.Nazwa := plik.Name;
E^.Data := plik.Time;
E^.Rozmiar := plik.Size;
E^.Atrybut := plik.Attr;
if param = 'n' then
begin
if (Lista = nil) or (Ansicomparetext(Lista^.nazwa,plik.name)>0) then
begin
E^.Nast := Lista;
Lista := E;
end
else
begin
Temp := Lista; Nast := Lista^.Nast;
while (Nast<> nil) and (Ansicomparetext(Lista^.nazwa,plik.name)<0) do
begin
Temp := Nast;
Nast := Nast^.Nast;
end;
E^.Nast := Nast;
Temp^.Nast := E;
end;
end
else if param = 'd' then
begin
if (Lista = nil) or (Lista^.data>plik.time) then
begin
E^.Nast := Lista;
Lista := E;
end
else
begin
Temp := Lista; Nast := Lista^.Nast;
while (Nast<> nil) and (Nast^.data<plik.time) do
begin
Temp := Nast;
Nast := Nast^.Nast;
end;
E^.Nast := Nast;
Temp^.Nast := E;
end;
end
else
begin
if (Lista = nil) or (Lista^.rozmiar>plik.size) then
begin
E^.Nast := Lista;
Lista := E;
end
else
begin
Temp := Lista; Nast := Lista^.Nast;
while (Nast<> nil) and (Nast^.rozmiar<plik.size) do
begin
Temp := Nast;
Nast := Nast^.Nast;
end;
E^.Nast := Nast;
Temp^.Nast := E;
end;
end;
dodaj:=lista;
end;
procedure Usun(glowa: TWskaznik);
var
Temp: Twskaznik;
begin
while glowa <> nil do
begin
temp := glowa^.Nast;
Dispose(glowa);
glowa := temp;
end;
end;
procedure ls(gdzie:string; param:char); {procedura wyszukujaca kolejnych plikow i folderow, przekazujaca dane do procedury dodaj}
var
plik, spr : tsearchrec;
lista : twskaznik;
begin
findfirst(gdzie+'\*.*', $00000031, plik);
while not (plik.name=spr.name) do
begin
if (plik.name<>'.') and (plik.name<>'..') then
begin
lista:=dodaj(plik, lista, param);
end;
spr:=plik;
findnext(plik);
end;
findclose(plik);
wyswietl(lista);
zapisz(lista);
usun(lista);
end;
procedure rozpoznaj(gdzie: string); {procedura rozpoznajaca wpisane polecenie}
var
polecenie:string;
param :char;
begin
while 1=1 do
begin
write(gdzie,'> ');
readln(polecenie);
if copy(polecenie,1,2) = 'cd' then gdzie:=cd(polecenie, gdzie)
else if copy(polecenie,1,2) = 'ls' then
begin
polecenie:=copy(polecenie,4,2);
if (polecenie = '-n') or (polecenie = '') or (polecenie= ' ') then param := 'n'
else if polecenie = '-d' then param := 'd'
else if polecenie = '-s' then param := 's'
else
begin
writeln('Podano zly parametr, wpisz pomoc aby uzyskac liste dostepnych parametrow');
end;
if (param='d') or (param ='s') or (param ='n') then ls(gdzie, param);
end
else if polecenie = 'koniec' then czynapewno
else if polecenie = 'pomoc' then pomoc
else writeln('Nie rozpoznano polecenia, wpisz pomoc, aby uzyskac liste dostepnych polecen.');
end;
end;
begin
clrscr;
rozpoznaj('c:');
end.
#0 fpc_ansistr_incr_ref at :0
#1 DODAJ({TIME = 1060265645, SIZE = 0, ATTR = 16, NAME = 0x309a70 'AsusVibeData', EXCLUDEATTR = 14, FINDHANDLE = 3217600, FINDDATA = {DWFILEATTRIBUTES = 16, FTCREATIONTIME = {DWLOWDATETIME = 1053172710, DWHIGHDATETIME = 30126695}, FTLASTACCESSTIME = {DWLOWDATETIME = 822180593, DWHIGHDATETIME = 30176753}, FTLASTWRITETIME = {DWLOWDATETIME = 822180593, DWHIGHDATETIME = 30176753}, NFILESIZEHIGH = 0, NFILESIZELOW = 0, DWRESERVED0 = 1966449043, DWRESERVED1 = 0, CFILENAME = 'AsusVibeData'#0#0#0#0#0#0#0#0'd'#254'B'#1#0#0#0#0'4'#1#0#0#0#0#1#0#128#254'B'#1'`'#253'B'#1#0#0#0#1#196#255'B'#1#213'q'#255'vq'#253#249'v'#187'15u'#0#0#0#0#231'15u,x'#19#183#4#181'A'#0#160'w'#178'tEo'#178't'#3#0#0#0#136#254'B'#1#1#0#0#0#156#254'B'#1#0#0#0#0#0#0#0#0#164#254'B'#1'5'#243'@'#0#3#0#0#0#136#254'B'#1#1#0#0#0#156#254'B'#1's'#0#0#0'T'#3#0#0#0#255'B'#1#1'e7u'#1#0#223'v'#0#0#0#0#222'z'#178't'#137#239'@'#0#7#0#0#0#0#0#1#0#13#0#0#0'T'#3#0#0#0#0#1#0#192#254'B'#1'M'#252'@'#0#0#0#0#0..., CALTERNATEFILENAME = 'ASUSVI~1'#0#233'A'#0#228#189}}, 0x76fb3cee, 110 'n') at lsdir.pas:173
#2 LS(0x417420 'c:', 110 'n') at lsdir.pas:253
#3 ROZPOZNAJ(0x417420 'c:') at lsdir.pas:285
#4 main at lsdir.pas:295