Как получить имя программы, с которой ассоциировано то или иное расширение
Материал из DRKB
Как получить имя программы, с которой ассоциировано то или иное расширение[править | править код]
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;
Author: Олег Кулабухов
ID: 01741