Difference between revisions of "PERL-Shortcuts"

From Organic Design wiki
({{perl}})
m
Line 1: Line 1:
 +
<source lang="perl">
 
#!/usr/bin/perl
 
#!/usr/bin/perl
  
−
# PLANS{{perl}}
+
# PLANS
 
# =====
 
# =====
 
# Renaming, global-naming, merging etc
 
# Renaming, global-naming, merging etc
Line 282: Line 283:
 
return $dump;
 
return $dump;
 
}
 
}
 +
</source>
 +
[[Category:PERL]]

Revision as of 02:54, 23 April 2020

#!/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--&gt;$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;
	}
Retrieved from "https://organicdesign.nz/wiki/index.php?title=PERL-Shortcuts&oldid=127893"