User Functions Exchange

Discuss and share scripts and script files...
admin
Site Admin
Posts: 47703
Joined: 22 May 2004 16:48
Location: Cologne, Win 8.1, Win 10
Contact:

Re: User Functions Exchange

Post by admin » 23 Feb 2016 16:13

Hot shit! :appl:

klownboy
Posts: 2792
Joined: 28 Feb 2012 19:27

Re: User Functions Exchange

Post by klownboy » 23 Feb 2016 19:11

Wow, talk about automation. That is really cool Sammay. :tup:

totmad1
Posts: 131
Joined: 24 Jun 2013 12:37

Re: User Functions Exchange

Post by totmad1 » 24 Feb 2016 17:27

Please note; requires previous posted function RepTokenPos
returns sorted list.
SelSortList()

Code: Select all

 FUNCTION SelSortList($string, $sep){
      //    function to sort list using Selection Sort
      //     (there are other sorts but this one is stable and
      //    quick. only drawback for small lists max 50 items)
      //  PLEASE Note uses previous posted function RepTokenPos
	$num=gettoken($string, "count", $sep) ;
	while ($i<=$num -1) {
	$Min=$i;
	$j=$i+1;
  	while ($j<=$num) {
	$res=gettoken( $string, $j, $sep);
	$res1=gettoken( $string, $Min, $sep);
	if( $res < $res1) { $Min=$j}
        $j++;
  	}
  	if( $i UnLikeI $Min) {
	$res=gettoken( $string, $i, $sep);
	$res1=gettoken( $string, $Min, $sep);
	// swap
        $string=RepTokenPos($string, $res, $Min, $sep) ;
        $string=RepTokenPos($string, $res1, $i, $sep);
  	}
        $i++;
	}
        return $string;}
Examples
assuming the functions are saved in <xyscripts>\inc\RepTokenPos.xyi
<xyscripts>\inc\SelSortList.xyi

Code: Select all

INCLUDE 'inc\RepTokenPos.xyi'
INCLUDE 'inc\SelSortList.xyi'

	$a="20|19|22|21|22|21|19|20|17|19"; $sp1="|";
	$d=SelSortList($a, $sp1);
	text $d;  // 17|19|19|19|20|20|21|21|22|22
totmad1 (totally mad one)

SammaySarkar
Posts: 4205
Joined: 12 Mar 2014 17:27
Location: Asteroid B-612 / Dhaka
Contact:

Re: User Functions Exchange

Post by SammaySarkar » 24 Feb 2016 17:38

The same functionality already exists as formatlist().

Code: Select all

 $a="20|19|22|21|22|21|19|20|17|19"; $sp1="|";
 text formatlist($a,'ns');

highend
Posts: 8304
Joined: 06 Feb 2011 00:33

Re: User Functions Exchange

Post by highend » 24 Feb 2016 17:43

@totmad1

I haven't studied your algorithm extensively but isn't this one a bit shorter and (naturally) a lot faster?

Code: Select all

function SelSortList($string, $sep="|", $direction="a") {
    $sort = ($direction UnLikeI "d") ? "s" : "r";
    return formatlist($string, $sort, $sep);
}

    $a = "20|19|22|21|22|21|19|20|17|19";

    text SelSortList($a);
$direction = a (ascending), d (descending), if neither a or d -> ascending by default
One of my scripts helped you out? Please donate via Paypal or highend (at) web (dot) de

totmad1
Posts: 131
Joined: 24 Jun 2013 12:37

Re: User Functions Exchange

Post by totmad1 » 25 Feb 2016 21:04

Sorry for taking so long to answer but very busy at moment.
In response to both your posts, it just shows there's always
more than one way to skin a cat. They both have there uses.
When I wrote the function it was an end to a means.
The speed wasn't top of my list, ease of converting from
other programming languages was.
I knew of "formatlist" but know it can't return which tokens
are moved , which would have been the next stage.
I must admit that I did post to see if it would produce an
idea for further uses.
Further ideas are to work on key=value ways to sort values.
Wether that makes sense, I'm not sure.
Another thread is key=(a,b,c) arrays or even (a,b,c,)as
token in lists.
totmad1 (totally mad one)

