Пишу ФТП-браузер (курсач себе такой придумал) Необходимо отображать при выводе файлов сервера соответствующию иконку. Пытаюсь вытащить иконки из реестра(DefaultIcon), но:
1) Не для всех расширений существует данное свойство.
2) При формировании списка в TImageList происходит нечто странное - часть иконок имеет совсем не тот вид, который должен быть на самом деле(Скорее всего я где то ошибся, но голова сейчас уже не соображает ни чего).

Вот код поиска иконок:

Код

type  PExtInfo = ^TExtInfo;  TExtInfo = record    Ext, IconPath: string[255];    IconIndex: integer;  end;  TExtentionsInfo = class(TList)  private    function Get(Index: Integer): PExtInfo;    procedure Put(Index: Integer; const Value: PExtInfo);  public    procedure Clear; override;    function Add(const Ext, IconPath: string; const IconIndex: integer): Integer;    function Extract(Item: Pointer): PExtInfo;    function First: PExtInfo;    function Last: PExtInfo;    property Items[Index: Integer]: PExtInfo read Get write Put; default;  end;  TExistExtentions = class(TObject)  private    FReg: TRegistry;  protected    FResult: TExtentionsInfo;  public    constructor Create;    destructor Destroy; override;    procedure EnumExtentions; virtual;    property ExistExtentionsInfo: TExtentionsInfo read FResult;  end;  TIconSize = (is16, is32);  TExistExtentionsIconList = class(TExistExtentions)  private    FIconList: TImageList;    FIconSize: TIconSize;    procedure SetIconSize(const Value: TIconSize);  public    constructor Create;    destructor Destroy; override;    procedure EnumExtentions; override;    property IconList: TImageList read FIconList;    property IconSize: TIconSize read FIconSize write SetIconSize;  end; ... procedure TExistExtentions.EnumExtentions; function PathExists(const List: TList; const Path: string): Boolean; var  i: integer; begin  Result := False;  for i := 0 to List.Count - 1 do    if AnsiCompareStr(PExtInfo(List.Items[i]).IconPath, Path) = 0 then    begin      Result := True;      Break;    end; end; var  Keys: TStringList;  Counter, SeparatorPos,  IconIndex, PathLen: integer;  DefValue, DefIconPath: string; begin  FResult.Clear;  with FReg do  begin    RootKey := HKEY_CLASSES_ROOT;    Keys := TStringList.Create;    try      if OpenKeyReadOnly('') then      begin        GetKeyNames(Keys);        CloseKey;        Counter := Keys.Count - 1;        while (Counter >= 0) do        begin          if (AnsiCompareStr(Keys[Counter][1], '.') = 0) and             (OpenKeyReadOnly(Keys[Counter])) then          try            DefValue := ReadString('');            if (DefValue <> '') and               (not PathExists(FResult, DefValue)) then              FResult.Add(Keys[Counter], DefValue, 0);          finally            CloseKey;          end;          Dec(Counter);        end;        Counter := FResult.Count - 1;        while Counter >= 0 do        begin          if OpenKeyReadOnly(PExtInfo(FResult[Counter]).IconPath) then          try            if KeyExists('DefaultIcon') then            begin              CloseKey;              if OpenKeyReadOnly(FResult[Counter].IconPath + '\DefaultIcon\') then              begin                DefIconPath := ReadString('');                if (DefIconPath <> '') and                   (not PathExists(FResult, DefIconPath)) then                begin                  SeparatorPos := Pos(',', DefIconPath);                  IconIndex := 0;                  if SeparatorPos <> 0 then                  begin                    Inc(SeparatorPos);                    PathLen := Length(DefIconPath);                    IconIndex := StrToInt(Copy(DefIconPath, SeparatorPos, PathLen - SeparatorPos + 1));                    Dec(SeparatorPos, 2);                    DefIconPath := Copy(DefIconPath, 1, SeparatorPos);                  end;                  FResult[Counter].IconPath := DefIconPath;                  FResult[Counter].IconIndex := IconIndex;                end;              end;            end            else              FResult.Delete(Counter);          finally            CloseKey;          end;          Dec(Counter);        end;      end;    finally      FreeAndNil(Keys);    end;  end; end; ... procedure TExistExtentionsIconList.EnumExtentions; var  i: integer;  Icon, DefaultIcon: TIcon;  IconPath: PAnsiChar; begin  inherited;  FIconList.Clear;  Icon := TIcon.Create;  DefaultIcon := TIcon.Create;    DefaultIcon.Handle := ExtractIcon(hInstance, 'shell32.dll', 0);    GetMem(IconPath, 256);  ZeroMemory(IconPath, 256);  try    for i := 0 to FResult.Count - 1 do      if FileExists(FResult[i].IconPath) then      begin        StrPCopy(IconPath, FResult[i].IconPath);        Icon.Handle := ExtractIcon(hInstance, IconPath,          FResult[i].IconIndex);        FIconList.AddIcon(Icon);      end      else        FIconList.AddIcon(DefaultIcon);  finally    FreeMem(IconPath, 256);    FreeAndNil(DefaultIcon);    FreeAndNil(Icon);  end; end;

Где я ошибся?
P.S. Шорошо бы иметь возможность найти все иконки(Может какая WinAPI функция есть для этого?).

Это сообщение отредактировал(а) <Spawn> - 8.1.2005, 20:28

найди пример в аттаче
http://forum.vingrad.ru/index.php?showtopic=39065

RAdmin Мне не нужны ассоциированные с файлом иконки(это я и сам могу сделать). Мне нужы все иконки и все связаные с ними расширения в ОС.

<Spawn> пардон.

Код

иконок имеет совсем не тот вид, который должен быть на самом деле

т.е. там что выдаётся? Иконка по дефолту? если так, то там DefaultIcon выставлено обычно как "%1" - т.е. там иконка зависит от контекста файла, как я понимаю. Для таких файлов придётся давать дефолтовое значение и по-другому никак. Туда пойдут и эзкэшники+scr, которым будет "немного другая" иконка. Если я не так понимаю что-то то уточни, какой именно вид имеют "не те" иконки (и желательно расширения парочку стда кинь).

<Spawn>, а не проще забить в прогу иконки и когда прога видит расширение то она вытаскивает из Image листа иконку асоциированную с данным расширением. И не возится с системными а забить свои тем более есть свобода выбора.

Цитата

забить в прогу иконки

Ээээээ... Больше и сказать-то нечего... А сколько весить всё это будет? А оптимальность где? 8) Этих расширений целая туча...

bartramОтвет дан выше (Этот код находит около 520 расширений...)

Illusion Dolphin
Приатачил 2 иконки, которые берутся из одного и того же файла, по одному индексу, но после помещения в TImageList имеют разный вид.

Присоединённый файл ( Кол-во скачиваний: 12 )
 ExtFind.zip

С ошибкой разобралс(точнее говоря нашел аж штуки 3 Вот что значит хорошо выспаться ). Осталось переписать код