PERL-Shortcuts

1. !/usr/bin/perl

1. PLANSOur Perl scripts.
2. =====
3. Renaming, global-naming, merging etc
4. Repairing (broken links and re-locating)
5. Could update the copy-contacts script to follow shortcuts properly

1. Later add to the PERL-NW allowing either cmd or bg

1. Add generic nodal layer (atts-array and name with migration/"casting" rules)

1. Add spreadsheet parsing

1. ======================================================================================================================= #

sub createShortcut; sub readShortcut; sub quadNullString; sub intToDWord; sub intToWord; sub scanTree; sub searchTree; sub dumpShortcut;

1. ======================================================================================================================= #

1. Create a shortcut file

sub createShortcut { ($shortcut, $target, $description) = shift;

1. PHP: if (!ereg("^([A-Za-z]):[\\](.+)$",$target,$m)) return;

return unless $target =~ /^([a-z]):[\\](.+)$/i; $drive = $1; $target = $2;

1. Create shortcut data structure

$lnk = "\x4c\x00\x00\x00"; # L $lnk .= "\x01\x14\x02\x00\x00\x00\x00\x00\xc0\x00\x00\x00\x00\x00\x00\x46"; # GUID $lnk .= "\x07\x00\x00\x00"; # Flags (bits: 0=itemlist 1=file/folder 2=description 3=relative path) $lnk .= "\x10\x00\x00\x00"; # File attributes $lnk .= "\x00\x00\x00\x00\x00\x00\x00\x00"; # Time 1 $lnk .= "\x00\x00\x00\x00\x00\x00\x00\x00"; # Time 2 $lnk .= "\x00\x00\x00\x00\x00\x00\x00\x00"; # Time 3 $lnk .= "\x00\x00\x00\x00"; # File length $lnk .= "\x00\x00\x00\x00"; # Icon number $lnk .= "\x01\x00\x00\x00"; # normal window $lnk .= "\x00\x00\x00\x00"; # Hotkey $lnk .= "\x00\x00\x00\x00"; # reserved $lnk .= "\x00\x00\x00\x00"; # reserved

1. Item id list (just copy dump for now)

$lnk .= intToWord(0x3e + length $target);

$lnk .= "\x14\x00"; # First item (?) $lnk .= "\x1f\x0f\xe0\x4f"; $lnk .= "\xd0\x20\xea\x3a"; $lnk .= "\x69\x10\xa2\xd8"; $lnk .= "\x08\x00\x2b\x30"; $lnk .= "\x30\x9d";

$lnk .= "\x19\x00"; $lnk .= "\x23$drive\x3a\x5c"; #Drive $lnk .= "\x00\x00\xb0\x0c"; $lnk .= "\xc1\x00\x00\x00"; $lnk .= "\x00\x00\x50\x42"; $lnk .= "\x42\x00\x00\x00"; $lnk .= "\x00\x71\x65";

$lnk .= intToWord(0xf + length $target); $lnk .= "\x31\x00\x00\x00"; $lnk .= "\x00\x00\x56\x31"; $lnk .= "\xf2\x2c\x10\x00"; $lnk .= "$target\x00"; #Path

$lnk .= "\x00\x00";

$lnk .= "\x30\x00\x00\x00"; # Offset to description

1. File location info (offsets are from start of this struct)

$lnk .= "\x2c\x00\x00\x00"; # Total length $lnk .= "\x1c\x00\x00\x00"; # this blocks length (always &1c) $lnk .= "\x01\x00\x00\x00"; # Flags (local volume only) $lnk .= "\x1c\x00\x00\x00"; # Offset to local volume table $lnk .= "\x00\x00\x00\x00"; $lnk .= "\x00\x00\x00\x00"; # Offset to network volume table $lnk .= "\x00\x00\x00\x00";

1. Local volume table

$lnk .= "\x18\x00\x00\x00"; # Length of table $lnk .= "\x03\x00\x00\x00"; # fixed disk $lnk .= "\x00\x00\x00\x00"; # Volume serial $lnk .= "\x00\x00\x00\x00"; # Offset to volume label

1. Description String

$lnk .= intToWord(length $description); # Length of string $lnk .= $description;

1. Extra

$lnk .= "\x00\x00\x00\x00"; # End

1. Write shortcut to file

open FH, '>', $shortcut; print FH $lnk; close FH; }

1. Extract target informaton from a shortcut

sub readShortcut { $shortcut = shift; global $ROOT;

# Read in shortcut binary file $bin=implode(,file("$ROOT$shortcut")); $target=;

# Count blocks in item_id_list $ptr=0x4e; $len=1; while ($len>0) { $len=ord(substr($bin,$ptr,1))+256*ord(substr($bin,$ptr+1,1)); $ptr+=$len; } $ptr+=2;

$descrip=; $flags=ord(substr($bin,0x14,1)); if ($flags&4) { $doffset=ord(substr($bin,$ptr,1))+256*ord(substr($bin,$ptr+1,1)); $dptr=$ptr+$doffset; $dlen=ord(substr($bin,$dptr,1))+256*ord(substr($bin,$dptr+1,1)); $descrip=substr($bin,$dptr+2,$dlen); # test if fatware's mangled it and return with target hacked from description - fuckin fatware! if (substr($descrip,0,2)=="[\x00") { $descrip=substr($bin,$dptr+3,$dlen*2-4); $target=$ROOT.str_replace("\x00","",$descrip); }

1. else if (substr($descrip,0,1)=="[") {
2. # one of ours
3. $target=$root.substr($descrip,1,strlen($descrip)-2);
4. print "Ours - $target\n";
5. }

$ptr+=4; }

if ($target==) { # It's not one of ours - just extract all strings and pick best

1. preg_match_all("/[ ^!@$^&\\[\\]()\\-_\\\\\\/+=~,.{}0-9a-zA-Z]{4,}\\x00/",$bin,$m);
2. foreach ($m[0] as $n) {
3. $n=str_replace("\x00","",$n);
4. if (ereg(":",$n)) {if (ereg("^.:",$n)) $target.=$n;}
5. else if (ereg("\\\\",$n)&&!ereg("\\\\\\\\",$n)) $target.=$n;
6. }

}

# Validate extracted info if ($target==) { print "\nCouldn't extract target from $shortcut\n";

1. foreach ($m[0] as $n) print "$n\n";

}