highend
Posts: 8304
Joined: 06 Feb 2011 00:33

Re: User Functions Exchange

Post by highend » 25 Feb 2016 21:57

(associative) arrays is something that should be provided by XY natively (for performance reasons) but this has been wish for ... quite some time :)
One of my scripts helped you out? Please donate via Paypal or highend (at) web (dot) de

totmad1
Posts: 131
Joined: 24 Jun 2013 12:37

Re: User Functions Exchange

Post by totmad1 » 13 Mar 2016 01:14

A related function which maybe useful. It uses a previous function posted called "RepTokenPos".

Code: Select all

FUNCTION swapkeyvalue($string, $sep, $keyvalsep){
          set $d;
       foreach( $item, $string, $sep){
       $key= gettoken($item, 1, $keyvalsep);
       $value=gettoken($item, 2, $keyvalsep);
        $item=RepTokenPos($item, $key, 2, $keyvalsep) ;
        $item=RepTokenPos($item, $value, 1, $keyvalsep);
       $d="$d$item$sep";
        }
        $string=$d;
       return $string;}
I have a script which uses this function twice, once before a sort then to swap back.
This was ("revealed") to me by an accident / purposeful act, on my part.

If you use this function to swap "key value" to "value key" and then "formatlist" and then swap back, it seems to work.
I did try to sort with max first, using "formatlist" "nr" but it did not work, tried to alter my sort function but not clever enough. Maybe someone can come up with complete answer to this problem.
I am hopeful that this function can be useful.
totmad1 (totally mad one)

highend
Posts: 8304
Joined: 06 Feb 2011 00:33

Re: User Functions Exchange

Post by highend » 13 Mar 2016 02:09

@totmad1

1. Please use proper formatting for your scripts (e.g. indentation). Terrible to read...
2. When you need help with scripting provide at least one example (with "real" data) where something goes wrong
a.) Show what the function accepts as valid input data
b.) Show the expected output

How I would create a key / value swapper function:

Code: Select all

    $str = "Dog:Frank;Cat:Steven;;Building:House";
    text SwapKeyValue($str, ";", ":");

    function SwapKeyValue($pairs, $sep, $keyvalsep) {
        $result = "";
        foreach($pair, $pairs, $sep) {
            $val = gettoken($pair, 1, $keyvalsep);
            $key = gettoken($pair, 2, $keyvalsep);
            $result = $result . $key . (($pair != "") ? $keyvalsep : "") . $val . $sep;
        }
        return trim($result, $sep, "R");
    }

Depening on what input data is delivered it isn't perfect (e.g. it would strip more than one separators from the end if you have multiple empty items in your source string. Could easily be countered with a regexreplace but it would need proper escaping of the character to remove...
Empty values inside the string are handled correctly though
One of my scripts helped you out? Please donate via Paypal or highend (at) web (dot) de

SammaySarkar
Posts: 4205
Joined: 12 Mar 2014 17:27
Location: Asteroid B-612 / Dhaka
Contact:

Re: User Functions Exchange

Post by SammaySarkar » 13 Mar 2016 05:27

highend wrote:Please use proper formatting for your scripts (e.g. indentation). Terrible to read...
The username is "totally mad one"... :mrgreen:

SammaySarkar
Posts: 4205
Joined: 12 Mar 2014 17:27
Location: Asteroid B-612 / Dhaka
Contact:

Re: User Functions Exchange

Post by SammaySarkar » 08 Sep 2016 20:05

varsize()

Code: Select all

varsize($var)
Returns the raw byte count of a variable's value.
    $var    The variable to measure.


FUNCTION CODE

Code: Select all

