TSHFILEINFO: Exe Icon ? Folder ?

Without delving too far into this...

A1. ExtractIcon API (see example on my webpage)



Good luck!!

Hmm... Does ExtractIcon work for *.DOC?

If not, you should probably use either FindExecutable or look in the registry directly (HKEY_CLASSES_ROOT\.doc).

Regards, Madshi.

I should mention that the attributes used in GetIconIndex are those of the SHGetFileInfo function like:

FILE_ATTRIBUTE_READONLY,
FILE_ATTRIBUTE_HIDDEN,
FILE_ATTRIBUTE_SYSTEM,
FILE_ATTRIBUTE_DIRECTORY,
FILE_ATTRIBUTE_ARCHIVE,
FILE_ATTRIBUTE_NORMAL,
FILE_ATTRIBUTE_TEMPORARY,
FILE_ATTRIBUTE_COMPRESSED, FILE_ATTRIBUTE_OFFLINE


Ciao, Mike

DrDelphi: I check your homepage and saw the example.. it worked fine.. I'll post a 25p q. A graded for you..

Lischke: great !! that works perfect !!
I got those sources from Delphi 3' FTP demo.. so .. did borland make it wrong ?

abou LARGEICONS: I tried using LARGEICONS in stead of small ones.. and it works with the ListView in all the ViewStyle modes except in the VsIcon one.. which is supposed to have LARGE icons.. I see large icons in the other 3 modes.. but I see no icon in the VsIcon style.. which should hold the big icons..

another things: why doesn't this work ?

function GetIconIndexName(const APath: String; Selected, Open: Boolean;
   Attrs: DWORD): string;
var
  SFI: TSHFileInfo;
begin
  if FileExists(APath) or DirectoryExists(APath) then
    SHGetFileInfo(PChar(APath), 0, SFI, SizeOf(TSHFileInfo),
     SHGFI_SYSICONINDEX or OPEN_FLAG[Open] or SELECTED_FLAG[Selected])
  else
    SHGetFileInfo(PChar(APath), Attrs, SFI, SizeOf(TSHFileInfo),
     SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES or OPEN_FLAG[Open] or
     SELECTED_FLAG[Selected]);
  Result := SFI.szTypeName;
end;

I want to get the TypeName for the sected extension..
what are OPEN and SELECTED for ? I just used FALSE on those parameters and worked.. but I don't know what they are for

you'll get 50p with A grade.

thanks

Thanks!

Well, I think the kind of file name specification might cause the function to fail, I don't know. Anyway, here is the stuff to retrieve the file description. You can make it much smaller than the other stuff because it is absolutely not necessary to have an existing file just to get its description. This stuff is stored in the registry and nothing else is returned.

function GetIconIndexName(const APath: String): String;
var
  SFI: TSHFileInfo;
begin
  SHGetFileInfo(PChar(APath), 0, SFI, SizeOf(TSHFileInfo), SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES);
  Result := SFI.szTypeName;
end;

procedure TMainForm.Button2Click(Sender: TObject);
begin
  Label4.Caption := GetIconIndexName('Project1.dpr');
end;

The flags Open and Selected are for the special cases you want to have an selected icon and/or (in case you retrieved a folder icon) whether it should be the open or the closed variant of the folder icon.

Regarding large icons:

I just tried the following and it works as expected. I place a normal listview and a normal image list on my form. Then I added a few entries to the listview (which I left in vsIcon view style) and assigned them an increasing image index (0, 1, 2 ...). I set the LargeImages property to my image list and the properties of the image list to be 32 in width and height and SharedImages to True. When the application runs I used a button click even to do:

procedure TMainForm.Button2Click(Sender: TObject);
begin
  ImageList2.Handle := GetSystemImageList(True);
end;

Immediately I got the large icons. No problem here.

Ciao, Mike

Adjusted points to 100

hi ! it worked.. it was just a silly thing I was doing wrong.

I'm sorry to bother you again.. I have more problems.. =(
I'll increase the points to 100, I'll increase them
if you find my problems a bit difficult..

thanks.


