Someone

procedure CopyAllOld(Ext: string; NewFiletype: string);
var
  OldFiletype: string;
  SubKeysA: TArrayOfString;
  SubValuesA: TArrayOfString;
  i: integer;
  Keys: string;
  Values: string;
  Data: string;
begin
  if RegKeyExists(HKCR, '.' + Ext) then
    RegQueryStringValue(HKCR, '.' + Ext, '', OldFiletype)
    if OldFiletype <> NewFiletype then
      begin
        RegGetSubkeyNames(HKCR, OldFiletype, SubKeysA);
        Keys := '';
        Values := '';
        for i := 0 to GetArrayLength(SubKeysA)-1 do
          Keys := Keys + SubKeysA[i]
          RegGetValueNames(HKCR, OldFiletype + '\' + Keys, SubValuesA)
          for i := 0 to GetArrayLength(SubValuesA)-1 do
            Values := Values + SubValuesA[i]
            RegQueryStringValue(HKCR, OldFiletype + '\' + Keys, Values, Data)

            RegWriteStringValue(HKCR, NewFiletype + '\' + Keys, Values, Data);
      end;
end;