Ярлыки, файловые ассоциации, расширения

Взять все расширения из реестра и их описание

2017-10-16T18:01:26+07:00

Этот код вернет программы, связанные с каждым расширением.

Очевидно, вы можете изменить его для поиска конкретного расширения.

Зарегистрировать новый тип файлов

2017-10-16T17:54:24+07:00

Не хуже M$ получается! У них свои типы файлов, и у нас будут свои! Всё, что для этого нужно - точно выполнять последовательность действий и научиться копировать в буфер, чтобы не писать все те коды, что будут тут изложены :))

Сначала, естественно, объявляем в uses модуль Registry.

Подробнее...

Как зарегистрировать своё расширение?

2017-10-16T17:47:35+07:00

Code:

Uses Registry;

{©Drkb v.3 ®Vit (Vitaly Nevzorov) - nevzorov@yahoo.com}

procedure RegisterFileType(FileType,FileTypeName, Description,ExecCommand:string);

begin

if (FileType='') or (FileTypeName='') or (ExecCommand='') then exit;

if FileType[1]<>'.' then FileType:='.'+FileType;

if Description='' then Description:=FileTypeName;

with Treginifile.create do

try

rootkey := hkey_classes_root;

writestring(FileType,'',FileTypeName);

writestring(FileTypeName,'',Description);

writestring(FileTypeName+'\shell\open\command','',ExecCommand+' "%1"');

finally

free;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

RegisterFileType('txt','TxtFile', 'Plain text','notepad.exe');

end;

Как зарегистрировать свой пункт в меню для моего типа файлов?

2017-10-16T18:04:59+07:00

Code:

uses

Registry;

procedure AddFileMenue(FilePrefix, Menue, Command: string);

var

reg: TRegistry;

typ: string;

begin

reg := TRegistry.Create;

with reg do

begin

RootKey := HKEY_CLASSES_ROOT;

OpenKey('.' + FilePrefix, True);

typ := ReadString('');

if typ = '' then

begin

typ := Fileprefix + 'file';

WriteString('', typ);

end;

CloseKey;

