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;