Delphi-PRAXiS
Seite 1 von 2  1 2      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Delphi routine aendern(speichern in listbox>speichern in hashtable) (https://www.delphipraxis.net/135418-routine-aendern-speichern-listbox-speichern-hashtable.html)

nimmersattXD 10. Jun 2009 14:29


routine aendern(speichern in listbox>speichern in hashtab
 
Hallo zusammen!

ich habe mal wieder ein problem ;)

ich habe im EasyDelphiHelper eine schoene routine gefunden, die rekursiv nach dateien in ordnern sucht:

Delphi-Quellcode:

procedure GetFilesInDirectory(Directory: String; const Mask: String;
                              List: TStrings;
                              WithSubDirs, ClearList: Boolean);

procedure ScanDir(const Directory: String);
var
  SR: TSearchRec;
begin
  if FindFirst(Directory + Mask, faAnyFile - faDirectory, SR) = 0 then try
    repeat
      List.Add(Directory+SR.Name)
    until FindNext(SR) <> 0;
  finally
    FindClose(SR);
  end;

  if WithSubDirs then begin
    if FindFirst(Directory + '*.*', faAnyFile, SR) = 0 then try
      repeat
        if ((SR.attr and faDirectory) = faDirectory) and
           (SR.Name <> '.') and (SR.Name <> '..') then
          ScanDir(Directory + SR.Name + '\');
      until FindNext(SR) <> 0;
    finally
      FindClose(SR);
    end;
  end;
end;

begin
  List.BeginUpdate;
  try
    if ClearList then
      List.Clear;
    if Directory = '' then Exit;
    if Directory[Length(Directory)] <> '\' then
      Directory := Directory + '\';
    ScanDir(Directory);
  finally
    List.EndUpdate;
  end;
end;
die ergebnisse speicher ich in listboxes:

Delphi-Quellcode:

procedure TForm1.BtnSearchPicClick(Sender: TObject);
var direct:string;
begin
direct:=EdpathP.Text;

GetFilesInDirectory2(direct,'*.jpg',LiBoPathOfPics.Items,true,true);
GetFilesInDirectory2(direct,'*.png',LiBoPathOfPics.Items,true,false);
GetFilesInDirectory2(direct,'*.pdf',LiBoPathOfPics.Items,true,false);
GetFilesInDirectory2(direct,'*.bmp',LiBoPathOfPics.Items,true,false);
GetFilesInDirectory2(direct,'*.gif*',LiBoPathOfPics.Items,true,false);

GetFilesInDirectory1(direct,'*.jpg',LiBoPic.Items,true,true);
GetFilesInDirectory1(direct,'*.png',LiBoPic.Items,true,false);
GetFilesInDirectory1(direct,'*.pdf',LiBoPic.Items,true,false);
GetFilesInDirectory1(direct,'*.bmp',LiBoPic.Items,true,false);
GetFilesInDirectory1(direct,'*.gif*',LiBoPic.Items,true,false);

LbPic.Caption:=(IntToStr(LiBoPic.Count));

end;
ihr seht ich suche nach bildern!

so nun hab ich aber von meinem chef erfahren das mein programm mit hashtabellen viel schneller sein wuerde. nach ein bisschen suchen habe ich auch eine schoene unit csDictionary.pas von alzaimar gefunden.

Ich hab zuerst versucht mit einer zaehlschleife einfach alle items der listbox in die hashtabelle zu laden, aber es sind inkompatible typs pointer und string. Ich weiss das es am schnellsten waer wenn ich es anstatt in die listbox lade gleich in eine hashtabelle, leider weiss ich nicht so recht wie ich die routine umstellen soll!

kann mir da vielleicht jemand helfen?

alzaimar 10. Jun 2009 14:46

Re: routine aendern(speichern in listbox>speichern in has
 
Verwende den Dateinamen als Key und 'nil' für 'Data'. Die Unit stellt ein Wörterbuch dar, bzw. einen Container, der zu einem String (Key) Informationen (Data) liefert.

Wesentlich schneller geht das dann aber auch nicht, denn eine StringList ist schon recht flott. Du musst bei den ListBox.items nur daran denken, 'BeginUpdate' VOR und 'EndUpdate' NACH dem Aufruf aufzurufen, denn sonst wird die Listbox bei jeder Einfügeoperation nue gezeichnet.

nimmersattXD 10. Jun 2009 14:53

Re: routine aendern(speichern in listbox>speichern in has
 
mmh ich wollte eigentlich das ganze ohne listboxes machen und mit der GetFilesInDirectory() routine gleich in einer hashtabelle speichern! Da die routine aber mit TStrings arbeitet und das woerterbuch mit strings oder integers, muss ich sie aendern, oder?

himitsu 10. Jun 2009 14:54

Re: routine aendern(speichern in listbox>speichern in has
 
ich würde es garnicht erst in eine ListBox eintragen, sondern eine TStringList verwenden und diese dann für die HashList auslesen und an die ListBox übergeben.

oder gleich List: TStrings; durch die Hashlist ersetzen.


PS: was sollst du denn, laut Chäffe, damit beschleunigen können?
soeine Liste macht ja wirklich nur viel sinn, wenn du in der Liste etwas suchen willst,

also wenn die Liste entweder sehr groß ist oder du sehr schnell viel finden willst/mußt.

nimmersattXD 10. Jun 2009 14:59

Re: routine aendern(speichern in listbox>speichern in has
 
um das mal zu erklaeren: ich soll ein programm machen, das zum einen die bilder in einem ordner sucht und dann die urls von allen bildern die in htmls, htmlms und jsps auftreten. beides wird dann von dem programm verglichen, um so rauszufinden welche bilder noch benutzt werden und welche nicht.

ich hab das alles mit listboxes realisiert, also mit den namen der bilder die in den ordnern gefunden wurde und eine mit den namen die in den htmls gefunden wurden, die items hab ich dann einfach verglichen ... das geht schon ganz schnell wie ich finde, aber mein chef meinte hashtables sind wesentlich schneller im finden und so ...

himitsu 10. Jun 2009 15:10

Re: routine aendern(speichern in listbox>speichern in has
 
wenn du die VCL wegläßt und direkt TStringList verwendest, bekommst du auch noch schon "etwas" Zeit raus.


um wieviele Bilder handelt es sich denn, so im Durchschnitt
und wie schnell läuft es inzwischen?


ansonsten kommst du schneller, wenn du die Hashlist direkt in die Suchmethode reinbaust

bzw. darin gleich sofort das gesuchte vergleichst und und dann direkt di Liste mit den ungenutzten Bildern erstellst.

nimmersattXD 10. Jun 2009 15:15

Re: routine aendern(speichern in listbox>speichern in has
 
also es handelt sich um etwa 7600 bilder, aber da kommen viele doppelt vor ... noch ein grund warum ich hashlists benutzten wollte, um bevor ich ein bild hinzufuege erstmal suche ob es das nich schon in der liste gibt.

und die suchroutine mit hashlists umzubauen war ja genau meine idee, leider weiss ich nicht genau wie ich das anstellen soll ... deswegen das thema!

himitsu 10. Jun 2009 15:48

Re: routine aendern(speichern in listbox>speichern in has
 
Delphi-Quellcode:
procedure GetFilesInDirectory(const Directory, Mask: String;
    List: TStringDictionary; WithSubDirs, ClearList: Boolean);

  procedure ScanDir(const Directory: String);
    var
      SR: TSearchRec;

    begin
      if FindFirst(Directory + Mask, faAnyFile - faDirectory, SR) = 0 then
        try
          repeat
            //if not List.Contains(Directory + SR.Name) then
              List.Add(Directory + SR.Name);
          until FindNext(SR) <> 0;
        finally
          FindClose(SR);
        end;

      if WithSubDirs then begin
        if FindFirst(Directory + '*.*', faAnyFile, SR) = 0 then try
          repeat
            if ((SR.attr and faDirectory) = faDirectory) and
               (SR.Name <> '.') and (SR.Name <> '..') then
              ScanDir(Directory + SR.Name + '\');
          until FindNext(SR) <> 0;
        finally
          FindClose(SR);
        end;
      end;
    end;

  begin
    if ClearList then
      List.Clear;
    if Directory = '' then Exit;
    ScanDir(IncludeTrailingPathDelimiter(Directory));
  end;
Das ganze könnte man dann noch so optimieren, das gleich mehere Masken übergeben werden könnte,
man nur noch eine Suchschleife in der Funktion hat und selber filtert.
Zusätzlich muß die Suchfunktion dann auch nur noch einmal aufgerufen werden.

[edit]
Prüfung auf doppelte Einträge wieder rausgemacht (auskommentiert), denn Doppeltes kann hier ja nicht vorkommen :angel2:


[add]
http://www.delphipraxis.net/internal...034817#1034817
Delphi-Quellcode:
procedure GetFilesInDirectory(const Directory, Mask: String;
    List: TStringDictionary; WithSubDirs, ClearList: Boolean);

  procedure ScanDir(const Directory: String);
    var
      SR: TSearchRec;

    begin
      if FindFirst(Directory + '*.*', faAnyFile, SR) = 0 then try
        repeat
          if (SR.Name <> '.') and (SR.Name <> '..') then
            if SR.attr and faDirectory <> 0 then
            begin
              if WithSubDirs then
                ScanDir(Directory + SR.Name + '\')
            end
            else if MatchText(Mask, SR.Name, False) then
              List.Add(Directory + SR.Name);
        until FindNext(SR) <> 0;
      finally
        FindClose(SR);
      end;
    end;

  begin
    if ClearList then
      List.Clear;
    if Directory <> '' then
      ScanDir(IncludeTrailingPathDelimiter(Directory));
  end;



GetFilesInDirectory(direct, '*.jpg|*.png|*.pdf|*.bmp|*.gif*', Hashlist, True, True);

nimmersattXD 10. Jun 2009 16:17

Re: routine aendern(speichern in listbox>speichern in has
 
mmh war ja ganz leicht :)

leider bekomm ich jetzt ne fehlermeldung wenn ich auf den button klicke:

Access violation at address ... in module '... .exe'. write to address .... .

himitsu 10. Jun 2009 16:29

Re: routine aendern(speichern in listbox>speichern in has
 
also, ich hab den Code jetzt nicht getestet ... hab's nur so hingetippt und bin einfach davon ausgegangen, daß er so läuft :oops:


Hast du mal gedebugt und geschaut wo es knallt?

und du hast auch die Liste erstellt? :angel2:
Delphi-Quellcode:
List := TStringDictionary.Create;

nimmersattXD 10. Jun 2009 16:38

Re: routine aendern(speichern in listbox>speichern in has
 
ah ok, das wars :oops:

kann ich bei den hashtables eigentlich auch zwei spalten machen? also eigentlich drei :) mit key, path und dem namen der datei ?? und wenn ja wieder mach ich das ?

himitsu 10. Jun 2009 16:55

Re: routine aendern(speichern in listbox>speichern in has
 
du kannst ja an Data jedes Eintrages irgendwas anhängen ... also auch ein Record oder ein Object, mit den zusätzlichen Werten.

Aber wenn du wirklich nur den Dateinamen (ohne Pfad) als Key nimmst, dann mußt du wirklich noch aufpassen, daß/ob da kein Dateiname mehrfach vorkommt, da ja ein Key eindeutig sein muß.

nat 10. Jun 2009 17:44

Re: routine aendern(speichern in listbox>speichern in has
 
Zitat:

Zitat von himitsu
Aber wenn du wirklich nur den Dateinamen (ohne Pfad) als Key nimmst, dann mußt du wirklich noch aufpassen, daß/ob da kein Dateiname mehrfach vorkommt, da ja ein Key eindeutig sein muß.

das hatte ich mir auch schon überlegt (schon bei einem anderen thread des autors).
wer sagt denn, dass logo.jpg in ordner-A gleich ist mit logo.jpg in ordner-B?
(in bezug auf die aufgabenstellung: doppelte dateien finden)

nimmersattXD 10. Jun 2009 19:18

Re: routine aendern(speichern in listbox>speichern in has
 
mmh also is hashtables doch nicht sone gute idee oder wie? oder ich lass die pfade einfach weg, ich denk mal wenn das programm fertig ist, will mein chef eh noch eine routine, die die bilder löscht, die nicht gebraucht werden, dann ich die ja nochmal fix suchen ...

himitsu 10. Jun 2009 19:30

Re: routine aendern(speichern in listbox>speichern in has
 
du darfst die Bilder halt nicht am Namen unterscheiden, sondern solltest besser den Inhalt vergleichen.

zum nochmal schnell suchen:
wenn es mehrere Dateien mit dem selben Namen gibt, wie willst du dann entscheiden, welche gelöscht werden muß, wenn du den Pfad nicht mehr hast?

[add]
wenn es mehrere Einträge mit dem selben Namen/Key gibt, dann ist die hier derzeit verwendete Hashlist ungeeignet, da sie keine doppelten Keys erlaubt.

nimmersattXD 11. Jun 2009 09:16

Re: routine aendern(speichern in listbox>speichern in has
 
mmh vllt habt ihr mein programm nicht verstanden, selbst wenn das bild mehrmals als datei vorkommt, kann es trotzdem sein das es nicht in den htmls is, also dann auch nich in der andern tabelle, wenn das der fall kann es ja geloescht werden, und dann ist es ja nich mehr so schwer nochmal GetFilesInDirectory aufzurufen und damit dann alle zu loeschen!

was passiert eigentlich in der hashtabelle wenn was gespeichert werden soll, was schon drin is? wird das dann einfach verworfen?

eigentlich brauch ich jetzt nur noch eine zaehlschleife machen, die jedes objekt der hashpic mit den objekten der andern hash tabele zu vergleichen! wie kommt man denn an die einzelnen objekte einer solchen tabelle? haben die einen index, den ich durchgehen kann? ok also mit .first komm ich ja an das erste un mit next an die naechsten elemente, aber wie komme ich dann nur an den inhalt vom key, zum speichern in einer stringvariable??

nimmersattXD 11. Jun 2009 12:57

Re: routine aendern(speichern in listbox>speichern in has
 
hat denn keiner eine idee?

nat 11. Jun 2009 15:15

Re: routine aendern(speichern in listbox>speichern in has
 
was genau ist denn jetzt noch dein problem? ich blicke nicht mehr ganz durch ;)
formuliere mal ein paar konkrete probleme, dann versuche ich dir zu antworten 8)

nimmersattXD 11. Jun 2009 15:29

Re: routine aendern(speichern in listbox>speichern in has
 
also hier erstmal mein quelltext, bei dem ich hilfe brauche:


Delphi-Quellcode:

procedure TForm1.BtnSearchSitClick(Sender: TObject);
var direct,filename:string;
    page:TStringList;
    i,idx:integer;
    re:TRegExpr;
    such:Boolean;
    hashsit,hashpic:TStringDictionary;
begin
direct:=Edpaths.Text;
hashsit:=TStringDictionary.Create;
hashpic:=TStringDictionary.Create;

GetFilesInDirectory1(direct,'*.html',hashsit,true,true);
GetFilesInDirectory1(direct,'*.htmlm',hashsit,true,false);
GetFilesInDirectory1(direct,'*.jsp',hashsit,true,false);

LiBoSit.Items.Add('das geht auch :D');


//routine zum suchen der Url in den htmls

page:=TStringList.Create;
re:=TRegExpr.Create;

   try
   for i:=0 to hashsit.TotalCount-1 do
     begin
     page.LoadFromFile(hashsit.first);
     re.ModifierI:=true;
     re.ModifierG:=true;
     re.ModifierM:=false;
     re.ModifierS:=false;
     re.ModifierX:=false;
     re.Expression:='<img .*?src=[\\]??"([^"]*?)[\\]??"';
     such:=re.Exec(page.Text);
     if such then
       repeat
       idx:=LastPos('/',re.match[1]);
         if idx > 0 then filename:=copy(re.Match[1],idx+1,length(re.Match[1]))
           else filename:=re.match[1];
           filename:=ReplaceHex(filename);

       if not (filename = '') then hashpic.Add(filename,nil);

       until not re.ExecNext;
       end;
   finally
     LiBoPicsFoundInPages.Sorted:=true;
     page.Free;
     re.Free;
   end;


end;
wundert euch nicht, manche variablen hab ich noch nicht geloescht, nach dem umstellen von listbox auf hashtabellen!

so ich hab jetzt die pfade von den htmls in hashsit gespeichert, das scheint auch zu funktionieren. jetzt hab ich halt das problem dass ich nicht weiss wie ich an die keys in der tabelle komme, zb in der zeile:
page.LoadFromFile(hashsit.first);
das inkompatible typen, is ja klar, aber wie mach ich denn dass die zaehlschleife durch jede datei geht und nach der regex sucht? also wie komm ich an den key ran!

nat 11. Jun 2009 16:43

Re: routine aendern(speichern in listbox>speichern in has
 
also die TStringDictionary-Klasse gehst du so durch:
Delphi-Quellcode:
var
  Key: String;
  dummy: Pointer;
begin
  Dict.First;
  while Dict.Next(Key, dummy) do
  begin
    //mach was mit Key
  end;
ich weiß nich mehr genau wie du dadrin speicherst, aber ich denke
Key ist dann dein dateiname. und den daten pointer brauchst du ja nicht.

aber deine html-dateien (bzw, jsp usw.) brauchst du doch nicht in ner
hash-table speichern. das macht doch auch gar keinen sinn, denn du
möchtest doch JEDE html-datei nach images parsen, oder?

nimmersattXD 11. Jun 2009 16:46

Re: routine aendern(speichern in listbox>speichern in has
 
in dem key is ja nich der text der html dateien, sondern nur der pfad von ihnen gespeichert! :wink:

nat 11. Jun 2009 17:05

Re: routine aendern(speichern in listbox>speichern in has
 
warum nur der pfad?
also wenn ich mir den source weiter oben durchlese steh da doch
Delphi-Quellcode:
List.Add(Directory + SR.Name);
das sollte der komplette dateiname (inkl. pfad sein)
aber wie gesagt, du solltest die html-dateien lieber in
ner TStringList speichern. das macht mehr sinn.
und wie ist das bei den bildern? jedes bild mit gleichem
dateinamen ist auch gleich? egal in welchem ordner es liegt?

nimmersattXD 12. Jun 2009 09:18

Re: routine aendern(speichern in listbox>speichern in has
 
naja ich meinte den ganzen pfad mit dateinamen, un es funst auch soweit un is schneller als mit den listboxes!! un die html werden waehrend der suche nach den url doch in eine strinlist geladen ...

naja un das mit den bildern: ich weiss ehrlich gesagt nicht was du jetzt nich verstehst :) das programm nimmt sich ein bild, geht durch alle htmls und guckt ob es da auch drin steht, wenn nich kann es geloescht werden, egal ob es ein oder dreimal in den ordern vorkommt, es wird ja nicht benutzt!!

Ich werde jetzt versuchen, mein programm fertig zu machen, wenn ich hilfe brauch weiss ich ja wo ich sehr gute bekomme :)

nimmersattXD 12. Jun 2009 11:23

Re: routine aendern(speichern in listbox>speichern in has
 
so habs geschafft :) un es richtig richtig schnell, hab bestimmt einige minuten eingspart!

das einzige was mich jetzt noch stoert is, dass ich am anfang 3 buttons hatte: einen zum suchen der bilder in den ordern, einer szum suchen der seiten und der darin befindlichen urls und dann noch einen um die beiden sachen zu vergleichen, um das alles zusammenzufuegen hab ich timer benitzt, ABER leider kommt wenn ich das so mache wieder ein "access violation"-fehlermeldung ... mach ich es aber ohne timer, also wenn ich die drei button nacheinander klicke, kommt das nicht!

ich stell einfach mal meinen ganzen quelltext on, habs auch versucht alles zu kommenttieren:

Delphi-Quellcode:

unit pictureviewer;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls,StrUtils ,csDictionary;

type
  TForm1 = class(TForm)
    EdpathP: TEdit;
    Label1: TLabel;
    BtnSearchPic: TButton;
    Label2: TLabel;
    EdpathS: TEdit;
    BtnSearchSit: TButton;
    LiBoUnused: TListBox;
    LiBoUsed: TListBox;
    BtnSearchFin: TButton;
    Label3: TLabel;
    Label4: TLabel;
    BtnSaveRes: TBitBtn;
    SaveDialog1: TSaveDialog;
    Timer1: TTimer;
    Label5: TLabel;
    Label8: TLabel;
    LbPic: TLabel;
    LbSit: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    LbPicsFoundInPages: TLabel;
    Label11: TLabel;
    Timer2: TTimer;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    procedure BtnSearchPicClick(Sender: TObject);
    procedure BtnSearchSitClick(Sender: TObject);
    procedure BtnSearchFinClick(Sender: TObject);
    procedure BtnSaveResClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

//##############################################################################

implementation

uses RegExpr;

var
    hashsit,hashpicofsit,hashpic:TStringDictionary;

var cancel:boolean;


procedure GetFilesInDirectory1(Directory: String; const Mask: String; //findet gesuchte dateien in ordner und gibt einen string
                              List: TStringDictionary;                //zurueck (pfad der dateien zusammen mit dem namen)
                              WithSubDirs, ClearList: Boolean);

procedure ScanDir(const Directory: String);
var
  SR: TSearchRec;
begin
  if FindFirst(Directory + Mask, faAnyFile - faDirectory, SR) = 0 then try
    repeat
      List.Add(Directory+SR.Name,nil);
    until FindNext(SR) <> 0;
  finally
    FindClose(SR);
  end;

  if WithSubDirs then begin
    if FindFirst(Directory + '*.*', faAnyFile, SR) = 0 then try
      repeat
        if ((SR.attr and faDirectory) = faDirectory) and
           (SR.Name <> '.') and (SR.Name <> '..') then
          ScanDir(Directory + SR.Name + '\');
      until FindNext(SR) <> 0;
    finally
      FindClose(SR);
    end;
  end;
end;

begin
    if ClearList then
      List.Clear;
    if Directory = '' then Exit;
    ScanDir(IncludeTrailingPathDelimiter(Directory));
end;

//##############################################################################

procedure GetFilesInDirectory(Directory: String; const Mask: String; //routine wie oben, gibt aber nur den namen der datei zurueck
                              List: TStringDictionary;
                              WithSubDirs, ClearList: Boolean);

procedure ScanDir(const Directory: String);
var
  SR: TSearchRec;
begin
  if FindFirst(Directory + Mask, faAnyFile - faDirectory, SR) = 0 then try
    repeat
      List.Add(SR.Name,nil);
    until FindNext(SR) <> 0;
  finally
    FindClose(SR);
  end;

  if WithSubDirs then begin
    if FindFirst(Directory + '*.*', faAnyFile, SR) = 0 then try
      repeat
        if ((SR.attr and faDirectory) = faDirectory) and
           (SR.Name <> '.') and (SR.Name <> '..') then
          ScanDir(Directory + SR.Name + '\');
      until FindNext(SR) <> 0;
    finally
      FindClose(SR);
    end;
  end;
end;

begin
    if ClearList then
      List.Clear;
    if Directory = '' then Exit;
    ScanDir(IncludeTrailingPathDelimiter(Directory));
end;

//##############################################################################

function LastPos(const needle, Haystack: String):integer; //findet die letzte position eines Zeichens in einem string
var idx: integer;
begin
  result := 0;
  idx := 0;
  repeat
    idx := PosEx(needle,Haystack,idx+1);
    if idx>0 then result := idx;
  until idx = 0;
end;

//##############################################################################

function ReplaceHex(url: string):string; //aendert zb ein %20 in ein leerzeichen
var idx,code: integer;
    hex: string;
begin
  idx:=0;
  result:=url;
  repeat
    idx := PosEx('%',result,idx+1);
    if idx>0 then
      begin
      hex:=copy(result,idx+1,2);
      if TryStrToInt('$'+hex,code) then
        begin
        result[idx]:=chr(code);
        delete(result,idx+1,2);
        end;
      end;
  until idx = 0;

end;

{$R *.dfm}

//##############################################################################
//##############################################################################

procedure TForm1.BtnSearchPicClick(Sender: TObject); //zum finden der Bilder in Ordner
var direct:string;
begin
direct:=EdpathP.Text;
hashpic:=TStringDictionary.Create;

GetFilesInDirectory(direct,'*.jpg',hashpic,true,true);
GetFilesInDirectory(direct,'*.png',hashpic,true,false);
GetFilesInDirectory(direct,'*.pdf',hashpic,true,false);
GetFilesInDirectory(direct,'*.bmp',hashpic,true,false);
GetFilesInDirectory(direct,'*.gif*',hashpic,true,false);

LbPic.Caption:=inttostr(hashpic.TotalCount);

end;



procedure TForm1.BtnSearchSitClick(Sender: TObject);  //zum finden der Seiten in den ordnern und der urls der bilder
var direct,filename,key:string;                       //in den html
    dummy:Pointer;
    page:TStringList;
    idx:integer;
    re:TRegExpr;
    such:Boolean;
begin
direct:=Edpaths.Text;
hashsit:=TStringDictionary.Create;
hashpicofsit:=TStringDictionary.Create;

GetFilesInDirectory1(direct,'*.html',hashsit,true,true);
GetFilesInDirectory1(direct,'*.htmlm',hashsit,true,false);
GetFilesInDirectory1(direct,'*.jsp',hashsit,true,false);

Panel2.Color:=clGreen;
//routine zum suchen der Url in den htmls

page:=TStringList.Create;
re:=TRegExpr.Create;
hashsit.First;

   try
   while hashsit.Next(key,dummy) do
     begin
     page.LoadFromFile(key);
     re.ModifierI:=true;
     re.ModifierG:=true;
     re.ModifierM:=false;
     re.ModifierS:=false;
     re.ModifierX:=false;
     re.Expression:='<img .*?src=[\\]??"([^"]*?)[\\]??"';
     such:=re.Exec(page.Text);
     if such then
       repeat
       idx:=LastPos('/',re.match[1]);
         if idx > 0 then filename:=copy(re.Match[1],idx+1,length(re.Match[1]))
           else filename:=re.match[1];
           filename:=ReplaceHex(filename);

       if not (filename = '') then hashpicofsit.Add(filename,nil);

       until not re.ExecNext;
       end;
   finally
     page.Free;
     re.Free;
   end;

   LbSit.Caption:=inttostr(hashsit.TotalCount);
   LbPicsFoundInPages.Caption:=inttostr(hashpicofsit.TotalCount);

   Panel3.Color:=clGreen;

end;


procedure TForm1.BtnSearchFinClick(Sender: TObject); //vergleicht gefundene bilder(aus ordner) und gefundene bilder(in htmls)
var anzPic,anzPicofsite,si,sj:integer;
    key:string;
    check:boolean;
    dummy:pointer;
begin

Timer1.Enabled:=true; //hier startet die TForm1.BtnSearchPicClick
Panel1.Color:=clGreen;
Timer2.Enabled:=true; //hier startet die TForm1.BtnSearchSitClick


hashpic.First;

if (hashpic.TotalCount>0) and (hashpicofsit.TotalCount>0) then
 begin
 Screen.Cursor:=crHourGlass ;
   try
    while hashpic.Next(key,dummy) do
     begin
     hashpicofsit.First;
     BtnSearchFin.Caption:='SEARCHING ...' ;
     if hashpicofsit.Find(key,dummy)
        then LiBoUsed.ItemIndex:=LiBoUsed.Items.Add(key)
        else LiBoUnused.ItemIndex:=LiBoUnused.Items.Add(key)
     end;
   finally
      begin
      Label5.Visible:=true;
      LiBoUsed.Sorted:=true;
      BtnSearchFin.Caption:='Search for unused pictures';
      screen.cursor:=crdefault;
      end;
   end;
end;

end;

end.

nat 12. Jun 2009 11:52

Re: routine aendern(speichern in listbox>speichern in has
 
also wenn du dein progamm noch beschleunigen willst, dann würde ich deine
GetFilesInDirectory so abändern, dass sie nur 1x aufgerufen wird.
die gültigen dateiendungen kann man z.B. in ner hash-table speichern und
dann die dateiendung der aktuellen datei in der hash-table suchen.
so z.B.:

Delphi-Quellcode:
  //brauchste nur 1x machen z.B. beim erstellen des forms
  FDictImageExt := TStringDictionary.Create;
  FDictImageExt.CaseSensitive := true;
  FDictImageExt.Add('.jpg');
  FDictImageExt.Add('.jpeg');
  FDictImageExt.Add('.gif');
  FDictImageExt.Add('.png');
  FDictImageExt.Add('.bmp');
  FDictImageExt.Add('.pdf');
und dann änderst du deine Routine so ab
Delphi-Quellcode:
procedure TForm1.GetFilesInDirectory(const Directory: String);
var
  SR: TSearchRec;
  Filename, Key: String;
begin
  if FindFirst(Directory + '*.*', faAnyFile, SR) = 0 then
  repeat
    if (SR.Name = '.') or (SR.Name = '..') then
      Continue;

    Filename := Directory + SR.Name;
    if (SR.Attr and faDirectory) = faDirectory then
      GetFilesInDirectory(Filename + '\')
    else
      if FDictImageExt.Contains(ExtractFileExt(Filename)) then
      begin
        //Filename ist ein Bild, mache etwas damit
      end;
  until FindNext(SR) <> 0;
end;

//aufruf
GetFilesInDirectory(IncludeTrailingPathDelimiter(direct));
du könntest dann noch als parameter eine liste übergeben
und dadrin die gefundenen bilder speichern oder in
einem feld deiner klasse speichern oder sonst wo :)

der vorteil ist, du gehst die dateien wirklich nur 1x durch.
bei deiner methode gehst du pro dateiendung 1x durch die dateien
durch. also in deinem fall 5x.
das gleiche gilt i.ü. für deine html-files... wo du nach 3 endungen
suchst, also auch 3x alle dateien durchgehst. das könnte man genau
so in in einem rutsch erledigen!

nimmersattXD 12. Jun 2009 11:55

Re: routine aendern(speichern in listbox>speichern in has
 
jo das waer ne gute idee, nur was ist mit meinem problem mit den timern un der fehleremeldung ??

nat 12. Jun 2009 13:39

Re: routine aendern(speichern in listbox>speichern in has
 
warum nimmst du dafür eigentlich timer?
davon mal abgesehen, dass in dem source-code, den du oben gepostet hast,
keine ontimer-methoden drin sind. wenn das dein ganzer code is, dann
hast du den timern gar kein event zugewiesen. ansonsten fehlt der code
und ich kann nicht sehen was da gemacht wird. und der satz "da kommt
ne access violation" (so in der art) ist nicht sonderlich hilfreich
bei der fehlersuche. wo (=zeile) und wann(=wenn du was gemacht hast) tritt der fehler genau auf!

nimmersattXD 12. Jun 2009 13:50

Re: routine aendern(speichern in listbox>speichern in has
 
ich hab ja auch bei der ontimer routine die btnsearch routinen eingefuegt, also im oi bei events. und das mit dem debuggen hab ich grad ausprobiert, aber egal wo ich den roten punkt hinmache, die fehlermeldung kommt gleich wenn ich auf den btnsearchfin klicke. ich finds halt nur komisch, dass wenn ich auf die button so einzeln klicke, alles einwandfrei funktioniert, aber wenn ich das den timern 'uebelasse' kommt die fehlermeldung kurz nachdem er das macht:
Delphi-Quellcode:
LbPic.Caption:=inttostr(hashpic.TotalCount);
klicke ich bei der fehlermeldung einfach auf ok, dann macht er auch einfach weiter!

nat 12. Jun 2009 14:18

Re: routine aendern(speichern in listbox>speichern in has
 
häng doch mal dein ganzes projekt an. dann kann ich das schnell debuggen.
is mir nun etwas zu komplex da alles genau durch zu gucken :)
könnte mir vorstellen, dass das mit den timern zusammen hängt.
wenn du timer1.enabled machst, wartet dein programm nicht bis
die ontimer-routine (in deinem fall die button-click-methode) fertig ist,
sondern macht so weiter (panel färben, timer2.enabled, deine anweisungen danach).
denke, da wird es dann knallen. kannst es mal mit buttonXYZ.click; versuchen
statt deinen timern.

nimmersattXD 12. Jun 2009 14:24

Re: routine aendern(speichern in listbox>speichern in has
 
Liste der Anhänge anzeigen (Anzahl: 1)
ok mit den btn123.click gehts aber ich moechte ja dass sich die panels nacheinander gruen faerben, aehnlich wie bei einer ampel :)


aber hier mal mein prog!

ps: ich arbeite grad an dem save-button, also nich beachten ;) ausser du kannst mir dabei auch noch helfen :stupid:

nat 12. Jun 2009 15:21

Re: routine aendern(speichern in listbox>speichern in has
 
das problem ist, dass du dem programm ja keine zeit gibts die farbänderung
auch an zu zeigen, da du ja noch in deiner routine steckt (und dein
programm damit in dem mom beschäftigt ist). du kannst dem programm
zeit geben diese dinge zu bearbeiten indem du einmal
Application.ProcessMessages; aufrufst nachdem du was geändert hast
(z.B. deine panel-farbe). alternativ könntest du deine ganze routine
in einene thread verpacken. dann würde dein programm auch nicht mehr
einfrieren. aber das is doch etwas komplexer :) (zumindest wenn man
es noch nie gemacht hat)

nimmersattXD 12. Jun 2009 15:33

Re: routine aendern(speichern in listbox>speichern in has
 
hey jetzt wirds langsam, echt cool was ihr alles wisst :) machst du das beruflich nat oder studierst du das?? muss ja irgendwo herkommen :) man sieht ja bei mir das normales schuldelphi nicht unbedingt tiefgreifend ist :tongue:

das mit dem threading hab ich schon irgendwo gelesen, aber ich glaub das programm is im mom schon so schnell, das es nicht stoert dass es einfriert ... mein chef war zumendest sehr zufrieden :dancer2: jetzt fehlt nur noch das mit dem excel, aber das is ja im andern thema :spin:

nat 12. Jun 2009 16:36

Re: routine aendern(speichern in listbox>speichern in has
 
habe zwar informatik studiert, aber delphi habe ich mir über die jahre selber beigebracht.
is ja ne super hilfe dabei, die einen schon ganz schön weit bringt. und wnen man doch mal nicht
weiter kommt gibts ja genug seiten/communities wo man nachschauen/fragen kann.
man muß halt nur etwas ehrgeiz haben.

was willst du da denn genau machen?
einfach nur 2-spalten in excel anzeigen?
excel kann doch auch csv-dateien lesen.
erstell doch einfach ne csv und öffne die mit delphi.

nimmersattXD 12. Jun 2009 16:43

Re: routine aendern(speichern in listbox>speichern in has
 
naja im grunde genommen hab ich das ja mit savetofile schon ganz gut drin, nur erstens sollen beide listboxes drin gespeichtert werden und zweitens sollen die in einer tabelle mit zwei spalten gegenueberstehen, ungefaehr so:

unused pictures ________ used pictures

___bild345.jpg __________ bild898.jpg
__........ __________________ ........

(unterstriche nicht beachten :wink: )


wie ich in dem andern thread schon geschrieben hab hab ich auch schon mit variants angefangen, siehste ja auch in meinem prog. aber mir fehlen irgendwie trotzdem die funktion wie zb. excel.sheets.add ...

nat 12. Jun 2009 16:46

Re: routine aendern(speichern in listbox>speichern in has
 
da hab ich noch nie was mit gemacht. also von daher kenne ich mich damit nich wirklich aus.
aber mit csv-datein könntest du doch genau das machen. halt nur ohne design. aber wenn das nicht
wichtig is...

nimmersattXD 12. Jun 2009 16:49

Re: routine aendern(speichern in listbox>speichern in has
 
ach design is nich wichtig, is nur dazu da das ein bissel abzugleichen, ob mein prog auch alles bekommt un so!

aber was genau meinst du mit csv-dateien?
gibts da ne funktion aehnlich wie savetofile??
oder muss ich da was anderes schreiben?

nat 12. Jun 2009 17:29

Re: routine aendern(speichern in listbox>speichern in has
 
CSV
die csv-datei mußt du halt von hand schreiben (ist aber ja nur ne text-datei).
also einfach einen string zusammenbasteln und in eine datei schreiben.

nimmersattXD 15. Jun 2009 13:19

Re: routine aendern(speichern in listbox>speichern in has
 
hallo nochmal,

mein prog ist fast fertig, in excel speichern kann ich jetzt auch

nun wollte ich gern noch etwas bezueglich der hashtables wissen:

wie kann man denn data(bzw.: nil) benutzten, also in meinem fall noch einen string speichern?

nimmersattXD 15. Jun 2009 15:10

Re: routine aendern(speichern in listbox>speichern in has
 
so jetzt hab ich mich noch ein bisschen ueber pointer informiert und mein programm geaendert, anscheinend speichert es auch schon meinen string im data der hashtabelle(hashpicofsit), aber bei der ausgabe will es einfach nicht funktionieren :(

hier mein quelltext dazu:

Delphi-Quellcode:
procedure TForm1.BtnSearchSitClick(Sender: TObject);  //zum finden der Seiten in den ordnern und der urls der bilder
var direct,filename,key:string;                       //in den html
    dummy:Pointer;
    page:TStringList;
    idx:integer;
    re:TRegExpr;
    such:Boolean;
begin
direct:=Edpaths.Text;
hashsit:=TStringDictionary.Create;
hashpicofsit:=TStringDictionary.Create;

if not (EdpathS.Text='') then
 begin
 GetFilesInDirectory1(direct,'*.html',hashsit,true,true);
 GetFilesInDirectory1(direct,'*.htmlm',hashsit,true,false);
 GetFilesInDirectory1(direct,'*.jsp',hashsit,true,false);
 end
else ShowMessage('Please, insert the directory paths first!');

LbSit.Caption:=inttostr(hashsit.TotalCount);
Panel2.Color:=clGreen;
Application.ProcessMessages;
//routine zum suchen der Url in den htmls

page:=TStringList.Create;
re:=TRegExpr.Create;
hashsit.First;

   try
   while hashsit.Next(key,dummy) do
     begin
     page.LoadFromFile(key);
     re.ModifierI:=true;
     re.ModifierG:=true;
     re.ModifierM:=false;
     re.ModifierS:=false;
     re.ModifierX:=false;
     re.Expression:='<img .*?src=[\\]??"([^"]*?)[\\]??"';
     such:=re.Exec(page.Text);
     if such then
       repeat
       idx:=LastPos('/',re.match[1]);
         if idx > 0 then filename:=copy(re.Match[1],idx+1,length(re.Match[1]))
           else filename:=re.match[1];
           filename:=ReplaceHex(filename);

       if not (filename = '') then hashpicofsit.Add(filename,@key) //hier kommt keine fehlermeldung, scheint also zu funktionieren
       until not re.ExecNext;
       end;
   finally
     page.Free;
     re.Free;
   end;

   LbPicsFoundInPages.Caption:=inttostr(hashpicofsit.TotalCount);

   Panel3.Color:=clGreen;
   Application.ProcessMessages;

end;

procedure TForm1.BtnSearchFinClick(Sender: TObject); //vergleicht gefundene bilder(aus ordner) und gefundene bilder(in htmls)
var key:string;
    dummy1:pointer;
    dummy2:^string;
    length,voll,i:double;
    parts,percent:integer;
begin

if not ((EdpathS.Text='')or(EdpathS.Text='')) then
begin
 BtnSearchPic.Click;
 Panel1.Color:=clGreen;
 Application.ProcessMessages;
 BtnSearchSit.Click;
 Application.ProcessMessages;

 length:=Panel5.Width;
 voll:=hashpic.TotalCount*0.05;
 Panel5.Width:=0;
 i:=0;
 percent:=0;
 Panel5.Visible:=true;
 parts:=round((length*5)/100);

 hashpic.First;

 if (hashpic.TotalCount>0) and (hashpicofsit.TotalCount>0) then
  begin
  Screen.Cursor:=crHourGlass ;
    try
     while hashpic.Next(key,dummy1) do
      begin
      hashpicofsit.First;
      BtnSearchFin.Caption:='SEARCHING ...' ;
      i:=i+1;
      if i>=voll then
        begin
        i:=0;
        Panel5.Width:=Panel5.Width+parts;
        percent:=percent+5;
        Label6.Caption:=(inttostr(percent)+'%');
        Application.ProcessMessages;
        end;
      if hashpicofsit.Find(key,dummy2) then  //hier kommt die fehlermeldung
        begin
        LiBoUsed.ItemIndex:=LiBoUsed.Items.Add(key);
        LiBoUnused.ItemIndex:=LiBoUnused.Items.Add(dummy2^); //AUSGABE der data
        end
      end;
     finally
       begin
       Panel5.Width:=445;
       Label6.Caption:='100 %';
       Label5.Visible:=true;
       BtnSearchFin.Caption:='Search for unused pictures';
       screen.cursor:=crdefault;
       end;
     end;
  end
 else ShowMessage('In the folders or in the pages are no pictures been found');

end
else ShowMessage('Please, insert the directory paths first!');

end;

fehlermeldung: [error] ...: Types of actual and formal var parameters must be identical

nat 16. Jun 2009 12:13

Re: routine aendern(speichern in listbox>speichern in has
 
hallo

hab deinen source nur kurz überflogen, aber versuch mal deine variable zu nem pointer zu casten, also
so in etwa
Delphi-Quellcode:
if hashpicofsit.Find(key, Pointer(dummy2))
edit:
hab nun mal etwas genauer geguckt...
Delphi-Quellcode:
if not (filename = '') then hashpicofsit.Add(filename,@key)
ich glaube nicht, dass das so funktionieren wird. du fügst einen pointer
auf eine lokale variable ein, die beim verlassen der funktion nicht mehr
verfügbar ist (somit auch, wenn du sie später verwenden willst).
du solltest selber speicher reservieren für deinen string und dann einen
pointer darauf einfügen. dieser string ist so lange verfügbar, bist du
ihn selber freigibst.

du könntest es in der art machen (so ausm kopf)
Delphi-Quellcode:
var
  P: PChar;
begin
...
  P := StrNew(PChar(key));
  Dict.Add(filename, P);
...
end;

//später dann
  ...
  Dict.Find(filename, P);
  showmessage(StrPas(P)); //oder mache irgendetwas anderes mit dem string
  ...

//wenn du ihn nicht mehr brauchst:
  StrDispose(P);


Alle Zeitangaben in WEZ +1. Es ist jetzt 03:28 Uhr.
Seite 1 von 2  1 2      

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz