Ветеран
Сообщения: 1274
Благодарности: 1030
Профиль
|
Отправить PM
| Цитировать
Цитата Beavimo :
я и говорю что не работает на 10-ке функция PinToTaskbar зато на 7-ке все хорошо... а вот PinToStartMenu работает прекрасно »
Beavimo , Microsoft считает, что закрепление ярлыка на Панели задач должен делать пользователь, а не приложение, и с каждой следующей сборкой что-нибудь да и отпиливают.
PinToTaskbar
Код:
const
CLSID_TaskbandPin = '{90AA3A4E-1CBA-4233-B8BB-535773D48449}' ;
IID_IPinnedList2 = '{BBD20037-BC0E-42F1-913F-E2936BB0EA0C}' ;
IID_IPinnedList3 = '{0DD79AE2-D156-45D4-9EEB-3B549769E940}' ;
CLSCTX_INPROC_SERVER = 1 ;
PLMC_EXPLORER = 4 ;
S_OK = 0 ;
type
PItemIDList = LongWord;
IPinnedList2 = interface (IUnknown)
'{BBD20037-BC0E-42F1-913F-E2936BB0EA0C}'
procedure EnumObjects; // dummy
function Modify(unpin, pin: PItemIDList): HRESULT;
procedure GetChangeCount; // dummy
procedure GetPinnableInfo; // dummy
procedure IsPinnable; // dummy
procedure Resolve; // dummy
function IsPinned(pidl: PItemIDList): HRESULT;
procedure GetPinnedItem; // dummy
procedure GetPinnedItemForAppID; // dummy
procedure ItemChangeNotify; // dummy
procedure UpdateForRemovedItemsAsNecessary; // dummy
end ;
IPinnedList3 = interface (IUnknown)
'{0DD79AE2-D156-45D4-9EEB-3B549769E940}'
procedure EnumObjects; // dummy
procedure GetPinnableInfo; // dummy
procedure IsPinnable; // dummy
procedure Resolve; // dummy
procedure LegacyModify; // dummy
procedure GetChangeCount; // dummy
function IsPinned(pidl: PItemIDList): HRESULT;
procedure GetPinnedItem; // dummy
procedure GetAppIDForPinnedItem; // dummy
procedure ItemChangeNotify; // dummy
procedure UpdateForRemovedItemsAsNecessary; // dummy
procedure PinShellLink; // dummy
procedure GetPinnedItemForAppID; // dummy
function Modify(unpin, pin: PItemIDList; ModifyCaller: LongWord): HRESULT;
end ;
function CoCreateInstance(rclsid: TCLSID; pUnkOuter: LongWord;
dwClsContext: DWORD; riid: TIID; out ppv: IUnknown): HRESULT; external 'CoCreateInstance@ole32.dll stdcall' ;
function ILCreateFromPath(const pszPath: string ): PItemIDList; external 'ILCreateFromPathW@shell32.dll stdcall' ;
procedure ILFree(pidl: PItemIDList); external 'ILFree@shell32.dll stdcall' ;
function PinToTaskbar(const AFilename: string ; AIsPin: Boolean): Boolean;
// AFilename : full path to executable file
// AIsPin....: False - unpin from TaskBar, True - pin to TaskBar
var
LPIDL: PItemIDList;
LUnk: IUnknown;
LPinnedList2: IPinnedList2;
LPinnedList3: IPinnedList3;
LShellApp: Variant;
LVerb: string ;
begin
Result := False;
if FileExists(AFilename) and
(GetWindowsVersion > $06010000 ) then
try
LPIDL := ILCreateFromPath(AFilename);
try
{ Windows 10 (build 1809) and above. }
OleCheck(CoCreateInstance(StringToGUID(CLSID_TaskbandPin), 0 ,
CLSCTX_INPROC_SERVER, StringToGUID(IID_IPinnedList3), LUnk));
LPinnedList3 := LUnk as IPinnedList3;
except
try
{ Windows 7, 8, 8.1 if IPinnedList2 supported. }
OleCheck(CoCreateInstance(StringToGUID(CLSID_TaskbandPin), 0 ,
CLSCTX_INPROC_SERVER, StringToGUID(IID_IPinnedList2), LUnk));
LPinnedList2 := LUnk as IPinnedList2;
except
{ Below Windows 10 (build 1809) fallback. }
LShellApp := CreateOleObject('Shell.Application' );
end ;
end ;
if AIsPin then // pin
begin
if LPinnedList3 <> nil then
begin
Result := LPinnedList3.IsPinned(LPIDL) <> S_OK;
if Result then
OleCheck(LPinnedList3.Modify(0 , LPIDL, PLMC_EXPLORER));
end
else if LPinnedList2 <> nil then
begin
Result := LPinnedList2.IsPinned(LPIDL) <> S_OK;
if Result then
OleCheck(LPinnedList2.Modify(0 , LPIDL));
end else
LVerb := 'taskbarpin' ;
end else // unpin
begin
if LPinnedList3 <> nil then
begin
Result := LPinnedList3.IsPinned(LPIDL) = S_OK;
if Result then
OleCheck(LPinnedList3.Modify(LPIDL, 0 , PLMC_EXPLORER));
end
else if LPinnedList2 <> nil then
begin
Result := LPinnedList2.IsPinned(LPIDL) = S_OK;
if Result then
OleCheck(LPinnedList2.Modify(LPIDL, 0 ));
end else
LVerb := 'taskbarunpin' ;
end ;
if LVerb <> '' then
LShellApp.Windows.Item.Document.Application
.NameSpace(ExtractFileDir(AFilename))
.ParseName(ExtractFileName(AFilename)).InvokeVerb(LVerb);
except
Result := False;
ShowExceptionMessage;
finally
ILFree(LPIDL);
end ;
end ;
PinToStartMenu
Код:
function PinToStartMenu(const AFilename: string ; AIsPin: Boolean): Boolean;
// AFilename : full path to exe- or lnk-file
// AIsPin : False - unpin from StartMenu, True - pin to StartMenu
var
LShellApp, LFolderItem: Variant;
LVerb, LnkName: string ;
begin
Result := False;
if not FileExists(AFilename) then Exit;
try
LShellApp := CreateOleObject('Shell.Application' );
LFolderItem := LShellApp.Windows.Item.Document.Application
.NameSpace(ExtractFileDir(AFilename))
.ParseName(ExtractFileName(AFilename));
{ Below Windows 8. }
if GetWindowsVersion < $06020000 then
begin
if AIsPin then
LVerb := 'startpin' else
LVerb := 'startunpin' ;
LFolderItem.InvokeVerb(LVerb);
Result := True;
end else
{ Windows 8 and above. }
begin
if not LFolderItem.IsLink then
begin
LnkName := LFolderItem.ExtendedProperty('FileDescription' );
if LnkName = '' then
LnkName := ExtractFileName(AFilename);
LnkName := ExpandConstant('{commonprograms}\' ) + ChangeFileExt(LnkName, '.lnk' );
if AIsPin then
Result := not FileExists(LnkName) and
FileExists(CreateShellLink(LnkName, '' , AFilename, '' , '' , '' , 0 , SW_SHOWNORMAL))
else
Result := DeleteFile(LnkName);
end else
begin
LnkName := ExpandConstant('{commonprograms}\' ) + ExtractFileName(LFolderItem.Path);
if AIsPin then
Result := not FileExists(LnkName) and
FileCopy(LFolderItem.Path, LnkName, False)
else
Result := DeleteFile(LnkName);
end ;
end ;
except
ShowExceptionMessage;
end ;
end ;
Последний раз редактировалось El Sanchez, 06-06-2020 в 16:19 .
Причина: 16.02.20:fix; 06.06.20: add PinToStartMenu
Это сообщение посчитали полезным следующие участники:
Отправлено : 18:19, 09-02-2020
| #559