Public feed
#723141
//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;