获得同相应扩展文件名关联的应用程序

delphi 编程 获得同相应扩展文件名关联的应用程序，代码 如下：

 

unit Unit1;

 

interface

 

uses

 

Windows, Messages, Registry,IniFiles,SysUtils, Variants, Classes, Graphics, Controls, Form s,

 

Dialogs, StdCtrls;

 

type

 

TForm 1 = class(TForm )

 

    Button1: TButton;

 

    procedure Button1Click(Sender: TObject);

 

private

 

    { Private declarations }

 

public

 

    { Public declarations }

 

end;

 

var

 

Form 1: TForm 1;

 

implementation

 

{$R *.dfm}

 

function GetProgramAssociation (Ext : string) : string;

 

//取得相关联的文件

 

var 

 

reg: TRegistry;

 

s : string;

 

WinIni : TIniFile;

 

WinIniFileName : array[0..MAX_PATH] of char;

 

begin

 

s := '';

 

reg := TRegistry.Create;

 

//生成注册表对象

 

reg.RootKey := HKEY_CLASSES_ROOT;

 

if reg.OpenKey('.' + ext + '\shell\open\command',false) <> false then

 

//打开指定的键值

 

begin

 

      s := reg.ReadString('');

 

      reg.CloseKey;

 

end

 

else

 

begin

 

    //如果不能打开

 

    if reg.OpenKey('.' + ext, false) <> false then

 

      begin

 

        s := reg.ReadString('');

 

        reg.CloseKey;

 

        if s <> '' then

 

        begin

 

          if reg.OpenKey(s + '\shell\open\command',false) <> false then

 

            s := reg.ReadString('');

 

            reg.CloseKey;

 

          end;

 

        end;

 

end;

 

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

 

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

 

result := s;

 

end;

 

procedure TForm 1.Button1Click(Sender: TObject);

 

begin

 

ShowMessage(GetProgramAssociation('gif'));

 

end;

 

end.