Index: /oup/releases/0.29a3/TFileTypeRegistration/IsAdmin.inc =================================================================== --- /oup/releases/0.29a3/TFileTypeRegistration/IsAdmin.inc (revision 32) +++ /oup/releases/0.29a3/TFileTypeRegistration/IsAdmin.inc (revision 32) @@ -0,0 +1,90 @@ +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; Index: /oup/releases/0.29a3/TFileTypeRegistration/SysUtils.inc =================================================================== --- /oup/releases/0.29a3/TFileTypeRegistration/SysUtils.inc (revision 32) +++ /oup/releases/0.29a3/TFileTypeRegistration/SysUtils.inc (revision 32) @@ -0,0 +1,307 @@ +function fileexists(const szFilename: string): boolean; +var + Handle : THandle; + FindData : TWin32FindData; +begin + Handle := FindFirstFile(pchar(szFilename),FindData); + Result := (Handle <> INVALID_HANDLE_VALUE); + + if(Result) then Windows.FindClose(Handle); +end; + +function ExtractFileDrive(const szFilename: string): string; +var + i : integer; +begin + Result := ''; + i := length(szFilename); + while(i > 0) do + begin + if(szFileName[i] = ':') then + begin + Result := copy(szFilename,1,i); + break; + end; + + dec(i); + end; +end; + +function ExtractFilePath(const szFilename: string): string; +var + i : integer; +begin + Result := ''; + i := length(szFileName); + while(i > 0) do + begin + if(szFileName[i] = ':') or + (szFileName[i] = '\') then + begin + Result := copy(szFileName,1,i); + break; + end; + + dec(i); + end; +end; + +function ExtractFileName(const szFilename: string): string; +var + i : integer; +begin + i := length(szFilename); + while(i > 0) do + begin + if(szFilename[i] = '\') then + break; + + dec(i); + end; + + Result := copy(szFilename,i + 1,length(szFilename)); +end; + +function CutFileExt(const szFilename: string): string; +var + i : integer; +begin + i := length(szFilename); + while(i > 0) do + begin + if(szFilename[i] = '.') then + break; + + dec(i); + end; + + if(i = 0) then Result := szFilename + else Result := copy(szFilename,1,i-1); +end; + +function ChangeFileExt(const szFileName, szNewExt: string): string; +begin + Result := CutFileExt(szFileName); + + if(szNewExt[1] <> '.') then Result := Result + '.' + szNewExt + else Result := Result + szNewExt; +end; + +function FileSearch(const Name, DirList: string): string; +var + I, P, L: Integer; +begin + Result := Name; + P := 1; + L := length(DirList); + + while(true) do begin + if(fileexists(Result)) then exit; + + while(P <= L) and (DirList[P] = ';') do inc(P); + if(P > L) then break; + + I := P; + while(P <= L) and (DirList[P] <> ';') do inc(P); + + Result := copy(DirList,I,P-I); + if not(Result[length(Result)] in[':','\']) then + Result := Result + '\'; + + Result := Result + Name; + end; + + Result := ''; +end; + +function StrToIntDef(const s: string; const i: integer): integer; +var + code : integer; +begin + Val(s,Result,code); if(code <> 0) then + Result := i; +end; + +function IntToStr(const i: integer): string; +begin + Str(i,Result); +end; + +// ----------------------------------------------------------------------------- + +function Format(fmt: string; params: array of const): string; +var + pdw1, + pdw2 : PDWORD; + i : integer; + pc : PCHAR; +begin + pdw1 := nil; + + if High(params) >= 0 then + GetMem(pdw1, (High(params) + 1) * sizeof(Pointer)); + + pdw2 := pdw1; + for i := 0 to High(params) do + begin + pdw2^ := PDWORD(@params[i])^; + inc(pdw2); + end; + + pc := GetMemory(1024); + if Assigned(pc) then + try + SetString(Result, pc, wvsprintf(pc, PCHAR(fmt), PCHAR(pdw1))); + finally + if (pdw1 <> nil) then FreeMem(pdw1); + FreeMem(pc); + end + else + Result := ''; +end; + + +// ----------------------------------------------------------------------------- + +function UpperCase(const s: string): string; +var + i : integer; +begin + Result := ''; + + if(length(s) > 0) then + begin + SetLength(Result,length(s)); + for i := 1 to length(s) do + Result[i] := UpCase(s[i]); + end; +end; + +function LowerCase(const s: string): string; +var + i : integer; +begin + Result := ''; + + if(length(s) > 0) then + begin + SetLength(Result,length(s)); + for i := 1 to length(s) do + case s[i] of + 'A'..'Z','Ä','Ö','Ü': + Result[i] := CHR(BYTE(s[i]) + 32); + else + Result[i] := s[i]; + end; + end; +end; + +function LoggedUser: string; +var + dwLen : dword; + fTest : boolean; +begin + Result := ''; + dwLen := MAX_PATH; SetLength(Result,dwLen); + + fTest := GetUserName(@Result[1],dwLen); + + if(not fTest) and (GetLastError = ERROR_MORE_DATA) then begin + SetLength(Result,dwLen); + fTest := GetUserName(@Result[1],dwLen); + end; + + if(fTest) and (Result[1] <> #0) then + SetLength(Result,dwLen - 1); +end; + +// ----------------------------------------------------------------------------- + +// +// delete files during next reboot (code by sakura) +// +function DeleteFileDuringNextSystemBoot(aFileName: string): Boolean; +var + ShortName, + winini : string; + os : TOSVersionInfo; + ts : array of string; + f : TextFile; + i : integer; +begin + Result := False; + + // get OS version + os.dwOSVersionInfoSize := sizeof(TOSVersionInfo); + GetVersionEx(os); + + case os.dwPlatformId of + // NT systems + VER_PLATFORM_WIN32_NT: + Result := MoveFileEx(pchar(aFileName),nil, + MOVEFILE_REPLACE_EXISTING + MOVEFILE_DELAY_UNTIL_REBOOT); + // 9x systems + VER_PLATFORM_WIN32_WINDOWS: + begin + // get Windows folder + SetLength(winini,MAX_PATH+1); + SetLength(winini,GetWindowsDirectory(@winini[1],MAX_PATH+1)); + + if(winini <> '') then begin + if(winini[length(winini)] <> '\') then + winini := winini + '\'; + winini := winini + 'wininit.ini'; + + // get short name of the given file + SetLength(ShortName,MAX_PATH+1); + SetLength(ShortName, + GetShortPathName(@aFilename[1],@ShortName[1],MAX_PATH+1)); + + if(ShortName <> '') then begin + // add it to "wininit.ini" to delete + // during next reboot + SetLength(ts,0); + + {$I-} + // get old file´s content + AssignFile(f,winini); + ReSet(f); + if(IoResult = 0) then begin + while(not eof(f)) do begin + SetLength(ts,length(ts)+1); + ReadLn(f,ts[length(ts)-1]); + + if(lstrcmpi('[rename]',pchar(ts[length(ts)-1])) = 0) then begin + SetLength(ts,length(ts)+1); + ts[length(ts)-1] := 'NUL='+ShortName; + end; + end; + CloseFile(f); + end; + + if(length(ts) = 0) then begin + SetLength(ts,2); + ts[0] := '[rename]'; + ts[1] := 'NUL='+ShortName; + end; + + // re-create + ReWrite(f); + Result := (IoResult = 0); + if(Result) then begin + for i := 0 to length(ts) - 1 do + WriteLn(f,ts[i]); + + CloseFile(f); + end; + {$I+} + + SetLength(ts,0); + end; + end; + end; + // only 9x and NT are supported + else + exit; + end; +end; Index: /oup/releases/0.29a3/TFileTypeRegistration/demo.txt =================================================================== --- /oup/releases/0.29a3/TFileTypeRegistration/demo.txt (revision 32) +++ /oup/releases/0.29a3/TFileTypeRegistration/demo.txt (revision 32) @@ -0,0 +1,34 @@ +uses + ftypesAPI; + +var + ftr : TFileTypeRegistration; + s:String; + + +ftr := TFileTypeRegistration.Create; +if(ftr <> nil) then begin + try + if(LOWORD(wp) = IDC_CREATEFOO) then begin + if(ftr.RegisterType('.foo','FooFile','FOO-File')) then begin + ftr.AddHandler('open','notepad.exe "%1"','Öffnen'); + ftr.AddHandler('print','notepad.exe /p "%1"'); + ftr.SetDefaultHandler; + ftr.AddNewFileSupport('.foo'); + end; + end; + if(LOWORD(wp) = IDC_DELPRINTVERB) then begin + if(ftr.GetInternalKey('.foo') <> '') then begin + ftr.DeleteHandler('print'); + ftr.SetDefaultHandler('open'); + end; + end; + if(LOWORD(wp) = IDC_REMOVEFOO) then begin + s := ftr.GetInternalKey('.foo'); + if(MessageBox(hwndDlg,pchar('Wollen Sie wirklich ".foo" und "' + s + '" entfernen?'), 'Frage',MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) = ID_YES) then + ftr.UnregisterType('.foo'); + end; + finally + ftr.Free; + end; +end; Index: /oup/releases/0.29a3/TFileTypeRegistration/ftypesAPI.pas =================================================================== --- /oup/releases/0.29a3/TFileTypeRegistration/ftypesAPI.pas (revision 32) +++ /oup/releases/0.29a3/TFileTypeRegistration/ftypesAPI.pas (revision 32) @@ -0,0 +1,544 @@ +// ----------------------------------------------------------------------------- +// +// TFileTypeRegistration-Klasse (Win32-API) +// Copyright (c) 2004 Mathias Simmack +// +// ----------------------------------------------------------------------------- + +// -- Revision history --------------------------------------------------------- +// +// * erste Version +// +// ----------------------------------------------------------------------------- +unit ftypesAPI; + +interface + +uses + Windows, ShlObj; + +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} +{$INCLUDE SysUtils.inc} + + +// ----------------------------------------------------------------------------- +// +// 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.