---

Er der en af jer kloge hoveder der kan hjælpe mig?

Jeg skal havde lavet en procedure/function som kan fra et givent katalog gå
alle filer igennem incl. under kataloger, altså lige som en søge funktion.
Er der en der ligger inde med sådan en stump kode eller kan fortælle mig
hvordan jeg laver den?


På forhånd tak.

/md

---

"Michael" <michael@danwebportal.com> wrote in message
news:NEAT5.4929$VR3.120894@news010.worldonline.dk...
> Er der en af jer kloge hoveder der kan hjælpe mig?
>
> Jeg skal havde lavet en procedure/function som kan fra et givent katalog
gå
> alle filer igennem incl. under kataloger, altså lige som en søge funktion.
> Er der en der ligger inde med sådan en stump kode eller kan fortælle mig
> hvordan jeg laver den?
>
>
> På forhånd tak.
>
> /md
>
>

Jeg kan desværre ikke give dig kode, men hvis du kan tage dig til takke med
et komponent (med tilhørende kode selvfølgelig) ved jeg at der findes et
ganske glimrende et på www.torry.net - har lige downloadet det selv :)

- Thomas

---

Hej

Jeg mente nok jeg engang havde lavet en sådan function og efter lidt roden
rundt fandt jeg den også. Den kaldes med 2 param. (1 eller 2 filnavne)
f.eks. findfiler('notepad.exe',''); og den vil så finde frem til det bib. på
C drevet der indeholder filen notepad.exe. Meget simpel, men måske kan du
bruge det til noget.

MVH HK

function FindFiler(nr1,nr2 : string) : string;
var
sti : string;
fundet : boolean;

function checkforfiles : boolean;
begin
result:=false;
if (nr1<>'') and fileexists(sti+nr1) then
if (nr2='') or fileexists(sti+nr2) then
result:=true;
end;

procedure start;
var
rec : tsearchrec;
findresult : integer;
begin
findresult:=findfirst(sti+'*.*',faDirectory ,rec);
while (not fundet) and (findresult=0) do
begin
if (rec.attr and faDirectory=faDirectory) and (rec.name<>'.') and
(rec.name<>'..') then
begin
sti:=sti+rec.name+'\';
fundet:=checkforfiles;
start;
end;
findresult:=findnext(rec);
end;
if (not fundet) and (length(sti)>3) then
begin
delete(sti,length(sti),1);
while sti(.length(sti).)<>'\' do
delete(sti,length(sti),1);
end;
findclose(rec);
end;

begin
sti:='C:\';
fundet:=false;
start;
result:=sti;
end;

"Michael" <michael@danwebportal.com> skrev i en meddelelse
news:NEAT5.4929$VR3.120894@news010.worldonline.dk...
> Er der en af jer kloge hoveder der kan hjælpe mig?
>
> Jeg skal havde lavet en procedure/function som kan fra et givent katalog
gå
> alle filer igennem incl. under kataloger, altså lige som en søge funktion.
> Er der en der ligger inde med sådan en stump kode eller kan fortælle mig
> hvordan jeg laver den?

---

Michael wrote in message ...

>Jeg skal havde lavet en procedure/function som kan fra et givent katalog gå
>alle filer igennem incl. under kataloger, altså lige som en søge funktion.
>Er der en der ligger inde med sådan en stump kode eller kan fortælle mig
>hvordan jeg laver den?

Du skal lave en rekursiv procedure, der søger igennem kataloget og kalder
sig selv hvis den støder på underkataloger. Prøv denne her :

