procedure WMPOpenFix;
var
  WMPNum: TArrayOfString;
  WMPExt: string;
  OldExts: TArrayOfString;
  I: Integer;
  J: Integer;
begin
  SetArrayLength(OldExts, 6);
  OldExts[0] := '*.mp4;*.m4a;*.m4b;*.m4v;*.mp4v;*.3gp;*.3g2';
  OldExts[1] := '*.ogg;*.ogm';
  OldExts[2] := '*.wv';
  OldExts[3] := '*.ts';
  OldExts[4] := '*.flv';
  OldExts[5] := '*.mkv;*.mka;*.mks';

  while WMPCount > WMPOpenMaxExt do
  begin
    if RegGetValueNames(HKLM, PlayerExts + 'Types', WMPNum) then
      for I := 0 to GetArrayLength(WMPNum)-1 do
      begin
        if RegQueryStringValue(HKLM, PlayerExts + 'Types', WMPNum[I], WMPExt) then
          for J := 0 to GetArrayLength(OldExts)-1 do
            if WMPExt = OldExts[J] then
              if RegDeleteValue(HKLM, PlayerExts + 'Types', WMPNum[I]) then
                WMPCount := WMPCount - Length(OldExts[J]) - 1;

        if I = 6 then Exit;
      end;
  end;
end;