Проблема Чтение \ запись данных в реестр

vernick

Мимокрокодил
Приветствую всех. Ребят, помогите пожалуйста разобраться.

Ситуация следующая. Возникла проблема с инсталлятором на Inno Setup. К нему нужно либо написать простецкий код, который менял бы всего несколько байт в реестре, либо помочь разобраться с имеющимся шаблоном кода. Сложность в том, что код сперва должен считать данные параметра "filterdata", запомнить их, а затем записать обратно, поменяв 4 байта, с 5-го по 8-й. Цель всего этого действа в изменении приоритета одного системного сплиттера отвечающего за воспроизведение видео Mpeg 2 в Windows, т.к. именно этим кодеком у нас закодированы fmv заставки в игре. Предварительное считывание необходимо в связи с тем, что на разных версиях Windows остальные байты блока "filterdata" немного отличаются, поэтому нужно точечно изменить только эти 4 байта приоритета. Я достал готовый шаблон кода под это дело, вот только никак не удаётся его завести, а в синтаксисе кода я почти ничего не смыслю.

Вот файл реестра: https://yadi.sk/d/rjALnN7TR7beeg

procedure SetMeritHelper(rootkey: Integer; clsid: String; b1, b2, b3, b4: Byte);
var
filterdata: AnsiString;
begin
if RegQueryBinaryValue(rootkey,
'CLSID\{083863F1-70DE-11d0-BD40-00A0C911CE86}\Instance\' + clsid,
'FilterData', filterdata) then begin
if Length(filterdata) < 16 then begin
Log('Invalid filterdata for ' + clsid);
exit;
end;
filterdata[5] := Chr(b1);
filterdata[6] := Chr(b2);
filterdata[7] := Chr(b3);
filterdata[8] := Chr(b4);
RegWriteBinaryValue(rootkey,
'CLSID\{083863F1-70DE-11d0-BD40-00A0C911CE86}\Instance\' + clsid,
'FilterData', filterdata);
end;
end;
end;

procedure SetMerit32(clsid: String; b1, b2, b3, b4: Byte);
begin
SetMeritHelper(HKCR32, clsid, b1, b2, b3, b4);
end;

procedure SetMeritUnlikely32(clsid: String);
begin
SetMerit32(clsid, 0, 0, 64, 0);
end;

Так выглядит блок данных на Win 7 и байты приоритета до изменений:



А так должены выглядеть после:


Заранее всем благодарен.
 

sergey3695

Ветеран
Модератор
Код:
[Setup]
AppName=My Application
AppVersion=1.5
DefaultDirName={pf}\My Application

[code]
procedure RePlaceTextinFile(FilePath, ses, ses2:string);
var
  S: TStringList;
  i : Integer;
  new1,new2: String;
begin
if FileExists(FilePath) then begin
  S:=tstringlist.create;
  S.LoadFromFile(FilePath);
for i := 0 to S.Count-1 do
begin
  if Pos(ses, S.Strings[i])>0 then
  begin
    new1:= Copy(S.Strings[i], 1, Length(ses)+Length(ses2));
//    MsgBox(new1, mbInformation, MB_OK);
    new2:= Copy(S.Strings[i], 1+Length(ses)+2*Length(ses2), Length(S.Strings[i]));
//    MsgBox(new2, mbInformation, MB_OK);
    S.Delete(i);
    S.Insert(i, new1 + ses2 + new2);
    MsgBox(new1 + ses2 + new2, mbInformation, MB_OK);
  end;
end;
  S.SaveToFile(ExpandConstant('{tmp}\Backup.reg'));
end;
end;

function InitializeSetup(): Boolean;
var
  Res: Integer;
  OldState: Boolean;
  Key, RegEdit: string;
begin
  RegEdit:= ExpandConstant('{win}\regedit.exe');
  Key:= 'HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{083863F1-70DE-11d0-BD40-00A0C911CE86}\Instance\{AFB6C280-2C41-11D3-8A60-0000F81E0E4A}';
  Exec(RegEdit, ' -ea Backup.reg ' + AddQuotes(Key), ExpandConstant('{tmp}'), SW_HIDE, ewWaitUntilTerminated, Res);
  RePlaceTextinFile(ExpandConstant('{tmp}\Backup.reg'),'"FilterData"=hex:', '00,00,60,00,');
if FileExists(ExpandConstant('{tmp}\Backup.reg')) then begin
  if IsWin64 then
  begin
    OldState := EnableFsRedirection(False);
    try
      Exec(ExpandConstant('{win}\regedit.exe'), ExpandConstant('/S "{tmp}\Backup.reg"'), '', SW_HIDE, ewWaitUntilTerminated, Res);
    finally
      EnableFsRedirection(OldState);
    end;
  end else
    Exec(ExpandConstant('{win}\regedit.exe'), ExpandConstant('/S "{tmp}\Backup.reg"'), '', SW_HIDE, ewWaitUntilTerminated, Res);
  DeleteFile(ExpandConstant('{tmp}\Backup.reg'));
end;
  Result:= True;
end;
ну вот готовое, так проще.
'00,00,60,00,' - я под такую запись сделал, как по скринам. (запятая в конце нужна, так поменьше кода писать xD ).
 

