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

Code:

Uses Registry;

{©Drkb v.3 ®Vit (Vitaly Nevzorov) - Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра.}

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;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

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

end;

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;

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;

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;

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;

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;

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;

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;

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;

   end;

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;

Code:

uses ShlObj, ActiveX, ComObj;

...

{©Drkb v.3®Vit (Vitaly Nevzorov) - Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра.}

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;

end;