6195
|
1 #!/usr/bin/perl
|
|
2
|
|
3 ## usage: w32codec_dl.pl (codec.conf location)
|
|
4
|
|
5 # this script will use MS's codec dl interface as used by MS Media Player
|
|
6 # to attempt to locate the codecs listed in codecs.conf. It will download
|
|
7 # them to a directory "codecs/" below the current dir.
|
|
8 # you will need the libwww-perl stuff and the utility "cabextract"
|
|
9 # which may be found at http://www.kyz.uklinux.net/cabextract.php3
|
|
10
|
|
11 # By Tom Lees, 2002. I hereby place this script into the public domain.
|
|
12
|
|
13 #use LWP::Debug qw(+);
|
|
14 use LWP::UserAgent;
|
|
15
|
|
16 $ua = LWP::UserAgent->new;
|
|
17 $ua->agent ("Mozilla/4.0 (compatible; MSIE 5.0; Windows 98; DigExt)");
|
|
18
|
|
19 # Parse the etc/codecs.conf file
|
|
20 my $cconf = $ARGV[0];
|
|
21 open CCONF, "<$cconf";
|
|
22
|
|
23 my $codec = "(none)";
|
|
24 my $mscodec = 0;
|
|
25
|
|
26 my $cc, @ccl;
|
|
27
|
|
28 mkdir "codecs";
|
|
29 chdir "codecs";
|
|
30
|
|
31 CC: while (<CCONF>)
|
|
32 {
|
|
33 next CC if (m/^[ \t]*\;/);
|
|
34 s/\;.*//g;
|
|
35 s/#.*//g;
|
|
36
|
|
37 if (m/^videocodec (.*)/)
|
|
38 {
|
|
39 $codec = $1;
|
|
40 }
|
|
41 elsif (m/^[ \t]+driver (.*)/)
|
|
42 {
|
|
43 if ($1 eq "dshow" || $1 eq "vfw")
|
|
44 {
|
|
45 $mscodec = 1;
|
|
46 }
|
|
47 else
|
|
48 {
|
|
49 $mscodec = 0;
|
|
50 }
|
|
51 }
|
|
52 elsif (m/^[ \t]+fourcc (.*)/ && $mscodec == 1)
|
|
53 {
|
|
54 $cclist = $1;
|
|
55 chomp $cclist;
|
|
56 #@ccl = ();
|
|
57 do
|
|
58 {
|
|
59 if ($cclist =~ m/\"(....)\"[, ]*(.*)/)
|
|
60 {
|
|
61 $cc = $1;
|
|
62 $cclist = $2;
|
|
63 }
|
|
64 elsif ($cclist =~ m/[, ]*(....)[, ]*(.*)/)
|
|
65 {
|
|
66 $cc = $1;
|
|
67 $cclist = $2;
|
|
68 }
|
|
69 else
|
|
70 {
|
|
71 $cc = $cclist;
|
|
72 $cclist = "";
|
|
73 }
|
|
74 if (!($cc =~ m/^[ \t]+/))
|
|
75 {
|
|
76 push @ccl, ($cc);
|
|
77 }
|
|
78 } while (length ($cclist) > 0);
|
|
79 }
|
|
80 }
|
|
81 close CCONF;
|
|
82
|
|
83 # Find the codecs
|
|
84 open CODEC_CABS, ">codecs.locations.info";
|
|
85 %fcc_try = ();
|
|
86 while ($#ccl > 0)
|
|
87 {
|
|
88 $cc = pop (@ccl);
|
|
89 if (!$fcc_try{"$cc"})
|
|
90 {
|
|
91 $fcc_try{"$cc"} = 1;
|
|
92 if (!find_codec ($cc))
|
|
93 {
|
|
94 print "$cc found\n";
|
|
95 }
|
|
96 else
|
|
97 {
|
|
98 print "MS didn't find $cc\n";
|
|
99 }
|
|
100 }
|
|
101 }
|
|
102 close CODEC_CABS;
|
|
103
|
|
104 %got_codecs = ();
|
|
105 sub find_codec
|
|
106 {
|
|
107 my ($fourcc) = @_;
|
|
108
|
|
109 my $guid = sprintf ("%08X", unpack ("V", $fourcc))."-0000-0010-8000-00AA00389B71";
|
|
110
|
|
111 my $req = HTTP::Request->new (POST => "http://activex.microsoft.com/objects/ocget.dll");
|
|
112 $req->header ('Accept', '*/*');
|
|
113 $req->content_type ('application/x-www-form-urlencoded');
|
|
114 $req->content ("CLSID=%7B${guid}%7D\n");
|
|
115 #$req->content ('CLSID={'.${guid}.'}');
|
|
116
|
|
117 my $res = $ua->request ($req);
|
|
118
|
|
119 if ($res->is_success) {
|
|
120 print "Lookup returned success... weird!\n";
|
|
121 return 1;
|
|
122 } else {
|
|
123 # Codec location
|
|
124 if ($res->code == 302)
|
|
125 {
|
|
126 my $loc = $res->headers->header ("Location");
|
|
127 if (!$got_codecs{"$loc"})
|
|
128 {
|
|
129 print CODEC_CABS "$loc\n";
|
|
130 $got_codecs{"$loc"} = 1;
|
|
131 get_codec ($loc);
|
|
132 }
|
|
133 # else
|
|
134 # {
|
|
135 # print "Already have $loc\n";
|
|
136 # }
|
|
137 return 0;
|
|
138 }
|
|
139 else
|
|
140 {
|
|
141 # print "Lookup failed (Microsoft probably doesn't know this codec)\n";
|
|
142 return 1;
|
|
143 }
|
|
144 }
|
|
145 }
|
|
146
|
|
147 sub get_codec
|
|
148 {
|
|
149 my ($url) = @_;
|
|
150
|
|
151 my $req = HTTP::Request->new (GET => $url);
|
|
152 $req->header ("Accept", "*/*");
|
|
153 my $res = $ua->request ($req);
|
|
154
|
|
155 if ($res->is_success)
|
|
156 {
|
|
157 open TMP, ">tmp.cab" or die "Unable to open tmp.cab";
|
|
158 print TMP $res->content;
|
|
159 close TMP;
|
|
160
|
|
161 system "cabextract tmp.cab";
|
|
162 unlink "tmp.cab";
|
|
163 }
|
|
164 else
|
|
165 {
|
|
166 print "No such file!\n";
|
|
167 }
|
|
168 }
|
|
169
|