const PlayerExts = 'SOFTWARE\testing\';
const WMPOpenMaxExt = 52;
var
  WMPCount: Integer;

procedure WMPOpenSemiEnd;
var
  WMPNum: TArrayOfString;
  WMPExt: string;
  I: Integer;
begin
  //entries ending with a semicolon will break WMP
  if RegGetValueNames(HKLM, PlayerExts + 'Types', WMPNum) then
    for I := 0 to GetArrayLength(WMPNum)-1 do
      if RegQueryStringValue(HKLM, PlayerExts + 'Types', WMPNum[I], WMPExt) then
        while WMPExt[Length(WMPExt)] = ';' do
        begin
          Delete(WMPExt, Length(WMPExt), 1);
          RegWriteStringValue(HKLM, PlayerExts + 'Types', WMPNum[I], WMPExt);
        end;
end;

function WMPOpenCount: Integer;
var
  WMPNum: TArrayOfString;
  WMPExt: string;
  I: Integer;
begin
  Result := 0;
  if RegGetValueNames(HKLM, PlayerExts + 'Types', WMPNum) then
    for I := 0 to GetArrayLength(WMPNum)-1 do
      if RegQueryStringValue(HKLM, PlayerExts + 'Types', WMPNum[I], WMPExt) then
      begin
        if WMPExt <> '' then
        begin
          Result := Result+1;
          while Pos(';', WMPExt) > 0 do
          begin
            Result := Result+1;
            Delete(WMPExt, Pos(';', WMPExt), 1);
          end;
        end;
      end;
end;

procedure WMPOpenExt(Name: string; Exts: string; Desc: string; AddCount: Integer);
var
  WMPNum: TArrayOfString;
  WMPExt: string;
  TempExt: string;
  I: Integer;
begin
  if WMPCount < WMPOpenMaxExt then
  begin
    //current naming used in CCCP, no one else follows this scheme so it should be safe
    if RegValueExists(HKLM, PlayerExts + 'Types', Uppercase(Name)) then Exit;
    if RegGetValueNames(HKLM, PlayerExts + 'Types', WMPNum) then
      for I := 0 to GetArrayLength(WMPNum)-1 do
      begin
        RegQueryStringValue(HKLM, PlayerExts + 'Types', WMPNum[I], WMPExt);
        //searching within current strings for generic Name
        if Pos('.' + Name + ';', Lowercase(WMPExt)) > 0 then Exit;
        if Pos('.' + Name, Lowercase(WMPExt)) > 0 then
          if Length(WMPExt) = (Pos('.' + Name, Lowercase(WMPExt))+Length(Name)) then Exit;
      end;

    //parses Exts input if there are too many extensions and removes off the end
    while ((WMPCount+AddCount) > WMPOpenMaxExt) and (AddCount > 0) do
    begin
      TempExt := '';
      for I := 1 to (AddCount-1) do
      begin
        TempExt := TempExt+Copy(Exts, 1, Pos(';', Exts));
        Delete(Exts, 1, Pos(';', Exts));
      end;
      if TempExt[Length(TempExt)] = ';' then
        Delete(TempExt, Length(TempExt), 1);
      AddCount := AddCount-1;
      Exts := TempExt;
    end;

    if (WMPCount+AddCount) <= WMPOpenMaxExt then
    begin
      WMPCount := WMPCount+AddCount;
      RegWriteStringValue(HKLM, PlayerExts + 'Types', Uppercase(Name), Exts);
      RegWriteStringValue(HKLM, PlayerExts + 'Descriptions', Uppercase(Name), Desc + ' (' + Exts + ')');
      RegWriteStringValue(HKLM, PlayerExts + 'MUIDescriptions', Uppercase(Name), Desc);
    end;
  end;
end;

procedure ExUsage;
begin
  WMPOpenSemiEnd;
  WMPCount := WMPOpenCount;

  WMPOpenExt('mkv', '*.mkv;*.mka', 'Matroska Media file');
  WMPOpenExt('ogm', '*.ogm', 'Ogg Media file');
end;