Speicherentlastung bei Scanner Rotine

sexmagic · Hält's aus hier Beiträge: 14 WinXP Pro Delphi 2006 w32

Hallo Jungs,

ich hoffe ich habe die richtige Sectionn gewählt für mein Probelm.

Mein Vorhaben:
Der User gibt ein Verzeichnis an und eine Ordnergrösse.
Das Programm Scannt den gesamten Ordner nach unterordnern und listet alle Ordner die grösser als der angegebene Wert sind.

Meine derzeitige Struktur:
Ich habe 2 FUnktionen und ein Onlick Ereignis.
Die erste Funktion durchsucht den angegebenen Pfad und schreibt alle Ordnernamen mit gesamten Pfad in ein Array, dort werden alle Ordner gefunden.

Anschliessend wird das gesamte Array an die Funktion 2 übergeben und dort werden alle Pfade im Array nochmal auf grösse gescannt und in ein Memo geschrieben.

Das funktioniert ansich ganz gut NUR, wenn jemand auf die Idee kommt ein ganzes Laufwerk zu scannen und das vielleicht noh 100 GB hat dann kann das ganz schnell mal den Speicher vollpumpen und das is ja nicht der sinn des ganzen.

Nun zu meiner Frage:
Wie schreibt man sowas Resourcenschonend, Damit der Ram nicht vollgestopft wird und vielleciht auch noch die CPU nicht auf 100% rennt.
Ich bin für jeden Tip dankbar, da ich noch totaler Anfänger bin in Delphi habe ich von solchen Abläufen noch nicht so viel Ahnung.

Ich hoffe meine Beschreibung war ausreichend.

Vielen Dank für eure Unterstütung!

Born-to-Frag · Beiträge: 1094 Win XP SP2, Win 2000 SP4 Delphi 7, 2k5

Erstmal wegen dem Ram:

Immer wenn du einen neuen Eintrag findest, rufst du da SetLength(MyArray, Length(MyArray) + 1); oder so auf?

CPU: Wenn er nichts anderes zu tun hat ist das doch OK. Wenn du aber willst das dein Programm auch weiter reagiert und nicht hängt dann pack alles in einen Thread.

greetz

_________________
Theorie ist wenn man alles weiß, aber nichts funktioniert. Praxis ist wenn alles funktioniert, aber niemand weiß warum.
Microsoft vereint Theorie und Praxis: Nichts funktioniert und niemand weiß warum.

sexmagic · Hält's aus hier Beiträge: 14 WinXP Pro Delphi 2006 w32

Hier sind mal die 2 Funktionen und der Button:

Also das mit dem Memos ist nur damit ich sehe was der macht die würd ich am schluss weglassen und alles in eine Dateischreiben damit ich so ne art Logfile habe.

Aber is der Ablauf so ok oder sollte man das anders machen?
Wie gesagt ich bin total neu auf dem Gebiert und tu mich da noch nen bischen schwer.
In nem anderen Forum hätte ich mich eh garnicht zu fragen getraut weil da bekommt man nur was auf die Mütze wenn man als Anfänger fragen stellt

Danke nochmal!

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:

// Alle Ordner finden im angegebenen Directory
function TForm1.FolderSize(fld: string):dword;
var
  sr : Tsearchrec;
  r : Integer;
  s : DWord;
begin
  fld := IncludeTrailingBackslash( fld );

  s := 0;
  r := Findfirst( (fld+'*.*'), faDirectory, sr );
  while ( r = 0 ) do
  begin
    SetLength(Werte, i+1);
    Application.ProcessMessages;

    if ( (sr.Attr AND faDirectory) <> 0 ) then
    begin

      if ( (sr.Name <> '.') AND (sr.Name <> '..') ) then
      begin
        Werte[i].Pfad := fld + sr.Name;
        //Memo1.Lines.Add(inttostr(i) + ' -- ' + fld + sr.Name );
        s := s + Foldersize( fld + sr.Name );
      end;

    end else

    begin
      s := s + sr.FindData.nFileSizeLow;
    end;

    Inc(i);
    r := Findnext(sr);
  end;
  
  Sysutils.Findclose(sr);
  Result := s;
end;


//Funktion um die Ordnergrössen aus dem gefundenen Ordnerarry auszulesen
function TForm1.FolderSize2(fld2: string):dword;
var
  sr2 : Tsearchrec;
  r2 : Integer;
  s2 : DWord;
begin
  fld2 := IncludeTrailingBackslash( fld2 );

  s2 := 0;
  r2 := Findfirst( (fld2+'*.*'), faDirectory, sr2 );
  while ( r2 = 0 ) do
  begin
    SetLength(Werte, i+1);
    Application.ProcessMessages;

    if ( (sr2.Attr AND faDirectory) <> 0 ) then
    begin

      if ( (sr2.Name <> '.') AND (sr2.Name <> '..') ) then
      begin
        Werte[i].Pfad := fld2 + sr2.Name;
        Memo1.Lines.Add(inttostr(i) + ' -- ' + fld2 + sr2.Name );
        //s2 := s2 + Foldersize2( fld2 + sr2.Name );
      end;

    end else

    begin
      s2 := s2 + sr2.FindData.nFileSizeLow;
    end;

    Inc(i);
    r2 := Findnext(sr2);
  end;
  
  Sysutils.Findclose(sr2);
  Result := s2;
 end;


