//Tasks: Register Extensions in Windows Media Player
const
  MediaPlayerMLS = 'SOFTWARE\Microsoft\MediaPlayer\MLS\Extensions';
  MultimediaExts = 'SOFTWARE\Microsoft\Multimedia\WMPlayer\Extensions';
  MultimediaGroups = 'SOFTWARE\Microsoft\Multimedia\WMPlayer\Groups\';
  MultimediaMIMEs = 'SOFTWARE\Microsoft\Multimedia\WMPlayer\MIME Types';
  PlayerExts = 'SOFTWARE\Microsoft\MediaPlayer\Player\Extensions\';
  WMPOpenMaxChar = 260;
var
  WMPCount: Integer;

function WMPKeysPresent(Ext: string; RegPath: string): Boolean;
var
  WMPExt: TArrayOfString;
  I: Integer;
begin
  Result := False;
  if RegGetSubkeyNames(HKLM, RegPath, WMPExt) then
    for I := 0 to GetArrayLength(WMPExt)-1 do
      if Pos(Ext, Lowercase(WMPExt[I])) > 0 then
        if Length(Ext) = Length(WMPExt[I]) then
        begin
          Result := True;
          Break;
        end;
end;

function WMPValuesPresent(Ext: string; RegPath: string): Boolean;
var
  WMPExt: TArrayOfString;
  I: Integer;
begin
  Result := False;
  if RegGetValueNames(HKLM, RegPath, WMPExt) then
    for I := 0 to GetArrayLength(WMPExt)-1 do
      if Pos(Ext, Lowercase(WMPExt[I])) > 0 then
        if Length(Ext) = Length(WMPExt[I]) then
        begin
          Result := True;
          Break;
        end;
end;

procedure WMPRegMultimediaExts(Ext: string; PerceivedType: string; MIMEType: string; ExtDesc: string);
var
  ProgID: string;
  Icon: string;
begin
  if Ext = '' then Exit;

  if WMPValuesPresent(Ext, MediaPlayerMLS) = False then
    RegWriteStringValue(HKLM, MediaPlayerMLS, Ext, PerceivedType);

  if WMPKeysPresent('.' + Ext, MultimediaExts) = False then
  begin
    //RegWriteStringValue(HKLM, MultimediaExts + '\.' + Ext, 'AlreadyRegistered', 'yes');  //what does this infer? what is already registered?
    RegWriteStringValue(HKLM, MultimediaExts + '\.' + Ext, 'Extension.MIME', MIMEType);
    RegWriteStringValue(HKLM, MultimediaExts + '\.' + Ext, 'MediaType.Description', ExtDesc);
    RegWriteStringValue(HKLM, MultimediaExts + '\.' + Ext, 'PerceivedType', PerceivedType);
    RegWriteDWordValue(HKLM, MultimediaExts + '\.' + Ext, 'Permissions', 15);
    RegWriteDWordValue(HKLM, MultimediaExts + '\.' + Ext, 'Runtime', 7);
  end;

  if RegQueryStringValue(HKCR, '.' + Ext, '', ProgID) then
  begin
    //RegWriteStringValue(HKLM, MultimediaExts + '\.' + Ext, 'Extension.Handler', ProgID);  //should this be set? progid can easily change after install
    if RegQueryStringValue(HKCR, ProgID + '\DefaultIcon', '', Icon) then
      Insert(ExpandEnvVars(Icon), Icon, 0);
  end;
  RegWriteStringValue(HKLM, MultimediaExts + '\.' + Ext, 'MediaType.Icon', Icon);  //must be always present, even if blank. should be rewritten every install, as icon may change. also takes care of incomplete .wv entry

  if not RegValueExists(HKCR, 'Applications\wmplayer.exe\SupportedTypes', '.' + Ext) then
    RegWriteStringValue(HKCR, 'Applications\wmplayer.exe\SupportedTypes', '.' + Ext, '');
end;

procedure WMPReg(Ext: string; PerceivedType: string; MIMEType: string; ExtDesc: string; CommaExts: string; SpaceExts: string; Desc: string);
var
  I: Integer;
  S: Integer;
