#!/usr/bin/perl

#####################################################################
#
#  FILE I/O FUNCTION LIBRARY v1.0              Last Update: 2022.7.12
#
#  This script contains functions written in pure Perl which
#  do various things with files such as read, write, append, etc.
#  This library does not depend on any other Perl modules or libraries.
#
#  Written by Zsolt N Perry in 2022, Pensacola, Fla.
#  For questions, comments, feature requests, or bug reports,
#  write to zsnp@juno.com.
#  This Perl script was tested with TinyPerl 5.8 under Windows XP.
#  This file was downloaded from http://www.wzsn.net/perl
#
#               THIS ENTIRE SOURCE CODE IS FREEWARE.
#  If you want to incorporate it or parts of it into your program,
#  just copy and paste whatever you need! There is no need to ask
#  for permission. This software is distributed "AS IS." There is
#  no warranty of any kind. The author will not be held liable for
#  any loss resulting from the use or misuse of this software.
#
#####################################################################

use 5.004;
use strict;
use warnings;
$| = 1;

##################################################
#                                File | v2023.1.12
# This function returns 1 if the first argument holds
# a valid path and file name, otherwise returns zero.
# This function does not check if a file or directory
# exists. It just tells you whether the file name and
# path look valid. It accepts both DOS, Windows,
# and Linux paths. Example:
#
# isValidFileName('C:\\Users/Joe/Desktop/x.txt') => 1
# isValidFileName('\\Users\\Joe\\Desktop\\...') => 0
#
# Usage: INTEGER = isValidFileName(STRING)
#
sub isValidFileName
{
  defined $_[0] or return 0;
  my $L = length($_[0]);
  $L > 0 && $L < 5000 or return 0;  # Too short or too long?

  # File name cannot have control characters and < > or |
  if ($_[0] =~ m/[\<\>\|\x00-\x08\x0B\x0C\x0E-\x1F]+/) { return 0; }

  # File name may not contain double backslashes or double
  # forward slashes or triple dots or double asterisk.
  # These things are illegal or have no meaning.
  if ($_[0] =~ m/\\\\|\/\/|\.\.\.|\*\*/) { return 0; }

  # Two dots may not be followed or preceded by plain text.
  # This is illegal: /bin..
  if ($_[0] =~ m/[^:\.\/\\]+\.\.|\.\.[^:\.\/\\]+/) { return 0; }

  # A path may only contain one ':' following the drive letter.
  (my $COLON = $_[0] =~ tr|:|:|) < 2 or return 0;
  if ($COLON)  # If colon is present...
    { if ($_[0] !~ m/^[\r\n\t "]*[A-Za-z]{1}\:/)
      { return 0; }}

  # A file name may only have 2 or zero double quotes _around_ it.
  if ($_[0] =~ tr|"|"|)
    { if ($_[0] !~ m/\A[\t\r\n ]*["]?[^"]+["]?[\t\r\n ]*\z/)
      { return 0; }}

  # File name cannot be longer than 256 bytes.
  if ($_[0] =~ m/[^\"\/\\]{257,}/) { return 0; }

  # An absolute path in DOS may not be followed by two dots.
  # This is illegal: "C:\\..\\README.txt"
  # In Linux, however, it might be okay: /../x.txt
  # because this small path segment may be part of a larger piece.
  if ($_[0] =~ m/^[\"\r\n\t ]*[A-Za-z]{1}\:([\/\\.])*[\/\\]{1}\.\./)
  { return 0; }

  return 1;
}
##################################################
#                                 File | v2023.1.4
# This function converts a Windows file attribute
# number to string representation.
#
# Usage: STRING = GetAttrStr(ATTRIBUTE)
#
sub GetStrAttr
{
  my $A = defined $_[0] ? $_[0] : 0;
  my $OUTPUT = '.' x 8;
  my $LETTER = 'LCASHRDV';
  my $P = 0;
  foreach(1024, 2048, 32, 4, 2, 1, 16, 8)
  {
    if ($A & $_) { vec($OUTPUT, $P, 8) = vec($LETTER, $P, 8); }
    $P++;
  }
  while (length($OUTPUT) < 4) { $OUTPUT .= '.'; }
  return $OUTPUT;
}
##################################################
#                                 File | v2023.1.4
# This function is a customizable readdir() function
# for Windows. It returns the directory contents as
# an array using a tiny JavaScript program to
# collect the data. [Tested with TinyPerl 5.8 on WinXP.]
# (This should work on Windows XP, 7, 8, 10, 11+, because
# all these versions come with builtin JS support.)
#
# Usage: LIST = WinReadDir(PATH, [SUBDIR, [ITEMS, [MAX, [REGEX]]]])
#
# NOTE: This function only works in Windows XP or higher!
# In Linux and other operating systems, an
# empty list will be returned.
#
# The easiest way to use the function is to simply
# provide a path as the first argument:
#
#   my @LIST = WinReadDir('C:\\HOME\\PERL');
#
# This will return something like this:
#
# 00000000000 1672793716 More\
# 00000000002 1656954558 Myfile{1758}.txt
# 00000000241 1574651186 SPEAK.VBS
# 00000001663 1607229792 Numbers.pl
# 00000002456 1670070972 cut.pl
# 00000059994 1672797060 filelib.pl
# 00000361490 1669902950 lib.pl
#
# The first 12 digits are the file's size. The next 10 digits
# are the file's last modified date given in seconds.
# If a file name ends with backslash "\" character, then
# that means it's a directory name.
#
# Each line is a separate array element.
#
# If a name contains unicode characters, the special
# characters will appear as a number between brackets.
# For example: Myfile{1758}.txt
# If you press ALT + 1758, it produces a little star icon.
# And that's the code that appears in the file name there.
#
# If a file or directory name contains the '{' character,
# then it will appear as '{123}' Also, if you need to refer
# to a directory that contains the '{' then again,
# you would do this:
#
#   my @LIST = WinReadDir('C:\\TEMP\\x{123}45}');
#
# As a result, the function will look in the directory C:\TEMP\x{45}
#
# The PATH may also contain special characters:
#
#   my @LIST = WinReadDir('C:\\TEMP\\MyWeirdFolder{9700}\\data', 1);
#
# The second argument is either 1 or 0. Default is zero.
# One means that sub-directories will be scanned as well.
# In that case, the output will look something like this:
#
# 00000000000 1661404204 IMGS\
# 00000000000 1659249130 DOCS\
# 00000014010 1642132972 DOCS\0023.bmp
# 00000014060 1115495874 DOCS\index.html
# 00000015838 1667767236 rr.bmp
# 00000015866 1667184404 MANDEL3.BMP
# 00000016730 1141128000 FeatherTexture.bmp
# 00000017062 1141128000 IMGS\Coffee Bean.bmp
# 00000018938 1666659612 TEMP.jif
#
# Notice that directories' size is always zero.
# Also notice that the list is sorted, and whatever comes
# first will determine how the list is sorted. You can
# change this order using the 3rd argument:
#
#   my @LIST = WinReadDir('C:\\TEMP', 1, 'N S M');
#
# The string 'N S M' will substitute the Name of the file
# first, then the Size and finally the Modified date all
# separated by spaces. You may use a different separator.
# I use space just because it makes it easier to read, but
# you could use the '|' character which then would allow
# you to split the items using the split() function:
#
#   my @LIST = WinReadDir('C:\\TEMP', 1, 'N|S|M');
#   foreach (@LIST)
#   {
#     my @ITEM = split(/\|/, $_);
#    # $ITEM[0] ---> NAME OF FILE
#    # $ITEM[1] ---> FILE SIZE
#    # $ITEM[2] ---> MODIFIED DATE
#   }
#
# There are more values available. For example, if you want
# the full name of the file with path, then use letter 'F':
#
#   my @LIST = WinReadDir('C:\\TEMP', 1, 'S**F');
#
# This will produce a list which starts with the file size,
# followed by the long file name. It will look something like this:
#
# 000000000000**C:\TEMP\MyWeirdFolder{931}{931}\
# 000000000000**C:\TEMP\x{123}45}\
# 000000000000**C:\TEMP\x{123}45}\test.txt
# 000000000002**C:\TEMP\testing{931}.txt
#
# These are more values that you can use:
#
#   S = insert file size
#   N = insert file name
#   M = insert file last modified date
#   C = insert file date of creation
#   A = insert file last accessed date
#   H = insert file's short name (8+3 format)
#   F = insert file's full name with path
#   T = insert file's attributes
#
# You can create your own customized list using a
# combinations of the above letters.
#
# The 4th argument allows you to limit the directory listing
# to only X items. For example, here we request only the
# first 10 files in the directory list. And we want the file
# attribute first, then date of creation, and the full name:
#
#   my @L = WinReadDir("C:\\WINDOWS", 0, 'T|C|F', 10);
#
# Returns the following list:
#
# 0016|1665934687|C:\WINDOWS\Config\
# 0016|1665934687|C:\WINDOWS\Cursors\
# 0016|1665934687|C:\WINDOWS\Help\
# 0016|1665934687|C:\WINDOWS\Media\
# 0016|1665934687|C:\WINDOWS\msagent\
# 0016|1665934687|C:\WINDOWS\repair\
# 0016|1665934687|C:\WINDOWS\system32\
# 0016|1665934687|C:\WINDOWS\system\
# 0018|1665934687|C:\WINDOWS\inf\
# 0021|1665934687|C:\WINDOWS\Fonts\
#
# The attribute is a 12-bit integer.
# The meaning of the bits is described here:
#
#     0 = Normal file
#     1 = Read-only file
#     2 = Hidden file
#     4 = System file
#     8 = Disk drive volume label (Not a real file)
#    16 = Directory
#    32 = Archive (most files)
#  1024 = Link or shortcut
#  2048 = Compressed file
#
# The 5th argument allows you to filter the results using a
# regex enclosed as a string. Now, keep in mind, we are not
# using Perl's regex engine. This is nowhere near as
# sophisticated, but it's better than nothing. Here, for
# example, we search for all executable files in the
# Windows directory:
#
#   my @L = WinReadDir("C:\\WINDOWS", 0, 'S bytes,  name: F', 10, '/exe/i');
#
# 000000010752 bytes,  name: C:\WINDOWS\hh.exe
# 000000015360 bytes,  name: C:\WINDOWS\TASKMAN.EXE
# 000000025600 bytes,  name: C:\WINDOWS\twunk_32.exe
# 000000049680 bytes,  name: C:\WINDOWS\twunk_16.exe
# 000000069120 bytes,  name: C:\WINDOWS\NOTEPAD.EXE
# 000000069632 bytes,  name: C:\WINDOWS\ALCMTR.EXE
# 000000086016 bytes,  name: C:\WINDOWS\SOUNDMAN.EXE
# 000000146432 bytes,  name: C:\WINDOWS\regedit.exe
# 000000256192 bytes,  name: C:\WINDOWS\winhelp.exe
# 000000283648 bytes,  name: C:\WINDOWS\winhlp32.exe
#
# In the next example, we want to find all files that have
# some special characters in their file name:
#
#   my @L = WinReadDir("C:\\TEMP", 0, 'S M T N', 0, '/[{]+/i');
#
# So, we get this list:
#
# 000000000000 1672896164 0016 MyWeirdFolder{931}{931}\
# 000000000000 1672896244 0032 testing{931}.txt
# 000000000000 1672896984 0016 x{123}45}\
#
# Usage: LIST = WinReadDir(PATH, [SUBDIR, [PATTRN, [MAX, [REGEX]]]])
#
sub WinReadDir
{
  my @DIR;
  $^O =~ m/MSWIN/i or return @DIR;
  my $PATH = defined $_[0] ? $_[0] : 'C:\\';
  $PATH =~ tr|\/|\\|;   # Convert / to \
  $PATH =~ tr|\\||s;    # Remove duplicate backslash.
  $PATH =~ s/\\/\\\\/g; # Now double each backslash.
  my $RET = defined $_[2] ? $_[2] : '';
  length($RET) or $RET = 'S M N';
  $RET =~ tr|'\r\n\\||d;   # Filter out unsafe characters
  my $START = -1;       # Start of separator string
  my $J = '';           # JavaScript code will go here
  my @f = ('toASCII(n.slice(PATHLEN))+d', 'fSize(s)', 'toASCII(n)+d',
     'fDate(f.DateCreated)', 'fDate(f.DateLastModified)',
     'fDate(f.DateLastAccessed)', 'fAttr(f)', 'f.ShortName');
  for (my $i = 0; $i < length($RET); $i++)
  {
    my $c = index('NSFCMATH', substr($RET, $i, 1));
    if ($c >= 0) {
      if ($START >= 0) {
        $J .= "'" . substr($RET, $START, $i - $START) . "',"; }
      $J .= "$f[$c],"; $START = -1;
    } elsif ($START < 0) { $START = $i; }
  } if ($START < 0) { $J = substr($J, 0, length($J) - 1); }
  else { $J .= "'" . substr($RET, $START) . "'"; } undef $RET;
  # Okay, at this point, $J should contain a list of properties
  # we want to save from each directory and file. These are things
  # we just plucked out of @f. For example, to record the file size,
  # $RET had to include the letter 'S' and when we see the letter S,
  # we insert "fSize(s)," into $J. This list in $J will then become
  # part of the JavaScript code. When the JS script runs, it creates
  # a list, joins the items and pushes the string into an array.
  my $RECURSIVE = defined $_[1] && $_[1] ? 'DIR(FullName);' : '';
  my $MAX = defined $_[3] ? $_[3] : 0;
  $MAX =~ tr|0-9||cd;  # Remove everything except numbers
  $MAX = ($MAX) ? "if(OUTPUT.length>=$MAX)return;" : '';
  my $REGEX = defined $_[4] ? $_[4] : '';

  # If the regex match is not true, then we continue reading
  # the directory, otherwise we add the file to our list.
  # The Regex only tests the name of the file, not its path.
  # So, if the path contains the pattern we're looking for,
  # we won't see that.

  # If $REGEX is not provided, then it won't become part of the code.
  if (length($REGEX))
  {
    # Sorry, we need to remove forward slashes and backslashes
    # among other things to prevent code injection vulnerability:
    $REGEX =~ tr|\/\\'"<>\r\n||d;
    $REGEX = "NameOnly=toASCII(FullName+'').split(BS).pop();if(!(/$REGEX/.test(NameOnly)))continue;";
  }

  my $JSCODE = "PATH=CNV('$PATH');OUTPUT=[];BS='\\\\';PATHLEN=PATH.length+((PATH.slice(-1)==BS)?0:1);try{FSO=new ActiveXObject('Scripting.FileSystemObject');DIR(PATH);WScript.StdOut.WriteLine(OUTPUT.sort().join('\\n'));}catch(e){}function PACK(d,n){$MAX var f=d?FSO.GetFolder(n):FSO.GetFile(n);var s=d?0:f.Size;n+='';OUTPUT.push([$J].join(''));}function CNV(s){var i,P;s=s.split('{');for(i=0;i<s.length;i++){P=s[i].indexOf('}');if(P>0)s[i]=String.fromCharCode(s[i].substr(0,P)&0xffff)+s[i].slice(P+1);}return s.join('');}function DIR(p){var F=FSO.GetFolder(p),FC,File,FullName;for(FC=new Enumerator(F.SubFolders);!FC.atEnd();FC.moveNext()){FullName=FC.item();Folder=FSO.GetFolder(FullName);$REGEX PACK(BS,FullName);$RECURSIVE}for(FC=new Enumerator(F.files);!FC.atEnd();FC.moveNext()){FullName=FC.item();$REGEX PACK('',FullName);}}function toASCII(s){var i,T=[];s+='';for(i=0;i<s.length;i++){c=s.charCodeAt(i);T.push(((c<32&&c!=10&&c!=13)||c>126||c==123)?'{'+c+'}':s.charAt(i));}return T.join('');}function fSize(s){return('000000000000'+s).slice(-12);}function fDate(d){return('0000000000'+(d*1)).slice(-13).substr(0,10);}function fAttr(f){return('0000'+f.Attributes).slice(-4);}";
  mkdir "C:\\TEMP";
  my $JSFILE = "C:\\TEMP\\GETDIR.JS";
  open(my $FILE, ">$JSFILE") or return @DIR;
  binmode $FILE;
  print $FILE $JSCODE;
  close $FILE;
  if (-s $JSFILE != length($JSCODE)) { return @DIR; }
  @DIR = split(/\n/, `CSCRIPT.EXE //NOLOGO $JSFILE`);
  unlink $JSFILE;
  return @DIR;
}
##################################################
#                                 File | v2023.1.3
# This function renames a file whose name contains
# special unicode characters.
#
# Usage: STATUS = WinRenameFile(FULLPATH, NEWNAME, [FORCE])
#
# Unicode characters must be placed
# between {} brackets in decimal format.
# For example: {9674} is the representation of a
# little diamond shaped character that you can
# replicate by pressing ALT + 9674.
#
# So, if you have a file called "Myfile{9674}.txt"
# and you want to rename it to "Myfile.txt" then simply do:
#
#   WinRenameFile('C:\\HOME\\Myfile{9674}.txt', 'Myfile.txt');
#
# This will rename the file. If you want to make sure that
# the file gets renamed even if the new name is already taken,
# then use 1 for the third argument:
#
#   WinRenameFile('C:\\Users\\Zsolt\\Desktop\\Myfile{9674}.txt', 'Myfile.txt', 1);
#
# And if the new file name exists AND happens to be read-only,
# the file will not be renamed. However, if you specify 2 for the
# third argument, then the read-only "Myfile.txt" will be deleted
# first, and then the file will be renamed anyway:
#
#   WinRenameFile('C:\\HOME\\Myfile{9674}.txt', 'Myfile.txt', 2);
#
# This can be used to remove unicode letters to make
# files accessible to simple command-line applications.
#
# You may use normal forward slash in place of backslash.
# It makes things a bit clearer:
#
#   WinRenameFile('C:/HOME/Myfile{9674}.txt', 'Myfile.txt');
#
# You must not type any slashes in the second name.
# The new name must only contain a file name and extension.
# If you want to move the file to another directory or another
# drive, you should use the builtin rename() function.
#
# This function returns non-zero on success or
# zero if the file could not be renamed.
#
# NOTE: This function only works in Windows XP or higher!
# In Linux and other operating systems, no change will
# take place and the function always returns zero.
#
# Usage: STATUS = WinRenameFile(FULLPATH, NEWNAME, [FORCE])
#
sub WinRenameFile
{
  $^O =~ m/MSWIN/i or return 0;
  defined $_[0] && defined $_[1] or return 0;
  my ($OLD, $NEW) = @_;
  my $FORCE = defined $_[2] ? $_[2] : 0;

  $OLD =~ tr|\x00-\x1F\"$\|<>||d;  # Remove illegal characters
  $OLD =~ tr|\/|\\|;   # Convert / to \
  $OLD =~ tr|\\||s;    # Remove duplicate backslash.
  $OLD =~ s/\\/\\\\/g; # Now double each backslash.

  $NEW =~ tr|\x00-\x1F\"$\|<>||d;  # Remove illegal characters
  $NEW =~ tr|\\|\/|;   # Convert \ to /
  if (index($NEW, '/') >= 0) { return 0; }

  length($OLD) or return 0;
  length($NEW) or return 0;

  my $JSCODE = "FORCE=$FORCE;OLD=CNV('$OLD');NEW=CNV('$NEW');try{FSO=new ActiveXObject('Scripting.FileSystemObject');if(!FSO.FileExists(OLD)){BYE(0);}if(FORCE){FULL=NEW;if(NEW.indexOf('\\\\')<0){P=OLD.lastIndexOf('\\\\');if(P>=0)FULL=OLD.substr(0,P+1)+NEW;}if(FORCE==2)FSO.DeleteFile(FULL,1);else FSO.DeleteFile(FULL);}}catch(e){}try{F=FSO.GetFile(OLD);F.name=NEW;BYE(1);}catch(e){BYE(0);}function BYE(x){WScript.Quit(x);}function CNV(s){var i,P;s=s.split('{');for(i=0;i<s.length;i++){P=s[i].indexOf('}');if(P>0)s[i]=String.fromCharCode(s[i].substr(0,P)&0xffff)+s[i].slice(P+1);}return s.join('');}";
  mkdir "C:\\TEMP";
  my $JSFILE = "C:\\TEMP\\RENAMER.JS";
  open(my $FILE, ">$JSFILE") or return 0;
  binmode $FILE;
  print $FILE $JSCODE;
  close $FILE;
  if (-s $JSFILE != length($JSCODE)) { return 0; }
  my $STATUS = system("CSCRIPT.EXE //NOLOGO $JSFILE");
  unlink $JSFILE;
  return $STATUS;
}
##################################################
#                                File | v2022.7.11
# Returns the current directory. (If a drive letter
# is provided in the first argument, then it returns
# the current directory for that drive. This only
# applies to DOS and Windows where each drive letter
# has its own current directory. If no drive letter
# is provided, then it returns the current directory
# of the current drive under DOS and Windows.)
#
# Usage: STRING = GetCurrentDirectory([DRIVE])
# 
sub GetCurrentDirectory
{
  if ($^O =~ /DOS|MSWIN/i)
  {
    my $DRV = defined $_[0] ? substr(Trim($_[0]), 0, 2) : '';
    return Trim(`CD $DRV`);
  }
  return Trim(`pwd`);
}
##################################################
#                                Time | v2022.2.11
# This function returns the time given in seconds
# (or the current time) as a string
# in the following format:
#
#   TimeStamp([TIME]) --> YYYY-MM-DD HH:MM:SS
#
# In contrast, the builtin function localtime()
# returns the date and time in the following format:
#   localtime()  --> Ddd Mmm  D HH:MM:SS YYYY
#
# Usage: STRING = TimeStamp([SECONDS])
#
sub TimeStamp
{
  my @D = localtime(defined $_[0] ? $_[0] : time);
  return sprintf('%.04d-%.02d-%.02d %.02d:%.02d:%.02d',
    (1900+$D[5]), (1+$D[4]), $D[3], $D[2], $D[1], $D[0]);
}
##################################################
#                               File | v2022.10.24
# This function takes a file name which may include
# the full path, and returns the file extension
# including the dot.
#
# Usage: STRING = GetFileExt(FULLNAME)
#
sub GetFileExt
{
  my $F = defined $_[0] ? $_[0] : '';
  $F =~ tr|\\|/|;           # Change every backslash to forward slash.
  my $P = rindex($F, '/');  # Find last forward slash in the path string.
  $P < 0 or $F = substr($F, $P + 1);
  $P = rindex($F, '.');     # Find last dot in the filename.
  return ($P > 0 && length($F) > $P + 1) ? substr($F, $P) : '';
}
##################################################
#                                File | v2022.2.19
# Returns just the file name without path or extension.
# Usage: FILE_NAME = NameOnly(FULL_PATH)
#
sub NameOnly
{
  defined $_[0] or return '';
  my $F = $_[0];
  $F =~ tr|\\|/|;
  my $P = rindex($F, '/');
  $P < 0 or $F = substr($F, $P + 1);
  $P = rindex($F, '.');
  return ($P > 0) ? substr($F, 0, $P) : $F;
}
##################################################
#                                       v2022.9.30
# This function returns information about a file or
# directory under Windows 98/XP/Vista/7/8/10/11..
#
# The returned array will have the following items:
#
# ARRAY[0] = FILE TYPE (0=DOESNT EXIST 1=FILE 2=DIRECTORY)
# ARRAY[1] = FILE SIZE IN BYTES
# ARRAY[2] = FILE ATTRIBUTE (32=ARCHIVE)
# ARRAY[3] = FILE DATE CREATED IN SECONDS
# ARRAY[4] = FILE DATE MODIFIED IN SECONDS
# ARRAY[5] = FILE DATE LAST ACCESSED IN SECONDS
# ARRAY[6] = TIME IN MILLISECONDS WHEN OPERATION STARTED
# ARRAY[7] = TIME IN MILLISECONDS WHEN OPERATION ENDED
#
# Usage: ARRAY = WinFileStat(FILENAME)
#
sub WinFileStat
{
  my $FILENAME = defined $_[0] ? $_[0] : '';
  my $UNICODE = index($FILENAME, "\0") < 0 ? 0 : 1;
  my $JSCODE = "FILE='_';T1=(new Date()).getTime();X=[];try{FSO=new ActiveXObject('Scripting.FileSystemObject');if(FSO.FileExists(FILE)){F=FSO.GetFile(FILE);X=[1,F.Size];}else if(FSO.FolderExists(FILE)){F=FSO.GetFolder(FILE);X=[2,0];}if(X.length)X.push(F.Attributes,toSec(F.DateCreated),toSec(F.DateLastModified),toSec(F.DateLastAccessed));}catch(e){}function toSec(D){t=new Date(D);return Math.round(t.getTime()/1000);}T2=(new Date()).getTime();while(X.length<6)X.push(0);X.push(T1,T2);WScript.StdOut.WriteLine(X.join('*'));WScript.Quit(0);";
  if ($UNICODE)
  {
    $FILENAME =~ s/\\/\\\x00\\/g;
    $JSCODE = "\xFF\xFE" . toUnicode($JSCODE);
    $JSCODE =~ s/\_\0/\Q$FILENAME\E/;
  }
  else
  {
    $FILENAME =~ s/\\/\\\\/g;
    $JSCODE =~ s/\_/\Q$FILENAME\E/;
  }
  my $DATA = RunJS('FILESTAT.JS', $JSCODE);
  $DATA =~ tr|0-9\*||cd;
  my @A = split(/\*/, $DATA);
  return @A;
}
##################################################
#
# This function searches STRING to see if any of its
# characters match any of the characters of SUBSTR.
# Returns 1 if a match was found; returns 0 otherwise.
# Usage: INTEGER = FindChar(STRING, SUBSTR)
#
sub FindChar
{
  defined $_[0] && defined $_[1] or return 0;
  length($_[0]) or return 0;
  my $i = length($_[1]);
  while ($i--)
  {
    index($_[0], substr($_[1], $i, 1)) < 0 or return 1;
  }
  return 0;
}
##################################################
#
# This function returns true if a filename matches
# a certain wildcard pattern. There may be several
# question marks in the search pattern, but only one
# asterisk is allowed! The matching is NOT case sensitive!
# Usage: INTEGER = isMatch(FILENAME, WILDCARD)
# Example: isMatch("New_Document.txt", "n*.txt") ---> 1
#
sub isMatch
{
  my $F = defined $_[0] ? uc($_[0]) : '';
  my $W = defined $_[1] ? uc($_[1]) : '';
  length($F) && length($W) or return 0;

  # If there are invalid characters...
  if (FindChar($W.$F, '<|>')) { return 0; }

  # If there aren't any wildcards at all...
  if (FindChar($W, '*?') == 0) { return ($F eq $W) ? 1 : 0; }

  # Match what's before the asterisk...
  return 0 unless (_isMatch($F, $W, 1));

  # Match what comes after the asterisk...
  return _isMatch($F, $W, -1);
}
##################################################
#
# This function is called by isMatch() to compare
# two strings until the first asterisk. Returns 1
# if both strings match until the first asterisk.
# This function can start comparing strings starting
# from the beginning or starting from the end!
# DIRECTION must be either 1 or -1.
# Usage: INTEGER = _isMatch(FILENAME, WILDCARD, DIRECTION)
#
sub _isMatch
{
  my $F = shift; my $f; my $LF = length($F)-1;
  my $W = shift; my $w; my $LW = length($W)-1;
  my $DIR = shift;
  my $STOP = $LW; my $START = 0; my $FSTART = 0;
  if ($DIR < 0) { $STOP = 0; $START = $LW; $FSTART = $LF; }
  while ($START != $STOP)
  {
    $w = vec($W, $START, 8);  # Grab byte from wildcard pattern
    $f = vec($F, $FSTART, 8); # Grab byte from filename
    $START += $DIR;
    $FSTART += $DIR;
    if ($w == 42)   # ASTERISK?
    { return 1; }
    else
    {
      # If the character is "?" then skip, but if
      # it's not "?", then the characters must match.
      if ($w != 63) { ($f == $w) or return 0; }
    }
  }
  return 1;
}
##################################################
#                                        v2020.1.7
# This function returns 1 if the given file name is
# a valid DOS 8+3 file name. Returns 0 otherwise.
# Usage: INTEGER = IsFileName83(STRING)
#
sub IsFileName83
{
  defined $_[0] or return 0;
  my $L = length($_[0]);
  $L < 13 or return 0;   # Name may be no longer than 12 bytes
  $L or return 0;
  my $N = $_[0];
  my $P;
  my $D = -1;
  my $VALID = '.0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!@#$%&{}()\'`^~-_';
  for (my $i = 0; $i < $L; $i++)
  {
    $P = index($VALID, substr($N, $i, 1));
    return 0 if ($P < 0);  # Invalid character?
    if ($P)
    {
      # The file name cannot be longer than 8 bytes, and
      # the file extension cannot be longer than 3 bytes.
      if ($D < 0) { $i < 8 or return 0; }
      else { $i - $D <= 3 or return 0; }
    }
    else
    {
      # The period cannot be the 1st or 10th character
      return 0 if ($i == 0 || $i > 8);
      return 0 if ($D > 0);   # Two periods are not allowed!
      $D = $i;
    }
  }
  return 1;
}
##################################################
#                                File | v2020.6.11
# Reads a single line from a file and returns a string without
# line breaks. This function can read the Nth line of a file,
# and it can also limit the size of the returned string.
# Usage: STRING = ReadLine(FILENAME, [LINE_NUMBER, [MAX_BYTES_TO_READ]]])
#
sub ReadLine
{
  my $NAME = defined $_[0] ? $_[0] : '';
  $NAME =~ tr/\"\0*?|<>//d;  # Remove special characters from file name
  length($NAME) or return '';
  -e $NAME or return '';     # Check if file exists
  -f $NAME or return '';     # Check if file is plain file
  -s $NAME or return '';     # Check file size
  my $LINE = defined $_[1] ? $_[1] : 0;
  $/ = "\n";
  local *FH;
  open FH, "<$NAME" or return '';  # Open file for reading
  foreach my $R (<FH>)                # Read file line by line
  {
    if (--$LINE < 0)
    {
      $LINE = $R;
      last;
    }
  }
  close(FH);
  $LINE =~ tr/\r\n//d;    # Remove any new line characters
  defined $_[2] or return $LINE;
  length($LINE) > $_[2] or return $LINE;
  return substr($LINE, 0, $_[2]);
}
##################################################
#                                       v2021.2.21
# Returns the path where this script resides.
# This path will always end with a backslash or
# forward slash depending on the OS.
# Usage: STRING = MyPath()
#
sub SelfPath
{
  my $PATH = $0;
  my $MSWIN = $^O =~ /MSWIN|DOS|OS2/i ? 1 : 0;
  my $SLASH = substr('/\\', $MSWIN, 1);
  my $P = rindex($PATH, $SLASH);
  $P < 0 or return Trim(substr($PATH, 0, $P)) . $SLASH;
  $PATH = ($MSWIN) ? `CD` : (exists($ENV{PWD}) ? $ENV{PWD} : `pwd`);
  $PATH = Trim($PATH) . $SLASH;
  $PATH =~ tr|/\\||s;
  return $PATH;
}
##################################################
#
# This function returns the NAME, the PATH, or the
# CONTENT of this perl script depending on which
# item is requested in the argument.
#
# Usage: STRING = Self(STRING)
#
# Examples:
#   Self('NAME')     - Returns the file name only
#   Self('PATH')     - Returns the file path only
#   Self('FULL')     - Returns both path and file name
#   Self('SIZE')     - Returns the file size of this script
#   Self('DATE')     - Returns the date this script was last modified
#   Self('CONTENT')  - Returns the content of this script
#
sub Self
{
  my $SELF = __FILE__;
  my $S = defined $_[0] ? uc($_[0]) : '';
  if ($S eq 'FULL') { return $SELF; }
  if ($S eq 'SIZE') { return -s $SELF; }
  if ($S eq 'DATE') { return FormatDate((stat($SELF))[9]); }
  $SELF = FixPath($SELF);
  my $P =0;
  if ($S eq 'NAME') { return ($P < 0) ? $SELF : substr($SELF, $P+1); }
  if ($S eq 'PATH') { return SelfPath(); }
  return ReadFile($SELF);
}
##################################################
#
# This function reads the contents of a directory
# and returns a detailed record of each file and
# directory in an array.
# Usage: ARRAY = ReadDIR(PATH)
#
sub ReadDIR
{
  my @A;
  my $P = 0;
  defined $_[0] or return @A;
  length($_[0]) or return @A;
  my $PATH = $_[0];

  $P = FixPath($P . '/');

  my $EXT;
  my $FULLNAME;
  local *DIR;
  opendir(DIR, $PATH) or return;
  while ((my $NAME = readdir(DIR)))
  {
    $FULLNAME = "$PATH$NAME";

    $EXT = rindex($NAME, '.') + 1;
    $EXT = $EXT > 1 ? uc(substr($NAME, $EXT, length($NAME))) : '';

    # We will display directories first, followed by
    # symbolic links, then all other special files,
    # and plain files last.
       if (-f($FULLNAME)) { $NAME = "3*$EXT*$NAME*"; }
    elsif (-d($FULLNAME)) { $NAME = "0*$EXT*$NAME*"; }
    elsif (-l($FULLNAME)) { $NAME = "1*$EXT*$NAME*"; }
    else                  { $NAME = "2*$EXT*$NAME*"; }

    # Get file info
    my @INFO = stat $FULLNAME;
    $NAME .= (vec($NAME, 0, 8) > 48 ? $INFO[7] : '0') . '*' . $INFO[2] . '*' . $INFO[9];

    # Store file data
    push(@A, $NAME);
  }
  closedir(DIR);
  return @A;
}
##################################################
#
# This function reads the contents of a folder
# and returns an array that contains file names
# whose extensions match the ones specified in
# the second argument. The second argument should
# be a string containing extensions separated
# by a single space.
# Example: ReadDIR('/work/text', 'TXT TEXT HTM')
#
# Usage: ARRAY = ReadDIR2(PATH, [EXTENSIONS])
#
sub ReadDIR2
{
  my @FILELIST;
  my $PATH = defined $_[0] ? $_[0] : '';
  my $FILTER = defined $_[1] ? $_[1] : '';
  my $F = length($FILTER);
  length($PATH) or return @FILELIST;
  $PATH .= '/';      # Make sure that path ends with '/'
  $PATH =~ tr|\\|/|; # Convert path to Linux format
  $PATH =~ tr|/||s;  # Remove double '//'
  if ($F)
  {
    # Format filter
    $FILTER =~ tr|a-z A-Z 0-9 _ ||cd;   # Remove bad characters
    $FILTER =~ tr|a-z|A-Z|;             # Convert to uppercase
    $FILTER = " $FILTER ";              # Add spaces for easy search
  }

  my $FULLNAME;
  local *DIR;
  opendir(DIR, $PATH) or return @FILELIST;
  while ((my $NAME = readdir(DIR)))
  {
    if (length($NAME) < 3)
      { $NAME ne '.' && $NAME ne '..' or next; }

    my $FULLNAME = "$PATH$NAME";

    # Ignore subdirectories; just deal with files.
    if (-f($FULLNAME))
    {
      # Do we return all files or just the ones
      # that have a certain extension?
      if ($F)
      {
        # Grab the file extension
        my $P = rindex($NAME, '.');
        $P++ > 0 or next;
        my $EXT = uc(substr($NAME, $P));

        # Skip file if its extension doesn't match
        index($FILTER, " $EXT ") >= 0 or next;
      }
      push(@FILELIST, $NAME);  # Add file to the list
    }
  }
  closedir(DIR);
  return @FILELIST;
}
##################################################
#
# This function returns the OS type as a number.
# 1=DOS 2=WINDOWS 3=LINUX 4=OSX 9=OTHER
# Usage: INTEGER = GetOS()
#
sub GetOS
{
  my $OS = uc($^O);
  index($OS, 'LINUX')  >= 0 ? 3 :
  index($OS, 'MSWIN')  >= 0 ? 2 :
  index($OS, 'DOS')    >= 0 ? 1 :
  index($OS, 'DARWIN') >= 0 ? 4 : 9;
}
##################################################
#                                      v2019.11.28
# This function expects a relative path which may
# begin with . or .. and returns an absolute path.
# Usage: FULLPATH = GetAbsolutePath(PATH)
#
sub GetAbsolutePath
{
  defined $_[0] or return '';
  my $P = Trim($_[0]);
  length($P) or return '';
  $P = FixPath($P);
  if (vec($P, 0, 8) == 46)	# Starts with . or ..
  {
    return JoinPath(GetCurrentDirectory(), $P);
  }
  elsif (vec($P, 0, 8) == 47)	# Starts with / or \
  {
    return JoinPath(GetCurrentDrive() . '/', $P);
  }
  elsif (vec($P, 1, 8) == 58)	# Starts with a drive letter?
  {
    if (vec($P, 2, 8) != 47)	# Missing / or \
    {
      my $DRIVE = substr($P, 0, 2);
      my $PATH_WITHOUT_DRIVE = substr(GetCurrentDirectory($DRIVE), 2);
      $P = substr($P, 2);
      # If the path is "C:WORK" or something like that, then
      # it is clearly missing a part. The drive letter
      # must always be followed by a backslash.
      return JoinPath($DRIVE . '/', $PATH_WITHOUT_DRIVE, $P);
    }
    return JoinPath($P, '');
  }
  return JoinPath(GetCurrentDirectory(), $P);
}
##################################################
#                                   
# Securely wipes a file so it will be unrecoverable
# once deleted from the drive.
#
# Usage: WipeFile(FILENAME)
#
sub WipeFile {}

##################################################

sub FileCompare {}
sub RemoveDirectoryTree {}
sub MoveDirectoryTree {}
sub CopyDirectoryTree {}
sub SecureWipeFile {}
sub CopyFile {}
sub MoveFile {}
sub FindExecutableInPath {}
sub FindStringInFile {}
sub CalculateFileChecksum {}
sub ChDIR {}
sub MkDIR {}
sub SetFileAttrib {}
sub GetFileAttrib {}
sub ReadINI {}
sub SaveINI {}
sub ReadCSV {}
sub SaveCSV {}

##################################################
#                                       v2022.9.24
# This function creates a bunch of subdirectories
# if they don't exist yet. If everything goes well,
# it returns the number of subdirectories created
# PLUS ONE. Returns zero if something went wrong.
#
# CAUTION: Do not mistype the path name!!!
# Also, if a file name exists that matches the
# directory name you want to create, the file will
# be renamed first (if the rename is unsuccessful,
# the file will be deleted) and the directory
# will be created in its place.
#
# For example, let's say you have a file called
# /tmp/mynotes and you call CreatePath('/tmp/mynotes/2022/March')
# In this case, the mynotes file will be renamed
# to mynotes.BAK, and the directory structure
# is then created. The return value is 4.
#
# Usage: INTEGER = CreatePath(PATH)
#
sub CreatePath
{
  my $PATH = FixPath($_[0] . '/.');   # Resolve . and .. references
  $PATH =~ tr`\\`/`;   # Change all backslash to forward slash for now.

  my $PREV = 0;
  my $CREATED = 0;
  for (my $i = 0; $i < length($PATH); $i++)
  {
    my $c = vec($PATH, $i, 8);
    if ($c == 47)             # Forward slash?
    {
      # Skip root. Don't test whether / or drive C:\ exists or not.
      next if ($i == 0 || $PREV == 58);

      my $F = substr($PATH, 0, $i - 1);
      if (-e $F)              # Is this name taken already?
      {
        if (-d $F) { next; }  # Yes, but it's a directory. Okay, perfect!
        rename $F, "$F.BAK";
        unlink $F;            # If the rename was unsuccessful, we delete it.
      }
      mkdir($F, 0664);        # And create a directory.
      $CREATED++;
    }
    $PREV = $c;
  }
  return (-d $PATH) ? $CREATED + 1 : 0;
}
##################################################
#                                       v2022.7.11
# Returns 1 if a file exists or 0 if it doesn't
# exist. Returns 2 if it's a directory.
#
# Usage: INTEGER = FileExists(FILENAME)
#
sub FileExists
{
  my $F = defined $_[0] ? $_[0] : '';
  return -d $F ? 2 : -e $F ? 1 : 0;
}
##################################################
#                                       v2022.7.11
#
# Returns the file size or zero
# if the file doesn't exist or if an error occurred.
#
# Usage: INTEGER = FileSize(FILENAME)
#
sub FileSize
{
  my $F = defined $_[0] ? $_[0] : '';

  -e $F or return 0;   # Exists?
  -f $F or return 0;   # Is it a file?
  return -s $F;        # Get file size.
}
##################################################
#                                        v2022.9.5
# This function removes illegal characters from
# a file name such as:  $ % ? * < > | " \t \r \n \0
# and any character whose ASCII value is 0-31.
#
# Usage: FILENAME = FilterFileName(FILENAME)
#
sub FilterFileName
{
  my $F = defined $_[0] ? $_[0] : '';
  $F =~ tr`<>*%$?\x00-\x1F\"\|``d;
  return $F;
}
##################################################
#                                File | v2023.1.13
# This function checks if a file exists and if
# it's a plain file and can be opened for reading.
# If the file passes all these checks, then the
# function returns 1, otherwise zero and prints
# an error message to stderr.
#
# An optional 2nd argument adds a file size check
# as well. The file must be at least this long
# for it to pass.
#
# Usage: INTEGER = CheckFile(FILENAME, [MINSIZE])
#
sub CheckFile
{
  my $ERR = '';
  foreach (0, 1)  # Try...
  {
    # Catch:
    if ($_) { print STDERR "\nERROR: $ERR\n"; return 0; }
    unless (defined $_[0] && length($_[0]))
      { $ERR = 'Missing file name.'; next; }
    if (length($_[0]) > 16000)
      { $ERR = 'File name is too long.'; next; }
    unless (-e $_[0])
      { $ERR = "File not found - $_[0]"; next; }
    unless (-f $_[0])
      { $ERR = "Not a plain file - $_[0]"; next; }
    if (defined $_[1] && -s $_[0] < $_[1])
      { $ERR = "File is too small - $_[0]"; next; }
    local *FILE;
    unless (sysopen(FILE, $_[0], 0))
      { $ERR = "Cannot open file for reading - $_[0]"; next; }
    close FILE;
    last;
  }
  return 1;
}
##################################################
#                                       v2022.8.26
# Reads an entire binary file or part of a file
# into a BUFFER using the sysopen(), sysseek() and
# sysread() functions. Returns 1 on success, or if
# an error occurs, the buffer's contents will be
# empty and the return value will be zero.
#
# An optional third argument will move the file
# pointer before reading, and an optional fourth
# argument can limit the number of bytes to read.
#
# Usage: STATUS = ReadFile(FILENAME, BUFFER, [START, [LENGTH]])
#
sub ReadFile
{
  my $FILE = defined $_[0] ? $_[0] : '';  # File name
  my $DATA = defined $_[1] ? $_[1] : '';  # Data buffer
  my $PTR = defined $_[2] ? $_[2] : 0;    # File pointer
  my $N = defined $_[3] ? $_[3] : 0;      # Bytes to read

  # We first find out if the buffer is a scalar or a scalar reference.
  # TinyPerl 5.8 creates a double copy of the read buffer
  # unless we use a reference.
  my $REF = length(ref($DATA));
  if ($REF == 0) { $DATA = \$_[1]; }  # Create a reference.
  elsif ($REF != 6) { return 0; }     # The word 'SCALAR' has 6 letters,
  # so if it's not 6 letters, then it's neither scalar nor reference.

  # Initialize our read buffer.
  $$DATA = '';

  # First, we will remove double quotes, $ sign, null * ? < > | and
  # various other illegal characters from the file name.
  $FILE =~ tr#<>*%$?\r\n\"\0|##d;

  -e $FILE || return 0;  # Let's check if the file exists.
  -f $FILE || return 0;  # Check if it's a plain file.
  my $SIZE = -s $FILE;   # Get file size.
  $SIZE || return 0;     # File size is zero?

  # Make sure all parameters are valid.
  if ($N < 0 || $PTR < 0 || $PTR >= $SIZE) { return 0; }

  # The sysread() function will reserve EXACTLY as many bytes of memory
  # as specified in its third argument even if the file size is much smaller.
  # So, it is a good idea to check and make sure that the LENGTH argument
  # does not hold a value that is far greater than necessary.
  $SIZE -= $PTR;  # Calculate the maximum value for the LENGTH argument.
  if ($N == 0 || $N > $SIZE) { $N = $SIZE; }
  
  local *H;
  sysopen(H, $FILE, 0) || return 0;   # Try to open file for read only.
  $PTR && sysseek(H, $PTR, 0);        # Move the file pointer if necessary.
  sysread(H, $$DATA, $N);             # Read $N number of bytes from file into $DATA.
  close H;
  return 1;
}
##################################################
#                                File | v2023.1.13
# This function reads an entire binary file or part
# of a file using the sysopen(), sysseek(), and
# sysread() builtin functions and returns a
# string reference to the content read
# or zero if an error occurred.
#
# The first argument should be the file name.
# An optional 2nd argument will move the file pointer
# before reading, and an optional 3rd argument can
# limit the number of bytes to read. If this number
# is zero or undefined, then it will read all the
# bytes until the end of file is reached. If the
# file pointer is negative, it will start reading
# from the end of file.
#
# Usage: REF = ReadFileRef(FILENAME, [START, [LENGTH]])
#
sub ReadFileRef
{
  my $F = FilterFileName($_[0]);      # File Name
  my $P = defined $_[2] ? $_[2] : 0;  # File Pointer
  my $L = defined $_[3] ? $_[3] : 0;  # Number of bytes to read

  my $DATA = '';         # This will be the read buffer
  my $REF = \$DATA;      # This will be the return value

  -e $F or return 0;     # File exists?
  -f $F or return 0;     # Is it a plain file?
  my $SIZE = -s $F;      # Get file size.

  # If the file pointer is negative then
  # we read from the end of the file.
  $P >= 0 or $P += $SIZE;

  # Make sure all parameters are valid.
  if ($L < 0 || $P < 0 || $P >= $SIZE) { return 0; }

  # Adjust number of bytes to read.
  $SIZE -= $P;
  if ($L == 0 || $L > $SIZE) { $L = $SIZE; }

  print "\n\n", $!;
  print "\n\n", $^E;

  local *FILE;
  sysopen(FILE, $F, 0) or return 0;  # Open file for read only.
  binmode FILE;
  $P && sysseek(FILE, $P, 0);        # Move file pointer
  sysread(FILE, $DATA, $L);          # Read file
  close FILE;
  return $REF;
}
##################################################
# Reads an entire file in raw mode and returns the contents in a string.
# Usage: STRING = ReadFile(FILENAME)
sub SimpleReadFile { my $NAME = shift; my $DATA; return '' unless (-f $NAME); return '' unless (-s $NAME); open my $FILE, '<:raw', $NAME or return ''; { local $/; $DATA = <$FILE>; } close $FILE; return '' unless (defined $DATA); return $DATA; }

# This function writes a string to a file. Returns the number of bytes written.
# Usage: INTEGER WriteFile(FILENAME, STRING)
sub SimpleWriteFile { my $NAME = shift; my $DATA = shift; my $LEN = length($DATA); open my $FILE, '>', $NAME or return 0; binmode $FILE; print $FILE $DATA; close $FILE or return 0; return (-s $NAME == $LEN) ? $LEN : 0; }

# This function reads no more than N number of lines from a text file and returns the contents as an array. Will EXIT() if the file doesn't exist.
# Usage: ARRAY ReadTextFile(FILENAME, N)
sub SimpleReadTextFile { my $NAME = shift; my $N = shift; my $i = 0; my @DATA; EXIT(0xcc0000) unless (-f $NAME); open my $FILE, '<', $NAME or return @DATA; while (my $LINE = <$FILE>) { last if ($i >= $N); $DATA[$i++] = Trim($LINE); } close $FILE; return @DATA; }

##################################################
#                                       v2022.9.10
# Writes a string to the end of a file.
# Creates a file if it didn't exist before.
# Returns 1 on success or 0 if something went wrong.
#
# Usage: INTEGER = AppendFile(FILENAME, CONTENT)
#
sub AppendFile
{
  @_ > 0 or return 0;
  my $FILE = FilterFileName($_[0]);
  length($FILE) or return 0;
  my $CONTENT = defined $_[2] ? length($_[2]) : 0;
  my $NOTEXIST = (-e $FILE) && (-f $FILE) ? 0 : 1;
  my $FILESIZE = $NOTEXIST ? 0 : -s $FILE;
  if ($NOTEXIST || $CONTENT)
  {
    local *H;
    open(H, ">>$FILE") or return 0;
    if ($CONTENT) { print H $_[1]; }
    close H;
  }
  -e $FILE or return 0;
  -f $FILE or return 0;
  return ($CONTENT == 0) ? 1 : ($FILESIZE + $CONTENT == (-s $FILE)) ? 1 : 0;
}
##################################################
#                                      v2022.08.26
# Creates and overwrites a file in binary mode.
# Returns 1 on success or 0 if something went wrong.
# Providing a third argument forces the file to be
# created even if a read-only file with the same name
# already exists.
#
# Usage: STATUS = CreateFile2(FILENAME, CONTENT, [FORCE])
#
sub CreateFile2
{
  my $FILE = FilterFileName($_[0]);
  my $LEN  = defined $_[1] ? length($_[1]) : 0;
  my $FORCE = defined $_[2] ? $_[2] : 0;

  if ($FORCE && -e $FILE)
  {
    if ($^O =~ m/DOS|MSWIN/i)
    { system("DEL /F /Q \"$FILE\""); }
    else
    { chmod 0655, $FILE; unlink $FILE; }
  }

  local *H;
  open(H, ">$FILE") or return 0;
  binmode H;
  $LEN && print H $_[1];
  close H;
  -e $FILE or return 0;               # File exists?
  -f $FILE or return 0;               # It's a plain file?
  return (-s $FILE == $LEN) ? 1 : 0;  # Double check file size.
}
##################################################
#                                      v2022.08.26
# Creates and overwrites a file in binary mode.
# Returns 1 on success or 0 if something went wrong.
#
# Usage: STATUS = CreateFile(FILENAME, CONTENT)
#
sub CreateFile
{
  my $FILE = defined $_[0] ? $_[0] : '';  # Get file name.
  my $DATA = defined $_[1] ? $_[1] : '';  # Get content.

  # The content to be written must be type scalar or scalar reference.
  my $REF = length(ref($DATA));
  $REF == 0 || $REF == 6 || return 0;   # 'SCALAR' has 6 letters
  if ($REF == 0) { $REF = 6; $DATA = \$_[1]; }

  # Get content length.
  my $LEN = ($REF) ? length($$DATA) : length($DATA);

  # Remove double quotes, $ sign, null * ? < > | and
  # various other illegal characters from the file name.
  $FILE =~ tr#<>*%$?\r\n\"\0|##d;

  local *H;
  open(H, ">$FILE") or return 0;
  binmode H;
  if ($LEN) { print H $REF ? $$DATA : $DATA; }
  close H;
  -e $FILE or return 0;               # File exists?
  -f $FILE or return 0;               # It's a plain file?
  return (-s $FILE == $LEN) ? 1 : 0;  # Double check file size.
}
##################################################
#                                        v2022.9.3
# This function copies a large part of a file to a
# different position within the same file without
# using a lot of resources.
# Returns 1 on success or zero if something went wrong.
#
# WARNING: If the computer loses power or crashes
# while this function is running, the file may
# become corrupted!!!
#
# Usage: CopyFileData(FileName, OldPos, NewPos, Size)
#
sub CopyFileData
{
  my $FILE = defined $_[0] ? $_[0] : '';
  my $OLD = defined $_[1] ? $_[1] : 0;
  my $NEW = defined $_[2] ? $_[2] : 0;
  my $LEN = defined $_[3] ? $_[3] : 0;

  # Make sure we have valid input.
  $FILE =~ tr`<>*%$?\x00-\x1F\"\|``d;  # Remove illegal characters from file name.
  if ($OLD == $NEW || $LEN == 0) { return 1; }
  if ($OLD < 0 || $NEW < 0 || $LEN < 0) { return 0; }
  -e $FILE or return 0;
  -f $FILE or return 0;
  my $SIZE = -s $FILE;
  if ($OLD >= $SIZE) { return 0; }
  if ($NEW + $LEN >= 17592186044416) { return 0; }  # Ext4 max file size = 16 TB

  # First we figure out how many cycles it will take to complete the operation.
  my $BLOCK = '';
  my $BLOCK_SIZE = 524288;
  my $CYCLES = CEIL($LEN / $BLOCK_SIZE);

  # We save the original pointers.
  # During the last cycle, if we need to copy multiple
  # cycles going in reverse direction, we need to restore the original pointers.
  my $SAVED_OLD = $OLD;
  my $SAVED_NEW = $NEW;

  # Next we need to find out are we copying data to a new location
  # that is farther away from the beginning of file or closer?
  # Also, is the source overlapping the destination?
  my $FARTHER = ($OLD < $NEW) ? 1 : 0;
  my $OVERLAP = ($FARTHER) ? ($OLD + $LEN < $NEW ? 0 : 1) : ($NEW + $LEN < $OLD ? 0 : 1);

  # If the data is overlapping and we're moving data farther, then we
  # need to start reading from the end of the data block to prevent
  # overwriting the stuff we're supposed to copy.
  my $DIR = $BLOCK_SIZE;
  if ($OVERLAP && $FARTHER && $CYCLES > 1)
  {
    $OLD += $LEN - $BLOCK_SIZE;
    $NEW += $LEN - $BLOCK_SIZE;
    $DIR = -$DIR;
  }

  # Display progress indicator when we're moving more than 500MB
  my $SHOW_PROGRESS = ($LEN >= 500000000) ? 1 : 0;
  $| = 1;

  # Start by opening the file for I/O binary mode.
  my $F;
  open($F, "+<$FILE") or return 0;
  binmode $F;
  $SHOW_PROGRESS && print "\nMoving ", int($LEN / 1000000), ' MB of data. Please wait.';
  for (my $i = 0; $i < $CYCLES; $i++)
  {
    if ($i + 1 == $CYCLES)  # Last cycle?
    {
      if ($LEN % $BLOCK_SIZE) { $BLOCK_SIZE = ($LEN % $BLOCK_SIZE); }
      if ($DIR < 0) { $OLD = $SAVED_OLD; $NEW = $SAVED_NEW; }
    }
    seek($F, $OLD, 0);
    read($F, $BLOCK, $BLOCK_SIZE);
    seek($F, $NEW, 0);
    print $F $BLOCK;
    $OLD += $DIR;
    $NEW += $DIR;
    $SHOW_PROGRESS && (($i & 63) == 0) && print '.';
  }
  close $F;
  $SHOW_PROGRESS && print "DONE.\n";
}
##################################################
#                                       v2022.8.28
# Assembles two or more strings to form a path.
# Removes duplicate slashes and resolves . and ..
# directory references. On Linux and MacOS systems,
# it returns a path string separated by forward slashes,
# and on Windows and DOS, it returns a path separated
# by backslash characters.
#
# Usage: STRING = MergePath(STRINGs)
#
sub MergePath { return FixPath(join('/', @_)); }

##################################################
#                                       v2022.9.24
# Changes the file name separator to forward slash
# or backslash depending on the current OS.
# Resolves . and .. in path strings.
# Eliminates duplicate slashes.
#
# Examples:
#     ../..               => ../..
#     a/b/././../../..    => ..
#     /a/b/c/./../x.txt   => /a/b/x.txt
#     a/../../../x.txt    => ../../x.txt
#     /a/b/../../../x.txt => /x.txt
#
# Paths can contain too many .. which point to nowhere.
# In that, case the function ignores the error and
# tries to resolve it as much as possible:
#
#     /../                => /
#     /../../a/b/c        => /a/b/c
#
# Usage: STRING = FixPath(PATH)
#
sub FixPath
{
  my $P = defined $_[0] ? $_[0] : '';

  $P =~ tr`\x00-\x1F\"\|<>``d;  # Remove illegal characters: < > | " \t \r \n \0
  $P =~ tr`\\`/`;   # Change all backslash to forward slash.
  $P =~ tr`\/``s;   # Remove duplicate slashes.

  my $DRV = '';
  if (vec($P, 1, 8) == 58) { $DRV = substr($P, 0, 2); $P = substr($P, 2); }

  my $ABS = 0;
  if (vec($P, 0, 8) == 47) { $ABS = 1; $P = substr($P, 1); }

  # Split the path string along '/' characters
  my @D = split(/\//, $P);
  my $i = @D;

  # First, let's eliminate '.' from the path string.
  while ($i--)
  {
    $D[$i] =~ s/^[\0- ]+|[\0- ]+$//g;   # Trim whitespace...
    if (length($D[$i]) == 0 || $D[$i] eq '.') { splice(@D, $i, 1); }
  }

  # Next, we resolve '..' in the path string.
  for ($i = 0; $i < @D; $i++)
  {
    if ($D[$i] eq '..')
    {
      if ($i == 0)
      {
        # If the path string begins with ..
        # then we can do one of two things: either eliminate
        # it or leave it. We eliminate it if the path is an absolute path,
        # because you can't go one level higher than /
        # If the path looks like ../a.txt then it's a relative path,
        # and we have to leave it like it is. But if it looks like
        # /../a.txt then we eliminate those, because /../a.txt
        # makes no sense. This is an invalid path.
        if ($ABS) { splice(@D, $i--, 1); }
        next;
      }

      # If we encounter a '..' but the previous string was also '..'
      # then we can't resolve it. Two '..' separated by '/' don't
      # cancel each other out. We skip this and move on...
      if ($D[$i - 1] eq '..') { next; }

      # Okay, if we can cancel out the previous string, then we use
      # the splice() function to erase the current '..' and the string before it.
      splice(@D, $i - 1, 2);
      $i -= 2;
    }
  }

  # Here we rebuild the original path string.
  $P = $DRV . ($ABS ? '/' : '') . join('/', @D);

  $P =~ tr`/``s;   # Remove duplicate slashes just in case. -- THIS LINE MAY BE UNNECESSARY. WILL HAVE TO REVIEW...

  # Change all forward slashes to backslash on DOS/Windows.
  if ($^O =~ m/DOS|MSWIN/i) { $P =~ tr`/`\\`; }
  # And we're done!

  return $P;
}
##################################################
#                                        v2020.1.9
# This function doubles backslash characters in a
# DOS string so when it is inserted into a string
# it becomes a single backslash.
#
# Usage: STRING = QuotePath(STRING)
#
sub QuotePath
{
  my $P = defined $_[0] ? $_[0] : '';
  $P =~ s/\\/\\\\/g;
  return $P;
}
##################################################
#                                        v2022.9.2
# Returns a temporary file name which includes full path.
# The path for temporary files is copied from $TEMPDIR
# global variable. If the path includes sub-directories
# which do not exist yet, then they will be created.
#
# With no arguments, this function returns a random
# file name with full path. It may look like 'c:\temp\abcdefgh.tmp'
#
# When one argument is provided, the suggested name will be
# used, and the '#' sign in the file name will be replaced
# with a number. For example:
#
#   CreateTempFile('ABCD####.tmp') => 'C:\TEMP\ABCD0001.tmp'
#
# When a third argument is given, this function will
# create the temporary file and return its full name.
#
# Usage: FULLNAME = CreateTempFile([FILENAME, [CONTENT]])
#
sub CreateTempFile
{
  my $FILENAME = defined $_[0] ? $_[0] : '';

  # The temporary file name may not include a path;
  # it may not include illegal characters such as < > | * ? % ' " \0 \r \n \t etc...
  $FILENAME =~ tr`<>*%$?\x00-\x1F\'\"\|\\\/``d;

  length($FILENAME) or $FILENAME = 'TRASH###.TMP';

  # Make sure temporary directory exists and we can use it.
  foreach (0...2)
  {
    last if (-d $TEMPDIR);
    if ($_ == 1) { $TEMPDIR = ($^O =~ /MSWIN|DOS/i) ? 'C:\\TEMP' : '/tmp'; }  # Can we use the default temp directory?
    if ($_ == 2) { $TEMPDIR = ($^O =~ /MSWIN|DOS/i) ? `cd` : `pwd`; last; }   # Let's use the current directory then.
    CreatePath($TEMPDIR);
  }
  $FILENAME = FixPath("$TEMPDIR/$FILENAME");

  # Create a numbered file name.
  my $P = index($FILENAME, '#');       # Find first '#' character
  my $TEMPNAME = $FILENAME;            # Make a copy of the filename
  my $DIGITS = length($TEMPNAME);      # Remember file name length
  if ($P >= 0)
  {
    $TEMPNAME =~ tr`#``d;              # Remove all '#' characters from file name to see how much it will shrink
    $DIGITS -= length($TEMPNAME);      # Get number of '#' characters in the file name originally
    my $F = "%0.${DIGITS}d";           # Create output pattern for sprintf()
    my $MAX = '1' . ('0' x $DIGITS);   # Calculate number of cycles for our for loop
    my $OLDEST = 0x7FFFFFFF;           # Last modified date of the oldest temp file that matches pattern in $FILENAME
    my $OVERWRITE = 1;                 # Should we overwrite one of the temp files instead of creating a new one?
    for (my $i = 0; $i < $MAX; $i++)
    {
      substr($FILENAME, $P, $DIGITS) = sprintf($F, $i);   # Insert serial number into filename.
      unless (-e $FILENAME) { $OVERWRITE = 0; last; }     # Check if file exists.
      my $MODIFIED = (stat($FILENAME))[9];                # Get file's last modified date
      if ($MODIFIED < $OLDEST) { $OLDEST = $MODIFIED; $TEMPNAME = $FILENAME; }   # Save oldest file's name in $TEMPNAME
    }
    if ($OVERWRITE) { $FILENAME = $TEMPNAME; }
  }
  local *FH;
  open(FH, ">$FILENAME") or return '';   # Now create the temp file.
  defined $_[1] && print FH $_[1];     # Write into it (if we have something to write).
  close FH;
  return $FILENAME;                      # Return the temp file's name and full path.
}
##################################################
#                                       v2022.8.27
# Deletes temporary files created by the
# CreateTempFile() function.
#
# Usage: DeleteTempFiles(SUGGESTED_NAME)
#
sub DeleteTempFiles
{
  @_ or return;
  -e $TEMPDIR or return;
  my $FILENAME = defined $_[0] ? $_[0] : '';

  my $COUNT = CountChar($FILENAME, '#');

  # Assemble temp file name.
  $FILENAME = FixPath("$TEMPDIR/$FILENAME");

  if ($COUNT == 0) { unlink($FILENAME); return; }

  # Create numbered file names.
  my $TOP = ('1' . ('0' x $COUNT)) | 0;
  my $FF = "%0.0${COUNT}d";
  my $TEMPNAME = '';
  for (my $i = 0; $i < $TOP; $i++)
  {
    my $TEMPNAME = $FILENAME;
    my $NUM = sprintf($FF, $i);
    $TEMPNAME =~ s/[\#]+/$NUM/;
    if (-e $TEMPNAME) { unlink($TEMPNAME); }
  }
}
##################################################
#                                       v2022.8.27
# Executes a JavaScript program on Windows.
# Captures and returns whatever is printed to stdout.
# The "SUGGESTED_FILENAME" may be left blank or
# it can contain a name
#
# Usage: STRING = RunJS(SUGGESTED_FILENAME, JAVASCRIPT_CODE)
#
sub RunJS
{
  $^O =~ m/MSWIN|DOS/i or return '';
  my $FILE = defined $_[0] ? $_[0] : 'SCRIPT##.JS';
  $FILE = CreateTempFile($FILE, defined $_[1] ? $_[1] : '');
  return `CSCRIPT.EXE //NOLOGO $FILE`;
}
##################################################
#                                       v2022.8.27
# Returns a list of logical drives in Windows.
# Each line starts with drive letter, followed by
# drive type, serial number, file system, label,
# total space and free space. All items will be
# separated by a '*' character.
#
# If one or more letters are provided as an argument,
# then data will be returned only about those drives.
# Example:
#   GetDriveInfo('CE') => Returns data about drive C: and E:
# If drive E: does not exist, then it will be left
# out of the list!
#
# Usage: STRING = GetDriveInfo([DRIVEs])
#
sub GetDriveInfo
{
  my $DRIVES = defined $_[0] ? $_[0] : 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  return RunJS('FREESP.JS', "V='$DRIVES';try{FSO=new ActiveXObject('Scripting.FileSystemObject');}catch(e){WScript.Quit(0);}A=[];function ToHex(N){N|=0;var i,X='';for(i=0;i<32;i+=4)X='0123456789ABCDEF'.charAt((N>>i)&15)+X;return X;}for(i=0;i<V.length;i++){L=V.charAt(i)+':';if(FSO.DriveExists(L)){D=FSO.GetDrive(L);if(D.IsReady){S=ToHex(D.SerialNumber)+'*'+D.FileSystem+'*'+D.VolumeName+'*'+D.TotalSize+'*'+D.FreeSpace;}A.push(L+'*'+D.DriveType+'*'+S);}}WScript.StdOut.WriteLine(A.join(\"\\r\\n\"));");
}
##################################################
#                                       v2022.8.27
# Returns a list of logical drives in Windows.
# Each line starts with drive letter, followed by
# drive type, serial number, file system,
# drive label, total space and free space.
#
# Usage: STRING = GetDriveList()
#
sub GetDriveList { return GetDriveInfo(); }
##################################################
#                                       v2022.8.27
# Returns the number of kilobytes left on drive
# C:\ or wherever the PATH is pointing to.
# 
# Usage: INTEGER = GetFreeSpace([PATH])
#
sub GetFreeSpace
{
  my $PATH = defined $_[0] ? $_[0] : '';
  if ($^O =~ m/MSWIN|DOS/i)
  {
    # Get free space in DOS and Windows by issuing the DIR command.
    if (length($PATH)) { -e $PATH or CreatePath($PATH); } else { $PATH = 'C:\\'; }
    my $DIR = `DIR $PATH`;
    $DIR =~ tr|j-q\\J-Q \.\-\r\n,<>\/\:||d;
    return int(GetLeftNumber($DIR, length($DIR)) / 1024);  # Return number of kilobytes
  }
  return GetValueFromTable(`df -lk`, 'AVAILABLE', '/');
}
##################################################
#                                       v2022.8.11
# Returns the size of available continuous memory
# in kilobytes under DOS/Windows/Linux/MacOS.
#
# Usage: INTEGER = GetFreeMemory()
# 
sub GetFreeMemory
{
  if ($^O =~ m/MSWIN|DOS/i)
  {
    WinVer() or return 640;   # Always report 640 KB for DOS.
    # On Windows, we run a small JavaScript program
    # that tells us how much memory is available.
    my $FREE = RunJS('FREEMEM.JS', "A=0;try{WMI=GetObject('winmgmts:\\\\\\\\.\\\\root\\\\CIMV2');m=WMI.ExecQuery('SELECT * FROM Win32_OperatingSystem');e=new Enumerator(m);/*A=e.item().TotalVisibleMemorySize;*/A=e.item().FreePhysicalMemory;}catch(e){}WScript.StdOut.WriteLine(A);");
    $FREE =~ tr|0-9||cd;
    return $FREE;
  }
  # For Linux and MacOS, we use the 'free' command:
  return GetValueFromTable(`free -k`, 'AVAILABLE', 'MEM:', 1);
}
##################################################
#                                       v2022.8.27
# This function returns the Windows version
# that is currently running on this PC:
#   0 = Windows is not running
#   1 = Windows 95
#   2 = Windows 98
#   3 = Windows Me
#   4 = Windows 2000
#   5 = Windows XP
#   6 = Windows Vista
#   7 = Windows 7
#   8 = Windows 8
#  10 = Windows 10
#  11 = Windows 11
#
# Usage: INTEGER = WinVer()
#
sub WinVer
{
  if ($^O =~ m/LINUX|DARWIN/i) { return 0; }
  my $VER = uc(`VER`);
  if (index($VER, 'WINDOWS') < 0 || !exists($ENV{WINDIR})) { return 0; }  # Not Windows?
  $VER =~ tr|0-9\.||cd;
  # Get Windows major/minor version and build number.
  my ($MAJ, $MIN, $BLD) = split(/\./, "$VER.0.0");
  if ($MAJ == 4 && $MIN == 0 && $BLD < 1381) { return 1; } # Windows 95
  if ($MAJ == 4 && $MIN == 1 && $BLD < 2195) { return 2; } # Windows 98
  if ($MAJ == 4 && $MIN == 9) { return 3; }                # Windows Me
  if ($MAJ == 5 && $MIN == 0) { return 4; }                # Windows 2000
  if ($MAJ == 5 && $MIN > 0 && $BLD < 6000) { return 5; }  # Windows XP
  if ($MAJ == 6 && $MIN == 0) { return 6; }                # Windows Vista
  if ($MAJ == 6 && $MIN == 1) { return 7; }                # Windows 7
  if ($MAJ == 6 && ($MIN == 2 || $MIN == 3)) { return 8; } # Windows 8.X
  if ($BLD >= 10000 && $BLD < 22000) { return 10; }        # Windows 10
  return ($BLD >= 22000) ? 11 : 0;                         # Windows 11
}
##################################################
#                                       v2022.8.27
# Returns the previous number in a string from a
# given position. If the pointer is pointing at
# a number, then it will return that number.
# The end of a number is marked by any non-digit.
#
# Usage: INTEGER = GetLeftNumber(STRING, POINTER)
#
sub GetLeftNumber
{
  my $STR = defined $_[0] ? $_[0] : '';
  my $PTR = defined $_[1] ? $_[1] : 0;
  my $L = length($STR);
  $L or return '';

  if ($PTR < 0) { $PTR = 0; }
  if ($PTR >= $L) { $PTR = $L - 1; }

  # Check what's at the pointer.
  my $c = vec($STR, $PTR, 8);
  my $NUMBER = ($c < 48 || $c > 57) ? 0 : 1;

  # Find the number's last digit.
  my $LAST = $PTR;
  my $START = 0;
  if ($NUMBER)
  {
    while ($LAST++ < $L)
    {
      $c = vec($STR, $LAST, 8);
      if ($c < 48 || $c > 57)
      { $LAST--; last; }
    }
  }
  if ($PTR > 0)
  {
    # Find the number's first digit.
    for (my $i = $PTR - 1; $i >= 0; $i--)
    {
      $c = vec($STR, $i, 8);
      if ($c < 48 || $c > 57)
      {
        # Non-digit found.
        if ($NUMBER) { $START = $i + 1; last; }
      }
      else
      {
        # Digit found.
        if ($NUMBER == 0) { $NUMBER = 1; $LAST = $i; }
      }
    }
  }
  return ($NUMBER) ? substr($STR, $START, $LAST - $START + 1) : '';
}
##################################################
#                                       v2021.1.17
# This function extracts digits from a string and
# returns them in an array.
#   Example:
# GetNumbers("34DX5g") -> ["34", "5"]
# GetNumbers("-x39.4") -> ["39", "4"]
#
# Usage: ARRAY = GetNumbers(STRING)
#
sub GetNumbers
{
  my @N;
  defined $_[0] or return @N;
  my ($L, $p, $i, $c) = (length($_[0]), -1);
  for ($i = 0; $i <= $L; $i++)
  {
    $c = vec($_[0], $i, 8);
    if ($c < 48 || $c > 57)
    {
      if ($p >= 0) { push(@N, substr($_[0], $p, $i - $p)); }
      $p = -1;
    }
    elsif ($p < 0) { $p = $i; }
  }
  return @N;
}
##################################################
#                                       v2022.8.27
# Returns a value from a "plain text spreadsheet"
# from a certain column where one of the values
# on a line equals FINDVALUE.
#
# Usage: STRING = GetValueFromTable(DATA, COLUMN_HEADING, FINDVALUE, [OFFSET])
#
sub GetValueFromTable
{
  @_ > 3 or return '';
  my $DATA = defined $_[0] ? uc($_[0]) : '';
  my $HEAD = defined $_[1] ? uc($_[1]) : '';
  my $FIND = defined $_[2] ? uc($_[2]) : '';
  my $OFFSET = defined $_[3] ? $_[3] : 0;
  
  my @LINES = split(/\n/, $DATA);
  my $COLUMN = -1;
  foreach (@LINES)
  {
    my @WORDS = split(/\s+/, $_);
    for (my $i = 0; $i < @WORDS; $i++)
    {
      if ($COLUMN < 0 && $WORDS[$i] eq $HEAD) { $COLUMN = $i + $OFFSET; }
      elsif ($WORDS[0] eq $FIND) { return ($COLUMN < @WORDS) ? $WORDS[$COLUMN] : ''; }
    }
  }
  return '';
}
##################################################
#                                        v2020.8.2
# This function counts how many times STRING contains
# a character which is provided in the second argument.
#
# Usage: INTEGER = CountChars(STRING, STRING)
#
sub CountChar
{
  defined $_[0] or return 0;
  defined $_[1] or return 0;
  my ($i, $C, $L) = (0, 0, length($_[0]));
  while ($i < $L)
  {
    ($i = index($_[0], $_[1], $i) + 1) or last;
    $C++;
  }
  return $C;
}
##################################################
#                             String | v2022.10.22
# This function removes whitespace from the left
# and right side of STRING. Whitespace is here defined
# as any character whose ASCII value is less than 33.
# This includes SPACE, TAB, ESC, NULL, CR, LF, etc...
# Usage: STRING = Trim(STRING)
#
sub Trim
{
  my $P = 0;
  (my $L = defined $_[0] ? length($_[0]) : 0) || return '';
  while ($P <= $L && ord(substr($_[0], $P++, 1)) < 33) {} $P--;
  while ($P <= $L && ord(substr($_[0], $L--, 1)) < 33) {}
  return substr($_[0], $P, $L - $P + 2);
}

##################################################
#                                       v2022.8.28
# Removes whitespace from before and after a string.
#          
# Usage: STRING = Trim(STRING)
#
#sub Trim
#{
#  defined $_[0] or return '';
#  (my $L = length($_[0])) or return '';   # String length is zero?
#  my $P = 0;
#  while ($P <= $L && vec($_[0], $P++, 8) < 33) {}       # Find first non-whitespace
#  for ($P--; $P <= $L && vec($_[0], $L--, 8) < 33;) {}  # Find last non-whitespace
#  return substr($_[0], $P, $L - $P + 2);
#}
##################################################
#                                       v2022.8.27
# Generates a random string from the characters provided.
#
# Usage: STRING = RandomStr(CHARSET, LENGTH)
#
sub RandomStr
{
  my $SET = defined $_[0] ? $_[0] : '';
  my $LEN = defined $_[1] ? $_[1] : 0;
  my $LSET = length($SET);
  if ($LEN == 0 || $LSET == 0) { return ''; }

  my $R = '';
  while ($LEN--)
  {
    vec($R, $LEN, 8) = vec($SET, int(rand()*$LSET), 8);
  }
  return $R;
}
##################################################
#                                       v2022.8.28
# Expands a string by inserting a 0 byte in front
# of each character.
#
# Usage: STRING = ASCII_to_Unicode(STRING)
#
sub ASCII_to_Unicode
{
  defined $_[0] or return '';
  my $L = length($_[0]);
  my $A = '';
  for (my $i = 0; $i < $L; $i++)
  { $A .= "\0" . substr($_[0], $i, 1); }
  return $A;
}
##################################################
#                                       v2022.8.28
# This function simply discards the high 8 bits of
# each 16-bit word and returns a new string.
#
# Usage: STRING = Unicode_to_ASCII(STRING)
#
sub Unicode_to_ASCII
{
  defined $_[0] or return '';
  my $L = length($_[0]);
  $L > 1 or return '';
  my $A = '';
  for (my $i = 1; $i < $L; $i += 2)
  { $A .= chr(vec($_[0], $i, 8)); }
  return $A;
}
##################################################





sub toUnicode
{
  my $STR = defined $_[0] ? $_[0] : '';
  my $OUTPUT = '';
  my $L = length($STR);
  for (my $i = 0; $i < $L; $i++)
  { $OUTPUT .= substr($STR, $i, 1) . "\0"; }
  return $OUTPUT;
}

# Usage: STRING = ShortenPath(PATH1, PATH2) - This function returns Path2 as relative to Path1 if both are full paths. If Path2 has the same origin as Path1, the common origin is removed, leaving only the difference. Example: ShortenPath('C:\\WORK', 'C:\\WORK\\2022\\LIST.pdf') => '2022\LIST.pdf'
sub ShortenPath { my $P1 = FixPath($_[0] . '/'); my $P2 = FixPath($_[1]); return (index($P2, $P1) == 0) ? substr($P2, length($P1)) : $P2; }
# Usage: STRING = TrimChar(STRING, SUBSTR) - Removes characters found in SUBSTR from before and after STRING. v2019.6.15
sub TrimChar {defined$_[0]||return'';my$L=length($_[0]);$L||return'';defined$_[1]||return$_[0];length($_[1])||return$_[0];my$START=0;my$LAST=0;while($L--){if(index($_[1],substr($_[0],$L,1))<0){$START=$L;$LAST or $LAST=$L+1;}}return substr($_[0],$START,$LAST-$START);}
# Usage: STRING = SafeFileName(FILENAME) - Removes illegal characters from a file name. v2022.7.11
sub SafeFileName {my$F=defined$_[0]?$_[0]:'';$F=~tr#<>*%$?\r\n\"\0|##d;return$F;}
# Usage: INTEGER = WriteFile(FILE_NAME, STRING, [POINTER]) - Overwrites a portion of a binary file with STRING. Returns 1 if succeeded or returns 0 if something went wrong.
sub WriteFile {my$F=SafeFileName($_[0]);length($F) or return 0; @_ or return 0; my $S = shift; defined $S or return 0; my $P = @_ ? shift : 0; defined $P or return 0; $P >= 0 or return 0; my $Z = -s $F; defined $Z or $Z = 0; $Z > 0 or $Z = 0; open(my $H, "+<$F") or return 0; binmode $H; if (length($S)) { if ($P) { sysseek $H, $P, 0; } print $H $S or return 0; } close $H or return 0; return 1; }
# Usage: INTEGER = isReadOnly(FILENAME) - Returns 1 if file or directory is read-only or 0 if not. Returns -1 when an error occurs. v2022.7.11
sub isReadOnly {my$F=SafeFileName($_[0]);length($F)||return-1;if(-d$F){my@M=stat($F);return($M[2]&2)?0:1;}elsif(-e$F){local*H;open(H,">>$F")||return 1;close H;return 0;}return-1;}
# Usage: STRING = GetTempDir() - Returns a path where temporary files may be stored. Always ends with a forward slash or backslash. v2022.7.12
sub GetTempDir {if($^O=~/DOS|MSWIN/i){foreach('Z:\\TEMP\\','C:\\TEMP\\'){mkdir($_);if(-d$_){return$_;}}return'C:\\';}my$D='/tmp/';-d$D||mkdir$D;return$D;}
# Usage: STRING = TempFile([PATH]) - Returns the full path and name of a temporary file (without file extension) that can be created. v2022.7.11
sub TempFile {my$T=SafeFileName($_[0]);if(length($T)){my$X=FileExists($T);if($X==1){$T='';}elsif($X==0){mkdir($T);-d$T or$T='';}}if(!length($T)){$T='/tmp';if($^O=~/DOS|MSWIN/i){my$Z='Z:\\TEMP';my$C='C:\\TEMP';my$W='C:\\WINDOWS\\TEMP';mkdir($Z);if(-d$Z){$T=$Z;}elsif(-d$C){$T=$C;}elsif(-d$W){$T=$W;}else{mkdir($C);$T=$C;}}}$T.='/';for(my$i=0;$i<256;$i++){my$N='';for(my$k=0;$k<8;$k++){$N.=chr(65+int(rand()*26));}-e($T.$N)or return FixPath($T.$N);}return'';}
# Usage: ARRAY = SplitPath(FULLPATH) - Returns an array with the following elements: 1) drive 2) path 3) filename 4) extension. v2022.7.11
sub SplitPath {my$FULL=defined$_[0]?$_[0]:'';$FULL=~tr#<>\r\n\"\0|##d;$FULL=~tr|\\|/|;$FULL=Trim($FULL);my$EXT='';my$PATH='';my$NAME='';my$DRIVE='';my$N=index($FULL,':');my$P=rindex($FULL,'.');my$S=rindex($FULL,'/');if($N>=0){$DRIVE=substr($FULL,$N-1,2);}if($S>=$N){$PATH=substr($FULL,$N+1,$S-$N);$N=$S;}$N++;if($P>$N){if($P<length($FULL)){$EXT=substr($FULL,$P+1);}$NAME=substr($FULL,$N,$P-$N);}else{$NAME=substr($FULL,$N);}return($DRIVE,$PATH,$NAME,$EXT);}
# Usage: FILENAME = GetFileName(FULLNAME) - Extracts the file name with extension from a full path. v2022.7.12
sub GetFileName {my$F=defined$_[0]?$_[0]:'';$F=~tr|\\|/|;my$P=rindex($F,'/');return$P<0?$F:substr($F,$P+1);}
# Usage: STRING = toDOSPath(PATH) - Converts all forward slashes to backslashes. v2022.7.12
sub toDOSPath {my$P=defined$_[0]?$_[0]:'';$P=~tr|/|\\|;return$P;}
# Usage: STRING = toLinuxPath(PATH) - Converts all backslashes to forward slashes. v2022.7.12
sub toLinuxPath {my$P=defined$_[0]?$_[0]:'';$P=~tr|\\|/|;return$P;}
# Usage: STRING = FormatDate(SECONDS) - Returns the date in this format: M/D/YYYY H:MM:SS MM  v2022.7.12
sub FormatDate { my @D = localtime(defined $_[0] ? $_[0] : time); my $A = $D[2] > 11 ? 'PM' : 'AM'; $D[2] or $D[2] = 12; $D[2] < 13 or $D[2] -= 12; return sprintf('%d/%d/%.04d %d:%.2d:%.2d %s', (1+$D[4]), $D[3], (1900+$D[5]), $D[2], $D[1], $D[0], $A); }
# Usage: STRING = GetFileDate(FILENAME, [TYPE]) - Returns a file's last modified date. TYPE can be: MODIFIED|ACCESSED|CREATED  v2022.7.12
sub GetFileDate {my$F=SafeFileName($_[0]);my$TYPE=defined$_[1]?$_[1]:'M';$TYPE=vec($TYPE,0,8);if($TYPE==65){$TYPE=8;}elsif($TYPE==67){$TYPE=10;}else{$TYPE=9;}if($^O=~/MSWIN/i&&$TYPE==10){my$T=GetTempDir();my$J=$T.'GETCTIME.JS';$T.='GETFTIME.TMP';CreateFile($J,"try{FSO=new ActiveXObject('Scripting.FileSystemObject');F=FSO.GetFile('".QuotePath($F)."');T=FSO.CreateTextFile('".QuotePath($T)."',1,0);T.Write(F.DateCreated);T.Close();}catch(e){}")||return'';system($J);return ReadFile($T);}my@M=stat($F);return FormatDate($M[$TYPE]);}
# Usage: INTEGER = SetFileDate(FILENAME, TIME) - Changes the last modified date of a file. Example: SetFileDate('notes.txt', '6/19/1995 6:07:13 PM');  v2022.7.12
sub SetFileDate {@_==2||return;my$F=SafeFileName($_[0]);my$DATE=defined$_[1]?$_[1]:'';if($^O=~/MSWIN/i){my$V=GetTempDir().'SETFDATE.VBS';CreateFile($V,"SET F=CreateObject(\"Shell.Application\").Namespace(\"".FixPath(GetPath($F))."\").ParseName(\"".GetFileName($F)."\")\r\nF.ModifyDate=\"$DATE\"\r\n")||return;system($V);return;}my@N=GetNumbers($DATE);if(index(uc($DATE),'PM')>=0){$N[3]+=12;}$DATE=sprintf('%.04d%.02d%.02d%.02d%.02d%.02d',$N[0],$N[1],$N[2],$N[3],$N[4],$N[5]);system("touch -m -t $DATE $F");}
# Usage: PATH = GetPath(FULLNAME) - Returns the path portion of a full file name without the trailing slash or backslash character. v2019.9.15
sub GetPath {return MergePath($_[0],'..');}

# Usage: INTEGER = SetFileSize(FILENAME, NEWSIZE) - Truncates a file or expands it with zero bytes. Returns 1 on success or 0 if something went wrong. v2022.7.12
sub SetFileSize
{
  defined$_[1]||return 1;
  my$F=SafeFileName($_[0]);
  my$S=defined$_[1];
  my$CURSIZE=-s$F;
  #truncate();
}

##################################################
#                                       v2022.9.10
# If a path is relative (in other words, it does
# not start with a backslash or forward slash),
# then this function adds the current directory
# in front of it and returns the absolute path.
#
# Usage: STRING = AbsPath(STRING)
#
sub AbsPath
{
  my $PATH = defined $_[0] ? $_[0] : '';
  # THIS IS NOT SO SIMPLE, because what if it's C:WORK ?
#  $PATH =~ m/^[\\\/]+/ or $PATH = GetCurrentDirectory() . '/' . $FILENAME;
  return FixPath($PATH);
}
##################################################
# 
# Checks if the argument string ends with a forward slash or
# backslash, and if it does, then removes it and returns 1,
# or returns 0 if no slash was found at the end of the string.
# Usage: INTEGER = EndsWithSlash(STRING)
#
sub EndsWithSlash
{
  my $P = defined $_[0] ? $_[0] : '';
  length($P) or return 0;
  index("\\/", substr($P, length($P)-1, 1)) >= 0 or return 0;
  chop $_[0];
  return 1;
}



##################################################

# Usage: HANDLE = OpenFileForReading(FILE_NAME) - Opens file for reading.
sub OpenFileForReading { my $F = _FileName(\@_); length($F) or return -1; -f $F or return -1; -s $F or return -1; my $HANDLE; open $HANDLE, "<$F" or return -1; return $HANDLE; }

# Usage: Readtil(FILE_HANDLE, LINE) - Moves the file pointer to a position right after LINE. The search is non-case sensitive. Each line is trimmed before comparison.
sub Readtil { @_ > 1 or return; my $H = shift; defined $H or return; return if ($H == -1); my $S = uc(Trim(shift)); length($S) or return; while (my $L = <$H>) { return if (index(uc(Trim($L)), $S) == 0); } }

# Usage: ARRAY = ReadLinex(HANDLE, [N]) - Reads N number of lines from an opened file handle and returns an array.
sub ReadLines { my @A; @_ or return @A; my $H = shift; defined $H or return @A; return @A if ($H == -1); my $M = @_ ? shift : 99999999; defined $M or return @A; $M or return @A; -f $H or return @A; -s $H or return @A; my $i = 0; while (my $L = <$H>) { $A[$i++] = Trim($L); $i < $M or last; } return @A; }

# Usage: ARRAY = ReadTextFile(FILE_NAME, [LIMIT]) - Reads the contents of a text file and returns the lines in an array. If a second argument is provided, then only the first few lines will be processed. Each line is trimmed before it is stored.
sub ReadTextFile { my @A; my $F = _FileName(\@_); length($F) or return @A; my $M = @_ ? shift : 99999999; defined $M or return @A; $M or return @A; -f $F or return @A; -s $F or return @A; my $H; my $B; my $i = 0; open $H, "<$F" or return @A; while (my $L = <$H>) { $A[$i++] = Trim($L); $i < $M or last; } close $H; return @A; }

# OLD VERSION: This function reads no more than N number of lines from a text file and returns the contents as an array. Will DIE() if the file doesn't exist.
# Usage: ARRAY ReadTextFile(FILENAME, N)
# sub ReadTextFile { my $NAME = shift; my $N = shift; my $i = 0; my @DATA; DIE(4) unless (-f $NAME); open my $FILE, '<', $NAME or return @DATA; while (my $LINE = <$FILE>) { last if ($i >= $N); $DATA[$i++] = Trim($LINE); } close $FILE; return @DATA; }
#

##################################################
#
# This function changes the current working directory.
# Usage: INTEGER = CHDIR(PATH)
#
sub CHDIR
{
  defined $_[0] or return 0;
  my $PATH = GetAbsolutePath($_[0]);
  if (-e $PATH)
  {
    `cd $PATH`;
    $ENV{PWD} = $PATH;
  }
  else
  {
    my @D = SplitPath($PATH);
    for (my $i = 0; $i < @D; $i++)
    {
    }
  }
}