Delphi-PRAXiS - Delphi Problem mit SHGetFileInfo in einem Thread

Hallo,

ich versuche SHGetFileInfo in einem Thread zu nutzen (Delphi 2007). Mit SHGetFileInfo will ich ImageIndex und OverlayIndex finden. Das scheint aber nicht zu funktionieren. Sobald ich 2 Threads starte verschwindet fast immer das Programm. Das kann man leicht in dem Testprogramm nachvollziehen. Der Ordner sollte viele Dateien beinhalten. Bei mir unter Vista Windows\System32 sind ca. 1800 Dateien. Wenn ich kein OverlayIndex ermitteln will (zeile "flags := flags or SHGFI_ICON or $000000040 ;" auskommentieren), dann scheint alles problemlos zu funktionieren. Ich brauche aber OverlayIndex auch.
Für Hinweise wäre ich sehr dankbar. Im Anhang ist ein Testprojekt zu finden.

Gruß
marcos

Delphi-Quellcode:

			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.