PERL-Shortcuts
From Organic Design wiki
#!/usr/bin/perl
# PLANS
# =====
# Renaming, global-naming, merging etc
# Repairing (broken links and re-locating)
# Could update the copy-contacts script to follow shortcuts properly
# Later add to the PERL-NW allowing either cmd or bg
# Add generic nodal layer (atts-array and name with migration/"casting" rules)
# Add spreadsheet parsing
# ======================================================================================================================= #
sub createShortcut;
sub readShortcut;
sub quadNullString;
sub intToDWord;
sub intToWord;
sub scanTree;
sub searchTree;
sub dumpShortcut;
# ======================================================================================================================= #
# Create a shortcut file
sub createShortcut {
($shortcut, $target, $description) = shift;
#PHP: if (!ereg("^([A-Za-z]):[\\](.+)$",$target,$m)) return;
return unless $target =~ /^([a-z]):[\\](.+)$/i;
$drive = $1;
$target = $2;
# 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
# 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
# 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";
# 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
# Description String
$lnk .= intToWord(length $description); # Length of string
$lnk .= $description;
# Extra
$lnk .= "\x00\x00\x00\x00"; # End
# Write shortcut to file
open FH, '>', $shortcut;
print FH $lnk;
close FH;
}
# 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);
}
# else if (substr($descrip,0,1)=="[") {
# # one of ours
# $target=$root.substr($descrip,1,strlen($descrip)-2);
# print "Ours - $target\n";
# }
$ptr+=4;
}
if ($target=='') {
# It's not one of ours - just extract all strings and pick best
# preg_match_all("/[ ^!@$^&\\[\\]()\\-_\\\\\\/+=~,.{}0-9a-zA-Z]{4,}\\x00/",$bin,$m);
# foreach ($m[0] as $n) {
# $n=str_replace("\x00","",$n);
# if (ereg(":",$n)) {if (ereg("^.:",$n)) $target.=$n;}
# else if (ereg("\\\\",$n)&&!ereg("\\\\\\\\",$n)) $target.=$n;
# }
}
# Validate extracted info
if ($target=='') {
print "\n<b>Couldn't extract target from $shortcut</b>\n";
# foreach ($m[0] as $n) print "$n\n";
}
# else if (!file_exists($target)) {
# #print "\n<b>Broken link found:</b>\n$shortcut\n-->$target\n";
# # Attempt to repair broken link
# if (ereg("(\\\\[^\\\\]+\\\\[^\\\\]+)$",$target,$m)) {
# if (file_exists($ROOT.$m[1])) {
# $target=str_replace("/","\\",$target);
# print "Repairing:$target\n";
# print $target;
# createShortcut("$ROOT$shortcut",$target,'['.$m[1].']');
# }
# }
# }
return $target;
}
#########################################################################################################################
# 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);
}
# Recursively scan dir structure and apply house-keeping rules
sub scanTree {
$dir = shift;
global $ROOT;
# if ($handle = opendir("$ROOT$dir")) {
# while (false !== ($name = readdir($handle))) {
# unless ($name =~ /^[.]/) {
# scanTree("$dir/$name") if is_dir("$dir/$name");
# echo "$dir/$name\n";
# readShortcut("$dir/$name") if (ereg('.lnk$',$name));
# }
# }
# }
closedir($handle);
}
# Recursively search structure for a file
sub searchTree {
($dir, $target) = shift;
global $ROOT;
$target = uc $target;
# if ($handle = opendir("$ROOT$dir")) {
# while (false !== ($name = readdir($handle))) {
# if ($target eq uc $name)) {
# closedir($handle);
# return "$dir$name";
# }
# else if ($name!='.'&&$name!='..'&&is_dir("$ROOT$dir$name"))
# if ($name=searchTree("$dir$name/",$target)) {
# closedir($handle);
# return $name;
# }
# }
# }
#closedir($handle);
return false;
}
#########################################################################################################################
# SHORTCUT DEBUGGING FUNCTIONS
# 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;
}
