Ver Mensaje Individual
  #10  
Antiguo 24-06-2003
Avatar de delphi.com.ar
delphi.com.ar delphi.com.ar is offline
Federico Firenze
 
Registrado: may 2003
Ubicación: Buenos Aires, Argentina *
Posts: 5.934
Reputación: 27
delphi.com.ar Va por buen camino
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!
__________________
delphi.com.ar

Dedique el tiempo suficiente para formular su pregunta si pretende que alguien dedique su tiempo en contestarla.

Última edición por delphi.com.ar fecha: 24-06-2003 a las 19:25:24.
Responder Con Cita