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 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 ), 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;

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