Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Как получить имя программы, с которой ассоциировано то или иное расширение?

01.01.2007
Автор: Олег Кулабухов

uses
{$IFDEF WIN32}
 
Registry; {We will get it from the registry}
{$ELSE}
 
IniFiles; {We will get it from the win.ini file}
{$ENDIF}
 
{$IFNDEF WIN32}
const
  MAX_PATH
= 144;
{$ENDIF}
 
function GetProgramAssociation(Ext: string): string;
var
{$IFDEF WIN32}
  reg
: TRegistry;
  s
: string;
{$ELSE}
 
WinIni: TIniFile;
 
WinIniFileName: array[0..MAX_PATH] of char;
  s
: string;
{$ENDIF}
begin
{$IFDEF WIN32}
  s
:= '';
  reg
:= TRegistry.Create;
  reg
.RootKey := HKEY_CLASSES_ROOT;
 
if reg.OpenKey('.' + ext + '\shell\open\command',
   
false) <> false then
 
begin
   
{The open command has been found}
    s
:= reg.ReadString('');
    reg
.CloseKey;
 
end
 
else
 
begin
   
{perhaps thier is a system file pointer}
   
if reg.OpenKey('.' + ext,
     
false) <> false then
   
begin
      s
:= reg.ReadString('');
      reg
.CloseKey;
     
if s <> '' then
     
begin
       
{A system file pointer was found}
       
if reg.OpenKey(s + '\shell\open\command',
         
false) <> false then
         
{The open command has been found}
          s
:= reg.ReadString('');
        reg
.CloseKey;
     
end;
   
end;
 
end;
 
{Delete any command line, quotes and spaces}
 
if Pos('%', s) > 0 then
   
Delete(s, Pos('%', s), length(s));
 
if ((length(s) > 0) and
   
(s[1] = '"')) then
   
Delete(s, 1, 1);
 
if ((length(s) > 0) and
   
(s[length(s)] = '"')) then
   
Delete(s, Length(s), 1);
 
while ((length(s) > 0) and
   
((s[length(s)] = #32) or
   
(s[length(s)] = '"'))) do
   
Delete(s, Length(s), 1);
{$ELSE}
 
GetWindowsDirectory(WinIniFileName, sizeof(WinIniFileName));
 
StrCat(WinIniFileName, '\win.ini');
 
WinIni := TIniFile.Create(WinIniFileName);
  s
:= WinIni.ReadString('Extensions',
    ext
,
   
'');
 
WinIni.Free;
 
{Delete any command line}
 
if Pos(' ^', s) > 0 then
   
Delete(s, Pos(' ^', s), length(s));
{$ENDIF}
  result
:= s;
end;
 
procedure TForm1
.Button1Click(Sender: TObject);
begin
 
ShowMessage(GetProgramAssociation('gif'));
end;