Работа с ассоциациями файла
Материал из DRKB
Работа с ассоциациями файла[править | править код]
unit Associations;
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;
{+------------------------------------------------------------
| 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;
{+------------------------------------------------------------
[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;
{+------------------------------------------------------------
| 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;
{+------------------------------------------------------------
[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;
end;
end;
end;
finally
reg.Free;
end;
end;
end.
Author: P. Below
ID: 01743