[Gareth]

Есть программа, хочу что бы определённые расширения файлов, по двойному клику по ним, открывались в моей программе.
В ручную это - пкм по файлу, свойства, вкладка общее, кнопка изменить и выбор программы..

В программе есть лист бокс, в нем я записываю все расширения, которые должны открываться в моей программе.
По кнопке происходит цикл и расширения ассоциируются с программой.

Проблема в автоматической ассоциации..
Знаю что в реестре, знаю что это не в HKEY_CLASSES_ROOT
а HKEY_CURRENT_USER\Software\Classes\
Только вот ничего не получается, расширения не ассоциируются с программой.

Помогите, что делаю не так?

Код:

Function asss(Const Ext, ExeName: String): Boolean;
begin
  with TRegistry.Create do
    try
      RootKey := HKEY_CURRENT_USER;
      if OpenKey('\Software\Classes\.'+ Ext, TRUE) then
        WriteString('', ExeName);
      if OpenKey('\Software\Classes\ProText', TRUE) then
        WriteString('', 'My Very Own Text File Type');
      if OpenKey('\Software\Classes\ProText\DefaultIcon', TRUE) then
        WriteString('', ExtractFilePath(ParamStr(0)) + ExeName);
      if OpenKey('\Software\Classes\ProText\shell\open\command', TRUE) then
        WriteString('', ExtractFilePath(ParamStr(0)) + ExeName + '"%1"');
    finally
      Free;
    end;
  SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0);
end;

зы ProText - название exe моей программы
win7 64, delphi 10.3

[lmikle]

бинарник 32 бита?
Таи, вроде, были заморочки, что для 32 битных бинарников своя копия реестра. Вроже, если пишешь в HKEY_LOCAL_MACHINE, то будет работать,а вот с HKEY_CURRENT_USER какие-то заморочки.

ЗЫ. Я отказался от регистрации ассоциаций из самого экзешника в пользу регистрации при инсталяции. Пользуюсь InnoSetup. Он делает все правильно.

ЗЗЫ. По коду. А кто будет закрывать ключи за тобой. Можнт потому и не работает?

ЗЗЫ2. Расширение с точкой передаешь? Типа ".txt"?

ЗЗЫ3. А, кажется понял почему не работает. Смотри вот этот пример внимательно:
https://stackoverflow.com/questions/...e-current-user
В первом ключе надо писать не имя экзешника, а имя программы, т.е. в твоем случае "ProText"
Далее, что за извращение в строке 11 и 13? ParamStr(0) уже дает тебе полный путь к бинарнику.
В строке 13, вроде, пробела не хватает (разделение имени бинарника и параметра).

[Gareth]

Сообщение от lmikle

бинарник 32 бита?
Таи, вроде, были заморочки, что для 32 битных бинарников своя копия реестра. Вроже, если пишешь в HKEY_LOCAL_MACHINE, то будет работать,а вот с HKEY_CURRENT_USER какие-то заморочки.

ЗЫ. Я отказался от регистрации ассоциаций из самого экзешника в пользу регистрации при инсталяции. Пользуюсь InnoSetup. Он делает все правильно.

ЗЗЫ. По коду. А кто будет закрывать ключи за тобой. Можнт потому и не работает?

ЗЗЫ2. Расширение с точкой передаешь? Типа ".txt"?

ЗЗЫ3. А, кажется понял почему не работает. Смотри вот этот пример внимательно:
https://stackoverflow.com/questions/...e-current-user
В первом ключе надо писать не имя экзешника, а имя программы, т.е. в твоем случае "ProText"
Далее, что за извращение в строке 11 и 13? ParamStr(0) уже дает тебе полный путь к бинарнику.
В строке 13, вроде, пробела не хватает (разделение имени бинарника и параметра).

Код:

Function asss(Const Ext, ExeName: String): Boolean;
begin
  with TRegistry.Create do
    try
      RootKey := HKEY_CURRENT_USER;
      if OpenKey('\Software\Classes\.'+ Ext, TRUE) then
        WriteString('', 'ProText');
      if OpenKey('\Software\Classes\ProText', TRUE) then
        WriteString('', 'My Very Own Text File Type');
      if OpenKey('\Software\Classes\ProText\DefaultIcon', TRUE) then
        WriteString('', ParamStr(0));
      if OpenKey('\Software\Classes\MyAppDataFile\shell\open\command', TRUE) then
        WriteString('', ParamStr(0) + ' "%1"');
    finally
      Free;
    end;
  SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0);
end;

Всё ровно не работает..
Наверно проще будет сказать, что в реестре должно появится и по какому пути...
Я просто не понимаю саму суть этого всего..
Вот что в реестре:

[Gareth]

так же скачал pas файл DSiWin32.pas
В нем уже есть функция ассоциации файлов...
Пытаюсь ассоциировать - результат тот же, ассоциация не меняется, даже после перезагрузки пк.

Код:

 DSiRegisterUserFileAssoc('cfg', 'ProText', 'MyProText', ParamStr(0), ParamStr(0) + ' "%1"');

[lmikle]

Строка 12.
Должна быть
\Software\Classes\ProText\shell\open\command

[Gareth]

Сообщение от lmikle

Строка 12.
Должна быть
\Software\Classes\ProText\shell\open\command

Перерыл весь гугл, пробовал все процедуры и функции которые попадались. Обращался в телеге в группу, пацаны кидали ссылки с stackoverflow - ничего не помогает...
скачал программу которая отслеживает все изминения в реестре..
В ручную менял программу по умолчанию для расширения, смотрел что изменилось в реестре - пытался сделать тоже самое через delphi - безрезультатно.

[lmikle]

Ну не знаю что у тебя там не работает.
Вот для D10.2 у меня все ок - регистрирует, при клике - открывает:

Код:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    btRegister: TButton;
    lbFileName: TLabel;
    edFileText: TMemo;
    procedure btRegisterClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  System.Win.Registry, ShlObj;

procedure TForm1.btRegisterClick(Sender: TObject);
const
  sKeyRoot = '\Software\Classes\';
  sExt = '.protxt';
  sAppName = 'ProText';
var
  R : TRegistry;
begin
  R := TRegistry.Create;
  Try
    R.RootKey := HKEY_CURRENT_USER;
    If R.OpenKey(sKeyRoot+sExt,True) Then
      Begin
        R.WriteString('',sAppName);
        R.CloseKey;
      End;
    If R.OpenKey(sKeyRoot + sAppName,True) Then
      Begin
        R.WriteString('',sAppName + ' file type');
        R.CloseKey
      End;
    If R.OpenKey(sKeyRoot + sAppName + '\DefaultIcon',True) Then
      Begin
        R.WriteString('','"' + ParamStr(0) + '",0');
        R.CloseKey;
      End;
    If R.OpenKey(sKeyRoot + sAppName + '\shell\open\command',True) Then
      Begin
        R.WriteString('','"' + ParamStr(0) + '" "%1"');
        R.CloseKey;
      End;
    SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0);
  Finally
    R.Free;
  End;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  If ParamCount > 0 Then
    Begin
      lbFileName.Caption := ParamStr(1);
      edFileText.Lines.LoadFromFile(ParamStr(1));
    End;
end;

end.