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

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

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 + 'shellopencommand', 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 + 'shellopencommand', 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

;

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com