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

zusammenfalten · markieren

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.

Also bei mir funktioniert das Programm ohne Probleme (Vista64). Vielleicht hast du eine ShellExtension installiert, die Probleme macht.

Ich nutze Vista 32 und Tortoise SVN. Hast du SVN? Könnte jemand mit SVN auch noch versuchen. Im Ordner müssen viele Dateien vorhanden sein 1500 - 2000.

Gruß
marcos

Zitat von marcos:

Hast du SVN?

Ja. TortoiseSVN 64Bit Vielleicht liegt es ja wirklich am 32bit Vista.

TortoiseSVN deinstalliert und - es läuft.
Aktuelle Version von TortoiseSVN installiert - es läuft, aber die OverlayIcons erscheinen nicht :(.
Was ich noch installiert habe ist VMWare Workstation 6.02.
Hat jemand so eine Kombination Vista32 + TortoiseSVN + VMWare und könnte das Testprogramm ausprobieren?