begin
  //parsing CommaExts and passing each ext to WMPRegMultimediaExts
  CommaExts := CommaExts + ',';
  S := 1;
  for I := 1 to Length(CommaExts) do
    if CommaExts[I] = ',' then
    begin
      WMPRegMultimediaExts(Copy(CommaExts, S, I - S), PerceivedType, MIMEType, ExtDesc);
      S := I + 1;
    end;

  if WMPKeysPresent(Ext, MultimediaGroups + PerceivedType) = False then
  begin
    RegWriteStringValue(HKLM, MultimediaGroups + PerceivedType + '\' + Uppercase(Ext), '', ExtDesc + ' (' + Lowercase(Ext) + ')');
    RegWriteStringValue(HKLM, MultimediaGroups + PerceivedType + '\' + Uppercase(Ext), 'Description', Desc);
    //RegWriteStringValue(HKLM, MultimediaGroups + PerceivedType + '\' + Uppercase(Ext), 'DescriptionFriendlyName', DescFriendly); //where does this entry even show up?
    RegWriteStringValue(HKLM, MultimediaGroups + PerceivedType + '\' + Uppercase(Ext), 'Extensions', SpaceExts);
    RegWriteStringValue(HKLM, MultimediaGroups + PerceivedType + '\' + Uppercase(Ext), 'FriendlyTypeName', ExtDesc);
    RegWriteStringValue(HKLM, MultimediaGroups + PerceivedType + '\' + Uppercase(Ext), 'MIME Types', MIMEType);
  end;

  if WMPKeysPresent(MIMEType, MultimediaMIMEs) = False then
  begin
    //RegWriteStringValue(HKLM, MultimediaMIMEs + '\' + MIMEType, 'AlreadyRegistered', 'yes');
    RegWriteStringValue(HKLM, MultimediaMIMEs + '\' + MIMEType, 'Extension.Key', '.' + Ext);
    RegWriteStringValue(HKLM, MultimediaMIMEs + '\' + MIMEType, 'Extensions.CommaSep', CommaExts);
    RegWriteStringValue(HKLM, MultimediaMIMEs + '\' + MIMEType, 'Extensions.SpaceSep', SpaceExts);
  end;
end;

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
        if WMPExt[Length(WMPExt)] = ';' then
        begin
          while WMPExt[Length(WMPExt)] = ';' do
            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
        Result := Result + Length(WMPExt) + 1;
end;

function WMPOpenPresent(Name: string): Boolean;
var
  WMPNum: TArrayOfString;
  WMPExt: string;
  I: Integer;
begin
  Result := False;
  if RegValueExists(HKLM, PlayerExts + 'Types', Uppercase(Name)) then
  begin
    Result := True;  //current naming used in CCCP, no one else follows this scheme so it should be safe
    Exit;
  end;

  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
      begin
        if Length(WMPExt) = (Pos('.' + Name, Lowercase(WMPExt)) + Length(Name)) then
        begin
          Result := True;  //checks for Name at end of string
          Exit;
        end;
        if Pos('.' + Name + ';', Lowercase(WMPExt)) > 0 then
        begin
          Result := True;
          Exit;
        end;
      end;
    end;
end;

procedure WMPOpenExt(Name: string; Exts: string; Desc: string);
var
  I: Integer;
  P: Integer;
begin
  if WMPCount < (WMPOpenMaxChar - 3) then  //minus 3 because you at least need room for a '*.' and null terminating character
  begin
    if WMPOpenPresent(Name) then Exit;

    //parses Exts input if there are too many chars and removes an extension off the end
    if (WMPCount + Length(Exts) + 1) > WMPOpenMaxChar then
    begin
      Exts := Exts + ';';
      P := 1;
      for I := 1 to Length(Exts) do
      begin
        if (WMPCount + I) > WMPOpenMaxChar then
          Break;
        if Exts[I] = ';' then
          P := I;
      end;
      Delete(Exts, P, Length(Exts) - P + 1);
    end;

    if Exts <> '' then
    begin
      WMPCount := WMPCount + P;
      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 WMPOpenFix;
var
  WMPNum: TArrayOfString;
  WMPExt: string;
  OldExts: TArrayOfString;
  I: Integer;
  J: Integer;
begin
  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
              begin
                RegDeleteValue(HKLM, PlayerExts + 'Descriptions', WMPNum[I]);
                RegDeleteValue(HKLM, PlayerExts + 'MUIDescriptions', WMPNum[I]);
                WMPCount := WMPCount - Length(OldExts[J]) - 1;
              end;

        if I = (GetArrayLength(WMPNum)-1) then Exit;
      end;
  end;
end;

procedure WMPOpenUninst;
begin
  RegDeleteValue(HKLM, PlayerExts + 'Types', 'MKV');
  RegDeleteValue(HKLM, PlayerExts + 'Types', 'MP4');
  RegDeleteValue(HKLM, PlayerExts + 'Types', 'OGM');
  RegDeleteValue(HKLM, PlayerExts + 'Types', 'FLV');
  RegDeleteValue(HKLM, PlayerExts + 'Types', 'TS');
  RegDeleteValue(HKLM, PlayerExts + 'Types', 'WV');
end;

procedure WMPExtensions;
begin
  WMPReg('flv', 'video', 'video/x-flv', 'Flash Video', 'flv', '.flv', 'Includes files with .flv extensions.');
  WMPReg('mkv', 'video', 'video/x-matroska', 'Matroska Video', 'mkv', '.mkv', 'Includes files with .mkv extensions.');
  WMPReg('mka', 'audio', 'audio/x-matroska', 'Matroska Audio', 'mka', '.mka', 'Includes files with .mka extensions.');
  WMPReg('mp4', 'video', 'video/mp4', 'MPEG-4 Video', 'mp4,m4v,mp4v', '.mp4 .m4v .mp4v', 'Includes files with .mp4, .m4v, and .mp4v extensions.');
  WMPReg('m4a', 'audio', 'audio/mp4', 'MPEG-4 Audio', 'm4a,m4b', '.m4a .m4b', 'Includes files with .m4a and .m4b extensions.');
  WMPReg('ogm', 'video', 'video/x-ogm', 'Ogg Media', 'ogm', '.ogm', 'Includes files with .ogm extensions.');
  WMPReg('ts', 'video', 'application/x-transportstream', 'MPEG Transport Stream', 'ts', '.ts', 'Includes files with .ts extensions.');
  WMPReg('wv', 'audio', 'audio/x-wavpack', 'WavPack Lossless Audio', 'wv', '.wv', 'Includes files with .wv extensions.');

  WMPOpenSemiEnd;
  WMPCount := WMPOpenCount;
  WMPOpenFix;
  //TODO: improve code to pass 1 ext at a time and append to its "major" grouping, allow greater control of order applied
  WMPOpenExt('mkv', '*.mkv;*.mka', 'Matroska Media file');
  WMPOpenExt('mp4', '*.mp4;*.m4a;*.m4b', 'MPEG-4 Media file');
  WMPOpenExt('ogm', '*.ogm', 'Ogg Media file');
  WMPOpenExt('flv', '*.flv', 'Flash Video file');
  WMPOpenExt('ts', '*.ts', 'Transport Stream file');
  WMPOpenExt('wv', '*.wv', 'WavPack Audio file');
end;