line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Parse::Lnk;
|
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# Many sections of this code were adapted from:
|
4
|
|
|
|
|
|
|
# Windows LNK file parser - Jacob Cunningham - jakec76@users.sourceforge.net
|
5
|
|
|
|
|
|
|
# from the SourceForge project located at:
|
6
|
|
|
|
|
|
|
# https://sourceforge.net/projects/jafat/files/lnk-parse/lnk-parse-1.0/lnk-parse-1.0.tar.gz
|
7
|
|
|
|
|
|
|
# Based on the contents of the document:
|
8
|
|
|
|
|
|
|
# http://www.i2s-lab.com/Papers/The_Windows_Shortcut_File_Format.pdf
|
9
|
|
|
|
|
|
|
|
10
|
2
|
|
|
2
|
|
146086
|
use 5.006;
|
|
2
|
|
|
|
|
16
|
|
11
|
2
|
|
|
2
|
|
11
|
use strict;
|
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
43
|
|
12
|
2
|
|
|
2
|
|
21
|
use warnings;
|
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
81
|
|
13
|
2
|
|
|
2
|
|
21
|
use Carp qw(croak);
|
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
6083
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
our $VERSION = '0.04';
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=pod
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=encoding latin1
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head1 NAME
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
Parse::Lnk - A cross-platform, depencency free, Windows shortcut (.lnk) meta data parser.
|
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head1 VERSION
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
Version 0.04
|
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=cut
|
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
require Exporter;
|
32
|
|
|
|
|
|
|
our @ISA = qw(Exporter);
|
33
|
|
|
|
|
|
|
our @EXPORT_OK = qw(parse_lnk resolve_lnk);
|
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
our $map = { # Tag names made up based on the docs
|
36
|
|
|
|
|
|
|
flag => {
|
37
|
|
|
|
|
|
|
0 => {
|
38
|
|
|
|
|
|
|
0 => 'NO SHELLIDLIST',
|
39
|
|
|
|
|
|
|
1 => 'HAS SHELLIDLIST',
|
40
|
|
|
|
|
|
|
},
|
41
|
|
|
|
|
|
|
1 => {
|
42
|
|
|
|
|
|
|
0 => 'NOT POINT TO FILE/DIR',
|
43
|
|
|
|
|
|
|
1 => 'POINTS TO FILE/DIR',
|
44
|
|
|
|
|
|
|
},
|
45
|
|
|
|
|
|
|
2 => {
|
46
|
|
|
|
|
|
|
0 => 'NO DESCRIPTION',
|
47
|
|
|
|
|
|
|
1 => 'HAS DESCRIPTION',
|
48
|
|
|
|
|
|
|
},
|
49
|
|
|
|
|
|
|
3 => {
|
50
|
|
|
|
|
|
|
0 => 'NO RELATIVE PATH STRING',
|
51
|
|
|
|
|
|
|
1 => 'HAS RELATIVE PATH STRING',
|
52
|
|
|
|
|
|
|
},
|
53
|
|
|
|
|
|
|
4 => {
|
54
|
|
|
|
|
|
|
0 => 'NO WORKING DIRECTORY',
|
55
|
|
|
|
|
|
|
1 => 'HAS WORKING DIRECTORY',
|
56
|
|
|
|
|
|
|
},
|
57
|
|
|
|
|
|
|
5 => {
|
58
|
|
|
|
|
|
|
0 => 'NO CMD LINE ARGS',
|
59
|
|
|
|
|
|
|
1 => 'HAS CMD LINE ARGS',
|
60
|
|
|
|
|
|
|
},
|
61
|
|
|
|
|
|
|
6 => {
|
62
|
|
|
|
|
|
|
0 => 'NO CUSTOM ICON',
|
63
|
|
|
|
|
|
|
1 => 'HAS CUSTOM ICON',
|
64
|
|
|
|
|
|
|
},
|
65
|
|
|
|
|
|
|
},
|
66
|
|
|
|
|
|
|
file => {
|
67
|
|
|
|
|
|
|
0 => 'READ ONLY TARGET',
|
68
|
|
|
|
|
|
|
1 => 'HIDDEN TARGET',
|
69
|
|
|
|
|
|
|
2 => 'SYSTEM FILE TARGET',
|
70
|
|
|
|
|
|
|
3 => 'VOLUME LABEL TARGET (not possible)',
|
71
|
|
|
|
|
|
|
4 => 'DIRECTORY TARGET',
|
72
|
|
|
|
|
|
|
5 => 'ARCHIVE',
|
73
|
|
|
|
|
|
|
6 => 'NTFS EFS',
|
74
|
|
|
|
|
|
|
7 => 'NORMAL TARGET',
|
75
|
|
|
|
|
|
|
8 => 'TEMP. TARGET',
|
76
|
|
|
|
|
|
|
9 => 'SPARSE TARGET',
|
77
|
|
|
|
|
|
|
10 => 'REPARSE POINT DATA TARGET',
|
78
|
|
|
|
|
|
|
11 => 'COMPRESSED TARGET',
|
79
|
|
|
|
|
|
|
12 => 'TARGET OFFLINE',
|
80
|
|
|
|
|
|
|
},
|
81
|
|
|
|
|
|
|
show_wnd => {
|
82
|
|
|
|
|
|
|
0 => 'SW_HIDE',
|
83
|
|
|
|
|
|
|
1 => 'SW_NORMAL',
|
84
|
|
|
|
|
|
|
2 => 'SW_SHOWMINIMIZED',
|
85
|
|
|
|
|
|
|
3 => 'SW_SHOWMAXIMIZED',
|
86
|
|
|
|
|
|
|
4 => 'SW_SHOWNOACTIVE',
|
87
|
|
|
|
|
|
|
5 => 'SW_SHOW',
|
88
|
|
|
|
|
|
|
6 => 'SW_MINIMIZE',
|
89
|
|
|
|
|
|
|
7 => 'SW_SHOWMINNOACTIVE',
|
90
|
|
|
|
|
|
|
8 => 'SW_SHOWNA',
|
91
|
|
|
|
|
|
|
9 => 'SW_RESTORE',
|
92
|
|
|
|
|
|
|
10 => 'SW_SHOWDEFAULT',
|
93
|
|
|
|
|
|
|
},
|
94
|
|
|
|
|
|
|
vol_type => {
|
95
|
|
|
|
|
|
|
0 => 'Unknown',
|
96
|
|
|
|
|
|
|
1 => 'No root directory',
|
97
|
|
|
|
|
|
|
2 => 'Removable (Floppy, Zip, USB, etc.)',
|
98
|
|
|
|
|
|
|
3 => 'Fixed (Hard Disk)',
|
99
|
|
|
|
|
|
|
4 => 'Remote (Network Drive)',
|
100
|
|
|
|
|
|
|
5 => 'CD-ROM',
|
101
|
|
|
|
|
|
|
6 => 'RAM Drive',
|
102
|
|
|
|
|
|
|
},
|
103
|
|
|
|
|
|
|
};
|
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
sub resolve_lnk {
|
106
|
10
|
|
|
10
|
1
|
9359
|
my $filename = shift;
|
107
|
10
|
|
|
|
|
47
|
my $l = __PACKAGE__->new (
|
108
|
|
|
|
|
|
|
filename => $filename,
|
109
|
|
|
|
|
|
|
resolve => 1,
|
110
|
|
|
|
|
|
|
);
|
111
|
10
|
|
|
|
|
37
|
$l->_parse;
|
112
|
10
|
|
|
|
|
81
|
$l->{base_path};
|
113
|
|
|
|
|
|
|
}
|
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
sub parse_lnk {
|
116
|
10
|
|
|
10
|
1
|
9341
|
my $filename = shift;
|
117
|
10
|
|
|
|
|
88
|
my $l = __PACKAGE__->new (
|
118
|
|
|
|
|
|
|
filename => $filename,
|
119
|
|
|
|
|
|
|
);
|
120
|
10
|
|
|
|
|
36
|
$l->_parse;
|
121
|
10
|
100
|
|
|
|
51
|
return if $l->{error};
|
122
|
5
|
|
|
|
|
26
|
$l;
|
123
|
|
|
|
|
|
|
}
|
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
sub new {
|
126
|
40
|
|
|
40
|
1
|
6529
|
my $class = shift;
|
127
|
40
|
50
|
33
|
|
|
257
|
if (@_ and @_ % 2) {
|
128
|
0
|
|
|
|
|
0
|
croak "This method expects (name => value) arguments. Odd number of arguments received";
|
129
|
|
|
|
|
|
|
}
|
130
|
40
|
|
|
|
|
137
|
my $self = {
|
131
|
|
|
|
|
|
|
@_,
|
132
|
|
|
|
|
|
|
};
|
133
|
40
|
|
|
|
|
117
|
bless $self, $class;
|
134
|
|
|
|
|
|
|
}
|
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
sub from {
|
137
|
10
|
|
|
10
|
1
|
16987
|
my $self = shift;
|
138
|
10
|
|
|
|
|
22
|
my $filename = shift;
|
139
|
10
|
50
|
|
|
|
51
|
$self = $self->new (
|
140
|
|
|
|
|
|
|
filename => $filename,
|
141
|
|
|
|
|
|
|
) unless ref $self;
|
142
|
10
|
|
|
|
|
44
|
$self->_parse;
|
143
|
10
|
100
|
|
|
|
55
|
return if $self->{error};
|
144
|
5
|
|
|
|
|
27
|
$self;
|
145
|
|
|
|
|
|
|
}
|
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
sub parse {
|
148
|
10
|
|
|
10
|
1
|
50
|
my $self = shift;
|
149
|
10
|
|
|
|
|
17
|
my $filename = shift;
|
150
|
10
|
50
|
|
|
|
37
|
$self = $self->new (
|
151
|
|
|
|
|
|
|
filename => $filename,
|
152
|
|
|
|
|
|
|
) unless ref $self;
|
153
|
10
|
|
|
|
|
31
|
$self->_parse;
|
154
|
10
|
100
|
|
|
|
50
|
return if $self->{error};
|
155
|
5
|
|
|
|
|
28
|
$self;
|
156
|
|
|
|
|
|
|
}
|
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
sub _reset {
|
159
|
40
|
|
|
40
|
|
71
|
my $self = shift;
|
160
|
40
|
50
|
|
|
|
96
|
return unless ref $self;
|
161
|
40
|
|
|
|
|
153
|
for my $k (keys %$self) {
|
162
|
50
|
|
|
|
|
134
|
delete $self->{$k};
|
163
|
|
|
|
|
|
|
}
|
164
|
40
|
|
|
|
|
71
|
$self;
|
165
|
|
|
|
|
|
|
}
|
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
sub _parse {
|
168
|
40
|
|
|
40
|
|
74
|
my $self = shift;
|
169
|
40
|
|
|
|
|
84
|
my $filename = $self->{filename};
|
170
|
40
|
|
|
|
|
83
|
my $resolve = $self->{resolve};
|
171
|
40
|
|
|
|
|
125
|
$self->_reset;
|
172
|
40
|
50
|
|
|
|
111
|
if (not defined $filename) {
|
173
|
0
|
|
|
|
|
0
|
$self->{error} = 'A filename is required';
|
174
|
0
|
|
|
|
|
0
|
return;
|
175
|
|
|
|
|
|
|
}
|
176
|
40
|
100
|
|
|
|
1390
|
if (not -f $filename) {
|
177
|
8
|
|
|
|
|
29
|
$self->{error} = "Not a file";
|
178
|
8
|
|
|
|
|
19
|
return;
|
179
|
|
|
|
|
|
|
}
|
180
|
32
|
50
|
|
|
|
1877
|
if (open my $in, '<', $filename) {
|
181
|
32
|
|
|
|
|
166
|
binmode $in;
|
182
|
32
|
|
|
|
|
108
|
$self->{_fh} = $in;
|
183
|
|
|
|
|
|
|
} else {
|
184
|
|
|
|
|
|
|
# We set error before croak, in case this call is being eval'ed
|
185
|
0
|
|
|
|
|
0
|
$self->{error} = "Can't open file '$filename' for reading";
|
186
|
0
|
|
|
|
|
0
|
croak $self->{error};
|
187
|
|
|
|
|
|
|
}
|
188
|
|
|
|
|
|
|
|
189
|
32
|
|
|
|
|
128
|
my $header = $self->_read_unpack(0, 1);
|
190
|
32
|
100
|
|
|
|
121
|
if ($header ne '4c') {
|
191
|
12
|
|
|
|
|
27
|
$self->{error} = 'Invalid Lnk file header';
|
192
|
12
|
|
|
|
|
134
|
close $self->{_fh};
|
193
|
12
|
|
|
|
|
34
|
delete $self->{_fh};
|
194
|
12
|
|
|
|
|
47
|
return;
|
195
|
|
|
|
|
|
|
}
|
196
|
|
|
|
|
|
|
|
197
|
20
|
|
|
|
|
69
|
$self->{guid} = $self->_read_unpack(4, 16);
|
198
|
|
|
|
|
|
|
|
199
|
20
|
|
|
|
|
76
|
my $flags = $self->_read_unpack_bin(20, 1);
|
200
|
20
|
|
|
|
|
94
|
my $flag_cnt = 0;
|
201
|
20
|
|
|
|
|
78
|
my @flag_bits = (0, 0, 0, 0, 0, 0, 0, 0);
|
202
|
20
|
|
|
|
|
83
|
while ($flag_cnt < 7) {
|
203
|
140
|
|
|
|
|
212
|
my $flag_bit = substr $flags, $flag_cnt, 1;
|
204
|
140
|
|
|
|
|
159
|
push @{$self->{flags}}, $map->{flag}->{$flag_cnt}->{$flag_bit};
|
|
140
|
|
|
|
|
494
|
|
205
|
140
|
100
|
|
|
|
287
|
if ($flag_bit eq '1') {
|
206
|
40
|
50
|
33
|
|
|
181
|
if ($flag_cnt >= 0 and $flag_cnt <= 6) {
|
207
|
40
|
|
|
|
|
63
|
$flag_bits[$flag_cnt] = 1;
|
208
|
|
|
|
|
|
|
}
|
209
|
|
|
|
|
|
|
}
|
210
|
140
|
|
|
|
|
279
|
$flag_cnt++;
|
211
|
|
|
|
|
|
|
}
|
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
# File Attributes 4bytes@18h = 24d
|
214
|
|
|
|
|
|
|
# Only a non-zero if "Flag bit 1" above is set to 1
|
215
|
|
|
|
|
|
|
#
|
216
|
20
|
50
|
|
|
|
217
|
if ($flag_bits[1] == 1) {
|
217
|
20
|
|
|
|
|
58
|
my $file_attrib = $self->_read_unpack_bin(24, 2);
|
218
|
20
|
|
|
|
|
48
|
my $file_att_cnt = 0;
|
219
|
20
|
|
|
|
|
70
|
while ($file_att_cnt < 13) {
|
220
|
260
|
|
|
|
|
352
|
my $file_bit = substr $file_attrib, $file_att_cnt, 1;
|
221
|
260
|
100
|
|
|
|
408
|
push @{$self->{attributes}}, $map->{file}->{$file_att_cnt} if $file_bit;
|
|
28
|
|
|
|
|
124
|
|
222
|
260
|
|
|
|
|
433
|
$file_att_cnt++;
|
223
|
|
|
|
|
|
|
}
|
224
|
|
|
|
|
|
|
}
|
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
# Create time 8bytes @ 1ch = 28
|
227
|
20
|
|
|
|
|
64
|
my $ctime = $self->_read_unpack(28, 8);
|
228
|
20
|
|
|
|
|
69
|
$ctime = Parse::Windows::Shortcut::Bigint::bighex($self->_reverse_hex($ctime));
|
229
|
20
|
|
|
|
|
876
|
$ctime = $self->_MStime_to_unix($ctime);
|
230
|
20
|
|
|
|
|
58
|
$self->{create_time} = $ctime;
|
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
# Access time 8 bytes@ 0x24 = 36D
|
233
|
20
|
|
|
|
|
57
|
my $atime = $self->_read_unpack(36, 8);
|
234
|
20
|
|
|
|
|
68
|
$atime = Parse::Windows::Shortcut::Bigint::bighex($self->_reverse_hex($atime));
|
235
|
20
|
|
|
|
|
585
|
$atime = $self->_MStime_to_unix($atime);
|
236
|
20
|
|
|
|
|
65
|
$self->{last_accessed_time} = $atime;
|
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
# Mod Time8b @ 0x2C = 44D
|
239
|
20
|
|
|
|
|
52
|
my $mtime = $self->_read_unpack(44, 8);
|
240
|
20
|
|
|
|
|
63
|
$mtime = Parse::Windows::Shortcut::Bigint::bighex($self->_reverse_hex($mtime));
|
241
|
20
|
|
|
|
|
551
|
$mtime = $self->_MStime_to_unix($mtime);
|
242
|
20
|
|
|
|
|
61
|
$self->{modified_time} = $mtime;
|
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
# Target File length starts @ 34h = 52d
|
245
|
20
|
|
|
|
|
57
|
my $f_len = $self->_read_unpack(52, 4);
|
246
|
20
|
|
|
|
|
67
|
$f_len = hex $self->_reverse_hex($f_len);
|
247
|
20
|
|
|
|
|
96
|
$self->{target_length} = $f_len;
|
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
# Icon File info starts @ 38h = 56d
|
250
|
20
|
|
|
|
|
66
|
my $ico_num = $self->_read_unpack(56, 4);
|
251
|
20
|
|
|
|
|
41
|
$ico_num = hex $ico_num;
|
252
|
20
|
|
|
|
|
56
|
$self->{icon_index} = $ico_num;
|
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
# ShowWnd val to pass to target
|
255
|
|
|
|
|
|
|
# Starts @3Ch = 60d
|
256
|
20
|
|
|
|
|
53
|
my $show_wnd = $self->_read_unpack(60, 1);
|
257
|
20
|
|
|
|
|
41
|
$show_wnd = hex $show_wnd;
|
258
|
20
|
|
|
|
|
49
|
$self->{show_wnd} = $show_wnd;
|
259
|
20
|
|
|
|
|
95
|
$self->{show_wnd_flag} = $map->{show_wnd}->{$show_wnd};
|
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
# Hot key
|
262
|
|
|
|
|
|
|
# Starts @40h = 64d
|
263
|
20
|
|
|
|
|
52
|
my $hot_key = $self->_read_unpack(64, 4);
|
264
|
20
|
|
|
|
|
39
|
$hot_key = hex $hot_key;
|
265
|
20
|
|
|
|
|
59
|
$self->{hot_key} = $hot_key;
|
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
# ItemID List
|
268
|
|
|
|
|
|
|
# Read size of item ID list
|
269
|
20
|
|
|
|
|
55
|
my $i_len = $self->_read_unpack(76, 2);
|
270
|
20
|
|
|
|
|
48
|
$i_len = hex $self->_reverse_hex($i_len);
|
271
|
|
|
|
|
|
|
# skip to end of list
|
272
|
20
|
|
|
|
|
42
|
my $end_of_list = (78 + $i_len);
|
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
# FileInfo structure
|
275
|
|
|
|
|
|
|
#
|
276
|
20
|
|
|
|
|
37
|
my $struc_start = $end_of_list;
|
277
|
20
|
|
|
|
|
28
|
my $first_off_off = ($struc_start + 4);
|
278
|
20
|
|
|
|
|
25
|
my $vol_flags_off = ($struc_start + 8);
|
279
|
20
|
|
|
|
|
26
|
my $local_vol_off = ($struc_start + 12);
|
280
|
20
|
|
|
|
|
104
|
my $base_path_off = ($struc_start + 16);
|
281
|
20
|
|
|
|
|
25
|
my $net_vol_off = ($struc_start + 20);
|
282
|
20
|
|
|
|
|
39
|
my $rem_path_off = ($struc_start + 24);
|
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
# Structure length
|
285
|
20
|
|
|
|
|
40
|
my $struc_len = $self->_read_unpack($struc_start, 4);
|
286
|
20
|
|
|
|
|
71
|
$struc_len = hex $self->_reverse_hex($struc_len);
|
287
|
20
|
|
|
|
|
41
|
my $struc_end = $struc_start + $struc_len;
|
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
# First offset after struct - Should be 1C under normal circumstances
|
290
|
20
|
|
|
|
|
68
|
my $first_off = $self->_read_unpack($first_off_off, 1);
|
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
# File location flags
|
293
|
20
|
|
|
|
|
88
|
my $vol_flags = $self->_read_unpack_bin($vol_flags_off, 1);
|
294
|
20
|
|
|
|
|
157
|
$vol_flags = substr $vol_flags, 0, 2;
|
295
|
20
|
|
|
|
|
56
|
my @vol_bits = (0, 0);
|
296
|
20
|
100
|
|
|
|
105
|
if ($vol_flags =~ /10/) {
|
297
|
8
|
|
|
|
|
21
|
$self->{target_type} = 'local';
|
298
|
8
|
|
|
|
|
37
|
$vol_bits[0] = 1;
|
299
|
8
|
|
|
|
|
19
|
$vol_bits[1] = 0;
|
300
|
|
|
|
|
|
|
}
|
301
|
|
|
|
|
|
|
# Haven't found this case yet...
|
302
|
20
|
100
|
|
|
|
83
|
if ($vol_flags =~ /01/) {
|
303
|
4
|
|
|
|
|
15
|
$self->{target_type} = 'network';
|
304
|
4
|
|
|
|
|
11
|
$vol_bits[0] = 0;
|
305
|
4
|
|
|
|
|
9
|
$vol_bits[1] = 1;
|
306
|
|
|
|
|
|
|
}
|
307
|
|
|
|
|
|
|
# But this one I did:
|
308
|
20
|
100
|
|
|
|
88
|
if ($vol_flags =~ /11/) {
|
309
|
8
|
|
|
|
|
28
|
$self->{target_type} = 'network';
|
310
|
8
|
|
|
|
|
12
|
$vol_bits[0] = 1;
|
311
|
8
|
|
|
|
|
21
|
$vol_bits[1] = 1;
|
312
|
|
|
|
|
|
|
}
|
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
# Local volume table
|
315
|
|
|
|
|
|
|
# Random garbage if bit0 is clear in volume flags
|
316
|
20
|
100
|
100
|
|
|
108
|
if ($vol_bits[0] == 1 and $vol_bits[1] == 0) {
|
317
|
|
|
|
|
|
|
# This is the offset of the local volume table within the
|
318
|
|
|
|
|
|
|
#File Info Location Structure
|
319
|
8
|
|
|
|
|
21
|
my $loc_vol_tab_off = $self->_read_unpack($local_vol_off, 4);
|
320
|
8
|
|
|
|
|
20
|
$loc_vol_tab_off = hex $self->_reverse_hex($loc_vol_tab_off);
|
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
# This is the asolute start location of the local volume table
|
323
|
8
|
|
|
|
|
17
|
my $loc_vol_tab_start = $loc_vol_tab_off + $struc_start;
|
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
# This is the length of the local volume table
|
326
|
8
|
|
|
|
|
22
|
my $local_vol_len = $self->_read_unpack(($loc_vol_tab_off + $struc_start), 4);
|
327
|
8
|
|
|
|
|
21
|
$local_vol_len = hex $self->_reverse_hex($local_vol_len);
|
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
# We now have enough info to
|
330
|
|
|
|
|
|
|
# Calculate the end of the local volume table.
|
331
|
8
|
|
|
|
|
14
|
my $local_vol_tab_end = $loc_vol_tab_start + $local_vol_len;
|
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
# This is the volume type
|
334
|
8
|
|
|
|
|
18
|
my $curr_tab_offset = $loc_vol_tab_off + $struc_start + 4;
|
335
|
8
|
|
|
|
|
21
|
my $vol_type = $self->_read_unpack($curr_tab_offset, 4);
|
336
|
8
|
|
|
|
|
24
|
$vol_type = hex $self->_reverse_hex($vol_type);
|
337
|
8
|
|
|
|
|
35
|
$self->{volume_type} = $map->{vol_type}->{$vol_type};
|
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
# Volume Serial Number
|
340
|
8
|
|
|
|
|
19
|
$curr_tab_offset = $loc_vol_tab_off + $struc_start + 8;
|
341
|
8
|
|
|
|
|
20
|
my $vol_serial = $self->_read_unpack($curr_tab_offset, 4);
|
342
|
8
|
|
|
|
|
21
|
$vol_serial = $self->_reverse_hex($vol_serial);
|
343
|
8
|
|
|
|
|
19
|
$self->{volume_serial} = $vol_serial;
|
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
# Get the location, and length of the volume label
|
346
|
|
|
|
|
|
|
# we should really read the vol_label_loc from offset Ch
|
347
|
8
|
|
|
|
|
16
|
my $vol_label_loc = $loc_vol_tab_off + $struc_start + 16;
|
348
|
8
|
|
|
|
|
24
|
my $vol_label_len = $local_vol_tab_end - $vol_label_loc;
|
349
|
8
|
|
|
|
|
27
|
my $vol_label = $self->_read_unpack_ascii($vol_label_loc, $vol_label_len);
|
350
|
8
|
|
|
|
|
36
|
$self->{volume_label} = $vol_label;
|
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
# This is the offset of the base path info within the
|
353
|
|
|
|
|
|
|
# File Info structure
|
354
|
|
|
|
|
|
|
# Random Garbage when bit0 is clear in volume flags
|
355
|
8
|
|
|
|
|
27
|
my $base_path_off = $self->_read_unpack($base_path_off, 4);
|
356
|
8
|
|
|
|
|
24
|
$base_path_off = hex $self->_reverse_hex($base_path_off);
|
357
|
8
|
|
|
|
|
14
|
$base_path_off = $struc_start + $base_path_off;
|
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
# Read base path data upto NULL term
|
360
|
8
|
|
|
|
|
23
|
my $bp_data = $self->_read_null_term($base_path_off);
|
361
|
8
|
|
|
|
|
19
|
$self->{base_path} = $bp_data;
|
362
|
8
|
100
|
|
|
|
31
|
if ($resolve) {
|
363
|
2
|
|
|
|
|
46
|
close $self->{_fh};
|
364
|
2
|
|
|
|
|
7
|
delete $self->{_fh};
|
365
|
2
|
|
|
|
|
17
|
return $self;
|
366
|
|
|
|
|
|
|
}
|
367
|
|
|
|
|
|
|
}
|
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
# Network Volume Table
|
370
|
18
|
100
|
66
|
|
|
79
|
if ($vol_bits[0] == 0 and $vol_bits[1] == 1) {
|
371
|
4
|
|
|
|
|
14
|
$net_vol_off = hex $self->_reverse_hex($self->_read_unpack($net_vol_off, 4));
|
372
|
4
|
|
|
|
|
9
|
$net_vol_off = $struc_start + $net_vol_off;
|
373
|
4
|
|
|
|
|
11
|
my $net_vol_len = $self->_read_unpack($net_vol_off, 4);
|
374
|
4
|
|
|
|
|
12
|
$net_vol_len = hex $self->_reverse_hex($net_vol_len);
|
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
# Network Share Name
|
377
|
4
|
|
|
|
|
9
|
my $net_share_name_off = $net_vol_off + 8;
|
378
|
4
|
|
|
|
|
11
|
my $net_share_name_loc = hex $self->_reverse_hex($self->_read_unpack($net_share_name_off, 4));
|
379
|
4
|
50
|
|
|
|
15
|
if ($net_share_name_loc ne "20") {
|
380
|
0
|
|
|
|
|
0
|
close delete $self->{_fh};
|
381
|
0
|
|
|
|
|
0
|
$self->{error} = 'Error: NSN ofset should always be 14h';
|
382
|
0
|
|
|
|
|
0
|
close $self->{_fh};
|
383
|
0
|
|
|
|
|
0
|
delete $self->{_fh};
|
384
|
0
|
|
|
|
|
0
|
return $self;
|
385
|
|
|
|
|
|
|
}
|
386
|
4
|
|
|
|
|
13
|
$net_share_name_loc = $net_vol_off + $net_share_name_loc;
|
387
|
4
|
|
|
|
|
13
|
my $net_share_name = $self->_read_null_term($net_share_name_loc);
|
388
|
4
|
|
|
|
|
12
|
$self->{base_path} = $net_share_name;
|
389
|
4
|
100
|
|
|
|
12
|
if ($resolve) {
|
390
|
1
|
|
|
|
|
24
|
close $self->{_fh};
|
391
|
1
|
|
|
|
|
5
|
delete $self->{_fh};
|
392
|
1
|
|
|
|
|
8
|
return $self;
|
393
|
|
|
|
|
|
|
}
|
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
# Mapped Network Drive Info
|
396
|
3
|
|
|
|
|
9
|
my $net_share_mdrive = $net_vol_off + 12;
|
397
|
3
|
|
|
|
|
10
|
$net_share_mdrive = $self->_read_unpack($net_share_mdrive, 4);
|
398
|
3
|
|
|
|
|
11
|
$net_share_mdrive = hex $self->_reverse_hex($net_share_mdrive);
|
399
|
3
|
50
|
|
|
|
10
|
if ($net_share_mdrive ne "0") {
|
400
|
3
|
|
|
|
|
6
|
$net_share_mdrive = $net_vol_off + $net_share_mdrive;
|
401
|
3
|
|
|
|
|
8
|
$net_share_mdrive = $self->_read_null_term($net_share_mdrive);
|
402
|
3
|
|
|
|
|
9
|
$self->{mapped_drive} = $net_share_mdrive;
|
403
|
|
|
|
|
|
|
}
|
404
|
|
|
|
|
|
|
}
|
405
|
|
|
|
|
|
|
|
406
|
17
|
100
|
100
|
|
|
97
|
if ($vol_bits[0] == 1 and $vol_bits[1] == 1) {
|
407
|
|
|
|
|
|
|
# Finding the location, as I'm not sure this is always 104
|
408
|
8
|
|
|
|
|
28
|
for my $i (1..10000) {
|
409
|
208
|
|
|
|
|
282
|
my $n = 4 * $i;
|
410
|
208
|
|
|
|
|
355
|
my $l = $self->_read_unpack($n, 4);
|
411
|
208
|
|
|
|
|
446
|
$l = hex $self->_reverse_hex($l);
|
412
|
208
|
|
|
|
|
304
|
my $net_share_name_off = $n + 8;
|
413
|
208
|
|
|
|
|
367
|
my $net_share_name_loc = hex $self->_reverse_hex($self->_read_unpack($net_share_name_off, 4));
|
414
|
208
|
100
|
|
|
|
466
|
if ($net_share_name_loc ne "20") {
|
415
|
200
|
|
|
|
|
355
|
next;
|
416
|
|
|
|
|
|
|
}
|
417
|
8
|
|
|
|
|
26
|
$net_vol_off = $n;
|
418
|
8
|
|
|
|
|
21
|
last;
|
419
|
|
|
|
|
|
|
}
|
420
|
|
|
|
|
|
|
|
421
|
8
|
|
|
|
|
22
|
my $net_vol_len = $self->_read_unpack($net_vol_off, 4);
|
422
|
8
|
|
|
|
|
26
|
$net_vol_len = hex $self->_reverse_hex($net_vol_len);
|
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
# Network Share Name
|
425
|
8
|
|
|
|
|
18
|
my $net_share_name_off = $net_vol_off + 8;
|
426
|
8
|
|
|
|
|
26
|
my $net_share_name_loc = hex $self->_reverse_hex($self->_read_unpack($net_share_name_off, 4));
|
427
|
8
|
50
|
|
|
|
36
|
if ($net_share_name_loc ne "20") {
|
428
|
0
|
|
|
|
|
0
|
close delete $self->{_fh};
|
429
|
0
|
|
|
|
|
0
|
$self->{error} = 'Error: NSN ofset should always be 14h';
|
430
|
0
|
|
|
|
|
0
|
close $self->{_fh};
|
431
|
0
|
|
|
|
|
0
|
delete $self->{_fh};
|
432
|
0
|
|
|
|
|
0
|
return $self;
|
433
|
|
|
|
|
|
|
}
|
434
|
8
|
|
|
|
|
21
|
$net_share_name_loc = $net_vol_off + $net_share_name_loc;
|
435
|
8
|
|
|
|
|
28
|
my $net_share_name = $self->_read_null_term($net_share_name_loc);
|
436
|
8
|
|
|
|
|
41
|
$self->{base_path} = $net_share_name;
|
437
|
8
|
100
|
|
|
|
24
|
if ($resolve) {
|
438
|
2
|
|
|
|
|
56
|
close $self->{_fh};
|
439
|
2
|
|
|
|
|
12
|
delete $self->{_fh};
|
440
|
2
|
|
|
|
|
29
|
return $self;
|
441
|
|
|
|
|
|
|
}
|
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
# Mapped Network Drive Info
|
444
|
6
|
|
|
|
|
12
|
my $net_share_mdrive = $net_vol_off + 12;
|
445
|
6
|
|
|
|
|
14
|
$net_share_mdrive = $self->_read_unpack($net_share_mdrive, 4);
|
446
|
6
|
|
|
|
|
17
|
$net_share_mdrive = hex $self->_reverse_hex($net_share_mdrive);
|
447
|
6
|
50
|
|
|
|
23
|
if ($net_share_mdrive ne "0") {
|
448
|
0
|
|
|
|
|
0
|
$net_share_mdrive = $net_vol_off + $net_share_mdrive;
|
449
|
0
|
|
|
|
|
0
|
$net_share_mdrive = $self->_read_null_term($net_share_mdrive);
|
450
|
0
|
|
|
|
|
0
|
$self->{mapped_drive} = $net_share_mdrive;
|
451
|
|
|
|
|
|
|
}
|
452
|
|
|
|
|
|
|
}
|
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
#Remaining Path
|
455
|
15
|
|
|
|
|
43
|
$rem_path_off = $self->_read_unpack($rem_path_off, 4);
|
456
|
15
|
|
|
|
|
37
|
$rem_path_off = hex $self->_reverse_hex($rem_path_off);
|
457
|
15
|
|
|
|
|
33
|
$rem_path_off = $struc_start + $rem_path_off;
|
458
|
15
|
|
|
|
|
36
|
my $rem_data = $self->_read_null_term($rem_path_off);
|
459
|
15
|
|
|
|
|
46
|
$self->{remaining_path} = $rem_data;
|
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
# The next starting location is the end of the structure
|
462
|
15
|
|
|
|
|
22
|
my $next_loc = $struc_end;
|
463
|
15
|
|
|
|
|
25
|
my $addnl_text;
|
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
# Description String
|
466
|
|
|
|
|
|
|
# present if bit2 is set in header flags.
|
467
|
15
|
50
|
|
|
|
74
|
if ($flag_bits[2] eq "1") {
|
468
|
0
|
|
|
|
|
0
|
($addnl_text, $next_loc) = $self->_add_info($next_loc);
|
469
|
0
|
|
|
|
|
0
|
$self->{description} = $addnl_text;
|
470
|
0
|
|
|
|
|
0
|
$next_loc = $next_loc + 1;
|
471
|
|
|
|
|
|
|
}
|
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
# Relative Path
|
474
|
15
|
50
|
|
|
|
60
|
if ($flag_bits[3] eq "1") {
|
475
|
0
|
|
|
|
|
0
|
($addnl_text, $next_loc) = $self->_add_info($next_loc);
|
476
|
0
|
|
|
|
|
0
|
$self->{relative_path} = $addnl_text;
|
477
|
0
|
|
|
|
|
0
|
$next_loc = $next_loc + 1;
|
478
|
|
|
|
|
|
|
}
|
479
|
|
|
|
|
|
|
# Working Dir
|
480
|
15
|
100
|
|
|
|
47
|
if ($flag_bits[4] eq "1") {
|
481
|
6
|
|
|
|
|
20
|
($addnl_text, $next_loc) = $self->_add_info($next_loc);
|
482
|
6
|
|
|
|
|
48
|
($self->{working_directory} = $addnl_text) =~ s/\x00//g;
|
483
|
6
|
|
|
|
|
16
|
$next_loc = $next_loc + 1;
|
484
|
|
|
|
|
|
|
}
|
485
|
|
|
|
|
|
|
# CMD Line
|
486
|
15
|
50
|
|
|
|
47
|
if ($flag_bits[5] eq "1") {
|
487
|
0
|
|
|
|
|
0
|
($addnl_text, $next_loc) = $self->_add_info($next_loc);
|
488
|
0
|
|
|
|
|
0
|
$self->{command_line} = $addnl_text;
|
489
|
0
|
|
|
|
|
0
|
$next_loc = $next_loc + 1;
|
490
|
|
|
|
|
|
|
}
|
491
|
|
|
|
|
|
|
#Icon filename
|
492
|
15
|
|
|
|
|
48
|
($addnl_text, $next_loc) = $self->_add_info($next_loc);
|
493
|
15
|
50
|
|
|
|
65
|
if ($flag_bits[6] eq "1") {
|
494
|
0
|
|
|
|
|
0
|
$self->{icon_filename} = $addnl_text;
|
495
|
|
|
|
|
|
|
}
|
496
|
15
|
|
|
|
|
397
|
close delete $self->{_fh};
|
497
|
15
|
|
|
|
|
159
|
$self;
|
498
|
|
|
|
|
|
|
}
|
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
sub _add_info {
|
501
|
21
|
|
|
21
|
|
36
|
my $self = shift;
|
502
|
21
|
|
|
|
|
46
|
my ($tmp_start_loc) = shift;
|
503
|
21
|
|
|
|
|
57
|
my $tmp_len = 2 * hex $self->_reverse_hex($self->_read_unpack($tmp_start_loc, 1));
|
504
|
21
|
|
|
|
|
42
|
$tmp_start_loc++;
|
505
|
21
|
100
|
|
|
|
59
|
if ($tmp_len ne "0") {
|
506
|
15
|
|
|
|
|
38
|
my $tmp_string = $self->_read_unpack_ascii($tmp_start_loc, $tmp_len);
|
507
|
15
|
|
|
|
|
33
|
my $now_loc = tell;
|
508
|
15
|
|
|
|
|
46
|
return ($tmp_string, $now_loc);
|
509
|
|
|
|
|
|
|
} else {
|
510
|
6
|
|
|
|
|
13
|
my $now_loc = tell;
|
511
|
6
|
|
|
|
|
12
|
my $tmp_string = 'Null';
|
512
|
6
|
|
|
|
|
28
|
return ($tmp_string, $now_loc);
|
513
|
|
|
|
|
|
|
}
|
514
|
|
|
|
|
|
|
}
|
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
sub _read_unpack {
|
517
|
781
|
|
|
781
|
|
1150
|
my $self = shift;
|
518
|
781
|
|
|
|
|
1214
|
my ($loc, $bites) = @_;
|
519
|
781
|
|
|
|
|
978
|
my $tmp_data;
|
520
|
781
|
50
|
|
|
|
8692
|
seek ($self->{_fh}, $loc, 0) or croak "Can't seek to $loc";
|
521
|
781
|
|
|
|
|
7099
|
read $self->{_fh}, $tmp_data, $bites;
|
522
|
781
|
|
|
|
|
2752
|
$tmp_data = unpack 'H*', $tmp_data;
|
523
|
781
|
|
|
|
|
2159
|
return $tmp_data;
|
524
|
|
|
|
|
|
|
}
|
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
sub _read_unpack_ascii {
|
527
|
23
|
|
|
23
|
|
36
|
my $self = shift;
|
528
|
23
|
|
|
|
|
44
|
my ($loc, $bites) = @_;
|
529
|
23
|
|
|
|
|
37
|
my $tmp_data;
|
530
|
23
|
50
|
|
|
|
257
|
seek ($self->{_fh}, $loc, 0) or croak "Can't seek to $loc\n";
|
531
|
23
|
|
|
|
|
230
|
read $self->{_fh}, $tmp_data, $bites;
|
532
|
23
|
|
|
|
|
105
|
$tmp_data = unpack 'A*', $tmp_data;
|
533
|
23
|
|
|
|
|
71
|
return $tmp_data;
|
534
|
|
|
|
|
|
|
}
|
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
sub _read_unpack_bin {
|
537
|
60
|
|
|
60
|
|
99
|
my $self = shift;
|
538
|
60
|
|
|
|
|
129
|
my ($loc, $bites) = @_;
|
539
|
60
|
|
|
|
|
86
|
my $tmp_data;
|
540
|
60
|
50
|
|
|
|
703
|
seek ($self->{_fh}, $loc, 0) or croak "Can't seek to $loc\n";
|
541
|
60
|
|
|
|
|
505
|
read $self->{_fh}, $tmp_data, $bites;
|
542
|
60
|
|
|
|
|
237
|
$tmp_data = unpack 'b*', $tmp_data;
|
543
|
60
|
|
|
|
|
170
|
return $tmp_data;
|
544
|
|
|
|
|
|
|
}
|
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
sub _MStime_to_unix {
|
547
|
60
|
|
|
60
|
|
112
|
my $self = shift;
|
548
|
60
|
|
|
|
|
90
|
my $mstime_dec = shift;
|
549
|
|
|
|
|
|
|
# The number of seconds between Unix/FILETIME epochs
|
550
|
60
|
|
|
|
|
74
|
my $MSConversion = '11644473600';
|
551
|
|
|
|
|
|
|
# Convert 100ms increments to Seconds.
|
552
|
60
|
|
|
|
|
211
|
$mstime_dec *= .0000001;
|
553
|
|
|
|
|
|
|
# Add difference in epochs
|
554
|
60
|
|
|
|
|
114
|
$mstime_dec -= $MSConversion;
|
555
|
60
|
|
|
|
|
682
|
sprintf '%0.3f', $mstime_dec;
|
556
|
|
|
|
|
|
|
}
|
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
sub _reverse_hex {
|
559
|
649
|
|
|
649
|
|
1028
|
my $self = shift;
|
560
|
649
|
|
|
|
|
801
|
my $HEXDATE = shift;
|
561
|
649
|
|
|
|
|
810
|
my @bytearry;
|
562
|
649
|
|
|
|
|
870
|
my $byte_cnt = 0;
|
563
|
649
|
100
|
|
|
|
1501
|
my $max_byte_cnt = length($HEXDATE) < 16 ? int(length($HEXDATE) / 2) : 8;
|
564
|
649
|
|
|
|
|
741
|
my $byte_offset = 0;
|
565
|
649
|
|
|
|
|
1182
|
while ($byte_cnt < $max_byte_cnt) {
|
566
|
2727
|
|
|
|
|
3940
|
my $tmp_str = substr $HEXDATE, $byte_offset, 2;
|
567
|
2727
|
|
|
|
|
3751
|
push @bytearry, $tmp_str;
|
568
|
2727
|
|
|
|
|
3057
|
$byte_cnt++;
|
569
|
2727
|
|
|
|
|
4336
|
$byte_offset += 2;
|
570
|
|
|
|
|
|
|
}
|
571
|
649
|
|
|
|
|
2021
|
return join '', reverse @bytearry;
|
572
|
|
|
|
|
|
|
}
|
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
sub _read_null_term {
|
575
|
38
|
|
|
38
|
|
54
|
my $self = shift;
|
576
|
38
|
|
|
|
|
51
|
my $loc = shift;
|
577
|
|
|
|
|
|
|
# Save old record seperator
|
578
|
38
|
|
|
|
|
99
|
my $old_rs = $/;
|
579
|
|
|
|
|
|
|
# Set new seperator to NULL term.
|
580
|
38
|
|
|
|
|
116
|
$/ = "\0";
|
581
|
38
|
50
|
|
|
|
438
|
seek ($self->{_fh}, $loc, 0) or die "Can't seek to $loc\n";
|
582
|
38
|
|
|
|
|
114
|
my $fh = $self->{_fh};
|
583
|
38
|
|
|
|
|
387
|
my $term_data = <$fh>;
|
584
|
38
|
100
|
|
|
|
158
|
chomp $term_data if $term_data;
|
585
|
|
|
|
|
|
|
# Reset
|
586
|
38
|
|
|
|
|
115
|
$/ = $old_rs;
|
587
|
38
|
|
|
|
|
95
|
return $term_data;
|
588
|
|
|
|
|
|
|
}
|
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
{
|
591
|
|
|
|
|
|
|
package Parse::Windows::Shortcut::Bigint;
|
592
|
2
|
|
|
2
|
|
1500
|
use bigint qw(hex);
|
|
2
|
|
|
|
|
11698
|
|
|
2
|
|
|
|
|
10
|
|
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
sub bighex {
|
595
|
60
|
|
|
60
|
|
103
|
my $v = shift;
|
596
|
60
|
|
|
|
|
1895
|
my $h = hex $v;
|
597
|
60
|
|
|
|
|
17252
|
$h.'';
|
598
|
|
|
|
|
|
|
}
|
599
|
|
|
|
|
|
|
}
|
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
=head1 SYNOPSIS
|
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
This module reads Win32 shortcuts (*.lnk files) to obtain the meta data in them.
|
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
Its goal is to be able to resolve the path they point to (along with other data),
|
607
|
|
|
|
|
|
|
from any platform/OS, without the need for depencencies.
|
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
Its use is very simple:
|
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
use Parse::Lnk;
|
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
my $data = Parse::Lnk->from($filename);
|
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
# $data is now a hashref if the file was parsed successfully.
|
616
|
|
|
|
|
|
|
# undef if not.
|
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
##########
|
619
|
|
|
|
|
|
|
# Or ... #
|
620
|
|
|
|
|
|
|
##########
|
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
use Parse::Lnk qw(parse_lnk);
|
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
my $data = parse_lnk $filename;
|
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
# $data is now a hashref if the file was parsed successfully.
|
627
|
|
|
|
|
|
|
# undef if not.
|
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
##########
|
630
|
|
|
|
|
|
|
# Or ... #
|
631
|
|
|
|
|
|
|
##########
|
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
use Parse::Lnk qw(resolve_lnk);
|
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
my $path = resolve_lnk $filename;
|
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
# $path is now a string with the path the lnk file points to.
|
638
|
|
|
|
|
|
|
# undef if the lnk file was not parsed successfully.
|
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
###############################################################
|
641
|
|
|
|
|
|
|
# Or, if you want a little more information/control on errors #
|
642
|
|
|
|
|
|
|
###############################################################
|
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
use Parse::Lnk;
|
645
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
my $lnk = Parse::Lnk->new;
|
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
$lnk->parse($filename) or die $lnk->{error};
|
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
# Or:
|
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
$lnk->parse($filename);
|
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
if ($lnk->{error}) {
|
655
|
|
|
|
|
|
|
# ... do your own error handling;
|
656
|
|
|
|
|
|
|
}
|
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
=head1 EXPORT
|
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
Nothing is exported by default. You can explicitly import this functions:
|
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
=head2 parse_lnk($filename)
|
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
This will return a Parse::Lnk instance, which is a hashref. The keys in that
|
668
|
|
|
|
|
|
|
hashref depend on the data that was parsed from the .lnk file.
|
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
It will return C on error.
|
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
use Parse::Lnk qw(parse_lnk);
|
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
my $lnk = parse_lnk $filename;
|
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
if ($lnk) {
|
677
|
|
|
|
|
|
|
print "$filename points to path $lnk->{base_path}\n";
|
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
my $create_date = localtime $lnk->{create_time};
|
680
|
|
|
|
|
|
|
print "$filename was created on $create_date";
|
681
|
|
|
|
|
|
|
} else {
|
682
|
|
|
|
|
|
|
print "Could not parse $filename";
|
683
|
|
|
|
|
|
|
}
|
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
=head2 resolve_lnk($filename)
|
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
This will return the path the .lnk file is pointing to.
|
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
It will return C on error.
|
690
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
use Parse::Lnk qw(resolve_lnk);
|
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
my $path = resolve_lnk $filename;
|
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
if ($path) {
|
696
|
|
|
|
|
|
|
print "$filename points to path $path";
|
697
|
|
|
|
|
|
|
} else {
|
698
|
|
|
|
|
|
|
print "Could not parse $filename";
|
699
|
|
|
|
|
|
|
}
|
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
=head1 METHODS
|
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
You can create a C instance and call a few methods on it. This
|
705
|
|
|
|
|
|
|
may give you more control/information when something goes wrong while parsing
|
706
|
|
|
|
|
|
|
the file.
|
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
=head2 new
|
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
This creates a new instance. You can pass the C value as argument,
|
711
|
|
|
|
|
|
|
or you can set/change it later.
|
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
use Parse::Lnk;
|
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
my $lnk = Parse::Lnk->new(filename => $filename);
|
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
# or
|
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
my $lnk = Parse::Lnk->new;
|
720
|
|
|
|
|
|
|
$lnk->{filename} = $filename;
|
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
=head2 parse
|
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
This method will parse the current C in the instance. You can change
|
725
|
|
|
|
|
|
|
the value of C and parse again at any point.
|
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
use Parse::Lnk;
|
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
my $lnk = Parse::Lnk->new(filename => $filename);
|
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
$lnk->parse;
|
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
if ($lnk->{error}) {
|
734
|
|
|
|
|
|
|
# handle the error
|
735
|
|
|
|
|
|
|
} else {
|
736
|
|
|
|
|
|
|
print "$filename points to $lnk->{base_path}";
|
737
|
|
|
|
|
|
|
}
|
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
for my $other_filename (@filenames) {
|
740
|
|
|
|
|
|
|
$lnk->{filename} = $other_filename;
|
741
|
|
|
|
|
|
|
$lnk->parse;
|
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
if ($lnk->{error}) {
|
744
|
|
|
|
|
|
|
# handle the error
|
745
|
|
|
|
|
|
|
next;
|
746
|
|
|
|
|
|
|
}
|
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
print "$other_filename points to $lnk->{base_path}";
|
749
|
|
|
|
|
|
|
}
|
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
=head2 from
|
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
It will return a C instance, or undef on error. This method was
|
754
|
|
|
|
|
|
|
written with plain package name calling in mind:
|
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
use Parse::Lnk;
|
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
my $lnk = Parse::Lnk->from($filename);
|
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
if ($lnk) {
|
761
|
|
|
|
|
|
|
print "$filename points to path $lnk->{base_path}\n";
|
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
my $create_date = localtime $lnk->{create_time};
|
764
|
|
|
|
|
|
|
print "$filename was created on $create_date";
|
765
|
|
|
|
|
|
|
} else {
|
766
|
|
|
|
|
|
|
print "Could not parse $filename";
|
767
|
|
|
|
|
|
|
}
|
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
=head1 AUTHOR
|
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
Francisco Zarabozo, C<< >>
|
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
=head1 BUGS
|
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
I'm sure there are many. I haven't found bugs with the lnk files I've tested
|
777
|
|
|
|
|
|
|
it. If you find a bug or you have a problem reading a shortcut/lnk file,
|
778
|
|
|
|
|
|
|
please don't hesitate to report it and don't forget to include the file in
|
779
|
|
|
|
|
|
|
question. If you are on Windows, you will have to zip the file in a way that
|
780
|
|
|
|
|
|
|
is the lnk file the one being zipped and not the actual directory/file it
|
781
|
|
|
|
|
|
|
is pointing to. I promise to look at any report and work on a solution as
|
782
|
|
|
|
|
|
|
fast as I can.
|
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
Please report any bugs or feature requests to C, or through
|
785
|
|
|
|
|
|
|
the web interface at L. I will be notified, and then you'll
|
786
|
|
|
|
|
|
|
automatically be notified of progress on your bug as I make changes.
|
787
|
|
|
|
|
|
|
|
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
=head1 SUPPORT
|
790
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command.
|
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
perldoc Parse::Lnk
|
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
You can also look for information at:
|
797
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
=over 4
|
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here)
|
801
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
L
|
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation
|
805
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
L
|
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
=item * CPAN Ratings
|
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
L
|
811
|
|
|
|
|
|
|
|
812
|
|
|
|
|
|
|
=item * Search CPAN
|
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
L
|
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
=back
|
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS
|
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT
|
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
This software is copyright (c) 2021 by Francisco Zarabozo.
|
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under
|
827
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself.
|
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
=cut
|
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
1;
|