procedure SoegOgDuSkalFinde(dir:string;var FilListe:TStringList);
var T:TSearchRec;
R:integer;
begin
R:=findfirst(dir+'\*.*',faAnyFile,T);
while R=0 do
begin
if ((T.attr=faDirectory) and ((T.name<>'.') and (T.name<>'..'))) then
begin
SoegOgDuSkalFinde(dir+'\'+T.name,FilListe);
end else if T.attr=faArchive then
begin
FilListe.add(dir+'\'+T.name);
end;
R:=findnext(T);
end;
findclose(T);
end;

Alle filer der findes gemmes i FilListe, som returneres når sidste søgning
er foretaget (sidste fil i første katalog). Udvid den eksempelvis med en
maske (f.eks *.pas) eller lad proceduren få en maske med den kan gå ud fra.

Følgende kald gennemsøger hele C-drevet, og returnerer samtlige filer og den
sti de er på.

procedure TForm1.Button1Click(Sender: TObject);
var T:TStringList;
begin
T:=TStringList.create;
SoegOgDuSkalFinde('C:',T);
listbox1.items.assign(T);
end;

hilsen,

---

---

Niels (niLLer) wrote in message <3a202738.21416767@news.12move.dk>...

>Det ville jeg nok skrive om til:
>
>procedure TForm1.Button1Click(Sender: TObject);
>var
> T: TStringList;
>begin
> T := TStringList.Create;
> try
> SoegOgDuSkalFinde('C:', T);
> ListBox1.Items.Assign(T);
> finally
> T.free;
> end;
>end;

Hvorfor? Ja, jeg kan nok regne ud hvorfor, men der er imho ingen potentielle
fejlkilder i min søgeprocedure. Den er tværtom så enkel og sikker som den
overhovedet kan være. FindFirst og FindNext vil ikke generere exceptions, og
der arbejdes kun med TSearchRec'en ifald der rent faktisk ikke er opstået en
exception. Der opereres ikke på TStringListen udover at der addes, og den
eneste fejlkilde der kanm tænkes her er, hvis items når udover
maximumgrænsen der er når der køres 95/98.

Men OK, hvis man vil være overforsigtig er det fint, men du skal vide at al
kode indenfor en try...except blok bliver eksekveret langsommere.

hilsen,

---

Just as I expected, "David A. D. Konrad" <konrad@dadk.dk> came up with
this:

>Niels (niLLer) wrote in message <3a202738.21416767@news.12move.dk>...
>
>>Det ville jeg nok skrive om til:
>> try
>> finally
>> T.free;
>> end;

>Hvorfor? Ja, jeg kan nok regne ud hvorfor, men der er imho ingen potentielle
>fejlkilder i min søgeprocedure. Den er tværtom så enkel og sikker som den
>overhovedet kan være. FindFirst og FindNext vil ikke generere exceptions, og
>der arbejdes kun med TSearchRec'en ifald der rent faktisk ikke er opstået en
>exception. Der opereres ikke på TStringListen udover at der addes, og den
>eneste fejlkilde der kanm tænkes her er, hvis items når udover
>maximumgrænsen der er når der køres 95/98.
>
>Men OK, hvis man vil være overforsigtig er det fint, men du skal vide at al
>kode indenfor en try...except blok bliver eksekveret langsommere.

Ok, man kan sikkert godt droppe try..finally blokken, men det jeg mest
tænkte på var faktisk "T.Free" linien! Det er jo ikke så smart at lave
rod i rammen!

Niels (aka. niLLer)
--
e-mail: nmartin at iname dot com ICQ UIN: 50187323
http://xoasis.com/~niller/ - niLLer's pages (My programs, in English)
http://whitehat.dk/g4s/ - The G4S Page (Personlig side, på dansk)
-- Behind the end of nowhere!

---

Niels (niLLer) wrote in message <3a202ae1.22353460@news.12move.dk>...

>Ok, man kan sikkert godt droppe try..finally blokken, men det jeg mest
>tænkte på var faktisk "T.Free" linien! Det er jo ikke så smart at lave
>rod i rammen!

Nej, men det er jo en lokal variabel.

hilsen,

---

Just as I expected, "David A. D. Konrad" <konrad@dadk.dk> came up with
this:

>>Ok, man kan sikkert godt droppe try..finally blokken, men det jeg mest
>>tænkte på var faktisk "T.Free" linien! Det er jo ikke så smart at lave
>>rod i rammen!
>
>Nej, men det er jo en lokal variabel.

BLiver den så automatisk free'et? Det har jeg aldrig hørt om før!

Niels (aka. niLLer)
--
e-mail: nmartin at iname dot com ICQ UIN: 50187323
http://xoasis.com/~niller/ - niLLer's pages (My programs, in English)
http://whitehat.dk/g4s/ - The G4S Page (Personlig side, på dansk)
-- Behind the end of nowhere!

---

Niels (niLLer) wrote in message <3a202e65.23253606@news.12move.dk>...
>Just as I expected, "David A. D. Konrad" <konrad@dadk.dk> came up with
>this:
>
>>>Ok, man kan sikkert godt droppe try..finally blokken, men det jeg mest
>>>tænkte på var faktisk "T.Free" linien! Det er jo ikke så smart at lave
>>>rod i rammen!
>>
>>Nej, men det er jo en lokal variabel.
>
>BLiver den så automatisk free'et? Det har jeg aldrig hørt om før!

Sådan har jeg altid opfattet det. Når der hoppes ud af proceduren tælles der
jo ned i stakken. Se dette

procedure CreateDummyList;
var T:TStringList;
count:integer;
begin
T:=TStringList.create;
for count:=0 to 100 do T.add('qwertqwertyqwertyqwertyqwerty');
end;

procedure TForm1.Button2Click(Sender: TObject);
var count: integer;
begin
for count:=1 to 1000 do CreateDummyList;
end;

Hvis nu vi indfører følgende

procedure TForm1.Button2Click(Sender: TObject);
var count: integer;
TMS : TMemoryStatus;
begin
TMS.dwLength := SizeOf(TMS);
GlobalMemoryStatus(TMS);
messagedlg('Brugt memory
:'+inttostr(TMS.dwMemoryLoad),mtInformation,[mbOk],0);
for count:=1 to 1000 do CreateDummyList;
GlobalMemoryStatus(TMS);
messagedlg('Brugt memory
:'+inttostr(TMS.dwMemoryLoad),mtInformation,[mbOk],0);
end;

Vil det ganske vist se ud som om der bruges en masse hukommelse. Hvis du
derimod skriver

procedure CreateDummyList;
var T:TStringList;
count:integer;
begin
T:=TStringList.create;
for count:=0 to 100 do T.add('qwertqwertyqwertyqwertyqwerty');
T.free;
end;

Bliver der ikke brugt noget hukommelse, men hvis du placerer
"hokummelsescheckeren" i en anden procedure sådan her

procedure TForm1.Button3Click(Sender: TObject);
var TMS : TMemoryStatus;
begin
TMS.dwLength := SizeOf(TMS);
GlobalMemoryStatus(TMS);
messagedlg('Brugt memory
:'+inttostr(TMS.dwMemoryLoad),mtInformation,[mbOk],0);
end;

og fjerner T.free, Vil det i alle tilfælde kunne ses, at der før og efter
man har eksekveret Button2Click ikke er forskel på brugen af hukommelse.
Dette tolker jeg som at lokale variabler automatisk fjernes fra hokummelsen
når man hopper ud af den og stack-pointeren flyttes tilbage til forrige
programdel...Men de bliver ikke freet som normalt, men simptlhen blot
fjernet fra det lokale adresseområde de lokale variabler benyttede.

hilsen,

---

Just as I expected, "David A. D. Konrad" <konrad@dadk.dk> came up with
this:

>Sådan har jeg altid opfattet det. Når der hoppes ud af proceduren tælles der
>jo ned i stakken. Se dette

<snip en længere forklaring>

>Dette tolker jeg som at lokale variabler automatisk fjernes fra hokummelsen
>når man hopper ud af den og stack-pointeren flyttes tilbage til forrige
>programdel...Men de bliver ikke freet som normalt, men simptlhen blot
>fjernet fra det lokale adresseområde de lokale variabler benyttede.

Nå ja, lokale variabler bliver automatisk "renset væk fra tavlen", men
husk at en objekt-variabel (som f.eks. T i dit eksempel er en
TStringList) kun er en pointer til et objekt. Og det bliver ikke
automatisk free'et når en variabel bliver slettet.

T := nil;

vil jo heller ikke free'e objektet T.

Niels (aka. niLLer)
--
e-mail: nmartin at iname dot com ICQ UIN: 50187323
http://xoasis.com/~niller/ - niLLer's pages (My programs, in English)
http://whitehat.dk/g4s/ - The G4S Page (Personlig side, på dansk)
-- Behind the end of nowhere!

---

> Nå ja, lokale variabler bliver automatisk "renset væk fra tavlen", men
> husk at en objekt-variabel (som f.eks. T i dit eksempel er en
> TStringList) kun er en pointer til et objekt. Og det bliver ikke
> automatisk free'et når en variabel bliver slettet.

btw, som jeg har også har skrevt i en anden post
så var det anderledes i TurboVision (borland pascal 1992)
der skulle du eksplicit erklærer en variable som værende pointer til et
givent object foa selv at New + Dispose (brugt dengang)
derimod hvis du erklærede en variable direkter som værende af et object blev
den frigivet automatisk (men det har altså ændret sig)

Thomas

---

> Men OK, hvis man vil være overforsigtig er det fint, men du skal vide at
al
> kode indenfor en try...except blok bliver eksekveret langsommere.

du freer heller ikke din TStringList
(efter også at have læst TurboVision bøger ser jeg at det fungerede lidt
anderledes dengang i 1992, implementereingen af sproget har faktisk ændret
sig de sidste 8 år åbenbart, lettere overraskende..)

Thomas

---

Jeg har lige et tillægsspørgsmål.

listbox1.items.assign(T);
listBox1.items.addStrings(T);

hvad er forskellen på assign og AddStrings? De virker begge to
/md


"David A. D. Konrad" <konrad@dadk.dk> wrote in message
news:Q5VT5.8562$zs.258639@twister.sunsite.auc.dk...
> Michael wrote in message ...
>
> >Jeg skal havde lavet en procedure/function som kan fra et givent katalog
gå
> >alle filer igennem incl. under kataloger, altså lige som en søge
funktion.
> >Er der en der ligger inde med sådan en stump kode eller kan fortælle mig
> >hvordan jeg laver den?
>
> Du skal lave en rekursiv procedure, der søger igennem kataloget og kalder
> sig selv hvis den støder på underkataloger. Prøv denne her :
>
> procedure SoegOgDuSkalFinde(dir:string;var FilListe:TStringList);
> var T:TSearchRec;
> R:integer;
> begin
> R:=findfirst(dir+'\*.*',faAnyFile,T);
> while R=0 do
> begin
> if ((T.attr=faDirectory) and ((T.name<>'.') and (T.name<>'..'))) then
> begin
> SoegOgDuSkalFinde(dir+'\'+T.name,FilListe);
> end else if T.attr=faArchive then
> begin
> FilListe.add(dir+'\'+T.name);
> end;
> R:=findnext(T);
> end;
> findclose(T);
> end;
>
> Alle filer der findes gemmes i FilListe, som returneres når sidste søgning
> er foretaget (sidste fil i første katalog). Udvid den eksempelvis med en
> maske (f.eks *.pas) eller lad proceduren få en maske med den kan gå ud
fra.
>
> Følgende kald gennemsøger hele C-drevet, og returnerer samtlige filer og
den
> sti de er på.
>
> procedure TForm1.Button1Click(Sender: TObject);
> var T:TStringList;
> begin
> T:=TStringList.create;
> SoegOgDuSkalFinde('C:',T);
> listbox1.items.assign(T);
> end;
>
> hilsen,
>
>
>
>

---

Michael wrote in message ...
>Jeg har lige et tillægsspørgsmål.
>
>listbox1.items.assign(T);
>listBox1.items.addStrings(T);
>
>hvad er forskellen på assign og AddStrings? De virker begge to

Ikke det store. Assign typecaster parameteren til TStrings og kalder dernæst
AddStrings

hilsen,