Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 13.08.2009, 04:16   #1
SalasAndriy
Форумчанин Подтвердите свой е-майл
 
Аватар для SalasAndriy
 
Регистрация: 01.11.2007
Сообщений: 157
Лампочка Проблема с перезагрузкой параметров из реестра

Вообщем программа делает простую ассоциацию файлов. Прописывает это всё в реестре, а потом исполняет:
Код:
SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
делаю я так: сперва ассоциирую все расширения аудио файлов которые мне надо, а потом уже исполняю высшеприведённый код...
Лично у меня на компе всё работает отлично... Ассоциируются файлы и норм, но дал другу потестить и у него после этой ассоциации слетела Windows...
Сперва грузилось всё сек 15 а потом раз и вот такое вот...
говорит что все значки и всё файлы зделались с расширением *.lnk
Ничего не запускалось после этого, ну а когда перезапустил комп то винда теперь не грузится...
у него стоял Windows XP SP3...

Можете кто-нить обьяснить в чём причина? Что это может быть? слетел реестр чтоли и виновата ли в этом прога? или это просто какой-то косяк в самой винде...

Могу выставить сюда кусок кода как именно проходит вся ассоциация...

Помогите... подскажите кто знает...
SalasAndriy вне форума Ответить с цитированием
Старый 13.08.2009, 04:44   #2
uberchel
Участник клуба
 
Аватар для uberchel
 
Регистрация: 19.01.2009
Сообщений: 1,485
По умолчанию

Код в студию !
uberchel вне форума Ответить с цитированием
Старый 13.08.2009, 14:22   #3
SalasAndriy
Форумчанин Подтвердите свой е-майл
 
Аватар для SalasAndriy
 
Регистрация: 01.11.2007
Сообщений: 157
По умолчанию Код в студию)

Вот это код компонента который проводит ассоциацию файла:
Код:
unit clsFileType;

interface
uses
  Registry, Windows, ShlObj, SysUtils, Dialogs, Classes;

type TFileTypeAcc = class(TComponent)
  private
    FFileExtension: string;
    FFileDescription: string;
    FOpenWith: string;
    FUseDDE: Boolean;
    FDdeMessage: string;
    FDDEApplicationNotRunning: string;
    FDDEApplication: string;
    FDDETopic: string;
    FOpenActionDescription: string;
    FOpenAction: string;
    FDefaultIcon: string;
    procedure SetFileExtension(const Value: string);

    function AllValuesSet: Boolean;
  public
    function Register: Boolean;
    function UnRegister: Boolean;
    procedure SystemUpdate;
    function Check : Boolean;
  published
    property FileExtension: string read FFileExtension write SetFileExtension;
    property FileDescription: string read FFileDescription write FFileDescription;
    property OpenAction: string read FOpenAction write FOpenAction;
    property OpenActionDescription: string read FOpenActionDescription write FOpenActionDescription;
    property OpenWith: string read FOpenWith write FOpenWith;
    property DefaultIcon: string read FDefaultIcon write FDefaultIcon;
    property UseDDE: Boolean read FUseDDE write FUseDDE;
    property DDEMessage: string read FDdeMessage write FDdeMessage;
    property DDEApplication: string read FDDEApplication write FDDEApplication;
    property DDEApplicationNotRunning: string read FDDEApplicationNotRunning write FDDEApplicationNotRunning;
    property DDETopic: string read FDDETopic write FDDETopic;

end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples',[TFileTypeAcc]);
end;

procedure TFileTypeAcc.SetFileExtension(const Value: string);
begin
  if not (Value[1] = '.') then
    FFileExtension := '.' + Value
  else
    FFileExtension := Value;
end;

function TFileTypeAcc.Register: Boolean;
var
  Reg: TRegistry;