FUNCTION varsize(&$var){
  /* calculate byte size of a variable
  ** $var   the variable to measure */
  $r = gettoken(hexdump($var,,'r'), 'count', ' ');
  return ($r==0)?$r:$r-1;
}
Examples
assuming the function is saved in <xyscripts>\inc\varsize.xyi

Code: Select all

INCLUDE 'inc\varsize.xyi'
"varsize() test"
  $a = '0';
  echo varsize($a);
  $d = readfile(<xyini>);
  echo varsize($d);
  echo varsize(readfile(<xyini>,'b'));
Notes
There's a subraction of 1 from the return, because hexdump returns non-empty hex values with a space at the end, adding 1 to the token count found with gettoken.

SammaySarkar
Posts: 4205
Joined: 12 Mar 2014 17:27
Location: Asteroid B-612 / Dhaka
Contact:

Re: User Functions Exchange

Post by SammaySarkar » 08 Oct 2016 08:38

regread()

Code: Select all

regread($value, $path, $bit=32, $esc=1, $typed=0)
Returns the data and optionally type of a registry value.
    $value   name of the value.
                   set empty to get the (Default) value.
    $path    path to the value.
    $bit      denote registry bitness
                   32 OR 0:  use 32bit registry (default)
                   64 OR 1:  use 64bit registry
    $esc     escaping of '\' in value name (converted to '\\')
                   1:  enabled (default)
                   0:  disabled
    $typed    return of data type
                   1: yes, return datatype with data
                   0: no, return only data

Returns Type|Data if $typed is 1, else returns just Data.
In case of errors, Type is set to 'ERROR' (probably localized).

FUNCTION CODE

Code: Select all

