|
:: MVP ::
|
|
|
:: RSS ::
|
|
|
Как програмно создать ярлык?
uses
{...,} ShlObj, ComObj, ActiveX;
function TForm1.CreateShortcut(const CmdLine, Args, WorkDir, LinkFile,
IconFile: string): IPersistFile;
var
MyObject: IUnknown;
MySLink: IShellLink;
MyPFile: IPersistFile;
WideFile: WideString;
begin
MyObject := CreateComObject( CLSID_ShellLink );
MySLink := MyObject as IShellLink;
MyPFile := MyObject as IPersistFile;
with MySLink do
begin
SetPath( PChar( CmdLine ) );
SetIconLocation( PChar( IconFile ), 0 );
SetArguments( PChar( Args ) );
SetWorkingDirectory( PChar( WorkDir ) );
end;
WideFile := LinkFile;
MyPFile.Save( PWChar( WideFile ), false );
Result := MyPFile;
end;
// CmdLine - путь к файлу
// Args - параметры командмой строки
// WorkDir - директория, в которой находится файл
// LinkFile - путь к папке, в которой будет создан ярлык
// IconFile - путь к файлу-иконке
|
Как получить имя файла из его ярлыка?
uses
{...,} ShlObj, ComObj, ActiveX;
function GetFileNameFromLink( LinkFileName: string ): string;
var
MyObject: IUnknown;
MySLink: IShellLink;
MyPFile: IPersistFile;
FileInfo: TWin32FINDDATA;
WidePath: array[0..MAX_PATH] of WideChar;
Buff: array[0..MAX_PATH] of Char;
begin
Result := '';
if ( FileExists( LinkFileName ) = false ) then
Exit;
MyObject := CreateComObject( CLSID_ShellLink );
MyPFile := MyObject as IPersistFile;
MySLink := MyObject as IShellLink;
StringToWideChar( LinkFileName, WidePath, SizeOf( WidePath ) );
MyPFile.Load( WidePath, STGM_READ );
MySLink.GetPath( Buff, MAX_PATH, FileInfo, SLGP_UNCPRIORITY );
Result := buff;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage( GetFileNameFromLink( 'C:\NOTEPAD.lnk' ) );
end;
|
Как получить рабочую директорию файла из его ярлыка?
uses
{...,} ShlObj, ComObj, ActiveX;
function GetFileWorkingDirectoryFromLink( LinkFileName: string ): string;
var
MyObject: IUnknown;
MySLink: IShellLink;
MyPFile: IPersistFile;
WidePath: array[0..MAX_PATH] of WideChar;
Buff: array[0..MAX_PATH] of Char;
begin
Result := '';
if ( FileExists( LinkFileName ) = false ) then
Exit;
MyObject := CreateComObject( CLSID_ShellLink );
MyPFile := MyObject as IPersistFile;
MySLink := MyObject as IShellLink;
StringToWideChar( LinkFileName, WidePath, SizeOf( WidePath ) );
MyPFile.Load( WidePath, STGM_READ );
MySLink.GetWorkingDirectory( Buff, MAX_PATH );
Result := buff;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage( GetFileWorkingDirectoryFromLink( 'C:\NOTEPAD.lnk' ) );
end;
|
Как получить описание файла из его ярлыка?
uses
{...,} ShlObj, ComObj, ActiveX;
function GetFileDescriptionFromLink( LinkFileName: string ): string;
var
MyObject: IUnknown;
MySLink: IShellLink;
MyPFile: IPersistFile;
WidePath: array[0..MAX_PATH] of WideChar;
Buff: array[0..MAX_PATH] of Char;
begin
Result := '';
if ( FileExists( LinkFileName ) = false ) then
Exit;
MyObject := CreateComObject( CLSID_ShellLink );
MyPFile := MyObject as IPersistFile;
MySLink := MyObject as IShellLink;
StringToWideChar( LinkFileName, WidePath, SizeOf( WidePath ) );
MyPFile.Load( WidePath, STGM_READ );
MySLink.GetDescription( Buff, MAX_PATH );
Result := buff;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage( GetFileDescriptionFromLink( 'C:\NOTEPAD.lnk' ) );
end;
|
Как получить параметры командной строки файла из его ярлыка?
uses
{...,} ShlObj, ComObj, ActiveX;
function GetFileArgumentsFromLink( LinkFileName: string ): string;
var
MyObject: IUnknown;
MySLink: IShellLink;
MyPFile: IPersistFile;
WidePath: array[0..MAX_PATH] of WideChar;
Buff: array[0..MAX_PATH] of Char;
begin
Result := '';
if ( FileExists( LinkFileName ) = false ) then
Exit;
MyObject := CreateComObject( CLSID_ShellLink );
MyPFile := MyObject as IPersistFile;
MySLink := MyObject as IShellLink;
StringToWideChar( LinkFileName, WidePath, SizeOf( WidePath ) );
MyPFile.Load( WidePath, STGM_READ );
MySLink.GetArguments( Buff, MAX_PATH );
Result := buff;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage( GetFileArgumentsFromLink( 'C:\NOTEPAD.lnk' ) );
end;
|
Как программно запустить ярлык?
uses
{...,} ShellAPI;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute( Handle, 'Open', 'C:\NOTEPAD.lnk', nil, nil, SW_SHOWNORMAL );
end;
|
Как получить список иконок рабочего стола?
// Способ первый
uses
SHDocVw, ShlObj, ActiveX;
procedure TForm1.Button1Click(Sender: TObject);
function IUnknown_QueryService(punkSite: IUnknown; sid: TGUID; riid: TGUID; var ppv): HResult;
var
psp: IServiceProvider;
begin
Pointer(ppv) := nil;
Result := E_FAIL;
if Assigned(punkSite) then
begin
Result := punkSite.QueryInterface(IServiceProvider, psp);
if Succeeded(Result) then
Result := psp.QueryService(sid, riid, ppv);
end;
end;
var
Handle: HWND;
ShWnd: IShellWindows;
WndIface: IDispatch;
shBrowser: IShellBrowser;
ShellView: IShellView;
FolderView: IFolderView;
Folder: IShellFolder;
ItemsEnum: IEnumIDList;
spidl: PItemIDList;
Fetched: Cardinal;
strRet: TStrRet;
pt: TPoint;
begin
ShWnd := CoShellWindows.Create;
try
WndIface := ShWnd.FindWindowSW(Null, Null, SWC_DESKTOP, Integer(Handle), SWFO_NEEDDISPATCH);
if Assigned(WndIface) then
begin
if Succeeded(IUnknown_QueryService(WndIface, SID_STopLevelBrowser, IID_IShellBrowser, shBrowser)) then
begin
if Succeeded(shBrowser.QueryActiveShellView(ShellView)) then
begin
if Succeeded(ShellView.QueryInterface(IID_IFolderView, FolderView)) then
begin
FolderView.GetFolder(IID_IShellFolder, Folder);
FolderView.Items(SVGIO_ALLVIEW, IID_IEnumIDList, ItemsEnum);
if Assigned(Folder) and Assigned(ItemsEnum) then
begin
// Получить следующий объект рабочего стола
while ItemsEnum.Next(1, spidl, Fetched) = S_OK do
begin
// Получить название иконки
Folder.GetDisplayNameOf(spidl, SHGDN_NORMAL, strRet);
// Получить координаты иконки
FolderView.GetItemPosition(spidl, pt);
Memo1.Lines.Add(Format('%s x:%d y:%d', [strRet.pOleStr, pt.X, pt.Y]))
end;
end;
end;
end;
end;
end;
finally
ShWnd := nil;
end;
end;
// Способ второй
uses
{...,} CommCtrl;
// GetDesktopListViewHandle
// Result: дескриптор объекта SysListView32, принадлежащего проводнику и
// обычно видимого в качестве "иконок рабочего стола"
function GetDesktopListViewHandle: HWND;
var
s: packed array [0..127] of Char;
Res: Integer;
begin
Result := FindWindow( 'ProgMan', nil );
Result := GetWindow( Result, GW_CHILD );
Result := GetWindow( Result, GW_CHILD );
Res := GetClassName( Result, s, SizeOf( s )-1 );
if ( Res = 0 ) or ( String( s ) <> 'SysListView32' ) then
Result := 0;
end;
procedure TAppForm.Button1Click(Sender: TObject);
const
PROCESS_ACCESS = PROCESS_VM_OPERATION or PROCESS_VM_READ or
PROCESS_VM_WRITE; // Доступ, необходимый для операций
type
PProcData = ^TProcData;
TProcData = record
Item: TLVItemA;
Txt: packed array [0..1023] of WideChar; // AnsiChar для не юникодовых версий Delphi
ItemRect: TRect;
end;
var
LV: HWND;
Cnt, i: Integer;
ProcID: DWORD;
ProcessHandle: THandle;
Data: TProcData;
RemoteProcData: PProcData;
Res: Boolean;
LI: TListItem;
ColWid: Integer;
begin
ListView1.Clear;
// Нахождение дескриптора ListView "рабочего стола"
LV := GetDesktopListViewHandle;
if LV = 0 then
begin
MessageDlg( 'Desktop''s SysListView32 not found.', mtError, [mbOK], 0 );
Exit;
end;
// Получение ID процесса по дескриптору ListView
ProcID := 0;
GetWindowThreadProcessId( LV, ProcID );
if ProcId = 0 then
begin
MessageDlg( 'Cannot retrieve process ID.', mtError, [mbOK], 0 );
Exit;
end;
// Открытие доступа к стороннему процессу
ProcessHandle := OpenProcess( PROCESS_ACCESS, False, ProcID );
if ProcessHandle = 0 then
RaiseLastOSError;
try
// Выделение памяти в ВАП нужного нам процесса
RemoteProcData := VirtualAllocEx( ProcessHandle, nil, SizeOf( RemoteProcData^ ),
MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE );
if RemoteProcData = nil then
RaiseLastOSError;
try
Cnt := ListView_GetItemCount( LV ); // Получение количества иконок
for i := 0 to Cnt-1 do
begin
FillChar( Data, SizeOf( Data ), 0) ; // Обнуление структуры
// Заполнение структуры LV_ITEM (точнее LV_ITEMA)
with Data.Item do
begin
iSubItem := 0;
pszText := @RemoteProcData^.Txt;
cchTextMax := SizeOf( RemoteProcData^.Txt )-1;
end;
// Копирование структуры из ВАП нашего процесса в структуру,
// находящуюся в ВАП нужного нам процесса
Res := WriteProcessMemory( ProcessHandle, RemoteProcData, @Data,
SizeOf( Data ), PLongWord( nil )^ );
if not Res then
RaiseLastOSError;
// Получение надписи под иконкой
SendMessage( LV, LVM_GETITEMTEXT, i, LPARAM( @RemoteProcData^.Item ) );
// Получение координат ограничивающего иконку прямоугольника
SendMessage( LV, LVM_GETITEMRECT, i, LPARAM( @RemoteProcData^.ItemRect ) );
// Чтение полученных данных из "чужого" ВАП в наш
Res := ReadProcessMemory( ProcessHandle, RemoteProcData, @Data,
SizeOf( Data ), PLongWord( nil )^ );
if not Res then
RaiseLastOSError;
// Добавление параметров иконки
LI := ListView1.Items.Add;
LI.ImageIndex := 0;
LI.SubItems.Add( IntToStr( i ) );
LI.SubItems.Add( Data.Txt );
with Data.ItemRect do
LI.SubItems.Add( Format( '%4d, %4d --- %4d, %4d',
[Left, Top, Right, Bottom] ) );
end;
finally
// Освобождение памяти
Res := LongBool( VirtualFreeEx( ProcessHandle, RemoteProcData,
0, MEM_RELEASE ) );
if not Res then
RaiseLastOSError;
end;
finally
// Закрытие дескриптора открытого процесса
CloseHandle( ProcessHandle );
end;
// Наведение "красоты"
if ListView1.Items.Count > 0 then
ColWid := -1
else
ColWid := -2;
for i := 2 to ListView1.Columns.Count-1 do
ListView1.Column[i].Width := ColWid;
end;
|
|
При использовании материала - ссылка на сайт обязательна
|
|