1. else if (!file_exists($target)) {
2. #print "\nBroken link found:\n$shortcut\n-->$target\n";
3. # Attempt to repair broken link
4. if (ereg("(\\\\[^\\\\]+\\\\[^\\\\]+)$",$target,$m)) {
5. if (file_exists($ROOT.$m[1])) {
6. $target=str_replace("/","\\",$target);
7. print "Repairing:$target\n";
8. print $target;
9. createShortcut("$ROOT$shortcut",$target,'['.$m[1].']');
10. }
11. }
12. }

return $target; }

2. UTILITY FUNCTIONS

sub quadNullString { $s = shift; $l = 1 + length $s; if (($nulls = ($l%4)) > 0) {$nulls = 4-$nulls} #return $s.str_repeat("\x00", $nulls+1); }

sub intToDWord { $i = shift; return chr($i&0xff).chr(($i&0xff00)>>8).chr(($i&0xff0000)>>16).chr(($i&0xff000000)>>24); }

sub intToWord { $i = shift; return chr($i&0xff).chr(($i&0xff00)>>8); }

1. Recursively scan dir structure and apply house-keeping rules

sub scanTree { $dir = shift; global $ROOT;

1. if ($handle = opendir("$ROOT$dir")) {
2. while (false !== ($name = readdir($handle))) {
3. unless ($name =~ /^[.]/) {
4. scanTree("$dir/$name") if is_dir("$dir/$name");
5. echo "$dir/$name\n";
6. readShortcut("$dir/$name") if (ereg('.lnk$',$name));
7. }
8. }
9. }

closedir($handle); }

1. Recursively search structure for a file

sub searchTree { ($dir, $target) = shift; global $ROOT; $target = uc $target;

1. if ($handle = opendir("$ROOT$dir")) {
2. while (false !== ($name = readdir($handle))) {
3. if ($target eq uc $name)) {
4. closedir($handle);
5. return "$dir$name";
6. }
7. else if ($name!='.'&&$name!='..'&&is_dir("$ROOT$dir$name"))
8. if ($name=searchTree("$dir$name/",$target)) {
9. closedir($handle);
10. return $name;
11. }
12. }
13. }

#closedir($handle); return false; }

2. SHORTCUT DEBUGGING FUNCTIONS

1. Debugging - dump shortcut files

sub dump { $hex = shift; $dump = ; $o = 0; for ($i = 0; $i < length $hex;) {

$d=dechex($i);if (length $d == 1) {$dump .= "000$d : "} else {$dump .= "00$d : "}

$d1=dechex(ord(substr($hex,$i++,1))); if (strlen($d1)==1) $dump.="0$d1"; else $dump.="$d1"; $d2=dechex(ord(substr($hex,$i++,1))); if (strlen($d2)==1) $dump.="0$d2"; else $dump.="$d2"; $d3=dechex(ord(substr($hex,$i++,1))); if (strlen($d3)==1) $dump.="0$d3"; else $dump.="$d3"; $d4=dechex(ord(substr($hex,$i++,1))); if (strlen($d4)==1) $dump.="0$d4"; else $dump.="$d4";

$dump.=' : '; $d1=hexdec($d1); $d2=hexdec($d2); $d3=hexdec($d3); $d4=hexdec($d4); if ($d1<32||$d1>126) {$dump .= '.'} else {$dump .= chr($d1)} if ($d2<32||$d2>126) {$dump .= '.'} else {$dump .= chr($d2)} if ($d3<32||$d3>126) {$dump .= '.'} else {$dump .= chr($d3)} if ($d4<32||$d4>126) {$dump .= '.'} else {$dump .= chr($d4)}

# Output comments with shortcut dump if ($i==4) {$dump .= " L\n"} elsif ($i==8) {$dump .= " GUID"} elsif ($i==20) {$dump .= "\n"} elsif ($i==24) {$dump .= " Flags\n"} elsif ($i==28) {$dump .= " File Attributes\n"} elsif ($i==32) {$dump .= " Time Stamps"} elsif ($i==52) {$dump .= "\n"} elsif ($i==56) {$dump .= " File Length\n"} elsif ($i==60) {$dump .= " Icon Number\n"} elsif ($i==64) {$dump .= " Window State\n"} elsif ($i==68) {$dump .= " Hotkey\n"} elsif ($i==72) {$dump .= " Reserved"} elsif ($i==0x50) {$dump .= " (Skipping Item ID List)\n\nFile Location Block:"; #$o+=$d1-2; $i+=$o; # skip item id list } elsif ($i==0x54+$o) {$dump .= " ???\n"} elsif ($i==0x58+$o) {$dump .= " Length of this structure\n"} elsif ($i==0x5c+$o) {$dump .= " Flags\n"} elsif ($i==0x60+$o) {$dump .= " Offset to LVtab\n"} elsif ($i==0x64+$o) {$dump .= " Offset to local Path\n"}

$dump .= " \n\n";

} return $dump; }