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

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

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
 |
 | Visibility : restricted to unit
 | Description:
 | This is a helper function which uses the passed reg object
 | to create a registry key.
 | Error Conditions:
 | If the key cannot be created a ERegistryError exception is
 | raised.
 | Created: 14.03.99 by P. Below
 +------------------------------------------------------------}

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: 14.03.99 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: 20.03.99 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: 21.03.99 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: 21.03.99 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 }
  End; { If }
  End; { If }
  End; { If }
  Finally
  reg.free;
  End;
 End; { FiletypeIsRegistered }
End { Unit Associations }.

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...