function regread($value, $path, $bit=32, $esc=1, $typed=0) {
/*basic function to find the type and data of a local registry value
**  $value   name of the value.
**             set empty to get the (Default) value.
**  $path    path to the value.
**  $bit     denote registry bitness
**             32 OR 0:  use 32bit registry (default)
**             64 OR 1:  use 64bit registry
**  $esc     escaping of '\' in value name (converted to '\\')
**             1:  enabled (default)
**             0:  disabled
**  $typed    return of data type
**             1: yes, return datatype with data
**             0: no, return only data
**  Returns Type|Data if $typed is 1, else returns just the Data.
**In case of errors, Type is set to 'ERROR' (probably localized).
*/
  $path = trim($path, "\");
  if ($esc) {
    $rawval = $value;
    $value  = replace($value, '\', '\\');
  } else {
    $rawval = replace($value, '\\', '\');
  }

  $bit  = ($bit==1)||($bit==64)?64:32;

  $data = runret("%ComSpec% /c reg QUERY ""$path"" "
                 ."/v".(($value)?" ""$value""":"e").
                 .((%OSBITNESS%==32)?"":" /reg:$bit")
                 ." && echo 0 || echo 1" // basic success/failure detection
                 , "%WINDIR%");
  $data = trim($data, "<crlf> ", "R");

  if !($data) {return 'ERROR|Nothing returned.';}
  if (gettoken($data, -1, <crlf>)==1){
    return replace(trim($data,"<crlf>1".chr(13),'R'), ': ', "|",,, 1); // return error
  }
  $s    = '    '; // 4-space separator in data fields
  $data = gettoken($data, 2, <crlf>,, 2);  //strip keyname line
  $data = replace($data, $s.$rawval.$s,,, 1);  // remove value name tab
  $type = ($typed==1)?gettoken($data, 1, $s).'|':"";  //get type
  $data = gettoken($data, 2, $s,, 2);  //get the data
  $data = replace($data, "<crlf 2>0");  //cleanup
  return  $type.$data;
}
Examples
assuming the function is saved in <xyscripts>\inc\regread.xyi

Code: Select all

INCLUDE 'inc\regread.xyi'
"regread() test"
  echo regread("PATH", "HKCU\Environment");
  echo regread("PATH", "HKCU\Environment",,, 1);
  echo regread("Path", "HKLM\Software\7-Zip", 64);
ed. returning type is optional now.

SammaySarkar
Posts: 4205
Joined: 12 Mar 2014 17:27
Location: Asteroid B-612 / Dhaka
Contact:

Re: User Functions Exchange

Post by SammaySarkar » 08 Oct 2016 08:41

regwrite()

Code: Select all

regwrite($data, $value, $path, $type=0, $bit=32, $esc=1, $sep)
Writes data to a registry value.
    $data    the data to write.
    $value   name of the value.
                   set empty to get the (Default) value.
    $path    path to the value.
    $type    type of the data.   
                   0 OR REG_SZ (default), 1 OR REG_MULTI_SZ, 2 OR REG_EXPAND_SZ,
                   3 OR REG_DWORD, 4 OR REG_QWORD, 5 OR REG_BINARY, 6 OR REG_NONE     
    $bit      denote registry bitness
                   32 OR 0:  use 32bit registry (default)
                   64 OR 1:  use 64bit registry
    $esc     escaping of '\' in value name (converted to '\\')
                   1:  enabled (default)
                   0:  disabled
    $sep    1 character as separator For REG_MULTI_SZ $type.

Returns 0 on success or error text on failure. (Note: this appears less than ideal, but I had no better idea.)

FUNCTION CODE

Code: Select all

function regwrite($data, $value, $path, $type=0, $bit=32, $esc=1, $sep) {
/*basic function to write data to a local registry value
**  $data    the data to write.
**  $value   name of the value.
**             set empty for the (Default) value.
**  $path    path to the value.
**  $type    type of the data.
**             0 OR REG_SZ
**             1 OR REG_MULTI_SZ
**             2 OR REG_EXPAND_SZ
**             3 OR REG_DWORD
**             4 OR REG_QWORD
**             5 OR REG_BINARY
**             6 OR REG_NONE
**  $bit     denote registry bitness
**             32 OR 0  use 32bit registry (default)
**             64 OR 1  use 64bit registry (invalid in x86 OS)
**  $esc     escaping of '\' in $data and $value (converted to '\\')
**             1 enabled (default)
**             0 disabled
**  $sep    1 character as separator For REG_MULTI_SZ.
**Returns 0 on success or error text on failure
*/
  $path = trim($path, "\");
  if ($type Like '#') {
    $types = 'SZ|MULTI_SZ|EXPAND_SZ|DWORD|QWORD|BINARY|NONE';
    $type  = 'REG_'.gettoken($types, $type+1, '|');
    unset $types;
  }
  if ($esc) {
    $data  = replace($data, '\', '\\');
    $value = replace($value, '\', '\\');
  }

  $bit  = ($bit==1)||($bit==64)?64:32;

  // REG ADD HKLM\Software\MyCo /v Path /t REG_EXPAND_SZ /d ^%systemroot^%
  $data = runret("%ComSpec% /c reg ADD ""$path""". " /f " //overwrite existing data
                 ." /v".(($value)?" ""$value""":"e")
                 ." /t $type"
                 .(($type=='REG_MULTI_SZ')?" /s ""$sep""":"")
                 .((%OSBITNESS%==32)?"":" /reg:$bit")
                 ." /d ""$data"""
                 ." && echo 0 || echo 1" // basic success/failure detection
                 , "%WINDIR%");

  $data = trim($data, "<crlf> ", 'R');

  if !($data) {return 'ERROR|Nothing returned';}
  if (gettoken($data, -1, <crlf>)==1){
    return replace(trim($data,"<crlf>1".chr(13),'R'), ': ', "|",,, 1); // return error
    // return 1;
  }
  return 0;
}
Examples
assuming the function is saved in <xyscripts>\inc\regwrite.xyi

Code: Select all

INCLUDE 'inc\regwrite.xyi'
"regwrite() test"
  //coming

highend
Posts: 8304
Joined: 06 Feb 2011 00:33

Re: User Functions Exchange

Post by highend » 04 Nov 2016 11:28

A simple debug function...

Atm it's tailored to my system because I create the .log file
in a ram disk (don't want to write to an SSD all the time).

I'm using it with Sublime Text. Feel free to change it to
your favorite editor.

$repeat repeats $sep <x> times to delimit debug entries in the file
$sep can be set to e.g. "," if necessary
$repeat is set to 2 by default to make the output more readable

I use an "_Initialize" section that includes this function and starts debugging:

Code: Select all

"_Initialize"
    include_once "<xyscripts>\inc\debug.xyi";
    debug(, "b");
And depending on what I need to debug and how to output it:
E.g. In a foreach loop I would use a $repeat value of 1 to make it more readable

Code: Select all

    $tabs = "R:\Debug|T:\Install";
    foreach($tab, $tabs) {
        $index = gettokenindex(regexreplace($tab, "(#|\[)", "[$1]"), get("Tabs", <crlf>), <crlf>, "iw");
        if ($index) { tab("close", 0, $index); }
        debug("Closed tab with index: $index", , 1)
    }

Code: Select all

function debug($str, $mode="a", $repeat=2, $sep="<crlf>") {
    $editor    = "D:\Tools\Sublime Text\sublime_text.exe";
    $debugFile = "R:\~XYDebug.log";

    if (exists("R:\") != 2) { echo "Ramdrive 'R:\' does not exist, no logging possible!"; }

    if !(regexmatches($mode, "^(b|begin|a|append|e|end)$")) {
        $message = <<<>>>
            ERROR: The debug function knows only three modes:

            01. b[egin]
            02. a[ppend] -> Default
            03. e[nd]

            But it received: "$mode" instead!
>>>;
        echo formatlist($message, "t", <crlf>);
        end 1==1;
    }

    // Start mode
    if (regexmatches($mode, "^(b|begin)$")) {
        $message = "Start of debug log:";
        $time    = formatdate();
        $div     = strrepeat("=", strlen($message) + strlen($time) + 1);
        $header  = <<<>>>
            $message $time
            $div<crlf 2>
>>>;
        writefile($debugFile, <crlf> . regexreplace($header, "^[ \t]+") . , "o", "tu");

    // Append mode
    } elseif (regexmatches($mode, "^(a|append)$")) {
        writefile($debugFile, $str . strrepeat($sep, $repeat), "a", "tu");

    // Stop mode
    } elseif (regexmatches($mode, "^(e|end)$")) {
        run """$editor"" ""$debugFile""", <xypath>;
    }
    return;
}
One of my scripts helped you out? Please donate via Paypal or highend (at) web (dot) de

zhaowu
Posts: 21
Joined: 24 Oct 2016 16:03

Re: User Functions Exchange

Post by zhaowu » 05 Nov 2016 15:21

Like Array.filter() in many languages which creates a new array with all elements that pass the test.

Example: Remove non-existent recent locations from list

Code: Select all

echo listFilter(get("list_recentlocations"), 'exists("{@Item}")', <crlf>)

Code: Select all

/**
 * List Filter
 *
 *
 * @param {list} $list              list of tokens
 * @param {expression} $filter      expression which returns {bool} on evaluation
 *                                  placeholder: {@Item}
 * @param {string} [$separator='|'] list separator
 * @param {flag} $flag              + s : escape single quote (') for each item
 *
 * @return {list} filtered list of tokens
 */
function listFilter($list, $filter, $separator = '|', $flag = '') {
	$l = ;
	foreach($item, $list, $separator) {
		if (strpos($flag, 's') >= 0) {
			$item = replace($item, "'", "''");
		}
		$expr = replace($filter, '{@Item}', $item, 1);
		if (eval($expr)) {
			$l = $l . $item . $separator;
		}
	}
	return trim($l, $separator, 'R');
}
Last edited by zhaowu on 06 Nov 2016 22:46, edited 1 time in total.

Post Reply