//Scan Button
procedure TForm1.Button1Click(Sender: TObject);
var k: integer;
    size: integer;
    st_fld: integer;
begin
  i:= 0;
  st_fld := 0;
   Caption := IntToStr( FolderSize(Edit1.Text) );
   ProgressBar1.Max := High(werte);

  if Edit1.Text = '' then
    ShowMessage('Geben Sie den Pfad an der durchsucht werden soll!')
  else if Edit2.Text = '' then
    ShowMessage('Geben Sie die mimimum Grösse an!')
  else
    begin

   for k:=Low(Werte) to High(Werte) do
   begin
     if Werte[k].pfad <> '' then
      begin
        size := ((Foldersize2(Werte[k].Pfad) div 1024) div 1024);
        if size >= StrToInt(Edit2.Text) then
          begin
             memo2.Lines.add(inttostr(k) + '  --  ' + Werte[k].pfad + '  --  ' + inttostr(size)+' MB');
            Label7.Caption := inttostr(Memo2.Lines.Count) + ' Ordner die grösser als '+ Edit2.Text + ' MB sind gefunden!';
            Label4.Caption := IntToStr(st_fld);
             Label2.Caption := IntToStr((FolderSize(Edit1.Text) div 1024) div 1024) + ' MB';

          end;
        ProgressBar1.Position := k-1;
        Inc(st_fld);
      end;
   end;
  end;
end;

Born-to-Frag · Beiträge: 1094 Win XP SP2, Win 2000 SP4 Delphi 7, 2k5

Ok genau wie ichs gesagt hab:

Du rufst immer wieder SetLength(Werte, i+1) auf. Das ist ein Problem und kostet nach ner zeit extrem viel Speicher (siehe hier). Mach es lieber so das du das Array immer um 1000 verlängerst und merke dir irgendwo wieviel wirklich davon verbraucht ist um es dann ggf. wieder du erhöhen.

Wegen den 100%, pack es lieber in einen thread dann kannst du die das Application.ProcessMessages die ganze Zeit sparen

_________________
Theorie ist wenn man alles weiß, aber nichts funktioniert. Praxis ist wenn alles funktioniert, aber niemand weiß warum.
Microsoft vereint Theorie und Praxis: Nichts funktioniert und niemand weiß warum.

sexmagic · Hält's aus hier Beiträge: 14 WinXP Pro Delphi 2006 w32

Also das mit dem Thread is mir noch etwas zu hoch glaub ich.

Habe ich das nun richtig verstanden mit dem Array:
-Ich setzte ne Globale variable "Groesse: integer = 1000;"
-Ich setze vor dem Schleifenbegin mit "SetLenght(Werte, Groesse)", dann in der schleife prüfe ich bei jedem durchgang den wert des Arrays mit "if Werte.count <= Groesse then" und führe den Block, sollte wert eben gleich gross sein setzte ich den Wert der Variable auf "Groesse := Groesse + 1000"

Ist das so richtig oder totaler schwachsinn? *gg*

Born-to-Frag · Beiträge: 1094 Win XP SP2, Win 2000 SP4 Delphi 7, 2k5

sexmagic hat folgendes geschrieben:

Also das mit dem Thread is mir noch etwas zu hoch glaub ich.

Habe ich das nun richtig verstanden mit dem Array:
-Ich setzte ne Globale variable "Groesse: integer = 1000;"
-Ich setze vor dem Schleifenbegin mit "SetLenght(Werte, Groesse)", dann in der schleife prüfe ich bei jedem durchgang den wert des Arrays mit "if Werte.count <= Groesse then" und führe den Block, sollte wert eben gleich gross sein setzte ich den Wert der Variable auf "Groesse := Groesse + 1000"

Ist das so richtig oder totaler schwachsinn? *gg*

Nein, Also du machst ne Globale Variable WerteCount: Integer = 0;

Dann ersetzt du das SetLength(Werte, i+1); durch

markieren

Delphi-Quelltext

1:
2:
3:

