Obtener el programa asociado a una extensión

5138 vistas

Puede que a veces nos interese saber qué programa está asociado a una determinada extensió. Para ello tendremos que actuar como explicamos a continuación

Tendremos que añadir en el uses la siguiente declaración:


delphi
  1. uses
  2.   {$IFDEF WIN32}
  3.   Registry; {We will get it from the registry}
  4.   {$ELSE}
  5.   IniFiles; {We will get it from the win.ini file}
  6.   {$ENDIF}
  7.  
  8. {$IFNDEF WIN32}
  9. const MAX_PATH = 144;
  10. {$ENDIF}



y la función será



delphi
  1. function GetProgramAssociation(Ext: string) : string;
  2. var
  3.   {$IFDEF WIN32}
  4.   reg: TRegistry;
  5.   s: string;
  6.   {$ELSE}
  7.   WinIni: TIniFile;
  8.   WinIniFileName: array[0..MAX_PATH] of char;
  9.   s: string;
  10.   {$ENDIF}
  11. begin
  12.   {$IFDEF WIN32}
  13.   s := '';
  14.   reg := TRegistry.Create;
  15.   reg.RootKey := HKEY_CLASSES_ROOT;
  16.   if reg.OpenKey('.' + ext + '\shell\open\command', false) <> false then
  17.   begin
  18.     { The open command has been found }
  19.     s := reg.ReadString('');
  20.     reg.CloseKey;
  21.   end
  22.   else
  23.   begin
  24.     {perhaps thier is a system file pointer}
  25.     if reg.OpenKey('.' + ext, false) <> false then
  26.     begin
  27.       s := reg.ReadString('');
  28.       reg.CloseKey;
  29.       if s <> '' then
  30.       begin
  31.         {A system file pointer was found}
  32.         if reg.OpenKey(s + '\shell\open\command', false) <> false then
  33.           {The open command has been found}
  34.           s := reg.ReadString('');
  35.         reg.CloseKey;
  36.       end;
  37.     end;
  38.   end;
  39.  
  40.   {Delete any command line, quotes and spaces}
  41.   if Pos('%', s) > 0 then
  42.     Delete(s, Pos('%', s), length(s));
  43.   if ((length(s) > 0) and (s[1] = '"')) then
  44.     Delete(s, 1, 1);
  45.   if ((length(s) > 0) and (s[length(s)] = '"')) then
  46.     Delete(s, Length(s), 1);
  47.   while ((length(s) > 0) and ((s[length(s)] = #32) or (s[length(s)] = '"'))) do
  48.     Delete(s, Length(s), 1);
  49.   {$ELSE}
  50.   GetWindowsDirectory(WinIniFileName, sizeof(WinIniFileName));
  51.   StrCat(WinIniFileName, '\win.ini');
  52.   WinIni := TIniFile.Create(WinIniFileName);
  53.   s := WinIni.ReadString('Extensions', ext, '');
  54.   WinIni.Free;
  55.   {Delete any command line}
  56.   if Pos(' ^', s) > 0 then
  57.     Delete(s, Pos(' ^', s), length(s));
  58.   {$ENDIF}
  59.   Result := s;
  60. end;



Para terminar veamos un ejemplo de llamada



delphi
  1. procedure TForm1.Button1Click(Sender: TObject);
  2. begin         
  3.   ShowMessage( GetProgramAssociation('gif') );
  4. end;