Wie ermittelt man das mit einem Dateityp verknüpfte Programm?

Die Funktion GetAssociatedProgramm funktioniert sowohl unter Win3.x, als auch unter Win9x. Sie findet das mit einem Dateitypen verknüpfte Programm, indem man ihr die Dateiendung übergibt. Unter Win9x wird das Programm aus der Registry ausgelesen, unter Win3.x aus der Systemdatei Win.ini.

ShowMessage(GetAssociatedProgram('gif'));

zeigt z.B. das mit GIF-Dateien verknüpfte Programm an.

uses
{$IFDEF WIN32}
  Registry; {Unter Win9x benutzen wir die Registry}
{$ELSE}
  IniFiles; {Unter Win3.x benutzen wir die Datei win.ini}
  const MAX_PATH = 144;
{$ENDIF}

function GetAssociatedProgram(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) then begin
    {The open command has been found}
    s:=reg.ReadString('');
    reg.CloseKey;
  end else begin
    {perhaps there is a system file pointer}
    if reg.OpenKey('.'+ext, 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) then begin
          {The open command has been found}
          s:=reg.ReadString('');
        end;
        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; {Johannes ??}

siehe auch:

Wie erstelle ich eine Dateiliste mit den registrierten Icons und Dateibeschreibungen?

Delphi FAQ