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
+------------------------------------------------------------}
{+------------------------------------------------------------
[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 }.
Статья Работа с ассоциациями файла раздела ОС и Железо Реестр может быть полезна для разработчиков на Delphi и FreePascal.
