Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Как узнать информацию о ярлыке по пути его нахождения ? [D7, WinXP]


Midaw ©   (2004-04-01 14:29:00) 

Как узнать информацию о ярлыке по пути его нахождения, т.е. создать IShellLink с информацией о существующем ярлыке ?


VMcL   (2004-04-01 18:57:00) [1]

Забыл:
TPathBuf = packed array [0 .. MAX_PATH] of Char;


VMcL   (2004-04-01 18:55:00) [2]


type
 TLinkInfo = packed record
   Path: String;
   Args: String;
   WorkDir: String;
   ShowCmd: TWindowState;
   Descr: String;
   IconPath: String;
   IconIdx: Integer;
   Hotkey: Word;
 end;

function ReadLink(var ALink: TLinkInfo; const AFileName: String): Boolean;
var
 Obj: IUnknown;
 Lnk: IShellLink;
 pFile: IPersistFile;
 Cmd: Integer;
 WFileName: WideString;
 pc: TPathBuf;
 FD: TWin32FindData;
const
 Mx = SizeOf(pc) - 1;
begin
 Result := False;

 Obj := CreateComObject(CLSID_ShellLink);
 if Obj = nil then
   raise Exception.Create(
     'ReadLink: cannot create IShellLink interface object.');

 Lnk := Obj as IShellLink;
 pFile := Obj as IPersistFile;

 WFileName := WideString(AFileName);
 if pFile.Load(PWideChar(WFileName),
   stgm_Read or stgm_Share_Deny_Write) <> S_OK then Exit;

 if Lnk.GetDescription(pc, Mx) <> S_OK then Exit;
 ALink.Descr := StrPas(pc);

 if Lnk.GetPath(pc, Mx, FD, 0) <> S_OK then Exit;
 ALink.Path := pc;

 if Lnk.GetArguments(pc, Mx) <> S_OK then Exit;
 ALink.Args := pc;

 if Lnk.GetWorkingDirectory(pc, Mx) <> S_OK then Exit;
 ALink.WorkDir := pc;

 if Lnk.GetShowCmd(Cmd) <> S_OK then Exit;
 case Cmd of
   sw_ShowNormal:       ALink.ShowCmd := wsNormal;
   sw_ShowMinNoActive:  ALink.ShowCmd := wsMinimized;
   sw_ShowMaximized:    ALink.ShowCmd := wsMaximized;
 else
   raise ERangeError.CreateFmt(
     'ReadLink: unexpected value of "show command" (%d).', [Cmd]);
 end;

 if Lnk.GetIconLocation(pc, Mx, ALink.IconIdx) <> S_OK then Exit;
 ALink.IconPath := CopyStr(pc);

 if Lnk.GetHotkey(ALink.Hotkey) <> S_OK then Exit;

 Result := True;
end;


Наверх

Титульная страница Поиск, карта сайта Написать письмо