Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
Разработка программного обеспечения
KANSoftWare

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

Delphi , ОС и Железо , Реестр

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

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
|
| 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 }.
www.drkb.ru

Статья Работа с ассоциациями файла раздела ОС и Железо Реестр может быть полезна для разработчиков на Delphi и FreePascal.


Комментарии и вопросы


Ваше мнение или вопрос к статье в виде простого текста (Tag <a href=... Disabled). Все комментарии модерируются, модератор оставляет за собой право удалить непонравившейся ему комментарий.

заголовок

e-mail

Ваше имя

Сообщение

Введите код




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.



:: Главная :: Реестр ::


реклама

::


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Rambler's Top100
26.09.2017 15:44:29/0.023371934890747/0