Difference between revisions of "PERL-Shortcuts"

Latest revision as of 02:54, 23 April 2020

Legacy: This article describes a concept that has been superseded in the course of ongoing development on the Organic Design wiki. Please do not develop this any further or base work on this concept, this is only useful for a historic record of work done. You may find a link to the currently used concept or function in this article, if not you can contact the author to find out what has taken the place of this legacy item.
#!/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;
	}
@@ Line 1: / Line 1: @@
+{{legacy}}
+<source lang="perl">
 #!/usr/bin/perl
-# PLANS{{perl}}
+# PLANS
 # =====
 # Renaming, global-naming, merging etc
@@ Line 282: / Line 284: @@
 	return $dump;
 	}
+</source>
+[[Category:PERL]]
Difference between revisions of "PERL-Shortcuts"

Latest revision as of 02:54, 23 April 2020

Navigation menu

Views

Personal tools

Navigation

Search

Navigation

Blogs

Recent activity

Site map

Tools
