unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ComObj,
ActiveX,shellapi, imglist;
type
TFileInfoThread =
class(TThread)
private
FListView : TListView;
FDirectory :
string;
FFileName :
string;
FFileIndex : integer;
FIconIndex: integer;
FOverlayIdx: integer;
protected
procedure Execute;
override;
procedure NextFile;
procedure GetFileInfo;
procedure UpdateIcon;
public
constructor Create(lv:TListView;dir:
string );
end;
type
TForm1 =
class(TForm)
Label1: TLabel;
Edit1: TEdit;
ListView1: TListView;
ListView2: TListView;
Button1: TButton;
labelThread1Ok: TLabel;
labelThread2Ok: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
FImages: TImageList;
FThread1: TFileInfoThread;
FThread2: TFileInfoThread;
procedure PopulateFiles(dir:
string; lv: TListView);
procedure Thread1Terminated(Sender: TObject);
procedure Thread2Terminated(Sender: TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
constructor TFileInfoThread.Create(lv: TListView; dir:
string);
begin
Inherited Create(True);
FListView := lv;
FDirectory:= dir;
FreeOnTerminate := true;
end;
procedure TFileInfoThread.Execute;
begin
FFileIndex := -1;
CoInitialize(
nil);
try
repeat
if Terminated
then break;
Synchronize(NextFile);
if FFileIndex >= 0
then begin
GetFileInfo;
Synchronize(UpdateIcon);
end;
until FFileIndex < 0 ;
finally
CoUninitialize;
end;
end;
procedure TFileInfoThread.NextFile;
begin
FFileIndex := FFileIndex + 1;
if FFileIndex >= FListView.Items.Count
then
FFileIndex := -1
else
FFileName := FlistView.Items[FFileIndex].Caption;
end;
procedure TFileInfoThread.GetFileInfo;
var fileInfoStru: TSHFileInfo;
flags: UINT;
filePath:
string;
begin
FIconIndex := -1;
FOverlayIdx:= -1;
filePath := IncludeTrailingBackslash(FDirectory) + FFileName;
Fillchar(fileInfoStru, Sizeof(fileInfoStru), 0 );
flags :=(SHGFI_TYPENAME
or SHGFI_DISPLAYNAME
or SHGFI_SYSICONINDEX );
// OverlayIndex
flags := flags
or SHGFI_ICON
or $000000040 ;
// 0x000000040 = SHGFI_OVERLAYINDEX;
SHGetFileInfo( PCHar(filePath),0,fileInfoStru, SizeOf(fileInfoStru ),flags);
if fileInfoStru.iIcon >32000
then begin
FOverlayIdx := ((fileInfoStru.iIcon
and $FF000000)
shr 24)-1 ;
FIconIndex := fileInfoStru.iIcon
and $00FFFFFF;
end
else
FIconIndex := fileInfoStru.iIcon;
if fileInfoStru.hIcon <>0
then
DestroyIcon(fileInfoStru.hIcon);
end;
procedure TFileInfoThread.UpdateIcon;
begin
if (FFileIndex >= FListView.Items.Count)
or (FFileIndex< 0)
then exit;
FListView.Items[FFileIndex].ImageIndex := FIconIndex;
FListView.Items[FFileIndex].OverlayIndex := FOverlayIdx;
end;
//--------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
begin
ListView1.Clear;
ListView2.Clear;
labelThread1Ok.Caption := '
';
labelThread2Ok.Caption := '
';
PopulateFiles(Edit1.Text, ListView1);
PopulateFiles(Edit1.Text, ListView2);
FThread1 := TFileInfoThread.Create(ListView1, Edit1.Text);
FThread1.OnTerminate := Thread1Terminated;
Fthread1.Resume;
FThread2 := TFileInfoThread.Create(ListView2, Edit1.Text);
FThread2.OnTerminate := Thread2Terminated;
Fthread2.Resume;
end;
procedure TForm1.FormCreate(Sender: TObject);
var SHFileInfo:TSHFileInfo;
begin
FImages := TImageList.Create(Self);
FImages.Handle := ShGetFileInfo('
', 0, SHFileInfo,
SizeOf(SHFileInfo), SHGFI_SMALLICON
or SHGFI_SYSICONINDEX);
FImages.ShareImages := TRUE;
FImages.DrawingStyle := dsTransparent;
ListView1.SmallImages := FImages;
ListView2.SmallImages := FImages;
Edit1.Text:='
E:\Windows\System32';
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FImages.Free;
end;
procedure TForm1.PopulateFiles(dir:
string; lv: TListView);
var rec: TSearchRec;
lvItem: TListItem;
found: integer;
begin
if lv=nil
then exit;
dir := IncludeTrailingBackslash(dir);
found:= FindFirst(dir+'
*', faAnyFile, rec);
while found=0
do begin
if (rec.
Name<>'
.')
and (rec.
Name<>'
..')
then begin
lvItem := lv.Items.Add;
lvItem.Caption := rec.
Name;
lvItem.ImageIndex := -1;
end;
found:=findnext(rec);
end;
findclose(rec);
end;
procedure TForm1.Thread1Terminated(Sender: TObject);
begin
labelThread1Ok.Caption := '
Thread 1 terminated';
end;
procedure TForm1.Thread2Terminated(Sender: TObject);
begin
labelThread2Ok.Caption := '
Thread 2 terminated';
end;
end.