routine aendern(speichern in listbox>speichern in hashtable)

[nimmersattXD]

in dem key is ja nich der text der html dateien, sondern nur der pfad von ihnen gespeichert! :wink:

[nat]

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]

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]

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]

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]

jo das waer ne gute idee, nur was ist mit meinem problem mit den timern un der fehleremeldung ??

[nat]

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]

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]

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]

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: