Bueno, veo que te respondieron antes... pero como tuve que recopilar código para darte una respuesta, te la voy a pasar de todos modos.
El tema es así, yo tengo una Unit con todas las funciones, procedimientos y tipos relacionados con "Accesos directos" y otras cosas, en este código puedes ver la función GetLinkFileInfo que extrae información de un ShortCut:
Código:
unit XXXX;
interface
uses
Windows, ShlObj;
type
TLinkFileInfo = record
FileName: string;
WorkDirectory: string;
IconLocation: string;
IconIndex: Integer;
Arguments: string;
Description: string;
ItemIdList: PItemIDList;
RelativePath: string;
ShowState: Integer;
HotKey: Word;
end;
function GetLinkFileInfo(const AFileName: string): TLinkFileInfo;
.........
implementation
uses
SysUtils, ActiveX, ComObj;
function GetLinkFileInfo(const AFileName: string): TLinkFileInfo;
var
hRes: hResult;
IShLnk: IShellLink;
Wfd: WIN32_FIND_DATA;
IPFile: IPersistFile;
FileBuff: PWideChar;
PBuff: PChar;
begin
GetMem(FileBuff, MAX_PATH);
GetMem(PBuff, MAX_PATH);
try
OleCheck(CoInitialize(nil));
try
OleCheck(Cocreateinstance(CLSID_ShellLink, nil,
CLSCTX_INPROC_SERVER, IID_IShellLinkA, IShLnk));
hRes := IShLnk.QueryInterface(IPersistFile, IPFile);
if Failed(hRes) then
OleCheck(hRes)
else
begin
StringToWideChar(AFileName, FileBuff, MAX_PATH);
hRes := IPFile.load(FileBuff, STGM_READ);
if Failed(hRes) then
OleCheck(hRes)
else
begin
hRes := IShLnk.resolve(0, SLR_NO_UI);
if Succeeded(hRes) then
begin
IShLnk.GetPath(PBuff, MAX_PATH, Wfd, SLGP_SHORTPATH);
Result.FileName := PBuff;
IShLnk.GetIconLocation(PBuff, MAX_PATH, Result.IconIndex);
Result.IconLocation := PBuff;
IShLnk.GetWorkingDirectory(PBuff, MAX_PATH);
Result.WorkDirectory := PBuff;
IShLnk.GetDescription(PBuff, MAX_PATH);
Result.Description := PBuff;
IShLnk.GetArguments(PBuff, MAX_PATH);
Result.Arguments := PBuff;
IShLnk.GetHotKey(Result.HotKey);
IShLnk.GetIdList(Result.ItemIdList);
IShLnk.GetShowCmd(Result.ShowState);
end;
end;
end;
finally
CoUninitialize;
end;
finally
FreeMem(FileBuff);
FreeMem(PBuff);
end;
end;
.........
end.
La implementación de estas funciones podría ser esta:
Código:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons;
type
TForm1 = class(TForm)
Button1: TButton;
OpenDialog1: TOpenDialog;
Edit1: TEdit;
SpeedButton1: TSpeedButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
LnkUtils, ShellApi;
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
LnkInfo: TLinkFileInfo;
AIconFile: TFileName;
MyIcon: TIcon;
wIcon: Word;
begin
{Trae la información del Link}
LnkInfo := GetLinkFileInfo('c:\fede\Editar Autoexec.lnk');
if LnkInfo.IconLocation = '' Then
AIconFile := LnkInfo.FileName {Si el ícono es del mismo archivo}
else
AIconFile := LnkInfo.IconLocation; {Si el ícono es de otro archivo}
wIcon := LnkInfo.IconIndex;
MyIcon:=TIcon.Create;
Try
{Extrae el Ícono}
MyIcon.Handle := ExtractAssociatedIcon(hInstance, PChar(AIconFile), wIcon);
{Dibuja el Ícono en el Botón}
SpeedButton1.Glyph.Width := MyIcon.Width;
SpeedButton1.Glyph.Height:= MyIcon.Height;
SpeedButton1.Glyph.Canvas.Draw(0, 0, MyIcon);
finally
MyIcon.Free;
end;
end;
end.
Bueno, espero que te sea de utilidad, podes recortar el código a tu gusto.
Saludos!