Untitled

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

  while WMPCount > WMPOpenMaxChar 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;