Inc(WerteCount);
if WerteCound mod 1000 = 0 then
  SetLength(Werte, Length(Werte) + 1000;

Und in FormCreate oder so machst du noch SetLength(Werte, 1000);

greetz

_________________
Theorie ist wenn man alles weiß, aber nichts funktioniert. Praxis ist wenn alles funktioniert, aber niemand weiß warum.
Microsoft vereint Theorie und Praxis: Nichts funktioniert und niemand weiß warum.

sexmagic · Hält's aus hier Beiträge: 14 WinXP Pro Delphi 2006 w32

Irgendwas stimmt da nicht, ich habs jetzt ausgebessert aber jetzt stürtzt das Programm immer mit einer Exception - Access Violation ab.

Ich langsam kenne ich mich selbst nichtmehr aus im code durch das ständige testen

Kannst du mal drüberschauen ob ich da sonst nen Bock geschossen habe in der allgemeinen Struktur, vielleicht sollte ich auch mal ne Runde drehen, ich glaub ich sehe den Wald vor lauter Büumen nichtmehr

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:

var
  Form1: TForm1;
  i: integer;
  werte: Array of TMeinArray;
  WerteCount: integer = 0;
  
implementation

{$R *.dfm}


// Alle Ordner finden im angegebenen Directory
function TForm1.FolderSize(fld: string):dword;
var
  sr : Tsearchrec;
  r : Integer;
  s : DWord;
begin
  fld := IncludeTrailingBackslash( fld );
  s := 0;
  r := Findfirst( (fld+'*.*'), faDirectory, sr );

  while ( r = 0 ) do
  begin
    Application.ProcessMessages;

    //Test
    Inc(WerteCount);
    if WerteCount mod 1000 = 0 then
    SetLength(Werte, Length(Werte) + 1000);
    //Test
    
    if ( (sr.Attr AND faDirectory) <> 0 ) then
    begin

      if ( (sr.Name <> '.') AND (sr.Name <> '..') ) then
      begin
        Werte[i].Pfad := fld + sr.Name;
        //Memo1.Lines.Add(inttostr(i) + ' -- ' + fld + sr.Name );
        s := s + Foldersize( fld + sr.Name );
      end;

    end else
    begin
      s := s + sr.FindData.nFileSizeLow;
    end;
    Inc(i);
    r := Findnext(sr);
  end;
  Sysutils.Findclose(sr);
  Result := s;
end;


//Funktion um die Ordnergrössen aus dem gefundenen Ordnerarry auszulesen
function TForm1.FolderSize2(fld2: string):dword;
var
  sr2 : Tsearchrec;
  r2 : Integer;
  s2 : DWord;
begin
  fld2 := IncludeTrailingBackslash( fld2 );
  s2 := 0;
  r2 := Findfirst( (fld2+'*.*'), faDirectory, sr2 );
while ( r2 = 0 )  do
  begin
    Application.ProcessMessages;
    if ( (sr2.Attr AND faDirectory) <> 0 ) then
    begin

      if ( (sr2.Name <> '.') AND (sr2.Name <> '..') ) then
      begin
        Werte[i].Pfad := fld2 + sr2.Name;
        Memo1.Lines.Add(inttostr(i) + ' -- ' + fld2 + sr2.Name );
        //s2 := s2 + Foldersize2( fld2 + sr2.Name );
      end;

    end else
    begin
      s2 := s2 + sr2.FindData.nFileSizeLow;
    end;
    Inc(i);
    r2 := Findnext(sr2);
  end;
  Sysutils.Findclose(sr2);
  Result := s2;
end;


//Scan Button
procedure TForm1.Button1Click(Sender: TObject);
var k: integer;
    size: integer;
    st_fld: integer;
begin
  i:= 0;
  st_fld := 0;
   Caption := IntToStr( FolderSize(Edit1.Text) );
   ProgressBar1.Max := High(werte);
  
  if Edit1.Text = '' then
    ShowMessage('Geben Sie den Pfad an der durchsucht werden soll!')
  else if Edit2.Text = '' then
    ShowMessage('Geben Sie die mimimum Grösse an!')
  else
    begin
   for k:=Low(Werte) to High(Werte) do
   begin
     if Werte[k].pfad <> '' then
      begin
        size := ((Foldersize2(Werte[k].Pfad) div 1024) div 1024);
        if size >= StrToInt(Edit2.Text) then
          begin
             memo2.Lines.add(inttostr(k) + '  --  ' + Werte[k].pfad + '  --  ' + inttostr(size)+' MB');
            Label7.Caption := inttostr(Memo2.Lines.Count) + ' Ordner die grösser als '+ Edit2.Text + ' MB sind gefunden!';
            Label4.Caption := IntToStr(st_fld);
             Label2.Caption := IntToStr((FolderSize(Edit1.Text) div 1024) div 1024) + ' MB';

          end;
        ProgressBar1.Position := k-1;
        Inc(st_fld);
      end;
    end;
   end;
  end;


//Form Create
procedure TForm1.FormCreate(Sender: TObject);
begin
  memo1.Text := '';
  memo2.Text := '';
  SetLength(Werte, 1000);
end;


//Abbrechen der Applikation
procedure TForm1.Button2Click(Sender: TObject);
begin
  memo1.Text := '';
  memo2.Text := '';
  i := 0;
  ZeroMemory(@Werte,SizeOf(Werte));
end;


//Nur Zahlen zulassen im Edit 2
procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
if not (Key in [#08, '0'..'9']) then
    Key := #0;
end;

Born-to-Frag · Beiträge: 1094 Win XP SP2, Win 2000 SP4 Delphi 7, 2k5

Geh doch mal im debugger durch, wo kommt die AV?

_________________
Theorie ist wenn man alles weiß, aber nichts funktioniert. Praxis ist wenn alles funktioniert, aber niemand weiß warum.
Microsoft vereint Theorie und Praxis: Nichts funktioniert und niemand weiß warum.

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme