Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 29.08.2022, 21:45
Gareth Gareth вне форума
Активный
 
Регистрация: 21.03.2013
Адрес: Приднестровье
Сообщения: 202
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Программная ассоциация файлов с моей программой

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

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

Проблема в автоматической ассоциации..
Знаю что в реестре, знаю что это не в 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

Последний раз редактировалось Gareth, 29.08.2022 в 22:28.
Ответить с цитированием
  #2  
Старый 29.08.2022, 23:59
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,004
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

бинарник 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, вроде, пробела не хватает (разделение имени бинарника и параметра).
Ответить с цитированием
Этот пользователь сказал Спасибо lmikle за это полезное сообщение:
Gareth (30.08.2022)
  #3  
Старый 30.08.2022, 19:12
Gareth Gareth вне форума
Активный
 
Регистрация: 21.03.2013
Адрес: Приднестровье
Сообщения: 202
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию

Цитата:
Сообщение от 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;
Всё ровно не работает..
Наверно проще будет сказать, что в реестре должно появится и по какому пути...
Я просто не понимаю саму суть этого всего..
Вот что в реестре:
Ответить с цитированием
  #4  
Старый 30.08.2022, 20:01
Gareth Gareth вне форума
Активный
 
Регистрация: 21.03.2013
Адрес: Приднестровье
Сообщения: 202
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию

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

Код:
 DSiRegisterUserFileAssoc('cfg', 'ProText', 'MyProText', ParamStr(0), ParamStr(0) + ' "%1"');
Ответить с цитированием
  #5  
Старый 31.08.2022, 03:06
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,004
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Строка 12.
Должна быть
\Software\Classes\ProText\shell\open\command
Ответить с цитированием
  #6  
Старый 02.09.2022, 00:32
Gareth Gareth вне форума
Активный
 
Регистрация: 21.03.2013
Адрес: Приднестровье
Сообщения: 202
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию

Цитата:
Сообщение от lmikle
Строка 12.
Должна быть
\Software\Classes\ProText\shell\open\command
Перерыл весь гугл, пробовал все процедуры и функции которые попадались. Обращался в телеге в группу, пацаны кидали ссылки с stackoverflow - ничего не помогает...
скачал программу которая отслеживает все изминения в реестре..
В ручную менял программу по умолчанию для расширения, смотрел что изменилось в реестре - пытался сделать тоже самое через delphi - безрезультатно.
Ответить с цитированием
  #7  
Старый 02.09.2022, 20:42
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,004
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

Ну не знаю что у тебя там не работает.
Вот для 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.
Ответить с цитированием
Этот пользователь сказал Спасибо lmikle за это полезное сообщение:
Gareth (10.01.2023)
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 23:20.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter