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.