Little explanation of my program:
I'm doing an FTP Client, so I use 2 ListViews.
in VsReport style, i have 4 columns(name,size,date,type)

Problem 1:
in the Local files ListView (ListView2)
I have 2 main procs: RefreshLocalDir and RefreshLocalView
which get the files/dirs list and add the corresponding
items/icons to the listview
when I change the directory to a ROOT (c:\ .. d:\ etc)
the items that have the FOLDER(directory) icon
are not correctly shown.. in stead of the folder icon
I see the default icon.. I mean, the icon you get for example
when you have a file with no extension..

maybe this is of help:
in the procedure TFtpForm.RefreshLocalDir();
there is this:

2: s:= getDirs(ToEdit2.Text);

if I change this for getdirs('c:\') ( or any other drive )
and I'm NOT currently in the ROOT, then icons are right..
if I try the same thing being at the root the error is
there. ( being in the root .. i mean, after doing ChDir('c:\') )



problem 2(derived from 1):
this same thing happens to ListView1 ONLY when ListView2
is in the ROOT folder. but the reverse thing doesn't happen..
I mean, if the REMOTE files listview(ListView1) is in the
ROOT ( I use a localhost ftp server running on my machine to
do the tests ) the other ListView2 is not affected..

problem 3:
for the Local files Listview ( listview2 )
I want to use EXE's own icon in stead of the default one..
to do that I can use DrDelphi's routines...
how do I do that ? I mean here:
  ListView2.Items.Add; ListView2.Items[a+q].caption:= Files3[a];
  ListView2.Items[a+q].ImageIndex:= GetIconIndex('c:\*'+ExtractFileExt(Files3[a]),false,false,0);

I could do something like:
 if lowercase(ExtractFileExt(Files3[a]))='.exe' then
 ListView2.Items[a+q].ImageIndex:= Functions.GetIconFromFile(AppendSlash(ToEdit2.Text)+Files3[a],0)

but it doesn't work because the icon is not in the imagelist..
ok I can create an icon, get the handle with GetIconFrom....
add this icon to the imagelist and then add the icon to the
ListView item.. but this way I would have more and more icons
added to the imagelist each time... and I can't delete the icon
from the imagelist once used also..

any idea ?

problem 4:
I want to use my own ICON for the "folder back" I mean
the directory '..' to go a folder back. To do so I added an
icon to the project resources, create an icon,load
it to an icon, added this icon to the imagelist, and then free
the icon. adn then to have this icon I use for IMAGEINDEX
the last icon in the imagelist.
ok this works, but when I COMPILE the program, the
compiled exe file has this icon in stead of the main one..
I tried using a DCR file which is used only by the unit
with the FTP Client ( my program has various forms )
doing {$R CHAT2.DCR} but the same thing happened..

Here's some bits of my code:

const
  SELECTED_FLAG: array[Boolean] of DWORD = (0, SHGFI_SELECTED);
  OPEN_FLAG: array[Boolean] of DWORD = (0, SHGFI_OPENICON);

var
  FtpForm: TFtpForm;
  Files,Sizes,Dates,strings: TstringList; // Remote Files
  Files2,Sizes2,Dates2: TstringList; // Remote Dirs
  Files3,Sizes3,Dates3: TstringList; // Local Files
  Files4,Sizes4,Dates4: TstringList; // Local Dirs
  DeleteIcon1,DeleteIcon2,Logged: Boolean;
  BackDir: string;

implementation

uses options,funcs;

{$R *.DFM}
{$R CHAT2.DCR}

function GetIconIndex(const APath: String; Selected, Open: Boolean;
   Attrs: DWORD): integer;
var
  SFI: TSHFileInfo;
begin
  if FileExists(APath) or DirectoryExists(APath) then
    SHGetFileInfo(PChar(APath), 0, SFI, SizeOf(TSHFileInfo),
     SHGFI_SYSICONINDEX or OPEN_FLAG[Open] or SELECTED_FLAG[Selected])
  else
    SHGetFileInfo(PChar(APath), Attrs, SFI, SizeOf(TSHFileInfo),
     SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES or OPEN_FLAG[Open] or
     SELECTED_FLAG[Selected]);
  Result := SFI.iIcon;
end;

function GetSystemImageList(Large: Boolean): Integer;
var
  SFI: TSHFileInfo;
begin
  if Large then
    Result := SHGetFileInfo('', 0, SFI, SizeOf(SFI),
                            SHGFI_SYSICONINDEX or SHGFI_LARGEICON)
  else
    Result := SHGetFileInfo('', 0, SFI, SizeOf(SFI),
                            SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
end;

function GetIconIndexName(const APath: String): String;
var
  SFI: TSHFileInfo;
begin
  SHGetFileInfo(PChar(APath), 0, SFI, SizeOf(TSHFileInfo), SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES);
  Result := SFI.szTypeName;
end;

procedure TFtpForm.FormCreate(Sender: TObject);
var Dt      : TWSAData;
    ico     : TIcon;
begin
strings:= TStringList.Create;
Files:= TStringList.Create; Sizes:= TStringList.Create;
Dates:= TStringList.Create; Files2:= TStringList.Create;
Sizes2:= TStringList.Create; Dates2:= TStringList.Create;
Files3:= TStringList.Create; Sizes3:= TStringList.Create;
Dates3:= TStringList.Create; Files4:= TStringList.Create;
Sizes4:= TStringList.Create; Dates4:= TStringList.Create;
Logged:= false;

ico:= TIcon.Create;
ico.Handle:= loadicon(HInstance,'ICON1');
ImageList1.handle:= GetSystemImageList(true);
ImageList2.handle:= GetSystemImageList(false);
if (Imagelist2.Addicon(ico) <> -1 ) then DeleteIcon2:= true else DeleteIcon2:= false;
if (Imagelist1.Addicon(ico) <> -1 ) then DeleteIcon1:= true else DeleteIcon1:= false;
ListView1.SmallImages:= ImageList2;
ListView1.LargeImages:= ImageList1;
ListView1.SmallImages.ShareImages:= true;
ListView1.LargeImages.ShareImages:= true;
ListView2.SmallImages:= ImageList2;
ListView2.LargeImages:= ImageList1;
ListView2.SmallImages.ShareImages:= true;
ListView2.LargeImages.ShareImages:= true;
FormStorage1.RestoreFormPlacement;
ComboBox1.ItemIndex:= ComboBox1.Tag;
ComboBox3.ItemIndex:= ComboBox3.Tag;
if SpeedButton3.Down then ListView1.ViewStyle:= vsIcon;
if SpeedButton5.Down then ListView1.ViewStyle:= vsList;
if SpeedButton6.Down then ListView1.ViewStyle:= vsReport;
if SpeedButton7.Down then ListView1.ViewStyle:= vsSmallIcon;
if SpeedButton4.Down then ListView2.ViewStyle:= vsIcon;
if SpeedButton8.Down then ListView2.ViewStyle:= vsList;
if SpeedButton9.Down then ListView2.ViewStyle:= vsReport;
if SpeedButton10.Down then ListView2.ViewStyle:= vsSmallIcon;
  { winsock info }
 Dt:= WinsockInfo;
 Memo1.Lines.Add('Winsock verion ' + IntToStr(LOBYTE(Dt.wVersion)) + '.' + IntToStr(HIBYTE(Dt.wVersion)));
 Memo1.Lines.Add(StrPas(Dt.szDescription));
 Memo1.Lines.Add(StrPas(Dt.szSystemStatus));
ico.Free;
ToEdit2.Text:= GetcurrentDir;
RefreshLocalDir;
end;

procedure TFtpForm.RefreshDirList();
Var a:Integer;
begin
  strings.LoadFromFile('ll.txt');
  DeleteFile('ll.txt');
  if strings.Count = 0 then Exit;
  if (strings.count > 0) and (strings[0][1]<>'d') and (strings[0][1]<>'-') then strings.Delete(0);
  if (strings.count > 0) and (GetName(strings[0])='.') then strings.Delete(0);
//  if (strings.count > 0) and (GetName(strings[0])='..') then strings.Delete(0);
  if strings.Count = 0 then Exit;
  Files.Clear; Files2.Clear;
  Sizes.Clear; Sizes2.Clear;
  Dates.Clear; Dates2.Clear;
  for a:= 0 to strings.Count-1 do
   begin
    if strings[a][1]='d' then
     begin
      Files2.Add(GetName(strings[a]));
      Sizes2.Add(GetSize(strings[a]));
      Dates2.Add(GetDate(strings[a]));
     end
    else
     begin
      Files.Add(GetName(strings[a]));
      Sizes.Add(GetSize(strings[a]));
      Dates.Add(GetDate(strings[a]));
     end;
   end;
 RefreshView(ComboBox1.Tag+1);
end;

procedure TFtpForm.RefreshView(mode: Integer);// sort 1=name 2=ext 3=size 4=date
Var a,b,c,q: Integer;
begin

   for a:= 0 to Files2.Count-1 do
   begin
    c:= a; for b:= c to Files2.Count -1 do if lowercase(Files2[b])<lowercase(Files2[c]) then c:= b;
    Files2.Exchange(a,c); Sizes2.Exchange(a,c); Dates2.Exchange(a,c);
   end;

   for a:= 0 to Files.Count-1 do
   begin
    c:= a;
    if mode = 1 then for b:= c to Files.Count -1 do if lowercase(Files[b]) < lowercase(Files[c]) then c:= b;
    if mode = 2 then for b:= c to Files.Count -1 do if lowercase(ExtractFileExt(Files[b])) < lowercase(ExtractFileExt(Files[c])) then c:= b;
    if mode = 3 then for b:= c to Files.Count -1 do if StrToInt(Sizes[b]) < StrToInt(Sizes[c]) then c:= b;
    Files.Exchange(a,c); Sizes.Exchange(a,c); Dates.Exchange(a,c);
   end;

 ListView1.Items.Clear;
 ListView1.Items.BeginUpdate;
  for a:= 0 to Files2.Count-1 do
   begin
    ListView1.Items.Add; ListView1.Items[a].caption:= Files2[a];
    if  Files2[a] = '..' then ListView1.Items[a].ImageIndex:= ImageList2.Count-1
     else
     ListView1.Items[a].ImageIndex:= GetIconIndex('',false,false,FILE_ATTRIBUTE_DIRECTORY);
    ListView1.Items[a].SubItems.Add('');
    ListView1.Items[a].SubItems.Add(Dates2[a]);
   end;
 q:= Files2.Count;
  for a:= 0 to Files.Count-1 do
   begin
    ListView1.Items.Add; ListView1.Items[a+q].caption:= Files[a];
    ListView1.Items[a+q].ImageIndex:= GetIconIndex('c:\*'+ExtractFileExt(Files[a]),false,false,0);
    ListView1.Items[a+q].SubItems.Add(Sizes[a]);
    ListView1.Items[a+q].SubItems.Add(Dates[a]);
    ListView1.Items[a+q].SubItems.Add(GetIconIndexName(Files[a]));
   end;
 ListView1.Items.EndUpdate;
end;

procedure TFtpForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if DeleteIcon1 then ImageList1.Delete(ImageList1.Count-1);
if DeleteIcon2 then ImageList2.Delete(ImageList2.Count-1);
strings.Free;
Files.Free; Sizes.Free;
Dates.Free; Files2.Free;
Sizes2.Free; Dates2.Free;
Files3.Free; Sizes3.Free;
Dates3.Free; Files4.Free;
Sizes4.Free; Dates4.Free;
//Action:= caFree;
end;

procedure TFtpForm.RefreshLocalDir();
Var s: string;
    a: Integer;
Label 2,3;
begin
  Files3.Clear; Files4.Clear;
  Sizes3.Clear; Sizes4.Clear;
  Dates3.Clear; Dates4.Clear;
  s:= getfiles(ToEdit2.Text,'*.*');
  if length(s) = 0 then goto 2;
 repeat
   a:= pos('/',s);
   Files3.Add(copy(s,1,a-1));
   Delete(s,1,a);
   a:= pos('/',s);
   Sizes3.Add(copy(s,1,a-1));
   Delete(s,1,a);
   a:= pos('/',s);
   Dates3.Add(copy(s,1,a-1));
   Delete(s,1,a);
 until length(s) = 0;

2:
  s:= getDirs(ToEdit2.Text);
  if length(s) = 0 then goto 3;
 repeat
   a:= pos('/',s);
   Files4.Add(copy(s,1,a-1));
   Delete(s,1,a);
   a:= pos('/',s);
   Sizes4.Add(copy(s,1,a-1));
   Delete(s,1,a);
   a:= pos('/',s);
   Dates4.Add(copy(s,1,a-1));
   Delete(s,1,a);
 until length(s) = 0;

3: RefreshLocalView(ComboBox3.Tag+1);
end;

function TFtpForm.getFiles(Path,sort: string): String;
var srec : TSearchRec;
    r,s  : string;
begin
 s:= '';
 r:= AppendSlash(Path);
 r:= r + sort;
 if findfirst(r,faAnyfile,srec) = 0 then
   repeat
     if Not(srec.attr and fadirectory > 0) then s:= s+srec.Name+'/'+InttoStr(srec.Size)+'/'+InttoStr(srec.Time)+'/';
   Until findnext(srec) <> 0;
   FindClose(SRec);
 Result:= s;
end;

function TFtpForm.getDirs(Path: string): String;
var srec : TSearchRec;
    r,s  : string;
begin
 s:= '';
 r:= AppendSlash(Path);
 r:= r+'*.*';
 if findfirst(r,faAnyfile,srec) = 0 then
   repeat
     if (srec.attr and fadirectory > 0) and (srec.name <>'.') then s:= s+srec.Name+'/'+InttoStr(srec.Size)+'/'+InttoStr(srec.Time)+'/';
   Until findnext(srec) <> 0;
   FindClose(SRec);
 Result:= s;
end;

procedure TFtpForm.RefreshLocalView(mode: Integer);// sort 1=name 2=ext 3=size 4=date
Var a,b,c,q: Integer;
begin
   for a:= 0 to Files4.Count-1 do
   begin
    c:= a; for b:= c to Files4.Count -1 do if lowercase(Files4[b])<lowercase(Files4[c]) then c:= b;
    Files4.Exchange(a,c); Sizes4.Exchange(a,c); Dates4.Exchange(a,c);
   end;

   for a:= 0 to Files3.Count-1 do
   begin
    c:= a;
    if mode = 1 then for b:= c to Files3.Count -1 do if lowercase(Files3[b]) < lowercase(Files3[c]) then c:= b;
    if mode = 2 then for b:= c to Files3.Count -1 do if lowercase(ExtractFileExt(Files3[b])) < lowercase(ExtractFileExt(Files3[c])) then c:= b;
    if mode = 3 then for b:= c to Files3.Count -1 do if StrToInt(Sizes3[b]) < StrToInt(Sizes3[c]) then c:= b;
    Files3.Exchange(a,c); Sizes3.Exchange(a,c); Dates3.Exchange(a,c);
   end;

 ListView2.Items.Clear;
  for a:= 0 to Files4.Count-1 do
   begin
    ListView2.Items.Add; ListView2.Items[a].caption:= Files4[a];
    if  Files4[a] = '..' then ListView2.Items[a].ImageIndex:= ImageList2.Count-1
     else
     ListView2.Items[a].ImageIndex:= GetIconIndex('',false,false,FILE_ATTRIBUTE_DIRECTORY);
    ListView2.Items[a].SubItems.Add('');
    ListView2.Items[a].SubItems.Add(Dates4[a]);
   end;
 q:= Files4.Count;
  for a:= 0 to Files3.Count-1 do
   begin
    ListView2.Items.Add; ListView2.Items[a+q].caption:= Files3[a];
//    if lowercase(ExtractFileExt(Files3[a]))='.exe' then
     //ListView2.Items[a+q].ImageIndex:= Functions.GetIconFromFile(AppendSlash(ToEdit2.Text)+Files3[a],0)
       ListView2.Items[a+q].ImageIndex:= GetIconIndex('c:\*'+ExtractFileExt(Files3[a]),false,false,0);
    ListView2.Items[a+q].SubItems.Add(Sizes3[a]);
    ListView2.Items[a+q].SubItems.Add(Dates3[a]);
    ListView2.Items[a+q].SubItems.Add(GetIconIndexName(Files3[a]));
   end;
end;

function TFtpForm.AppendSlash(txt: string): string;
begin
if txt[length(txt)]='\' then Result:= txt else Result:= txt+'\';
end;

procedure TFtpForm.ListView2DblClick(Sender: TObject);
begin
if Files4.Count = 0 then Exit;
if ListView2.SelCount = 0 then Exit;
if ListView2.Selected.Index < Files4.Count then
 begin
  ChDir(AppendSlash(ToEdit2.Text)+ListView2.Selected.Caption);
  ToEdit2.Text:= GetCurrentDir;
  RefreshLocalDir;
 end;
end;

----------

function TFunctions.GetIconFromFile(fil: string; iconnum: Integer): integer;
begin
Result:= Extracticon(hinstance,PChar(fil),iconnum);
end;

function TFunctions.FindIconNumber(fil: string): Integer;
begin
Result:= ExtractIcon(Hinstance,PChar(fil),Cardinal(-1));
end;

procedure TFunctions.LoadIconsToImgLst(fil: string; imglist: TImageList);
Var a: Integer;
    ic: TIcon;
begin
ic:= TIcon.Create;
 for a:= 0 to FindIconNumber(fil)-1 do
  begin
  ic.Handle:= GetIconFromFile(PChar(fil),a);
  imglist.addicon(ic);
  end;
ic.Free;
end;

Hi Bryan,

I don't know why others get 500 points questions which they can answer with one line and I always have such complex (well, rather expensive) problems like yours. Anyway, I think the best would be to send me your project as a whole and I will have a look. Please consider also a significant increase of points as I'm going to answer you 5 questions in one.

Ciao, Mike

well.. ok,
let's forget about my last comment.

I increased p. to 100 and will accept your answer with an A, but once it works.. your answer doesn't work 100 %.. it doesn't work when the current folder is any root..

example:
if I do CHDIR('c:\');
and then retrieve the icons for the folders then it doesn't work

if I retrieve the folders icons of c:\ they are only right if the current directory is not the root, i mean, if I haven't done chdir('c:\'); or the program hasn't started in the root.

forget all the other questions in the last comment.. I just want your answer to fully work

thanks for your time..

bryan

Hi Bryan,

okay, then let's focus on the current folder issue. I hammered the following code together in about 20 minutes (including testing) and found no problem. Please try it out in your context and if you cannot find an error in your code then please describe as exact as possible what you mean with: "it doesn't work".

procedure TMainForm.Button3Click(Sender: TObject);

var
  Item: TListItem;
  ThisPath: String;
  SR: TSearchRec;

begin
  ImageList2.Handle := GetSystemImageList(True);
  ChDir('C:\');
  ThisPath := 'C:\';
  with ListView1 do
  begin
    Items.Clear;
    if FindFirst(ThisPath + '*.*', faAnyFile, SR) = 0 then
    begin
      repeat
        Item := Items.Add;
        Item.Caption := SR.Name;
        if (SR.Attr and faDirectory) <> 0 then
          Item.ImageIndex := GetIconIndex(SR.Name, False, False, FILE_ATTRIBUTE_NORMAL or FILE_ATTRIBUTE_DIRECTORY)
                                          else
          Item.ImageIndex := GetIconIndex(SR.Name, False, False, FILE_ATTRIBUTE_NORMAL);
      until FindNext(SR) <> 0;
      FindClose(SR);
    end;
  end;
end;


Ciao, Mike

hi there, sorry, I was 3 weeks away.. it works alright now. it seems the q. has been auto paq-ed for time, how many points did you get ?

Hi Bryan,

indeed, the auto-paq feature works now quite well. Unfortunately, the questions are just graded with a C (but the grade doesn't appear in an expert's last ten gradings).

Ciao, Mike