function RegisterFileType(
const szExtension, szInternalName,
szDescription, szFileIcon:
string): boolean;
var
reg : TRegistry;
szRealInternalName :
string;
begin
// * benötigt Admin-Rechte zum Schreiben in HKCR
// * Dateiendung sollte mehr als 1 Zeichen haben
// * das 1. Zeichen muss ein Punkt sein
// * "szInternalName" darf nicht leer sein
Result := (IsAdmin)
and
(length(szExtension) > 1)
and
(szExtension[1] = '
.')
and
(szInternalName <> '
');
if(Result)
then
begin
// Ergebnis zurücksetzen
Result := false;
// Registry öffnen
reg := TRegistry.Create;
if(reg <>
nil)
then
try
reg.RootKey := HKEY_CLASSES_ROOT;
// ist der Dateityp evtl. schon registriert?
szRealInternalName := '
';
if(reg.KeyExists(szExtension))
and
(reg.OpenKey(szExtension,false))
then
try
szRealInternalName := reg.ReadString('
');
finally
reg.CloseKey;
end;
// offenbar gibt es den Schlüssel noch nicht,
// darum: neu anlegen, & den internen Verweis
// eintragen
if(szRealInternalName = '
')
then
begin
if(reg.OpenKey(szExtension,true))
then
try
reg.WriteString('
',szInternalName);
Result := (reg.ReadString('
') = szInternalName);
finally
reg.CloseKey;
end;
if(Result)
then szRealInternalName := szInternalName;
end;
// den vorhandenen internen Schlüssel entweder
// öffnen oder neu erzeugen (wenn er noch nicht
// existiert)
if(Result)
and
(reg.OpenKey(szRealInternalName,true))
then
try
// Beschreibung für Dateityp eintragen
if(szDescription <> '
')
then
begin
reg.WriteString('
',szDescription);
Result := (Result)
and
(reg.ReadString('
') = szDescription);
end;
// Symbol festlegen
if(szFileIcon <> '
')
and
(reg.OpenKey('
DefaultIcon',true))
then
try
reg.WriteString('
',szFileIcon);
Result := (Result)
and
(reg.ReadString('
') = szFileIcon);
finally
reg.CloseKey;
end;
finally
reg.CloseKey;
end;
finally
reg.Free;
end;
// das System über die Änderung "informieren"
SHChangeNotify(SHCNE_ASSOCCHANGED,SHCNF_IDLIST,
nil,
nil);
end;
end;