Index: oup/current/FTypeReg.pas =================================================================== --- oup/current/FTypeReg.pas (revision 88) +++ (revision ) @@ -1,625 +1,0 @@ -// ----------------------------------------------------------------------------- -// -// TFileTypeRegistration-Klasse (Win32-API) -// Copyright (c) 2004 Mathias Simmack -// -// ----------------------------------------------------------------------------- - -// -- Revision history --------------------------------------------------------- -// -// * erste Version -// -// ----------------------------------------------------------------------------- -unit FTypeReg; - -interface - -uses - Windows, ShlObj, SysUtils; - -type - TFileTypeRegistration = class - FRegConnector : HKEY; - FExtension, - FInternalName : string; - FVerb : string; - public - constructor Create; - destructor Destroy; override; - function RegisterType(const Extension, InternalName: string; - Description: string = ''; IconFile: string = ''; - IconIndex: integer = -1): boolean; - function UnregisterExtension(const Extension: string): boolean; - function UnregisterType(const Extension: string): boolean; - procedure UpdateShell; - function AddHandler(const HandlerVerb, CommandLine: string; - HandlerDescription: string = ''): boolean; overload; - function DeleteHandler(const HandlerVerb: string): boolean; - function SetDefaultHandler: boolean; overload; - function SetDefaultHandler(const HandlerVerb: string): boolean; overload; - function GetInternalKey(const Extension: string): string; - function AddNewFileSupport(const Extension: string): boolean; - function RemoveNewFileSupport(const Extension: string): boolean; - - property Extension: string read FExtension; - property InternalName: string read FInternalName; - property CurrentVerb: string read FVerb; - end; - - -implementation - -(* ***************************************************************************** - - Beispiel #1: Einen neuen Dateityp registrieren - ---------------------------------------------- - - ftr := TFileTypeRegistration.Create; - if(ftr <> nil) then - try - // die Dateiendung ".foo" registrieren, der interne Schlüssel - // lautet "FooFile", eine Beschreibung und eine Symboldatei - // sind ebenfalls angegeben - if(ftr.RegisterType('.foo','FooFile','FOO Description', - 'c:\folder\icon.ico')) then - begin - // fügt den Handler "open" hinzu und verknüpft ihn mit dem - // Programm "foo.exe" - ftr.AddHandler('open','"c:\folder\foo.exe" "%1"'); - - // setzt den zuletzt benutzten Handler ("open" in dem Fall) - // als Standard - ftr.SetDefaultHandler; - end; - - if(ftr.RegisterType('.foo','ThisIsNotTheFOOKey')) then - // Das ist kein Fehler! Obwohl hier der interne Name - // "ThisIsNotTheFOOKey" verwendet wird, benutzt die Funktion - // intern den bereits vorhandenen Schlüssel "FooFile" (s. oben). - begin - // zwei neue Handler werden registriert, ... - ftr.AddHandler('print','"c:\folder\foo.exe" /p "%1"'); - ftr.AddHandler('edit','notepad.exe "%1"'); - - // ... & dank der überladenen Funktion "SetDefaultHandler" - // kann diesmal auch "print" als Standardhandler gesetzt - // werden - ftr.SetDefaultHandler('print'); - end; - finally - ftr.Free; - end; - - - Beispiel #2: Einen neuen Typ mit einem vorhandenen Schlüssel - verknüpfen - ------------------------------------------------------------ - - Das Beispiel registriert die Endung ".foo" auf die gleiche - Weise wie Textdateien (.txt). Es wird einfach der interne - Schlüsselname ermittelt und für die Endung ".foo" gesetzt - - ftr := TFileTypeRegistration.Create; - if(ftr <> nil) then - try - strInternalTextFileKey := ftr.GetInternalKey('.txt'); - if(strInternalTextFileKey <> '') then - ftr.RegisterType('.foo',strInternalTextFileKey); - finally - ftr.Free; - end; - - - Beispiel #3: Einen Handler entfernen - ------------------------------------ - - ftr := TFileTypeRegistration.Create; - if(ftr <> nil) then - try - // den internen Schlüsselnamen des Typs ".foo" ermitteln, ... - if(ftr.GetInternalKey('.foo') <> '') then - // ... wobei das Ergebnis in dem Fall unwichtig ist, weil - // intern auch die Eigenschaft "FInternalName" gesetzt - // wird - begin - // den "print"-Handler entfernen, ... - ftr.DeleteHandler('print'); - - // ... & den Standardhandler aktualisieren - ftr.SetDefaultHandler('open'); - end; - finally - ftr.Free; - end; - - - Beispiel #4: Nur eine Dateiendung entfernen - ------------------------------------------- - - In diesem Fall wird lediglich die Endung ".foo" entfernt. Der - evtl. vorhandene interne Schlüssel bleibt bestehen. Das ist - für das Beispiel #2 nützlich, wenn die Endung ".foo" entfernt - werden soll, intern aber mit den Textdateien verlinkt ist, die - ja im Normalfall nicht entfernt werden dürfen/sollten. - - ftr.UnregisterExtension('.foo'); - - - Beispiel #5: Den kompletten Dateityp entfernen - ---------------------------------------------- - - Dieses Beispiel entfernt dagegen den kompletten Dateityp, - inkl. des evtl. vorhandenen internen Schlüssels (vgl. mit - Beispiel #4). - - ftr.UnregisterType('.foo'); - - Bezogen auf Beispiel #2 wäre das die fatale Lösung, weil dadurch - zwar die Endung ".foo" deregistriert wird, gleichzeitig wird - aber auch der intern verwendete Schlüssel der Textdateien - gelöscht. - - ALSO, VORSICHT!!! - -***************************************************************************** *) - - -// -// Admin-Rechte sind erforderlich (Funktion von NicoDE) -// -//{$INCLUDE IsAdmin.inc} -function GetAdminSid: PSID; -const - // bekannte SIDs ... (WinNT.h) - SECURITYNTAUTHORITY: TSIDIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5)); - // bekannte RIDs ... (WinNT.h) - SECURITYBUILTINDOMAINRID: DWORD = $00000020; - DOMAINALIASRIDADMINS: DWORD = $00000220; -begin - Result := nil; - AllocateAndInitializeSid(SECURITYNTAUTHORITY, 2, SECURITYBUILTINDOMAINRID, - DOMAINALIASRIDADMINS, 0, 0, 0, 0, 0, 0, Result); -end; - -function IsAdmin: LongBool; -var - TokenHandle : THandle; - ReturnLength : DWORD; - TokenInformation : PTokenGroups; - AdminSid : PSID; - Loop : Integer; - wv : TOSVersionInfo; -begin - wv.dwOSVersionInfoSize := sizeof(TOSversionInfo); - GetVersionEx(wv); - - Result := (wv.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS); - - if(wv.dwPlatformId = VER_PLATFORM_WIN32_NT) then - begin - TokenHandle := 0; - if OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, TokenHandle) then - try - ReturnLength := 0; - GetTokenInformation(TokenHandle, TokenGroups, nil, 0, ReturnLength); - TokenInformation := GetMemory(ReturnLength); - if Assigned(TokenInformation) then - try - if GetTokenInformation(TokenHandle, TokenGroups, - TokenInformation, ReturnLength, ReturnLength) then - begin - AdminSid := GetAdminSid; - for Loop := 0 to TokenInformation^.GroupCount - 1 do - begin - if EqualSid(TokenInformation^.Groups[Loop].Sid, AdminSid) then - begin - Result := True; - break; - end; - end; - FreeSid(AdminSid); - end; - finally - FreeMemory(TokenInformation); - end; - finally - CloseHandle(TokenHandle); - end; - end; -end; - -function WVersion: string; -var - OSInfo: TOSVersionInfo; -begin - Result := '3X'; - OSInfo.dwOSVersionInfoSize := sizeof(TOSVERSIONINFO); - GetVersionEx(OSInfo); - case OSInfo.dwPlatformID of - VER_PLATFORM_WIN32S: begin - Result := '3X'; - Exit; - end; - VER_PLATFORM_WIN32_WINDOWS: begin - Result := '9X'; - Exit; - end; - VER_PLATFORM_WIN32_NT: begin - Result := 'NT'; - Exit; - end; - end; //case -end; - - -// ----------------------------------------------------------------------------- -// -// Registry -// -// ----------------------------------------------------------------------------- - -function RegWriteSubKeyVal(const parent: HKEY; SubKeyName: string; - ValueName, Value: string): boolean; -var - tmp : HKEY; -begin - Result := false; - if(parent = INVALID_HANDLE_VALUE) or - (SubKeyName = '') then exit; - - if(RegCreateKeyEx(parent,pchar(SubKeyName),0,nil,0,KEY_READ or KEY_WRITE, - nil,tmp,nil) = ERROR_SUCCESS) then - try - Result := (RegSetValueEx(tmp,pchar(ValueName),0,REG_SZ,pchar(Value), - length(Value) + 1) = ERROR_SUCCESS); - finally - RegCloseKey(tmp); - end; -end; - -function RegReadSubKeyStr(const parent: HKEY; SubKeyName: string; - ValueName: string): string; -var - tmp : HKEY; - lpData, - dwLen : dword; -begin - Result := ''; - if(parent = INVALID_HANDLE_VALUE) or - (SubKeyName = '') then exit; - - if(RegOpenKeyEx(parent,pchar(SubKeyName),0,KEY_READ, - tmp) = ERROR_SUCCESS) then - try - lpData := REG_NONE; - dwLen := 0; - if(RegQueryValueEx(tmp,pchar(ValueName),nil,@lpData,nil, - @dwLen) = ERROR_SUCCESS) and - (lpData in[REG_SZ,REG_EXPAND_SZ]) and - (dwLen > 0) then - begin - SetLength(Result,dwLen); - - if(RegQueryValueEx(tmp,pchar(ValueName),nil,@lpData, - @Result[1],@dwLen) = ERROR_SUCCESS) then - SetLength(Result,dwLen - 1) - else - Result := ''; - end; - finally - RegCloseKey(tmp); - end; -end; - -function RegKeyExists(const parent: HKEY; KeyName: string): boolean; -var - tmp : HKEY; -begin - Result := (RegOpenKeyEx(parent,pchar(KeyName),0,KEY_READ,tmp) = - ERROR_SUCCESS); - if(Result) then RegCloseKey(tmp); -end; - -function RegDeleteWholeKey(parent: HKEY; KeyName: string): boolean; -var - reg : HKEY; - dwSubkeys : dword; - dwLen : dword; - i : integer; - buf : array[0..MAX_PATH]of char; -begin - if(RegOpenKeyEx(parent,pchar(KeyName),0,KEY_READ,reg) = ERROR_SUCCESS) then - try - if(RegQueryInfoKey(reg,nil,nil,nil,@dwSubKeys,nil, - nil,nil,nil,nil,nil,nil) = ERROR_SUCCESS) and - (dwSubKeys > 0) then - for i := 0 to dwSubKeys - 1 do begin - ZeroMemory(@buf,sizeof(buf)); - dwLen := MAX_PATH; - - if(RegEnumKeyEx(reg,i,buf,dwLen,nil,nil,nil,nil) = ERROR_SUCCESS) and - (dwLen > 0) then - RegDeleteWholeKey(reg,buf); - end; - finally - RegCloseKey(reg); - end; - - Result := (RegDeleteKey(parent,pchar(KeyName)) = ERROR_SUCCESS); -end; - - -// ----------------------------------------------------------------------------- -// -// TFileTypeRegistration-Klasse -// -// ----------------------------------------------------------------------------- - -constructor TFileTypeRegistration.Create; -var - key: HKEY; - sub: PChar; -begin - FExtension := ''; - FInternalName := ''; - FVerb := ''; - - // Zugriff auf die Registry, & HKEY_CLASSES_ROOT - // als Root setzen - if(WVersion='9X') or IsAdmin then begin - key:=HKEY_CLASSES_ROOT; - sub:=nil; - end else begin - key:=HKEY_CURRENT_USER; - sub:=PChar('SOFTWARE\Classes'); - end; - - if RegOpenKeyEx(key,sub,0,KEY_ALL_ACCESS, FRegConnector) <> ERROR_SUCCESS then - FRegConnector := INVALID_HANDLE_VALUE; -end; - -destructor TFileTypeRegistration.Destroy; -begin - if(FRegConnector <> INVALID_HANDLE_VALUE) then - RegCloseKey(FRegConnector); -end; - -function TFileTypeRegistration.RegisterType(const Extension, - InternalName: string; Description: string = ''; IconFile: string = ''; - IconIndex: integer = -1): boolean; -var - strDummy : string; -begin - // Standardergebnis - Result := false; - if(FRegConnector = INVALID_HANDLE_VALUE) or - (Extension = '') or - (Extension[1] <> '.') then exit; - - // ist dieser Typ evtl. schon registriert? - strDummy := self.GetInternalKey(Extension); - - // Nein. :o) - if(strDummy = '') then strDummy := InternalName; - - // den Schlüssel mit der Dateiendung anlegen oder aktualisieren - Result := RegWriteSubKeyVal(FRegConnector,Extension,'',strDummy); - if(not Result) then exit; - - // den internen Schlüssel öffnen - if(Result) then - begin - // Beschreibung anlegen - if(Description <> '') then - RegWriteSubKeyVal(FRegConnector,strDummy,'',Description); - - // Symbol zuweisen (Datei muss existieren!) - if(IconFile <> '') and - (fileexists(IconFile)) then - begin - if(IconIndex <> -1) then - RegWriteSubKeyVal(FRegConnector,strDummy + '\DefaultIcon', - '',Format('%s,%d',[IconFile,IconIndex])) - else - RegWriteSubKeyVal(FRegConnector,strDummy + '\DefaultIcon', - '',IconFile); - end; - end; - - // Systemsymbole aktualisieren - self.UpdateShell; - - // Properties aktualisieren - if(Result) then - begin - FExtension := Extension; - FInternalName := strDummy; - end; -end; - -function TFileTypeRegistration.UnregisterExtension(const Extension: string): - boolean; -begin - Result := false; - if(FRegConnector = INVALID_HANDLE_VALUE) or - (Extension = '') or - (Extension[1] <> '.') then exit; - - // die Endung entfernen - Result := (RegKeyExists(FRegConnector,Extension)) and - (RegDeleteWholeKey(FRegConnector,Extension)); - - // Systemsymbole aktualisieren - self.UpdateShell; -end; - -function TFileTypeRegistration.UnregisterType(const Extension: string): - boolean; -var - strDummy : string; -begin - Result := false; - if(FRegConnector = INVALID_HANDLE_VALUE) or - (Extension = '') or - (Extension[1] <> '.') then exit; - - // den internen Namen der Endung ermitteln - strDummy := self.GetInternalKey(Extension); - - // die Endung entfernen (s. "UnregisterExtension"), ... - Result := (self.UnregisterExtension(Extension)) and - // ... & den internen Schlüssel löschen - (strDummy <> '') and - (RegKeyExists(FRegConnector,strDummy)) and - (RegDeleteWholeKey(FRegConnector,strDummy)); - - // Systemsymbole aktualisieren - self.UpdateShell; -end; - -procedure TFileTypeRegistration.UpdateShell; -begin - SHChangeNotify(SHCNE_ASSOCCHANGED,SHCNF_IDLIST,nil,nil); -end; - - -const - ShellKey = '%s\shell\%s'; - -function TFileTypeRegistration.AddHandler(const HandlerVerb, - CommandLine: string; HandlerDescription: string = ''): boolean; -begin - // Standardergebnis - Result := false; - if(FRegConnector = INVALID_HANDLE_VALUE) or - (FInternalName = '') or - (HandlerVerb = '') or - (CommandLine = '') then exit; - - // der interne Schlüssel muss existieren - if(RegKeyExists(FRegConnector,FInternalName)) then - begin - // den Handler (= Verb) erzeugen - Result := RegWriteSubKeyVal(FRegConnector, - Format(ShellKey + '\command',[FInternalName,HandlerVerb]), - '', - CommandLine); - - // ggf. Beschreibung für Handler setzen - if(HandlerDescription <> '') then - RegWriteSubKeyVal(FRegConnector, - Format(ShellKey,[FInternalName,HandlerVerb]), - '', - HandlerDescription); - end; - - // interne Eigenschaft anpassen (für "SetDefaultHandler") - if(Result) then - FVerb := HandlerVerb; -end; - -function TFileTypeRegistration.DeleteHandler(const HandlerVerb: string): - boolean; -begin - // Standardergebnis - Result := false; - if(FRegConnector = INVALID_HANDLE_VALUE) or - (FInternalName = '') or - (HandlerVerb = '') then exit; - - // Handlerschlüssel entfernen (sofern vorhanden) - Result := - (RegKeyExists(FRegConnector, - Format(ShellKey,[FInternalName,HandlerVerb]))) and - (RegDeleteWholeKey(FRegConnector, - Format(ShellKey,[FInternalName,HandlerVerb]))); -end; - -function TFileTypeRegistration.SetDefaultHandler: boolean; -begin - if(FInternalName <> '') and (FVerb <> '') then - Result := self.SetDefaultHandler(FVerb) - else - Result := false; -end; - -function TFileTypeRegistration.SetDefaultHandler(const HandlerVerb: string): - boolean; -begin - Result := false; - if(FRegConnector = INVALID_HANDLE_VALUE) or - (FInternalName = '') or - (HandlerVerb = '') then exit; - - // interner Schlüssel muss existieren, ... - if(RegKeyExists(FRegConnector,FInternalName)) and - // ... & Handler muss existieren, ... - (RegKeyExists(FRegConnector, - Format(ShellKey,[FInternalName,HandlerVerb]))) then - begin - // ... dann den Handler als Standard eintragen - Result := RegWriteSubKeyVal(FRegConnector,FInternalName + '\shell', - '',HandlerVerb); - end; -end; - -function TFileTypeRegistration.GetInternalKey(const Extension: string): string; -begin - if(FRegConnector = INVALID_HANDLE_VALUE) or - (Extension = '') or - (Extension[1] <> '.') then exit; - - // einen evtl. eingestellten internen Namen zurücksetzen - FInternalName := ''; - - // den Schlüssel der Dateiendung öffnen, ... - if(RegKeyExists(FRegConnector,Extension)) then - FInternalName := RegReadSubKeyStr(FRegConnector,Extension,''); - - // ... als Funktionsergebnis zurückliefern - if(not RegKeyExists(FRegConnector,FInternalName)) then - FInternalName := ''; - - Result := FInternalName; -end; - - -function TFileTypeRegistration.AddNewFileSupport(const Extension: string): - boolean; -var - Description : string; -begin - Result := false; - if(FRegConnector = INVALID_HANDLE_VALUE) or - (Extension = '') or - (Extension[1] <> '.') then exit; - - // interne Beschreibung des Typs ermitteln - if(self.GetInternalKey(Extension) <> '') then - Description := RegReadSubKeyStr(FRegConnector,FInternalName,'') - else - Description := ''; - - // die Beschreibung darf keine Leerzeichen enthalten, weil sie - // als Referenz für den neuen Dateinamen verwendet wird, ... - if(pos(#32,Description) > 0) or - // ... & sie darf auch nicht leer sein - (Description = '') then exit; - - Result := (RegKeyExists(FRegConnector,Extension)) and - (RegWriteSubKeyVal(FRegConnector,Extension + '\ShellNew','NullFile','')); -end; - -function TFileTypeRegistration.RemoveNewFileSupport(const Extension: string): - boolean; -begin - Result := false; - if(FRegConnector = INVALID_HANDLE_VALUE) or - (Extension = '') or - (Extension[1] <> '.') then exit; - - Result := (RegKeyExists(FRegConnector,Extension + '\ShellNew')) and - (RegDeleteWholeKey(FRegConnector,Extension + '\ShellNew')); -end; - -end. Index: oup/current/ImportedStuff/FTypeReg.pas =================================================================== --- oup/current/ImportedStuff/FTypeReg.pas (revision 89) +++ oup/current/ImportedStuff/FTypeReg.pas (revision 89) @@ -0,0 +1,625 @@ +// ----------------------------------------------------------------------------- +// +// TFileTypeRegistration-Klasse (Win32-API) +// Copyright (c) 2004 Mathias Simmack +// +// ----------------------------------------------------------------------------- + +// -- Revision history --------------------------------------------------------- +// +// * erste Version +// +// ----------------------------------------------------------------------------- +unit FTypeReg; + +interface + +uses + Windows, ShlObj, SysUtils; + +type + TFileTypeRegistration = class + FRegConnector : HKEY; + FExtension, + FInternalName : string; + FVerb : string; + public + constructor Create; + destructor Destroy; override; + function RegisterType(const Extension, InternalName: string; + Description: string = ''; IconFile: string = ''; + IconIndex: integer = -1): boolean; + function UnregisterExtension(const Extension: string): boolean; + function UnregisterType(const Extension: string): boolean; + procedure UpdateShell; + function AddHandler(const HandlerVerb, CommandLine: string; + HandlerDescription: string = ''): boolean; overload; + function DeleteHandler(const HandlerVerb: string): boolean; + function SetDefaultHandler: boolean; overload; + function SetDefaultHandler(const HandlerVerb: string): boolean; overload; + function GetInternalKey(const Extension: string): string; + function AddNewFileSupport(const Extension: string): boolean; + function RemoveNewFileSupport(const Extension: string): boolean; + + property Extension: string read FExtension; + property InternalName: string read FInternalName; + property CurrentVerb: string read FVerb; + end; + + +implementation + +(* ***************************************************************************** + + Beispiel #1: Einen neuen Dateityp registrieren + ---------------------------------------------- + + ftr := TFileTypeRegistration.Create; + if(ftr <> nil) then + try + // die Dateiendung ".foo" registrieren, der interne Schlüssel + // lautet "FooFile", eine Beschreibung und eine Symboldatei + // sind ebenfalls angegeben + if(ftr.RegisterType('.foo','FooFile','FOO Description', + 'c:\folder\icon.ico')) then + begin + // fügt den Handler "open" hinzu und verknüpft ihn mit dem + // Programm "foo.exe" + ftr.AddHandler('open','"c:\folder\foo.exe" "%1"'); + + // setzt den zuletzt benutzten Handler ("open" in dem Fall) + // als Standard + ftr.SetDefaultHandler; + end; + + if(ftr.RegisterType('.foo','ThisIsNotTheFOOKey')) then + // Das ist kein Fehler! Obwohl hier der interne Name + // "ThisIsNotTheFOOKey" verwendet wird, benutzt die Funktion + // intern den bereits vorhandenen Schlüssel "FooFile" (s. oben). + begin + // zwei neue Handler werden registriert, ... + ftr.AddHandler('print','"c:\folder\foo.exe" /p "%1"'); + ftr.AddHandler('edit','notepad.exe "%1"'); + + // ... & dank der überladenen Funktion "SetDefaultHandler" + // kann diesmal auch "print" als Standardhandler gesetzt + // werden + ftr.SetDefaultHandler('print'); + end; + finally + ftr.Free; + end; + + + Beispiel #2: Einen neuen Typ mit einem vorhandenen Schlüssel + verknüpfen + ------------------------------------------------------------ + + Das Beispiel registriert die Endung ".foo" auf die gleiche + Weise wie Textdateien (.txt). Es wird einfach der interne + Schlüsselname ermittelt und für die Endung ".foo" gesetzt + + ftr := TFileTypeRegistration.Create; + if(ftr <> nil) then + try + strInternalTextFileKey := ftr.GetInternalKey('.txt'); + if(strInternalTextFileKey <> '') then + ftr.RegisterType('.foo',strInternalTextFileKey); + finally + ftr.Free; + end; + + + Beispiel #3: Einen Handler entfernen + ------------------------------------ + + ftr := TFileTypeRegistration.Create; + if(ftr <> nil) then + try + // den internen Schlüsselnamen des Typs ".foo" ermitteln, ... + if(ftr.GetInternalKey('.foo') <> '') then + // ... wobei das Ergebnis in dem Fall unwichtig ist, weil + // intern auch die Eigenschaft "FInternalName" gesetzt + // wird + begin + // den "print"-Handler entfernen, ... + ftr.DeleteHandler('print'); + + // ... & den Standardhandler aktualisieren + ftr.SetDefaultHandler('open'); + end; + finally + ftr.Free; + end; + + + Beispiel #4: Nur eine Dateiendung entfernen + ------------------------------------------- + + In diesem Fall wird lediglich die Endung ".foo" entfernt. Der + evtl. vorhandene interne Schlüssel bleibt bestehen. Das ist + für das Beispiel #2 nützlich, wenn die Endung ".foo" entfernt + werden soll, intern aber mit den Textdateien verlinkt ist, die + ja im Normalfall nicht entfernt werden dürfen/sollten. + + ftr.UnregisterExtension('.foo'); + + + Beispiel #5: Den kompletten Dateityp entfernen + ---------------------------------------------- + + Dieses Beispiel entfernt dagegen den kompletten Dateityp, + inkl. des evtl. vorhandenen internen Schlüssels (vgl. mit + Beispiel #4). + + ftr.UnregisterType('.foo'); + + Bezogen auf Beispiel #2 wäre das die fatale Lösung, weil dadurch + zwar die Endung ".foo" deregistriert wird, gleichzeitig wird + aber auch der intern verwendete Schlüssel der Textdateien + gelöscht. + + ALSO, VORSICHT!!! + +***************************************************************************** *) + + +// +// Admin-Rechte sind erforderlich (Funktion von NicoDE) +// +//{$INCLUDE IsAdmin.inc} +function GetAdminSid: PSID; +const + // bekannte SIDs ... (WinNT.h) + SECURITYNTAUTHORITY: TSIDIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5)); + // bekannte RIDs ... (WinNT.h) + SECURITYBUILTINDOMAINRID: DWORD = $00000020; + DOMAINALIASRIDADMINS: DWORD = $00000220; +begin + Result := nil; + AllocateAndInitializeSid(SECURITYNTAUTHORITY, 2, SECURITYBUILTINDOMAINRID, + DOMAINALIASRIDADMINS, 0, 0, 0, 0, 0, 0, Result); +end; + +function IsAdmin: LongBool; +var + TokenHandle : THandle; + ReturnLength : DWORD; + TokenInformation : PTokenGroups; + AdminSid : PSID; + Loop : Integer; + wv : TOSVersionInfo; +begin + wv.dwOSVersionInfoSize := sizeof(TOSversionInfo); + GetVersionEx(wv); + + Result := (wv.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS); + + if(wv.dwPlatformId = VER_PLATFORM_WIN32_NT) then + begin + TokenHandle := 0; + if OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, TokenHandle) then + try + ReturnLength := 0; + GetTokenInformation(TokenHandle, TokenGroups, nil, 0, ReturnLength); + TokenInformation := GetMemory(ReturnLength); + if Assigned(TokenInformation) then + try + if GetTokenInformation(TokenHandle, TokenGroups, + TokenInformation, ReturnLength, ReturnLength) then + begin + AdminSid := GetAdminSid; + for Loop := 0 to TokenInformation^.GroupCount - 1 do + begin + if EqualSid(TokenInformation^.Groups[Loop].Sid, AdminSid) then + begin + Result := True; + break; + end; + end; + FreeSid(AdminSid); + end; + finally + FreeMemory(TokenInformation); + end; + finally + CloseHandle(TokenHandle); + end; + end; +end; + +function WVersion: string; +var + OSInfo: TOSVersionInfo; +begin + Result := '3X'; + OSInfo.dwOSVersionInfoSize := sizeof(TOSVERSIONINFO); + GetVersionEx(OSInfo); + case OSInfo.dwPlatformID of + VER_PLATFORM_WIN32S: begin + Result := '3X'; + Exit; + end; + VER_PLATFORM_WIN32_WINDOWS: begin + Result := '9X'; + Exit; + end; + VER_PLATFORM_WIN32_NT: begin + Result := 'NT'; + Exit; + end; + end; //case +end; + + +// ----------------------------------------------------------------------------- +// +// Registry +// +// ----------------------------------------------------------------------------- + +function RegWriteSubKeyVal(const parent: HKEY; SubKeyName: string; + ValueName, Value: string): boolean; +var + tmp : HKEY; +begin + Result := false; + if(parent = INVALID_HANDLE_VALUE) or + (SubKeyName = '') then exit; + + if(RegCreateKeyEx(parent,pchar(SubKeyName),0,nil,0,KEY_READ or KEY_WRITE, + nil,tmp,nil) = ERROR_SUCCESS) then + try + Result := (RegSetValueEx(tmp,pchar(ValueName),0,REG_SZ,pchar(Value), + length(Value) + 1) = ERROR_SUCCESS); + finally + RegCloseKey(tmp); + end; +end; + +function RegReadSubKeyStr(const parent: HKEY; SubKeyName: string; + ValueName: string): string; +var + tmp : HKEY; + lpData, + dwLen : dword; +begin + Result := ''; + if(parent = INVALID_HANDLE_VALUE) or + (SubKeyName = '') then exit; + + if(RegOpenKeyEx(parent,pchar(SubKeyName),0,KEY_READ, + tmp) = ERROR_SUCCESS) then + try + lpData := REG_NONE; + dwLen := 0; + if(RegQueryValueEx(tmp,pchar(ValueName),nil,@lpData,nil, + @dwLen) = ERROR_SUCCESS) and + (lpData in[REG_SZ,REG_EXPAND_SZ]) and + (dwLen > 0) then + begin + SetLength(Result,dwLen); + + if(RegQueryValueEx(tmp,pchar(ValueName),nil,@lpData, + @Result[1],@dwLen) = ERROR_SUCCESS) then + SetLength(Result,dwLen - 1) + else + Result := ''; + end; + finally + RegCloseKey(tmp); + end; +end; + +function RegKeyExists(const parent: HKEY; KeyName: string): boolean; +var + tmp : HKEY; +begin + Result := (RegOpenKeyEx(parent,pchar(KeyName),0,KEY_READ,tmp) = + ERROR_SUCCESS); + if(Result) then RegCloseKey(tmp); +end; + +function RegDeleteWholeKey(parent: HKEY; KeyName: string): boolean; +var + reg : HKEY; + dwSubkeys : dword; + dwLen : dword; + i : integer; + buf : array[0..MAX_PATH]of char; +begin + if(RegOpenKeyEx(parent,pchar(KeyName),0,KEY_READ,reg) = ERROR_SUCCESS) then + try + if(RegQueryInfoKey(reg,nil,nil,nil,@dwSubKeys,nil, + nil,nil,nil,nil,nil,nil) = ERROR_SUCCESS) and + (dwSubKeys > 0) then + for i := 0 to dwSubKeys - 1 do begin + ZeroMemory(@buf,sizeof(buf)); + dwLen := MAX_PATH; + + if(RegEnumKeyEx(reg,i,buf,dwLen,nil,nil,nil,nil) = ERROR_SUCCESS) and + (dwLen > 0) then + RegDeleteWholeKey(reg,buf); + end; + finally + RegCloseKey(reg); + end; + + Result := (RegDeleteKey(parent,pchar(KeyName)) = ERROR_SUCCESS); +end; + + +// ----------------------------------------------------------------------------- +// +// TFileTypeRegistration-Klasse +// +// ----------------------------------------------------------------------------- + +constructor TFileTypeRegistration.Create; +var + key: HKEY; + sub: PChar; +begin + FExtension := ''; + FInternalName := ''; + FVerb := ''; + + // Zugriff auf die Registry, & HKEY_CLASSES_ROOT + // als Root setzen + if(WVersion='9X') or IsAdmin then begin + key:=HKEY_CLASSES_ROOT; + sub:=nil; + end else begin + key:=HKEY_CURRENT_USER; + sub:=PChar('SOFTWARE\Classes'); + end; + + if RegOpenKeyEx(key,sub,0,KEY_ALL_ACCESS, FRegConnector) <> ERROR_SUCCESS then + FRegConnector := INVALID_HANDLE_VALUE; +end; + +destructor TFileTypeRegistration.Destroy; +begin + if(FRegConnector <> INVALID_HANDLE_VALUE) then + RegCloseKey(FRegConnector); +end; + +function TFileTypeRegistration.RegisterType(const Extension, + InternalName: string; Description: string = ''; IconFile: string = ''; + IconIndex: integer = -1): boolean; +var + strDummy : string; +begin + // Standardergebnis + Result := false; + if(FRegConnector = INVALID_HANDLE_VALUE) or + (Extension = '') or + (Extension[1] <> '.') then exit; + + // ist dieser Typ evtl. schon registriert? + strDummy := self.GetInternalKey(Extension); + + // Nein. :o) + if(strDummy = '') then strDummy := InternalName; + + // den Schlüssel mit der Dateiendung anlegen oder aktualisieren + Result := RegWriteSubKeyVal(FRegConnector,Extension,'',strDummy); + if(not Result) then exit; + + // den internen Schlüssel öffnen + if(Result) then + begin + // Beschreibung anlegen + if(Description <> '') then + RegWriteSubKeyVal(FRegConnector,strDummy,'',Description); + + // Symbol zuweisen (Datei muss existieren!) + if(IconFile <> '') and + (fileexists(IconFile)) then + begin + if(IconIndex <> -1) then + RegWriteSubKeyVal(FRegConnector,strDummy + '\DefaultIcon', + '',Format('%s,%d',[IconFile,IconIndex])) + else + RegWriteSubKeyVal(FRegConnector,strDummy + '\DefaultIcon', + '',IconFile); + end; + end; + + // Systemsymbole aktualisieren + self.UpdateShell; + + // Properties aktualisieren + if(Result) then + begin + FExtension := Extension; + FInternalName := strDummy; + end; +end; + +function TFileTypeRegistration.UnregisterExtension(const Extension: string): + boolean; +begin + Result := false; + if(FRegConnector = INVALID_HANDLE_VALUE) or + (Extension = '') or + (Extension[1] <> '.') then exit; + + // die Endung entfernen + Result := (RegKeyExists(FRegConnector,Extension)) and + (RegDeleteWholeKey(FRegConnector,Extension)); + + // Systemsymbole aktualisieren + self.UpdateShell; +end; + +function TFileTypeRegistration.UnregisterType(const Extension: string): + boolean; +var + strDummy : string; +begin + Result := false; + if(FRegConnector = INVALID_HANDLE_VALUE) or + (Extension = '') or + (Extension[1] <> '.') then exit; + + // den internen Namen der Endung ermitteln + strDummy := self.GetInternalKey(Extension); + + // die Endung entfernen (s. "UnregisterExtension"), ... + Result := (self.UnregisterExtension(Extension)) and + // ... & den internen Schlüssel löschen + (strDummy <> '') and + (RegKeyExists(FRegConnector,strDummy)) and + (RegDeleteWholeKey(FRegConnector,strDummy)); + + // Systemsymbole aktualisieren + self.UpdateShell; +end; + +procedure TFileTypeRegistration.UpdateShell; +begin + SHChangeNotify(SHCNE_ASSOCCHANGED,SHCNF_IDLIST,nil,nil); +end; + + +const + ShellKey = '%s\shell\%s'; + +function TFileTypeRegistration.AddHandler(const HandlerVerb, + CommandLine: string; HandlerDescription: string = ''): boolean; +begin + // Standardergebnis + Result := false; + if(FRegConnector = INVALID_HANDLE_VALUE) or + (FInternalName = '') or + (HandlerVerb = '') or + (CommandLine = '') then exit; + + // der interne Schlüssel muss existieren + if(RegKeyExists(FRegConnector,FInternalName)) then + begin + // den Handler (= Verb) erzeugen + Result := RegWriteSubKeyVal(FRegConnector, + Format(ShellKey + '\command',[FInternalName,HandlerVerb]), + '', + CommandLine); + + // ggf. Beschreibung für Handler setzen + if(HandlerDescription <> '') then + RegWriteSubKeyVal(FRegConnector, + Format(ShellKey,[FInternalName,HandlerVerb]), + '', + HandlerDescription); + end; + + // interne Eigenschaft anpassen (für "SetDefaultHandler") + if(Result) then + FVerb := HandlerVerb; +end; + +function TFileTypeRegistration.DeleteHandler(const HandlerVerb: string): + boolean; +begin + // Standardergebnis + Result := false; + if(FRegConnector = INVALID_HANDLE_VALUE) or + (FInternalName = '') or + (HandlerVerb = '') then exit; + + // Handlerschlüssel entfernen (sofern vorhanden) + Result := + (RegKeyExists(FRegConnector, + Format(ShellKey,[FInternalName,HandlerVerb]))) and + (RegDeleteWholeKey(FRegConnector, + Format(ShellKey,[FInternalName,HandlerVerb]))); +end; + +function TFileTypeRegistration.SetDefaultHandler: boolean; +begin + if(FInternalName <> '') and (FVerb <> '') then + Result := self.SetDefaultHandler(FVerb) + else + Result := false; +end; + +function TFileTypeRegistration.SetDefaultHandler(const HandlerVerb: string): + boolean; +begin + Result := false; + if(FRegConnector = INVALID_HANDLE_VALUE) or + (FInternalName = '') or + (HandlerVerb = '') then exit; + + // interner Schlüssel muss existieren, ... + if(RegKeyExists(FRegConnector,FInternalName)) and + // ... & Handler muss existieren, ... + (RegKeyExists(FRegConnector, + Format(ShellKey,[FInternalName,HandlerVerb]))) then + begin + // ... dann den Handler als Standard eintragen + Result := RegWriteSubKeyVal(FRegConnector,FInternalName + '\shell', + '',HandlerVerb); + end; +end; + +function TFileTypeRegistration.GetInternalKey(const Extension: string): string; +begin + if(FRegConnector = INVALID_HANDLE_VALUE) or + (Extension = '') or + (Extension[1] <> '.') then exit; + + // einen evtl. eingestellten internen Namen zurücksetzen + FInternalName := ''; + + // den Schlüssel der Dateiendung öffnen, ... + if(RegKeyExists(FRegConnector,Extension)) then + FInternalName := RegReadSubKeyStr(FRegConnector,Extension,''); + + // ... als Funktionsergebnis zurückliefern + if(not RegKeyExists(FRegConnector,FInternalName)) then + FInternalName := ''; + + Result := FInternalName; +end; + + +function TFileTypeRegistration.AddNewFileSupport(const Extension: string): + boolean; +var + Description : string; +begin + Result := false; + if(FRegConnector = INVALID_HANDLE_VALUE) or + (Extension = '') or + (Extension[1] <> '.') then exit; + + // interne Beschreibung des Typs ermitteln + if(self.GetInternalKey(Extension) <> '') then + Description := RegReadSubKeyStr(FRegConnector,FInternalName,'') + else + Description := ''; + + // die Beschreibung darf keine Leerzeichen enthalten, weil sie + // als Referenz für den neuen Dateinamen verwendet wird, ... + if(pos(#32,Description) > 0) or + // ... & sie darf auch nicht leer sein + (Description = '') then exit; + + Result := (RegKeyExists(FRegConnector,Extension)) and + (RegWriteSubKeyVal(FRegConnector,Extension + '\ShellNew','NullFile','')); +end; + +function TFileTypeRegistration.RemoveNewFileSupport(const Extension: string): + boolean; +begin + Result := false; + if(FRegConnector = INVALID_HANDLE_VALUE) or + (Extension = '') or + (Extension[1] <> '.') then exit; + + Result := (RegKeyExists(FRegConnector,Extension + '\ShellNew')) and + (RegDeleteWholeKey(FRegConnector,Extension + '\ShellNew')); +end; + +end.