OpenKey(typ + '\shell\' + Menue + '\command', True);

WriteString('', command + ' "%1"');

CloseKey;

Free;

end;

procedure DeleteFileMenue(Fileprefix, Menue: string);

var

reg: TRegistry;

typ: string;

begin

reg := TRegistry.Create;

with reg do

begin

RootKey := HKEY_CLASSES_ROOT;

OpenKey('.' + Fileprefix, True);

typ := ReadString('');

CloseKey;

OpenKey(typ + '\shell', True);

DeleteKey(Menue);

CloseKey;

Free;

end;

{ Example}

procedure TForm1.Button1Click(Sender: TObject);

begin

AddFileMenue('rtf', 'Edit with Notepad', 'C:\Windows\system\notepad.exe');

{

Если нажать правой кнопкой мыши на *.ртф-файл потом Вы можете увидеть

всплывающее меню: "Редактировать с помощью Блокнота".

При нажатии на эту точку Блокнот открывает файл.

}

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

{

Undo your changes in the Registry:

}

DeleteFileMenue('rtf', 'Edit with Notepad');

end;

Как показать иконку, ассоциированную с данным типом файла?

2017-10-16T17:51:35+07:00

ShellApi функция ExtractAssociatedIcon()

Code:

uses ShellApi;

procedure TForm1.Button1Click(Sender: TObject);

var

Icon: hIcon;

IconIndex: word;

begin

IconIndex := 1;

Icon := ExtractAssociatedIcon(HInstance,

Application.ExeName,

IconIndex);

DrawIcon(Canvas.Handle, 10, 10, Icon);

end;

Как получить имя программы, с которой ассоциировано то или иное расширение

2017-10-16T17:53:01+07:00

Code:

uses

{$IFDEF WIN32}

Registry; {We will get it from the registry}

{$ELSE}

IniFiles; {We will get it from the win.ini file}

{$ENDIF}

{$IFNDEF WIN32}

const

MAX_PATH = 144;

{$ENDIF}

function GetProgramAssociation(Ext: string): string;

var

{$IFDEF WIN32}

reg: TRegistry;

s: string;

{$ELSE}

WinIni: TIniFile;

WinIniFileName: array[0..MAX_PATH] of char;

s: string;

{$ENDIF}

begin

{$IFDEF WIN32}

s := '';

reg := TRegistry.Create;

reg.RootKey := HKEY_CLASSES_ROOT;

if reg.OpenKey('.' + ext + '\shell\open\command',

false) <> false then

begin

{The open command has been found}

s := reg.ReadString('');

reg.CloseKey;

end

else

begin

{perhaps thier is a system file pointer}

if reg.OpenKey('.' + ext,

false) <> false then

begin

s := reg.ReadString('');

reg.CloseKey;

if s <> '' then

begin

{A system file pointer was found}

if reg.OpenKey(s + '\shell\open\command',

false) <> false then

{The open command has been found}

s := reg.ReadString('');

reg.CloseKey;

end;

{Delete any command line, quotes and spaces}

if Pos('%', s) > 0 then

Delete(s, Pos('%', s), length(s));

if ((length(s) > 0) and

(s[1] = '"')) then

Delete(s, 1, 1);

if ((length(s) > 0) and

(s[length(s)] = '"')) then

Delete(s, Length(s), 1);

while ((length(s) > 0) and

((s[length(s)] = #32) or

(s[length(s)] = '"'))) do

Delete(s, Length(s), 1);

{$ELSE}

GetWindowsDirectory(WinIniFileName, sizeof(WinIniFileName));

StrCat(WinIniFileName, '\win.ini');

WinIni := TIniFile.Create(WinIniFileName);

s := WinIni.ReadString('Extensions',

ext,

'');

WinIni.Free;

{Delete any command line}

if Pos(' ^', s) > 0 then

Delete(s, Pos(' ^', s), length(s));

{$ENDIF}

result := s;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage(GetProgramAssociation('gif'));

end;

Автор: Олег Кулабухов

Как получить список всех расширений и их ассоциаций?

2017-10-16T18:08:39+07:00

Этот код вернет программы, связанные с каждым расширением.

Очевидно, вы можете изменить его для поиска конкретного расширения.

Подробнее...

Как программно создать ярлык?

2017-10-16T17:48:26+07:00

Code:

uses ShlObj, ComObj, ActiveX;

procedure CreateLink(const PathObj, PathLink, Desc, Param: string);

var

IObject: IUnknown;

SLink: IShellLink;

PFile: IPersistFile;

begin

IObject := CreateComObject(CLSID_ShellLink);

SLink := IObject as IShellLink;

PFile := IObject as IPersistFile;

with SLink do begin

SetArguments(PChar(Param));

SetDescription(PChar(Desc));

SetPath(PChar(PathObj));

end;

PFile.Save(PWChar(WideString(PathLink)), FALSE);

end;

Автор: Gavrilo

Как прочитать shortcut's link information?

2017-10-16T18:02:53+07:00

Code:

uses

ShlObj,

ComObj,

ActiveX,

CommCtrl;

type

PShellLinkInfoStruct = ^TShellLinkInfoStruct;

TShellLinkInfoStruct = record

FullPathAndNameOfLinkFile: array[0..MAX_PATH] of Char;

FullPathAndNameOfFileToExecute: array[0..MAX_PATH] of Char;

ParamStringsOfFileToExecute: array[0..MAX_PATH] of Char;

FullPathAndNameOfWorkingDirectroy: array[0..MAX_PATH] of Char;

Description: array[0..MAX_PATH] of Char;

FullPathAndNameOfFileContiningIcon: array[0..MAX_PATH] of Char;

IconIndex: Integer;

HotKey: Word;

ShowCommand: Integer;

FindData: TWIN32FINDDATA;

end;

procedure GetLinkInfo(lpShellLinkInfoStruct: PShellLinkInfoStruct);

var

ShellLink: IShellLink;

PersistFile: IPersistFile;

AnObj: IUnknown;

begin

// access to the two interfaces of the object

AnObj := CreateComObject(CLSID_ShellLink);

ShellLink := AnObj as IShellLink;

PersistFile := AnObj as IPersistFile;

// Opens the specified file and initializes an object from the file contents.

PersistFile.Load(PWChar(WideString(lpShellLinkInfoStruct^.FullPathAndNameOfLinkFile)), 0);

with ShellLink do

begin

// Retrieves the path and file name of a Shell link object.

GetPath(lpShellLinkInfoStruct^.FullPathAndNameOfFileToExecute,

SizeOf(lpShellLinkInfoStruct^.FullPathAndNameOfLinkFile),

lpShellLinkInfoStruct^.FindData,

SLGP_UNCPRIORITY);

// Retrieves the description string for a Shell link object.

GetDescription(lpShellLinkInfoStruct^.Description,

SizeOf(lpShellLinkInfoStruct^.Description));

// Retrieves the command-line arguments associated with a Shell link object.

GetArguments(lpShellLinkInfoStruct^.ParamStringsOfFileToExecute,

SizeOf(lpShellLinkInfoStruct^.ParamStringsOfFileToExecute));

// Retrieves the name of the working directory for a Shell link object.

GetWorkingDirectory(lpShellLinkInfoStruct^.FullPathAndNameOfWorkingDirectroy,

SizeOf(lpShellLinkInfoStruct^.FullPathAndNameOfWorkingDirectroy));

// Retrieves the location (path and index) of the icon for a Shell link object.

GetIconLocation(lpShellLinkInfoStruct^.FullPathAndNameOfFileContiningIcon,

SizeOf(lpShellLinkInfoStruct^.FullPathAndNameOfFileContiningIcon),

lpShellLinkInfoStruct^.IconIndex);

// Retrieves the hot key for a Shell link object.

GetHotKey(lpShellLinkInfoStruct^.HotKey);

// Retrieves the show (SW_) command for a Shell link object.

GetShowCmd(lpShellLinkInfoStruct^.ShowCommand);

end;

procedure TForm1.Button1Click(Sender: TObject);

const

br = #13#10;

var

LinkInfo: TShellLinkInfoStruct;

s: string;

begin

FillChar(LinkInfo, SizeOf(LinkInfo), #0);

LinkInfo.FullPathAndNameOfLinkFile := 'C:\WINNT\Profiles\user\Desktop\FileName.lnk';

GetLinkInfo(@LinkInfo);

with LinkInfo do

s := FullPathAndNameOfLinkFile + br +

FullPathAndNameOfFileToExecute + br +

ParamStringsOfFileToExecute + br +

FullPathAndNameOfWorkingDirectroy + br +

Description + br +

FullPathAndNameOfFileContiningIcon + br +

IntToStr(IconIndex) + br +

IntToStr(LoByte(HotKey)) + br +

IntToStr(HiByte(HotKey)) + br +

IntToStr(ShowCommand) + br +

FindData.cFileName + br +

FindData.cAlternateFileName;

Memo1.Lines.Add(s);

end;

Как связать определённое расширение файлов с моим приложением?

2017-10-16T17:50:43+07:00

В Win32 необходимо создать новую запись в реестре в корневом ключе HKEY_CLASSES_ROOT, которая будет указывать на расширение файла, командную строку и иконку, которая будет отображаться для этого расширения. В Win16, просто включить расширение файла и командную строку в секцию [Extensions] в Win.ini.

Подробнее...

Как создать ShortCut файл (.LNK)?

2017-10-16T18:06:52+07:00

Code:

uses ShlObj, ActiveX, ComObj;

...

{©Drkb v.3®Vit (Vitaly Nevzorov) - nevzorov@yahoo.com}

procedure CreateShortCut(ShortCutName, Parameters, FileName: string);

var ShellObject: IUnknown;

ShellLink: IShellLink;

PersistFile: IPersistFile;

FName: WideString;

begin

ShellObject := CreateComObject(CLSID_ShellLink);

ShellLink := ShellObject as IShellLink;

PersistFile := ShellObject as IPersistFile;

with ShellLink do

begin

SetArguments(PChar(Parameters));

SetPath(PChar(FileName));

SetWorkingDirectory(PChar(extractfilepath(FileName)));

FName := ShortCutName;

PersistFile.Save(PWChar(FName), False);

end;

Как удалить/восстановить файлы из корзины?

2017-10-16T18:06:09+07:00

Code:

program del;

uses

ShellApi;

//function SHFileOperation(const lpFileOp: TSHFileOpStruct): Integer; stdcall;

var

T: TSHFileOpStruct;

P: string;

begin

P := 'C:\Windows\System\EL_CONTROL.CPL';

with T do

begin

Wnd := 0;

wFunc := FO_DELETE;

pFrom := Pchar(P);

fFlags := FOF_ALLOWUNDO

end;

SHFileOperation(T);

end.

Подробнее...

Работа с ассоциациями файла

2017-10-16T17:59:55+07:00

Code:

Unit Associations; { Subset }

Interface

Procedure RegisterFiletype( Const extension, filetype, description,

verb: String; params: String );

Procedure RegisterFileIcon( Const filetype, iconsource: String;

iconindex: Cardinal );

Function FiletypeIsRegistered( Const extension, filetype: String ):

Boolean;

Implementation

Uses Windows, Classes, SysUtils, Registry;

ResourceString

eCannotCreateKey =

'Cannot create key %s, the user account may not have the required '+

'rights to create registry keys under HKEY_CLASSES_ROOT.';

Type

ERegistryError = Class( Exception );

{+------------------------------------------------------------

| Procedure CreateKey

|Видимость: ограничен блоком

| Описание:

| Это вспомогательная функция, которая использует переданный reg объект

| для создания раздела реестра.

| условия возникновения ошибок:

| Если ключ не может быть создан - сработает исключение ERegistryError

+------------------------------------------------------------}

Procedure CreateKey( reg: TRegistry; Const keyname: String );

Begin

If not reg.OpenKey( keyname, True ) Then

raise ERegistryError.CreateFmt( eCannotCreateKey, [keyname] );

End; { CreateKey }

{+------------------------------------------------------------

| Procedure InternalRegisterFiletype

| Parameters :

| extension : file extension, including the dot, to register

| filetype : string to use as key for the file extension

| description: string to show in Explorer for files with this

| extension. If description is empty the file

| type will not show up in Explorers list of

| registered associations!

| verb : action to register, 'open', 'edit', 'print' etc.

| The action will turn up as entry in the files

| context menu in Explorer.

| serverapp : full pathname of the executable to associate with

| the file extension, including any command line

| switches. Include the "%1" placeholder as well.

| Actions like printto may require more than one

| placeholder.

| Visibility : restricted to unit

| Description:

| Creates the three basic registry keys for a file extension.

| HKCR\<extension> = <filetype>

| HKCR\<filetype> = <description>

| HKCR\<filetype>\shell\<verb>\command = <serverapp>

| If the keys already exist they are overwritten!

| Error Conditions:

| A ERegistryError exception will result if a key cannot be

| created. Failure to create a key is usually due to insufficient

| user rights and only a problem on NT.

| Created: by P. Below

+------------------------------------------------------------}

Procedure InternalRegisterFiletype( Const extension, filetype,

description,

verb, serverapp: String );

Var

reg: TRegistry;

keystring: String;

Begin

reg:= TRegistry.Create;

Try

reg.Rootkey := HKEY_CLASSES_ROOT;

CreateKey( reg, extension );

reg.WriteString( '', filetype );

reg.CloseKey;

CreateKey( reg, filetype );

reg.WriteString('', description );

reg.closekey;

keystring := Format('%s\shell\%s\command', [filetype, verb] );

CreateKey( reg, keystring );

reg.WriteString( '', serverapp);

reg.CloseKey;

Finally

reg.free;

End;

End; { InternalRegisterFiletype }

{+------------------------------------------------------------

[OBJECT]

| Procedure RegisterFiletype

[OBJECT]

| Parameters :

| extension : file extension, including the dot, to register

| filetype : string to use as key for the file extension

| description: string to show in Explorer for files with this

| extension. If description is empty the file

| type will not show up in Explorers list of

| registered associations!

| verb : action to register, 'open', 'edit', 'print' etc.

| The action will turn up as entry in the files

| context menu in Explorer.

| params : The command line parameters to pass to the

| app when a file action is requested. If this

| parameter is empty "%1" is used by default.

| Visibility : exported from unit

| Description:

| Builds the commandline to use from the applications filename

| and the passed params and hands the rest of the work off to

| InternalRegisterFiletype.

| Error Conditions: none

| Created: by P. Below

+------------------------------------------------------------}

Procedure RegisterFiletype( Const extension, filetype, description,

verb: String; params: String );

Begin

If Length(params) = 0 Then

params := '"%1"';

InternalRegisterFiletype(

extension, filetype, description, verb,

ParamStr(0) + ' ' + params );

End; { RegisterFiletype }

{+------------------------------------------------------------

| Procedure RegisterFileIcon

| Parameters :

| filetype : file type key name to register the icon for

| iconsource: full pathname of the executable or ICO file

| that contains the icon

| iconindex : index of the icon to use, if several are containd

| in iconsource. Counts from 0!

| Visibility : exported from unit

| Description:

| Creates the registry keys required to tell Explorer which icon

| to display for files of this type. RegisterFileType needs

| to be called first to associate the filetype with an extension.

| The registry key added is

| HKCR\<filetype>\DefaultIcon = <iconsource>,<iconindex>

| If the key already exists it is overwritten!

| The icon specified should contain both large (32*32) and small

| (16*16) versions of the icon, to optain optimal display

| quality. If only one icon format is present Windows will

| generate the other from it.

| Error Conditions:

| A ERegistryError exception will result if a key cannot be

| created. Failure to create a key is usually due to insufficient

| user rights and only a problem on NT.

| Error Conditions: none

| Created: by P. Below

+------------------------------------------------------------}

Procedure RegisterFileIcon( Const filetype, iconsource: String;

iconindex: Cardinal );

Var

reg: TRegistry;

keystring: String;

Begin

reg:= TRegistry.Create;

Try

reg.Rootkey := HKEY_CLASSES_ROOT;

keystring := Format( '%s\DefaultIcon',[filetype] );

CreateKey( reg, keystring );

reg.WriteString( '', Format( '%s,%d', [iconsource,iconindex] ));

reg.CloseKey;

Finally

reg.free;

End;

End; { RegisterFileIcon }

{+------------------------------------------------------------

[OBJECT]

| Function FiletypeIsRegistered

[OBJECT]

| Parameters :

| extension : file extension, including the dot, to search for

| filetype : string to use as key for the file extension

| Returns : True if this application is registered as server

| for the 'open' action, false otherwise.

| Visibility : exported from unit

| Description:

| Checks if there is a registry entry for the passed extension,

| if it is associated with the expected file type and if this

| application is registered as server for the 'open' action.

| Error Conditions: none

| Created: by P. Below

+------------------------------------------------------------}

Function FiletypeIsRegistered( Const extension, filetype: String ):

Boolean;

Var

reg: TRegistry;

keystring: String;

Begin

Result := False;

reg:= TRegistry.Create;

Try

reg.Rootkey := HKEY_CLASSES_ROOT;

If reg.OpenKey(extension, false) Then Begin

{ Extension is registered, check filetype }

keystring := reg.ReadString('');

reg.Closekey;

If CompareText( keystring, filetype) = 0 Then Begin

{ Filetype is registered for this extension, check server. }

keystring := Format( '%s\shell\open\command',[filetype] );

If reg.OpenKey( keystring, false ) Then Begin

{ Command key exists, but is this app the server? }

keystring := UpperCase( reg.ReadString(''));

reg.CloseKey;

If Pos( UpperCase(ParamStr(0)), keystring ) = 1 Then Begin

{ Yes, server matches! }

Result := True;

End; { If }

Finally

reg.free;

End;

End; { FiletypeIsRegistered }

End { Unit Associations }.