begin
  Result := False;

  if not AllValuesSet then
    Exit;

  Reg := TRegistry.Create;

  try
    Reg.RootKey := HKEY_CLASSES_ROOT;
    Reg.OpenKey(FFileExtension, True);
    Reg.WriteString('', FFileDescription);
    Reg.CloseKey;
    Reg.OpenKey(FFileDescription, True);
    Reg.WriteString('', FFileDescription);
    Reg.CloseKey;
    Reg.OpenKey(FFileDescription + '\DefaultIcon', True);
    Reg.WriteString('', FDefaultIcon);
    Reg.CloseKey;
    Reg.OpenKey(FFileDescription + '\Shell\' + FOpenAction, True);
    Reg.WriteString('', FOpenActionDescription);
    Reg.CloseKey;
    Reg.OpenKey(FFileDescription + '\Shell\' + FOpenAction + '\Command', True);
    Reg.WriteString('', '"' + FOpenWith + '" "%1"');
    Reg.CloseKey;

    if FUseDDE then
    begin
      Reg.OpenKey(FFileDescription + '\Shell\' + FOpenAction + '\ddeexec', True);
      Reg.WriteString('', FDDEMessage);
      Reg.CloseKey;

      Reg.OpenKey(FFileDescription + '\Shell\' + FOpenAction + '\ddeexec\Application', True);
      Reg.WriteString('', FDDEApplication);
      Reg.CloseKey;

      Reg.OpenKey(FFileDescription + '\Shell\' + FOpenAction + '\ddeexec\IfExec', True);
      Reg.WriteString('', FDDEApplicationNotRunning);
      Reg.CloseKey;

      Reg.OpenKey(FFileDescription + '\Shell\' + FOpenAction + '\ddeexec\Topic', True);
      Reg.WriteString('', FDDETopic);
      Reg.CloseKey;
    end;

  finally
    Reg.Free;
  end;

  Result := True;
end;

function TFileTypeAcc.UnRegister: Boolean;
var
  reg: TRegistry;
  sClassName: string;
begin
  reg := TRegistry.Create;

  if FFileExtension = '' then
    raise Exception.Create('TFileTypeAcc.FileExtension property has not been set');

  try
    reg.RootKey := HKEY_CLASSES_ROOT;

    if not reg.KeyExists(FFileExtension) then
    begin
      Result := True;
      Exit;
    end;

    reg.OpenKey(FFileExtension, True);
    sClassName := reg.ReadString('');
    reg.CloseKey;
    reg.DeleteKey(FFileExtension);

    if not reg.KeyExists(sClassName) then
    begin
      Result := True;
      Exit;
    end;

    reg.DeleteKey(sClassName);
  finally
    reg.Free;
  end;

  Result := True;
end;
// Остальная часть кода ниже (Не вместилось)
SalasAndriy вне форума Ответить с цитированием
Старый 13.08.2009, 14:24   #4
SalasAndriy
Форумчанин Подтвердите свой е-майл
 
Аватар для SalasAndriy
 
Регистрация: 01.11.2007
Сообщений: 157
По умолчанию

Это продолжение кода компонента:
Код:
function TFileTypeAcc.AllValuesSet: Boolean;
var
  sFile: string;
begin
  if FFileExtension = '' then
    raise Exception.Create('TFileTypeAcc.FileExtension has not been set');

  if FFileDescription = '' then
    FFileDescription := Copy(FFileExtension, 2, Length(FFileExtension)) + ' File';

  if FOpenWith = '' then
    raise Exception.Create('TFileTypeAcc.OpenWith has not been set');

  if FOpenAction = '' then
    FOpenAction := 'Open';

  if FOpenActionDescription = '' then
    FOpenActionDescription := '&' + FOpenAction;

  if FDefaultIcon = '' then
    FDefaultIcon := FOpenWith + ',0';

  if FUseDDE then
  begin
    if FDDEMessage = '' then
      FDDEMessage := '[Open(%1)]';
      
    if FDDEApplication = '' then
    begin
      sFile := ExtractFileName(FOpenWith);
      FDDEApplication := Copy(sFile, 1, Length(sFile) - Length(ExtractFileExt(sFile)));
    end;

    if FDDETopic = '' then
      FDDETopic := 'Server';
  end;

  Result := True;
end;

// Обновляем систему чтобы она приняла новые изменения в реестре
procedure TFileTypeAcc.SystemUpdate;
begin
  SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
end;

// Проверка на ассоциацию
function TFileTypeAcc.Check : Boolean;
var reg:TRegistry;
    st:string;
begin
  result := false;
  reg := TRegistry.Create;
  reg.RootKey := HKEY_CLASSES_ROOT;
  if reg.OpenKey(FFileExtension,false) then begin
    st := reg.ReadString('');
    reg.CloseKey;
    if reg.OpenKey(st+'\Shell\' + FOpenAction + '\Command',false) then begin
      if reg.ReadString('') = ('"' + FOpenWith + '" "%1"') then result := true;
      reg.CloseKey;
    end;
  end;  
  reg.Free;
end;

end.
// Продолжение дальше... не вместилось...
SalasAndriy вне форума Ответить с цитированием
Старый 13.08.2009, 14:24   #5
SalasAndriy
Форумчанин Подтвердите свой е-майл
 
Аватар для SalasAndriy
 
Регистрация: 01.11.2007
Сообщений: 157
По умолчанию

А это код как я его использую:
Код:
//Это процедура для ассоциации конкретного расширения
procedure TFormOpt.SaveAssociateFileExt(Ext, Des: string; Checked: boolean; Icon: integer);
begin
  FileTypeAcc1.FileExtension := '.' + Ext;
  if Checked then
  begin
    FileTypeAcc1.UnRegister;
    FileTypeAcc1.FileDescription := Des;
    FileTypeAcc1.OpenWith := Application.ExeName;
    FileTypeAcc1.OpenAction:= 'Open';
    FileTypeAcc1.OpenActionDescription:= '&Открыть в Angelic Player';
    FileTypeAcc1.DDEApplicationNotRunning:= '[Open(%1)]';
    FileTypeAcc1.Register;
    FileTypeAcc1.UseDDE := True;
    FileTypeAcc1.DDEMessage := '[Open(%1)]';
    FileTypeAcc1.DDETopic := frmMain.DDEAngelicPlayer.Name;
    FileTypeAcc1.DefaultIcon:= FileLibIconsPack + ',' + IntToStr(Icon);
    FileTypeAcc1.Register;
    FileTypeAcc1.OpenAction := 'Enqueue';
    FileTypeAcc1.OpenActionDescription := '&Добавить в плейлист Angelic Player';
    FileTypeAcc1.DDEMessage := '[Enqueue(%1)]';
    FileTypeAcc1.Register;
    FileTypeAcc1.OpenAction := 'Play';
    FileTypeAcc1.OpenActionDescription := '&Воспроизвести в Angelic Player';
    FileTypeAcc1.DDEMessage := '[Open(%1)]';
    FileTypeAcc1.Register;
  end else
  begin
    FileTypeAcc1.UnRegister;
  end;
end;
// А это процедура ассоциации уже всех расширений которые мне нужно
procedure TFormOpt.SaveAssociateFiles;
begin
  SaveAssociateFileExt('mp1', 'MPEG Layer 1', sCheckListBox1.Checked[0], 2);
  SaveAssociateFileExt('mp2', 'MPEG Layer 2', sCheckListBox1.Checked[1], 3);
  SaveAssociateFileExt('mp3', 'MPEG Layer 3', sCheckListBox1.Checked[2], 4);
  SaveAssociateFileExt('cda', 'CD Digital Audio', sCheckListBox1.Checked[3], 30);
  SaveAssociateFileExt('wav', 'Windows WAVE', sCheckListBox1.Checked[4], 6);
  SaveAssociateFileExt('ogg', 'OGG Vorbis Audio', sCheckListBox1.Checked[5], 5);
  SaveAssociateFileExt('mo3', 'Compressed Tracker Module', sCheckListBox1.Checked[6], 1);
  SaveAssociateFileExt('it', 'Impulse Tracker Module', sCheckListBox1.Checked[7], 7);
  SaveAssociateFileExt('xm', 'Fast Tracker Module', sCheckListBox1.Checked[8], 8);
  SaveAssociateFileExt('s3m', 'Stream Tracker 3 Module', sCheckListBox1.Checked[9], 9);
  SaveAssociateFileExt('mtm', 'Tracker Module', sCheckListBox1.Checked[10], 10);
  SaveAssociateFileExt('mod', 'Tracker Module 2', sCheckListBox1.Checked[11], 11);
  SaveAssociateFileExt('umx', 'Unreal Music File', sCheckListBox1.Checked[12], 12);
  SaveAssociateFileExt('wma', 'Windows Media Audio', sCheckListBox1.Checked[13], 13);
  SaveAssociateFileExt('wm', 'Windows Media Audio 2', sCheckListBox1.Checked[14], 14);
  SaveAssociateFileExt('ofr', 'OptimFROG Audio', sCheckListBox1.Checked[15], 15);
  SaveAssociateFileExt('ofs', 'OptimFROG Audio 2', sCheckListBox1.Checked[16], 16);
  SaveAssociateFileExt('flac', 'Free Lossless Audio', sCheckListBox1.Checked[17], 17);
  SaveAssociateFileExt('wv', 'WavPack', sCheckListBox1.Checked[18], 18);
  SaveAssociateFileExt('aac', 'FAAD Audio', sCheckListBox1.Checked[19], 19);
  SaveAssociateFileExt('mp4', 'FAAD Audio 2', sCheckListBox1.Checked[20], 20);
  SaveAssociateFileExt('ac3', 'AC3 Audio', sCheckListBox1.Checked[21], 21);
  SaveAssociateFileExt('alac', 'Apple Lossless Audio', sCheckListBox1.Checked[22], 22);
  SaveAssociateFileExt('aif', 'Apple Audio', sCheckListBox1.Checked[23], 27);
  SaveAssociateFileExt('aiff', 'Apple Audio 2', sCheckListBox1.Checked[24], 27);
  SaveAssociateFileExt('ape', 'Monkeys Audio Audio', sCheckListBox1.Checked[25], 23);
  SaveAssociateFileExt('mpc', 'Musepack Audio', sCheckListBox1.Checked[26], 24);
  SaveAssociateFileExt('spx', 'Speex Audio', sCheckListBox1.Checked[27], 25);
  SaveAssociateFileExt('tta', 'True Audio', sCheckListBox1.Checked[28], 26);
  SaveAssociateFileExt('pls', 'Playlist', sCheckListBox1.Checked[29], 29);
  SaveAssociateFileExt('m3u', 'M3U Playlist', sCheckListBox1.Checked[30], 28);

  // здесь перезагружаются параметры из реестра
  FileTypeAcc1.SystemUpdate;
end;

procedure TFormOpt.sButton9Click(Sender: TObject);
begin
  SaveAssociateFiles;
end;
Вот... Я думал может не стоит писать вот эту строчку:
Код:
FileTypeAcc1.SystemUpdate;
Оно же всеравно все файлы которые я проассоциировал будут открываться нормально за исключением правильного отображения иконок файлов... но после перезагрузки все иконки будут нормальны...
Как думаете? Что посоветуете?)
SalasAndriy вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Проблема с загрузкой параметров из ini-файла Nomad Помощь студентам 6 03.08.2009 16:04
Помоготе с перезагрузкой компа Maladoj Общие вопросы .NET 2 09.04.2009 19:43
Поиск параметров реестра Лубышев Общие вопросы Delphi 1 08.06.2008 22:11
Удаление ключей и параметров из реестра... Altera Общие вопросы Delphi 1 06.05.2008 20:32
Проблема с перезагрузкой Romanus Общие вопросы C/C++ 1 11.02.2007 15:24