vernick

Мимокрокодил
Благодарю, код работает, патчит как надо (правда выскакивает сообщение после пропатчивания с перечислением всех внесённых байт, кстати, почему-то, сразу после запуска инсталятора, пока не знаю как убрать). Но на этот раз код по какой-то причине запоминает содержание ключа только один раз, после чего, даже после пересборки инсталяшки, возвращает только те данные, что запомнил в первый раз, вне зависимости от внесённых перед этим изменений в блок Filterdata. Хотя бэкапов, хвостов вроде нигде нет, странно как-то.
 

sergey3695

Ветеран
Модератор
vernick, MsgBox(new1 + ses2 + new2, mbInformation, MB_OK);
сообщение. просто закомментируй или сотри. это просто, чтобы видеть что вносит (а не что там есть). для проверки.
странно как-то вы там игрушку пишите, не соображая в элементарном паскале. вот что странно.
Но на этот раз код по какой-то причине запоминает содержание ключа только один раз, после чего, даже после пересборки инсталяшки, возвращает только те данные, что запомнил в первый раз, вне зависимости от внесённых перед этим изменений в блок Filterdata.
ну я без понятия, что там делается. код для создания, редактирования и внесения я дал. работу со строкой думаю не сложно осилить.
 

vernick

Мимокрокодил
Спасибо. Нет, мы не пишем никакую игрушку, просто в меру своих сил пытаемся исправить недостатки оригинала. Как я уже сказал, я не разбираюсь в коде, этим у нас занимаются другие люди, которые сейчас отсутствуют.
 

El Sanchez

Новичок
vernick, пример попроще.
Код:
[CustomMessages]
SInvalidFilterDataW64=Invalid filterdata for '%s' in 64-bit registry view.
SInvalidFilterDataW32=Invalid filterdata for '%s' in 32-bit registry view.
SUnableSetFilterDataW64=Unable to set filterdata for '%s' in 64-bit registry view. Error Code: 0x%.8x (%s).
SUnableSetFilterDataW32=Unable to set filterdata for '%s' in 32-bit registry view. Error Code: 0x%.8x (%s).

[Code]
const
  CodeRootKeyFlag64Bit = $02000000;

procedure SetFilterPriority(ARootKey: Integer; const ACLSID: string; const AData: AnsiString);
var
  LDataOffset, LResultCode: Integer;
  LSubKeyName: string;
  LFilterData: AnsiString;
begin
  LSubKeyName := 'SOFTWARE\Classes\CLSID\{083863F1-70DE-11D0-BD40-00A0C911CE86}\Instance\';
  if RegQueryBinaryValue(ARootKey, LSubKeyName + ACLSID, 'FilterData', LFilterData) then
  begin
    if Length(LFilterData) < 16 then
    begin
      if ARootKey and CodeRootKeyFlag64Bit <> 0 then
        Log(Format(CustomMessage('SInvalidFilterDataW64'), [ACLSID])) else
        Log(Format(CustomMessage('SInvalidFilterDataW32'), [ACLSID]));
      Exit;
    end;
    LDataOffset := 5;
    Delete(LFilterData, LDataOffset, Length(AData));
    Insert(AData, LFilterData, LDataOffset);
    if not RegWriteBinaryValue(ARootKey, LSubKeyName + ACLSID, 'FilterData', LFilterData) then
    begin
      LResultCode := DLLGetLastError;
      if ARootKey and CodeRootKeyFlag64Bit <> 0 then
        Log(Format(CustomMessage('SUnableSetFilterDataW64'), [ACLSID, LResultCode, SysErrorMessage(LResultCode)])) else
        Log(Format(CustomMessage('SUnableSetFilterDataW32'), [ACLSID, LResultCode, SysErrorMessage(LResultCode)]));
    end;
  end;
end;

procedure InitializeWizard;
begin
  SetFilterPriority(HKLM32, '{AFB6C280-2C41-11D3-8A60-0000F81E0E4A}', #$00#$00#$A0#$00);
  if IsWin64 then
    SetFilterPriority(HKLM64, '{AFB6C280-2C41-11D3-8A60-0000F81E0E4A}', #$00#$00#$A0#$00);
end;
P.S. В реальном приложении вызывать SetFilterPriority где-нибудь в конце установки.
 

vernick

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

El Sanchez

Новичок
El Sanchez, а как посмотреть, что считалось в LFilterData?
sergey3695, брейкпоинт (F5) на RegQueryBinaryValue, запуск (F9), останов на брейке, пошаговое выполнение (F8/F7), курсор на переменную. Странный вопрос, отладкой не пользуетесь, что ли?
 

sergey3695

Ветеран
Модератор
El Sanchez, да я нубло, мне так плохо видно.
Код:
function GetBinStr(S: ansistring): string;
var
  i: integer;
begin
    for i := 1 to Length(s) do
    begin
        result := result + Format('%.2x', [Ord(s[i])]);
        if not (i = Length(s)) then result := result + ',';
    end;
end;

//    MsgBox(GetBinStr(LFilterData), mbInformation, MB_OK);
 
Сверху