Dateiendungen registrieren

[Meflin]

Hier eine möglichkeit, eine eigene dateiendung zu registrieren:

Delphi-Quellcode:

function InstallExt(Extension, ExtDescription, FileDescription, 
                    OpenWith, ParamString: string; IconIndex: Integer; 
                    ExtVerb: string = 'Open'): Boolean; 
var 
  Reg: TRegistry; 
begin 
  Reg := TRegistry.Create; 
  try 
    with Reg do 
    begin 
      RootKey := HKEY_CLASSES_ROOT; 
      OpenKey(Extension, True); 
      WriteString('', ExtDescription); 
      OpenKey('\' + ExtDescription, True); 
      WriteString('', FileDescription); 
      OpenKey('DefaultIcon', True); 
      WriteString('', OpenWith + ','+IntToStr(IconIndex)); 
      OpenKey('\' + ExtDescription + '\Shell\'+ExtVerb+'\Command', True); 
      WriteString('', '"' + OpenWith + '" "' + ParamString + '"'); 
    end; 
    Result := True; 
  except 
    Result := False; 
  end; 
  Reg.Free; 
end;

und die passende deinstallationsroutine dazu:

Delphi-Quellcode:

function UnInstallExt(Extension, ExtDescription: String): Boolean; 
var 
  Reg: TRegistry; 
begin 
  Reg := TRegistry.Create; 
  try 
    with Reg do 
    begin 
      RootKey := HKEY_CLASSES_ROOT; 
      DeleteKey(Extension); 
      DeleteKey('\' + ExtDescription); 
    end; 
    Result := True; 
  except 
    Result := False; 
  end; 
  Reg.Free; 
end;

und hier noch eine möglichkeit von MathiasSimmack die hier veröffentlicht wurde:

Delphi-Quellcode:

uses  
  Registry, ShlObj;  

 
function RegisterFileType(const szExtension,  
  szInternalName,  
  szDescription,  
  szFileIcon : string): boolean;  
var  
  reg : TRegistry;  
begin  
  // benötigt Admin-Rechte zum Schreiben in HKEY_CLASSES_ROOT  
  Result := (IsAdmin) and  
  // die Dateiendung sollte mehr als 1 Zeichen haben, denn ...  
    (length(szExtension) > 1) and  
  // ... das erste Zeichen muss ein Punkt sein  
    (szExtension[1] = '.') and  
  // und die anderen Parameter dürfen nicht leer sein  
    (szInternalName <> '') and  
    (szDescription <> '') and  
    (szFileIcon <> '');  

 
  if(Result) then  
  begin  
    Result := false;  
    reg    := TRegistry.Create;  
    if(reg <> nil) then  
    try  
      reg.RootKey := HKEY_CLASSES_ROOT;  

 
      // lege Schlüssel für Dateiendung mit Verweis auf  
      // internen Namen an  
      if(reg.OpenKey(szExtension,true)) then  
      try  
        reg.WriteString('',szInternalName);  
        Result := (reg.ReadString('') = szInternalName);  
      finally  
        reg.CloseKey;  
      end;  

 
      // lege Schlüssel mit internem Namen an  
      if(Result) and  
        (reg.OpenKey(szInternalName,true)) then  
      try  
        // Beschreibung für Dateityp eintragen  
        reg.WriteString('',szDescription);  
        Result := (Result) and  
          (reg.ReadString('') = szDescription);  

 
        if(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;  

 
function UnregisterFileType(const szExtension: string): boolean;  
var  
  reg : TRegistry;  
  s   : string;  
begin  
  Result := (IsAdmin) and  
    (length(szExtension) > 1) and  
    (szExtension[1] = '.');  

 
  if(Result) then  
  begin  
    reg    := TRegistry.Create;  
    if(reg <> nil) then  
    try  
      reg.RootKey := HKEY_CLASSES_ROOT;  

 
      // internen Schlüsselnamen für diesen Dateityp  
      // ermitteln  
      if(reg.OpenKey(szExtension,false)) then  
      try  
        s := reg.ReadString('');  
      finally  
        reg.CloseKey;  
      end;  

 
      // den Hauptschlüssel (= Dateiendung) löschen  
      Result := (reg.DeleteKey(szExtension)) and  
      // den ermittelten internen Schlüssel ebenfalls löschen  
        (s <> '') and  
        (reg.KeyExists(s)) and  
        (reg.DeleteKey(s));  
    finally  
      reg.Free;  
    end;  

 
    SHChangeNotify(SHCNE_ASSOCCHANGED,SHCNF_IDLIST,nil,nil);  
  end;  
end;  

 

 
const  
  szKeyName = '%s\shell\%s';  

 
function AddFileHandler(const szInternalName,  
  szHandlerName,  
  szHandlerDescription,  
  szCommandLine: string): boolean;  
var  
  reg : TRegistry;  
begin  
  Result := (IsAdmin) and  
    (szInternalName <> '') and  
    (szHandlerName <> '') and  
    (szCommandLine <> '');  
  // "szHandlerDescription" ist optional und wird  
  // nicht geprüft  
 
  if(Result) then  
  begin  
    reg    := TRegistry.Create;  
    if(reg <> nil) then  
    try  
      reg.RootKey := HKEY_CLASSES_ROOT;  

 
      // der Schlüssel "szInternalName" muss existieren  
      if(reg.KeyExists(szInternalName)) then  
      begin  
        // dann wird ein entsprechender Unterschlüssel mit  
        // der gewünschten Aktion erzeugt  
        if(reg.OpenKey(Format(szKeyName + '\command',  
          [szInternalName,szHandlerName]),true)) then  
          try  
            // die angegebene "Kommandozeile" wird als  
            // Standard eingetragen  
            reg.WriteString('',szCommandLine);  
            Result := (reg.ReadString('') = szCommandLine);  
          finally  
            reg.CloseKey;  
          end;  

 
        // gibt es eine Beschreibung?  
        if(szHandlerDescription <> '') then  
          if(reg.OpenKey(Format(szKeyName,  
            [szInternalName,szHandlerName]),true)) then  
            try  
              reg.WriteString('',szHandlerDescription);  
            finally  
              reg.CloseKey;  
            end;  
      end;  
    finally  
      reg.Free;  
    end;  
  end;  
end;  

 
function DelFileHandler(const szInternalName,  
  szHandlerName : string): boolean;  
var  
  reg : TRegistry;  
begin  
  Result := (IsAdmin) and  
    (szInternalName <> '') and  
    (szHandlerName <> '');  

 
  if(Result) then  
  begin  
    reg := TRegistry.Create;  
    if(reg <> nil) then  
    try  
      reg.RootKey := HKEY_CLASSES_ROOT;  
      Result      :=  
        (reg.KeyExists(Format(szKeyName,[szInternalName,szHandlerName]))) and  
        (reg.DeleteKey(Format(szKeyName,[szInternalName,szHandlerName])));  
    finally  
      reg.Free;  
    end;  
  end;  
end;  

 
function SetDefaultHandler(const szInternalName,  
  szDefaultHandler: string): boolean;  
var  
  reg : TRegistry;  
begin  
  Result := (IsAdmin) and  
    (szInternalName <> '') and  
    (szDefaultHandler <> '');  

 
  if(Result) then  
  begin  
    reg := TRegistry.Create;  
    if(reg <> nil) then  
    try  
      reg.RootKey := HKEY_CLASSES_ROOT;  

 
      if(reg.KeyExists(szInternalName)) and  
        (reg.OpenKey(szInternalName + '\shell',false)) then  
      try  
        reg.WriteString('',szDefaultHandler);  
        Result := (reg.ReadString('') = szDefaultHandler);  
      finally  
        reg.CloseKey;  
      end;  
    finally  
      reg.Free;  
    end;  
  end;  
end;

[edit=Matze]Code formatiert. Mfg, Matze[/edit]

[Matze]

Zur ersten Version: Es fehlen die Ressourcenschutzblöcke. ;)

Hier ist der Code zur ersten Version mit Ressourcenschutzblöcken.

[CalganX]

Von MathiasSimmack kommt noch folgende erweiterte Version:

Zitat:

Zitat von MathiasSimmack

Als Ersatz für die eingangs erwähnte "RegisterFileType" stelle ich noch diese Variante zur Diskussion. Im Gegensatz zu der obigen (die ja auch von mir ist ;)) prüft diese hier, ob der Dateityp evtl. schon registriert ist.

Auf die Weise werden vorhandene Dateitypen nicht einfach überschrieben.

Delphi-Quellcode:

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;

[MathiasSimmack]

Ich habe noch was besseres. ;) Ich häng mal die Unit zur Diskussion ran. Mit ihr kann man Dateitypen registrieren/entfernen, Handler (= Verbs) hinzufügen/entfernen und die Explorer-Integration (Rechtsklick -> Neu -> Dateityp) einbauen/entfernen.

Kritik und Vorschläge entweder hier rein (wenn die Mods und der Chef das erlauben :stupid:), oder wir öffnen einen Thread und feilen solange am Code bis er perfekt ist. Mir egal.


Edit: Die ZIP enthält neben der leicht gefixten Unit nun auch noch die API-Variante und ein nonVCL-Demo.

[CalganX]

Und für den Fall, dass der ausführende User keine Adminrechte hat, hat der ehemalige User notErnie folgenden Source zusammengestellt, der allerdings von MathiasSimmack's Klasse (vorherige Beitragsanhang) unabhängig ist.

Delphi-Quellcode:

//----von Mathias Simmacks "IsAdmin.inc" (TFileTypeRegistration.zip) geklaut:

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;

//----von Mathias Simmacks "IsAdmin.inc" (TFileTypeRegistration.zip) geklaut:

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;

procedure registerfiletype(Handle: HWnd; ft, key, desc, icon, prg: string);
// Benutzung z.b. für ZIP-Dateien:
// registerfiletype(Handle, '.zip', '', 'Zip-Archiv', paramstr(0) + ',1', paramstr(0));
var
  myReg: TRegIniFile;
  wo: byte;
begin

  if WVersion = '3X' then
  begin
  //MessageBox(Handle, 'Window 3.x wird nicht unterstützt.', 'Information', mb_IconInformation);
    exit;
  end;

  wo := pos('.', ft);

  while wo > 0 do begin
    delete(ft, wo, 1);
    wo := pos('.', ft);
  end;

  if (ft = '') or (prg = '') then exit;
  if pos('*', ft) <> 0 then exit;
  if pos('?', ft) <> 0 then exit;

  ft := '.' + ft;

  try
    myReg := TRegIniFile.create('');

    if (WVersion = '9X') or (IsAdmin = true) then
    begin
      //MessageBox(Handle, 'Admin-Rechte oder Win9x.', 'Information', mb_IconInformation);
      myReg.RootKey := HKEY_CLASSES_ROOT;
      key := ExtractFileName(Application.ExeName) + copy(ft, 2, maxint);
    end else
    begin
      myReg.RootKey := HKEY_CURRENT_USER;
      key := '\Software\Classes\.' + copy(ft, 2, maxint);
    end;

    myReg.WriteString(ft, '', key);
    myReg.WriteString(key, '', desc);

    if icon <> '' then
      myReg.WriteString(key + '\DefaultIcon', '', icon);

    myReg.WriteString(key + '\shell\open\command', '', '"' + prg + '" "%1"');

  finally
    myReg.free;
  end;

  SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
  MessageBox(Handle, PChar('Der Dateityp "*' + ft + '" wurde mit ' + ExtractFileName(Application.ExeName) + ' verknüpft.'), 'Information', mb_IconInformation);
end;

//////////////////////////