File Coverage

blib/lib/Image/ExifTool/LNK.pm
Criterion Covered Total %
statement 128 171 74.8
branch 48 112 42.8
condition 5 21 23.8
subroutine 9 9 100.0
pod 0 5 0.0
total 190 318 59.7


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