File Coverage

blib/lib/Image/ExifTool/LNK.pm
Criterion Covered Total %
statement 107 143 74.8
branch 39 92 42.3
condition 2 15 13.3
subroutine 7 7 100.0
pod 0 4 0.0
total 155 261 59.3


line stmt bran cond sub pod time code
1             #------------------------------------------------------------------------------
2             # File: LNK.pm
3             #
4             # Description: Read meta information from MS Shell Link files
5             #
6             # Revisions: 2009/09/19 - P. Harvey Created
7             #
8             # References: 1) http://msdn.microsoft.com/en-us/library/dd871305(PROT.10).aspx
9             # 2) http://www.i2s-lab.com/Papers/The_Windows_Shortcut_File_Format.pdf
10             #------------------------------------------------------------------------------
11              
12             package Image::ExifTool::LNK;
13              
14 1     1   3695 use strict;
  1         3  
  1         27  
15 1     1   4 use vars qw($VERSION);
  1         2  
  1         33  
16 1     1   5 use Image::ExifTool qw(:DataAccess :Utils);
  1         1  
  1         2138  
17              
18             $VERSION = '1.07';
19              
20             sub ProcessItemID($$$);
21             sub ProcessLinkInfo($$$);
22              
23             # Information extracted from LNK (Windows Shortcut) files
24             %Image::ExifTool::LNK::Main = (
25             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
26             GROUPS => { 2 => 'Other' },
27             VARS => { HEX_ID => 1 }, # print hex ID's in documentation
28             NOTES => 'Information extracted from MS Shell Link (Windows shortcut) files.',
29             # maybe the Flags aren't very useful to the user (since they are
30             # mainly structural), but extract them anyway for completeness
31             0x14 => {
32             Name => 'Flags',
33             Format => 'int32u',
34             PrintConv => { BITMASK => {
35             0 => 'IDList',
36             1 => 'LinkInfo',
37             2 => 'Description',
38             3 => 'RelativePath',
39             4 => 'WorkingDir',
40             5 => 'CommandArgs',
41             6 => 'IconFile',
42             7 => 'Unicode',
43             8 => 'NoLinkInfo',
44             9 => 'ExpString',
45             10 => 'SeparateProc',
46             12 => 'DarwinID',
47             13 => 'RunAsUser',
48             14 => 'ExpIcon',
49             15 => 'NoPidAlias',
50             17 => 'RunWithShim',
51             18 => 'NoLinkTrack',
52             19 => 'TargetMetadata',
53             20 => 'NoLinkPathTracking',
54             21 => 'NoKnownFolderTracking',
55             22 => 'NoKnownFolderAlias',
56             23 => 'LinkToLink',
57             24 => 'UnaliasOnSave',
58             25 => 'PreferEnvPath',
59             26 => 'KeepLocalIDList',
60             }},
61             },
62             0x18 => {
63             Name => 'FileAttributes',
64             Format => 'int32u',
65             PrintConv => { BITMASK => {
66             0 => 'Read-only',
67             1 => 'Hidden',
68             2 => 'System',
69             3 => 'Volume', #(not used)
70             4 => 'Directory',
71             5 => 'Archive',
72             6 => 'Encrypted?', #(ref 2, not used in XP)
73             7 => 'Normal',
74             8 => 'Temporary',
75             9 => 'Sparse',
76             10 => 'Reparse point',
77             11 => 'Compressed',
78             12 => 'Offline',
79             13 => 'Not indexed',
80             14 => 'Encrypted',
81             }},
82             },
83             0x1c => {
84             Name => 'CreateDate',
85             Format => 'int64u',
86             Groups => { 2 => 'Time' },
87             # convert time from 100-ns intervals since Jan 1, 1601
88             RawConv => '$val ? $val : undef',
89             ValueConv => '$val=$val/1e7-11644473600; ConvertUnixTime($val,1)',
90             PrintConv => '$self->ConvertDateTime($val)',
91             },
92             0x24 => {
93             Name => 'AccessDate',
94             Format => 'int64u',
95             Groups => { 2 => 'Time' },
96             RawConv => '$val ? $val : undef',
97             ValueConv => '$val=$val/1e7-11644473600; ConvertUnixTime($val,1)',
98             PrintConv => '$self->ConvertDateTime($val)',
99             },
100             0x2c => {
101             Name => 'ModifyDate',
102             Format => 'int64u',
103             Groups => { 2 => 'Time' },
104             RawConv => '$val ? $val : undef',
105             ValueConv => '$val=$val/1e7-11644473600; ConvertUnixTime($val,1)',
106             PrintConv => '$self->ConvertDateTime($val)',
107             },
108             0x34 => {
109             Name => 'TargetFileSize',
110             Format => 'int32u',
111             },
112             0x38 => {
113             Name => 'IconIndex',
114             Format => 'int32u',
115             PrintConv => '$val ? $val : "(none)"',
116             },
117             0x3c => {
118             Name => 'RunWindow',
119             Format => 'int32u',
120             PrintConv => {
121             0 => 'Hide',
122             1 => 'Normal',
123             2 => 'Show Minimized',
124             3 => 'Show Maximized',
125             4 => 'Show No Activate',
126             5 => 'Show',
127             6 => 'Minimized',
128             7 => 'Show Minimized No Activate',
129             8 => 'Show NA',
130             9 => 'Restore',
131             10 => 'Show Default',
132             },
133             },
134             0x40 => {
135             Name => 'HotKey',
136             Format => 'int32u',
137             PrintHex => 1,
138             PrintConv => {
139             OTHER => sub {
140             my $val = shift;
141             my $ch = $val & 0xff;
142             if (chr $ch =~ /^[A-Z0-9]$/) {
143             $ch = chr $ch;
144             } elsif ($ch >= 0x70 and $ch <= 0x87) {
145             $ch = 'F' . ($ch - 0x6f);
146             } elsif ($ch == 0x90) {
147             $ch = 'Num Lock';
148             } elsif ($ch == 0x91) {
149             $ch = 'Scroll Lock';
150             } else {
151             $ch = sprintf('Unknown (0x%x)', $ch);
152             }
153             $ch = "Alt-$ch" if $val & 0x400;
154             $ch = "Control-$ch" if $val & 0x200;
155             $ch = "Shift-$ch" if $val & 0x100;
156             return $ch;
157             },
158             0x00 => '(none)',
159             # these entries really only for documentation
160             0x90 => 'Num Lock',
161             0x91 => 'Scroll Lock',
162             "0x30'-'0x39" => "0-9",
163             "0x41'-'0x5a" => "A-Z",
164             "0x70'-'0x87" => "F1-F24",
165             0x100 => 'Shift',
166             0x200 => 'Control',
167             0x400 => 'Alt',
168             },
169             },
170             # note: tags 0x10xx are synthesized tag ID's
171             0x10000 => {
172             Name => 'ItemID',
173             SubDirectory => { TagTable => 'Image::ExifTool::LNK::ItemID' },
174             },
175             0x20000 => {
176             Name => 'LinkInfo',
177             SubDirectory => { TagTable => 'Image::ExifTool::LNK::LinkInfo' },
178             },
179             0x30004 => 'Description',
180             0x30008 => 'RelativePath',
181             0x30010 => 'WorkingDirectory',
182             0x30020 => 'CommandLineArguments',
183             0x30040 => 'IconFileName',
184             # note: tags 0xa000000x are actually ID's (not indices)
185             0xa0000000 => {
186             Name => 'UnknownData',
187             SubDirectory => { TagTable => 'Image::ExifTool::LNK::UnknownData' },
188             },
189             0xa0000001 => {
190             Name => 'EnvVarData',
191             SubDirectory => { TagTable => 'Image::ExifTool::LNK::UnknownData' },
192             },
193             0xa0000002 => {
194             Name => 'ConsoleData',
195             SubDirectory => { TagTable => 'Image::ExifTool::LNK::ConsoleData' },
196             },
197             0xa0000003 => {
198             Name => 'TrackerData',
199             SubDirectory => { TagTable => 'Image::ExifTool::LNK::TrackerData' },
200             },
201             0xa0000004 => {
202             Name => 'ConsoleFEData',
203             SubDirectory => { TagTable => 'Image::ExifTool::LNK::ConsoleFEData' },
204             },
205             0xa0000005 => {
206             Name => 'SpecialFolderData',
207             SubDirectory => { TagTable => 'Image::ExifTool::LNK::UnknownData' },
208             },
209             0xa0000006 => {
210             Name => 'DarwinData',
211             SubDirectory => { TagTable => 'Image::ExifTool::LNK::UnknownData' },
212             },
213             0xa0000007 => {
214             Name => 'IconEnvData',
215             SubDirectory => { TagTable => 'Image::ExifTool::LNK::UnknownData' },
216             },
217             0xa0000008 => {
218             Name => 'ShimData',
219             SubDirectory => { TagTable => 'Image::ExifTool::LNK::UnknownData' },
220             },
221             0xa0000009 => {
222             Name => 'PropertyStoreData',
223             SubDirectory => { TagTable => 'Image::ExifTool::LNK::UnknownData' },
224             },
225             0xa000000b => {
226             Name => 'KnownFolderData',
227             SubDirectory => { TagTable => 'Image::ExifTool::LNK::UnknownData' },
228             },
229             0xa000000c => {
230             Name => 'VistaIDListData',
231             SubDirectory => { TagTable => 'Image::ExifTool::LNK::UnknownData' },
232             },
233             );
234              
235             %Image::ExifTool::LNK::ItemID = (
236             GROUPS => { 2 => 'Other' },
237             PROCESS_PROC => \&ProcessItemID,
238             # (can't find any documentation on these items)
239             0x0032 => {
240             Name => 'Item0032',
241             SubDirectory => { TagTable => 'Image::ExifTool::LNK::Item0032' },
242             },
243             );
244              
245             %Image::ExifTool::LNK::Item0032 = (
246             GROUPS => { 2 => 'Other' },
247             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
248             0x0e => {
249             Name => 'TargetFileDOSName',
250             Format => 'var_string',
251             },
252             #not at a fixed offset -- offset is given by last 2 bytes of the item + 0x14
253             #0x22 => {
254             # Name => 'TargetFileName',
255             # Format => 'var_ustring',
256             #},
257             );
258              
259             %Image::ExifTool::LNK::LinkInfo = (
260             GROUPS => { 2 => 'Other' },
261             PROCESS_PROC => \&ProcessLinkInfo,
262             FORMAT => 'int32u',
263             VARS => { NO_ID => 1 },
264             VolumeID => { },
265             DriveType => {
266             PrintConv => {
267             0 => 'Unknown',
268             1 => 'Invalid Root Path',
269             2 => 'Removable Media',
270             3 => 'Fixed Disk',
271             4 => 'Remote Drive',
272             5 => 'CD-ROM',
273             6 => 'Ram Disk',
274             },
275             },
276             DriveSerialNumber => { },
277             VolumeLabel => { },
278             LocalBasePath => { },
279             CommonNetworkRelLink => { },
280             CommonPathSuffix => { },
281             NetName => { },
282             DeviceName => { },
283             NetProviderType => {
284             PrintHex => 1,
285             PrintConv => {
286             0x1a0000 => 'AVID',
287             0x1b0000 => 'DOCUSPACE',
288             0x1c0000 => 'MANGOSOFT',
289             0x1d0000 => 'SERNET',
290             0x1e0000 => 'RIVERFRONT1',
291             0x1f0000 => 'RIVERFRONT2',
292             0x200000 => 'DECORB',
293             0x210000 => 'PROTSTOR',
294             0x220000 => 'FJ_REDIR',
295             0x230000 => 'DISTINCT',
296             0x240000 => 'TWINS',
297             0x250000 => 'RDR2SAMPLE',
298             0x260000 => 'CSC',
299             0x270000 => '3IN1',
300             0x290000 => 'EXTENDNET',
301             0x2a0000 => 'STAC',
302             0x2b0000 => 'FOXBAT',
303             0x2c0000 => 'YAHOO',
304             0x2d0000 => 'EXIFS',
305             0x2e0000 => 'DAV',
306             0x2f0000 => 'KNOWARE',
307             0x300000 => 'OBJECT_DIRE',
308             0x310000 => 'MASFAX',
309             0x320000 => 'HOB_NFS',
310             0x330000 => 'SHIVA',
311             0x340000 => 'IBMAL',
312             0x350000 => 'LOCK',
313             0x360000 => 'TERMSRV',
314             0x370000 => 'SRT',
315             0x380000 => 'QUINCY',
316             0x390000 => 'OPENAFS',
317             0x3a0000 => 'AVID1',
318             0x3b0000 => 'DFS',
319             },
320             },
321             );
322              
323             %Image::ExifTool::LNK::UnknownData = (
324             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
325             GROUPS => { 2 => 'Other' },
326             );
327              
328             %Image::ExifTool::LNK::ConsoleData = (
329             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
330             GROUPS => { 2 => 'Other' },
331             0x08 => {
332             Name => 'FillAttributes',
333             Format => 'int16u',
334             PrintConv => 'sprintf("0x%.2x", $val)',
335             },
336             0x0a => {
337             Name => 'PopupFillAttributes',
338             Format => 'int16u',
339             PrintConv => 'sprintf("0x%.2x", $val)',
340             },
341             0x0c => {
342             Name => 'ScreenBufferSize',
343             Format => 'int16u[2]',
344             PrintConv => '$val=~s/ / x /; $val',
345             },
346             0x10 => {
347             Name => 'WindowSize',
348             Format => 'int16u[2]',
349             PrintConv => '$val=~s/ / x /; $val',
350             },
351             0x14 => {
352             Name => 'WindowOrigin',
353             Format => 'int16u[2]',
354             PrintConv => '$val=~s/ / x /; $val',
355             },
356             0x20 => {
357             Name => 'FontSize',
358             Format => 'int16u[2]',
359             PrintConv => '$val=~s/ / x /; $val',
360             },
361             0x24 => {
362             Name => 'FontFamily',
363             Format => 'int32u',
364             PrintHex => 1,
365             PrintConv => {
366             0 => "Don't Care",
367             0x10 => 'Roman',
368             0x20 => 'Swiss',
369             0x30 => 'Modern',
370             0x40 => 'Script',
371             0x50 => 'Decorative',
372             },
373             },
374             0x28 => {
375             Name => 'FontWeight',
376             Format => 'int32u',
377             },
378             0x2c => {
379             Name => 'FontName',
380             Format => 'undef[64]',
381             RawConv => q{
382             $val = $self->Decode($val, 'UCS2');
383             $val =~ s/\0.*//s;
384             return length($val) ? $val : undef;
385             },
386             },
387             0x6c => {
388             Name => 'CursorSize',
389             Format => 'int32u',
390             },
391             0x70 => {
392             Name => 'FullScreen',
393             Format => 'int32u',
394             PrintConv => '$val ? "Yes" : "No"',
395             },
396             0x74 => { #PH (MISSING FROM MS DOCUMENTATION! -- screws up subsequent offsets)
397             Name => 'QuickEdit',
398             Format => 'int32u',
399             PrintConv => '$val ? "Yes" : "No"',
400             },
401             0x78 => {
402             Name => 'InsertMode',
403             Format => 'int32u',
404             PrintConv => '$val ? "Yes" : "No"',
405             },
406             0x7c => {
407             Name => 'WindowOriginAuto',
408             Format => 'int32u',
409             PrintConv => '$val ? "Yes" : "No"',
410             },
411             0x80 => {
412             Name => 'HistoryBufferSize',
413             Format => 'int32u',
414             },
415             0x84 => {
416             Name => 'NumHistoryBuffers',
417             Format => 'int32u',
418             },
419             0x88 => {
420             Name => 'RemoveHistoryDuplicates',
421             Format => 'int32u',
422             PrintConv => '$val ? "Yes" : "No"',
423             },
424             );
425              
426             %Image::ExifTool::LNK::TrackerData = (
427             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
428             GROUPS => { 2 => 'Other' },
429             0x10 => {
430             Name => 'MachineID',
431             Format => 'var_string',
432             },
433             );
434              
435             %Image::ExifTool::LNK::ConsoleFEData = (
436             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
437             GROUPS => { 2 => 'Other' },
438             0x08 => {
439             Name => 'CodePage',
440             Format => 'int32u',
441             },
442             );
443              
444             #------------------------------------------------------------------------------
445             # Extract null-terminated ASCII or Unicode string from buffer
446             # Inputs: 0) buffer ref, 1) start position, 2) flag for unicode string
447             # Return: string or undef if start position is outside bounds
448             sub GetString($$;$)
449             {
450 2     2 0 4 my ($dataPt, $pos, $unicode) = @_;
451 2 50       4 return undef if $pos >= length($$dataPt);
452 2         5 pos($$dataPt) = $pos;
453 2 50       17 return $1 if ($unicode ? $$dataPt=~/\G((?:..)*?)\0\0/sg : $$dataPt=~/\G(.*?)\0/sg);
    50          
454 0         0 return substr($$dataPt, $pos);
455             }
456              
457             #------------------------------------------------------------------------------
458             # Process item ID data
459             # Inputs: 0) ExifTool object reference, 1) dirInfo reference, 2) tag table ref
460             # Returns: 1 on success
461             sub ProcessItemID($$$)
462             {
463 1     1 0 2 my ($et, $dirInfo, $tagTablePtr) = @_;
464 1         3 my $dataPt = $$dirInfo{DataPt};
465 1         2 my $dataLen = length $$dataPt;
466 1         2 my $pos = 0;
467             my %opts = (
468             DataPt => $dataPt,
469             DataPos => $$dirInfo{DataPos},
470 1         6 );
471 1         6 $et->VerboseDir('ItemID', undef, $dataLen);
472 1         2 for (;;) {
473 2 100       7 last if $pos + 4 >= $dataLen;
474 1         4 my $size = Get16u($dataPt, $pos);
475 1 50 33     6 last if $size < 2 or $pos + $size > $dataLen;
476 1         4 my $tag = Get16u($dataPt, $pos+2); # (just a guess -- may not be a tag at all)
477             AddTagToTable($tagTablePtr, $tag, {
478             Name => sprintf('Item%.4x', $tag),
479             SubDirectory => { TagTable => 'Image::ExifTool::LNK::UnknownData' },
480 1 50       4 }) unless $$tagTablePtr{$tag};
481 1         11 $et->HandleTag($tagTablePtr, $tag, undef, %opts, Start => $pos, Size => $size);
482 1         1 $pos += $size;
483             }
484             }
485              
486             #------------------------------------------------------------------------------
487             # Process link information data
488             # Inputs: 0) ExifTool object reference, 1) dirInfo reference, 2) tag table ref
489             # Returns: 1 on success
490             sub ProcessLinkInfo($$$)
491             {
492 1     1 0 4 my ($et, $dirInfo, $tagTablePtr) = @_;
493 1         3 my $dataPt = $$dirInfo{DataPt};
494 1         3 my $dataLen = length $$dataPt;
495 1 50       3 return 0 if $dataLen < 0x20;
496 1         3 my $hdrLen = Get32u($dataPt, 4);
497 1         3 my $lif = Get32u($dataPt, 8); # link info flags
498             my %opts = (
499             DataPt => $dataPt,
500             DataPos => $$dirInfo{DataPos},
501 1         5 Size => 4, # (typical value size)
502             );
503 1         3 my ($off, $unicode, $pos, $val, $size);
504 1         3 $et->VerboseDir('LinkInfo', undef, $dataLen);
505 1 50       4 if ($lif & 0x01) {
506             # read Volume ID
507 1         2 $off = Get32u($dataPt, 0x0c);
508 1 50       3 if ($off + 0x20 <= $dataLen) {
509             # my $len = Get32u($dataPt, $off);
510 1         6 $et->HandleTag($tagTablePtr, 'DriveType', undef, %opts, Start=>$off+4);
511 1         4 $pos = Get32u($dataPt, $off + 0x0c);
512 1 50       4 if ($pos == 0x14) {
513             # use VolumeLabelOffsetUnicode instead
514 0         0 $pos = Get32u($dataPt, $off + 0x10);
515 0         0 $unicode = 1;
516             }
517 1         2 $pos += $off;
518 1         4 $val = GetString($dataPt, $pos, $unicode);
519 1 50       4 if (defined $val) {
520 1         2 $size = length $val;
521 1 50       3 $val = $et->Decode($val, 'UCS2') if $unicode;
522 1         4 $et->HandleTag($tagTablePtr, 'VolumeLabel', $val, %opts, Start=>$pos, Size=>$size);
523             }
524             }
525             # read local base path
526 1 50       4 if ($hdrLen >= 0x24) {
527 0         0 $pos = Get32u($dataPt, 0x1c);
528 0         0 $unicode = 1;
529             } else {
530 1         4 $pos = Get32u($dataPt, 0x10);
531 1         3 undef $unicode;
532             }
533 1         3 $val = GetString($dataPt, $pos, $unicode);
534 1 50       3 if (defined $val) {
535 1         2 $size = length $val;
536 1 50       3 $val = $et->Decode($val, 'UCS2') if $unicode;
537 1         5 $et->HandleTag($tagTablePtr, 'LocalBasePath', $val, %opts, Start=>$pos, Size=>$size);
538             }
539             }
540 1 50       5 if ($lif & 0x02) {
541             # read common network relative link
542 0         0 $off = Get32u($dataPt, 0x14);
543 0 0 0     0 if ($off and $off + 0x14 <= $dataLen) {
544 0         0 my $siz = Get32u($dataPt, $off);
545 0         0 $pos = Get32u($dataPt, $off + 0x08);
546 0 0 0     0 if ($pos > 0x14 and $siz >= 0x18) {
547 0         0 $pos = Get32u($dataPt, $off + 0x14);
548 0         0 $unicode = 1;
549             } else {
550 0         0 undef $unicode;
551             }
552 0         0 $val = GetString($dataPt, $pos, $unicode);
553 0 0       0 if (defined $val) {
554 0         0 $size = length $val;
555 0 0       0 $val = $et->Decode($val, 'UCS2') if $unicode;
556 0         0 $et->HandleTag($tagTablePtr, 'NetName', $val, %opts, Start=>$pos, Size=>$size);
557             }
558 0         0 my $flg = Get32u($dataPt, $off + 0x04);
559 0 0       0 if ($flg & 0x01) {
560 0         0 $pos = Get32u($dataPt, $off + 0x0c);
561 0 0 0     0 if ($pos > 0x14 and $siz >= 0x1c) {
562 0         0 $pos = Get32u($dataPt, $off + 0x18);
563 0         0 $unicode = 1;
564             } else {
565 0         0 undef $unicode;
566             }
567 0         0 $val = GetString($dataPt, $pos, $unicode);
568 0 0       0 if (defined $val) {
569 0         0 $size = length $val;
570 0 0       0 $val = $et->Decode($val, 'UCS2') if $unicode;
571 0         0 $et->HandleTag($tagTablePtr, 'DeviceName', $val, %opts, Start=>$pos, Size=>$size);
572             }
573             }
574 0 0       0 if ($flg & 0x02) {
575 0         0 $val = Get32u($dataPt, $off + 0x10);
576 0         0 $et->HandleTag($tagTablePtr, 'NetProviderType', $val, %opts, Start=>$off + 0x10);
577             }
578             }
579             }
580 1         3 return 1;
581             }
582              
583             #------------------------------------------------------------------------------
584             # Extract information from a MS Shell Link (Windows shortcut) file
585             # Inputs: 0) ExifTool object reference, 1) dirInfo reference
586             # Returns: 1 on success, 0 if this wasn't a valid LNK file
587             sub ProcessLNK($$)
588             {
589 1     1 0 3 my ($et, $dirInfo) = @_;
590 1         3 my $raf = $$dirInfo{RAF};
591 1         1 my ($buff, $buf2, $len, $i);
592              
593             # read LNK file header
594 1 50       4 $raf->Read($buff, 0x4c) == 0x4c or return 0;
595 1 50       8 $buff =~ /^.{4}\x01\x14\x02\0{5}\xc0\0{6}\x46/s or return 0;
596 1         6 $len = unpack('V', $buff);
597 1 50       3 $len >= 0x4c or return 0;
598 1 50       11 if ($len > 0x4c) {
599 0 0       0 $raf->Read($buf2, $len - 0x4c) == $len - 0x4c or return 0;
600 0         0 $buff .= $buf2;
601             }
602 1         5 $et->SetFileType();
603 1         4 SetByteOrder('II');
604              
605 1         3 my $tagTablePtr = GetTagTable('Image::ExifTool::LNK::Main');
606 1         4 my %dirInfo = (
607             DataPt => \$buff,
608             DataPos => 0,
609             DataLen => length $buff,
610             DirLen => length $buff,
611             );
612 1         5 $et->ProcessDirectory(\%dirInfo, $tagTablePtr);
613              
614 1         4 my $flags = Get32u(\$buff, 0x14);
615              
616             # read link target ID list
617 1 50       4 if ($flags & 0x01) {
618 1 50       9 $raf->Read($buff, 2) or return 1;
619 1         3 $len = unpack('v', $buff);
620 1 50       4 $raf->Read($buff, $len) == $len or return 1;
621 1         7 $et->HandleTag($tagTablePtr, 0x10000, undef,
622             DataPt => \$buff,
623             DataPos => $raf->Tell() - $len,
624             Size => $len,
625             );
626             }
627              
628             # read link information
629 1 50       4 if ($flags & 0x02) {
630 1 50       4 $raf->Read($buff, 4) or return 1;
631 1         3 $len = unpack('V', $buff);
632 1 50       4 return 1 if $len < 4;
633 1 50       4 $raf->Read($buf2, $len - 4) == $len - 4 or return 1;
634 1         3 $buff .= $buf2;
635 1         4 $et->HandleTag($tagTablePtr, 0x20000, undef,
636             DataPt => \$buff,
637             DataPos => $raf->Tell() - $len,
638             Size => $len,
639             );
640             }
641              
642             # read string data
643 1         6 my @strings = qw(Description RelativePath WorkingDirectory
644             CommandLineArguments IconFileName);
645 1         5 for ($i=0; $i<@strings; ++$i) {
646 5         7 my $mask = 0x04 << $i;
647 5 100       11 next unless $flags & $mask;
648 4 50       11 $raf->Read($buff, 2) or return 1;
649 4         8 $len = unpack('v', $buff);
650 4 50       10 $len *= 2 if $flags & 0x80; # characters are 2 bytes if Unicode flag is set
651 4 50       10 $raf->Read($buff, $len) or return 1;
652 4         6 my $val;
653 4 50       13 $val = $et->Decode($buff, 'UCS2') if $flags & 0x80;
654 4         13 $et->HandleTag($tagTablePtr, 0x30000 | $mask, $val,
655             DataPt => \$buff,
656             DataPos => $raf->Tell() - $len,
657             Size => $len,
658             );
659             }
660              
661             # read extra data
662 1         7 while ($raf->Read($buff, 4) == 4) {
663 3         7 $len = unpack('V', $buff);
664 3 100       6 last if $len < 4;
665 2         3 $len -= 4;
666 2 50       6 $raf->Read($buf2, $len) == $len or last;
667 2 50       5 next unless $len > 4;
668 2         4 $buff .= $buf2;
669 2         6 my $tag = Get32u(\$buff, 4);
670 2         4 my $tagInfo = $$tagTablePtr{$tag};
671 2 50 33     13 unless (ref $tagInfo eq 'HASH' and $$tagInfo{SubDirectory}) {
672 0         0 $tagInfo = $$tagTablePtr{0xa0000000};
673             }
674 2         6 $et->HandleTag($tagTablePtr, $tag, undef,
675             DataPt => \$buff,
676             DataPos => $raf->Tell() - $len - 4,
677             TagInfo => $tagInfo,
678             );
679             }
680 1         11 return 1;
681             }
682              
683             1; # end
684              
685             __END__