# utility routines

package DS;

1;

=comment
use util;
IS::SetReg("HKLM/SOFTWARE/AAA", "name", "value");
my $value = IS::GetReg("HKLM/SOFTWARE/AAA", "name");
print "value = $value\n";
IS::DelRegKey("HKLM/SOFTWARE/AAA");
=cut



#-------Read/Write files ------------------------------------
sub ReadFile   # (filename)
{
    # read file in ascii mode
    my ($data);
    open (IN, "$_[0]") || return "";
    read (IN, $data, (-s IN));
    close IN;
    return $data;
}


sub WriteFile   # (filename , data)
{
    # save file in ascii mode
    open (OUT, ">$_[0]") || die "Error: Can't create $_[0]\n";
    print OUT $_[1];
    close OUT;
}

sub DumpFile   # (filename , data)
{
    # save file in binary mode
    open (OUT, ">$_[0]") || die "Error: Can't create $_[0]\n";
    binmode OUT;
    print OUT $_[1];
    close OUT;
}


#-------------------------------------------
sub echosys
{
    my ($cmd) = @_;
    # print command, then call system

    print "$cmd\n";
    $rc = system($cmd);
    $rc = $rc >> 8;
    if ($rc) {
        print "ERROR: Press enter to continue";
        <STDIN>;
    }
}


sub ExpandArgs
{
    my ($argsptr) = @_;
    my @a = @$argsptr;
    my (@b, $f);

    @$argsptr = ();
    while ($f = shift(@a)) {
        if ($f =~ m/[\*\?]/) {
            push(@$argsptr, glob($f));
        }
        else {
            push(@$argsptr, $f);
        }
    }
}



#-------registry functions------------------------------------
use Win32::Registry;

sub GetReg
{
    my ($entry) = @_;
    # example IS::GetReg('HKLM\SOFTWARE\key\entryname');
    # use value of undef to delete value

    #print "entry = $entry\n";
    my ($hkey, $disposition);
    $entry =~ s%/%\\%g;

    my ($topkey, $subkey, $entryname);

    if ($entry =~ m/(^.*?)\\(.+?)\\([^\\]+)$/) {
        ($topkey, $subkey, $entryname) = ($1, $2, $3);
		$entryname = undef if ($entryname eq 'default' || $entryname eq "\@" );
    }
    elsif ($entry =~ m/(^.*?)\\([^\\]+)$/) {
        #($topkey, $subkey, $entryname) = ($1, "", $2);
        ($topkey, $subkey, $entryname) = ($1, $2, undef);
    }
    else {
        print "Invalid registry entry $entry\n";
        exit;
    }
    #print "topkey = $topkey, subkey = $subkey, entryname = $entryname\n";

    if ($topkey =~ /^(HKEY_CLASSES_ROOT)|(HKCR)$/) {
        $topkey = &HKEY_CLASSES_ROOT;
    }
    elsif ($topkey =~ /^(HKEY_LOCAL_MACHINE)|(HKLM)$/) {
        $topkey = &HKEY_LOCAL_MACHINE;
    }
    elsif ($topkey =~ /^(HKEY_CURRENT_USER)|(HKCU)$/) {
        $topkey = &HKEY_CURRENT_USER;
    }
    else {
        print "Invalid registry entry $entry\n";
        exit;
    }


    my $saveW = $^W; $^W = 0;

    my ($type, $value);


    if ($subkey) {
	    Win32::Registry::RegOpenKeyEx ( $topkey, $subkey, 0, &KEY_QUERY_VALUE, $hkey) || return undef;
	}
	else {
    	    $hkey = $topkey;
    }

    Win32::Registry::RegQueryValueEx( $hkey, $entryname, 0, $type, $value);
    Win32::Registry::RegCloseKey( $hkey );
    $^W = $saveW;
    return $value;
}


sub SetReg
{
    my ($entry, $value) = @_;
    # example IS::SetReg('HKLM\SOFTWARE\key\entryname', $value);
    # use value of undef to delete value

    #print "entry = $entry\n";
    my ($hkey, $disposition);
    $entry =~ s%/%\\%g;

    my ($topkey, $subkey, $entryname);

    if ($entry =~ m/(^.*?)\\(.+?)\\([^\\]+)$/) {
        ($topkey, $subkey, $entryname) = ($1, $2, $3);
		$entryname = undef if ($entryname eq 'default' || $entryname eq "\@" );
    }
    elsif ($entry =~ m/(^.*?)\\([^\\]+)$/) {
        #($topkey, $subkey, $entryname) = ($1, "", $2);
        ($topkey, $subkey, $entryname) = ($1, $2, undef);
    }
    else {
        print "Invalid registry entry $entry\n";
        exit;
    }
    #print "topkey = $topkey, subkey = $subkey, entryname = $entryname\n";

    if ($topkey =~ /^(HKEY_CLASSES_ROOT)|(HKCR)$/) {
        $topkey = &HKEY_CLASSES_ROOT;
    }
    elsif ($topkey =~ /^(HKEY_LOCAL_MACHINE)|(HKLM)$/) {
        $topkey = &HKEY_LOCAL_MACHINE;
    }
    elsif ($topkey =~ /^(HKEY_CURRENT_USER)|(HKCU)$/) {
        $topkey = &HKEY_CURRENT_USER;
    }
    else {
        print "Invalid registry entry $entry\n";
        exit;
    }


    my $saveW = $^W; $^W = 0;

    if ($subkey) {
        Win32::Registry::RegCreateKeyEx( $topkey, $subkey,
	        0, 'NT Perl 5', REG_OPTION_NON_VOLATILE, &KEY_ALL_ACCESS, 0,
    	    $hkey, $disposition ) || 
                return print ("Error: RegCreateKeyEx " .  Win32::FormatMessage(Win32::GetLastError()));
    } else {
    	    $hkey = $topkey;
    }

    if (defined $value) {
        # preserve the type, eg REG_EXPAND_SZ
        my ($type, $oldvalue);
        if (!Win32::Registry::RegQueryValueEx($hkey, $entryname, 0, $type, $oldvalue)) {
            $type = &REG_SZ;
        }
	    Win32::Registry::RegSetValueEx($hkey, $entryname, 0, $type, $value)
            || return print ("Error: set value\n");
    }
    else {
	    Win32::Registry::RegDeleteValue($hkey, $entryname);
    }


    Win32::Registry::RegCloseKey( $hkey );
    $^W = $saveW;
}


sub DelRegKey
{
    my ($key) = @_;

    $key =~ s%/%\\%g;
    my $topkey;
    if ($key =~ s/^(HKEY_CLASSES_ROOT\\)|(HKCR\\)//) {
        $topkey = &HKEY_CLASSES_ROOT;
    }
    elsif ($key =~ s/^(HKEY_LOCAL_MACHINE\\)|(HKLM\\)//) {
        $topkey = &HKEY_LOCAL_MACHINE;
    }
    elsif ($key =~ s/^(HKEY_CURRENT_USER\\)|(HKCU\\)//) {
        $topkey = &HKEY_CURRENT_USER;
    }
    else {
        print "Invalid key $key\n";
        exit;
    }

    Win32::Registry::RegDeleteKey($topkey, $key) ||
		print ("Error: RegDeleteKey " .  Win32::FormatMessage(Win32::GetLastError()));

}


#-------Process functions------------------------------------

#use Win32::API;     # neeeded for perl2exe
sub CreateProcess
{
    my ($cmd, $show) = @_;
    # show 0 = hidden, 1, = normal 2 = minimized
    # If the function succeeds, the return value is nonzero.

    eval("use Win32::API;");
    my $win32api_avail = !$@;

    if (!$win32api_avail) {
        print "Warning: Win32::API not available\n";
        system("start /min $cmd"); # 98/NT starts independent console
        return 1;
    }

    my $dwFlags = 1;   # STARTF_USESHOWWINDOW
    $dwFlags |= 0x00000100;   # STARTF_USESTDHANDLES 
                              # otherwise we inherit the parents handles on 98

    # SW_HIDE=0 SW_SHOWNORMAL=1 SW_SHOWMINIMIZED=2
    my $si = pack("LLLLLLLLLLLL SS LLLL", 
                68,0,0,0, 0,0,0,0, 0,0,0,$dwFlags, 
                $show,0,0,
                -1, -1 , -1
                );

    my $processinfo = pack("LLLL", 0,0,0,0);
    my $dwCreationFlags = 0x10; # CREATE_NEW_CONSOLE
    #my $dwCreationFlags = 8; # DETACHED_PROCESS
    #$dwCreationFlags |= 0x200; # CREATE_NEW_PROCESS_GROUP 
    my $CreateProcess = new Win32::API("kernel32", "CreateProcess", 
        ['P','P','P','P', 'N','N', 'P','P','P','P'], 'N');
 
    $CreateProcess || die;
    my $rc = $CreateProcess->Call(
                0, $cmd,
                0, 0,   # security
                0,  # inherit
                $dwCreationFlags,
                0,      # env
                ".",    # cwd
                $si,
                $processinfo);
    return $processinfo;
}



sub WaitProcess
{
    my ($process) = @_;
    my ($hProcess) = unpack("LLLL", $process);
    my $inifinate = 0xffffffff;
    my $WaitForSingleObject = new Win32::API("kernel32", "WaitForSingleObject", ['N','N'], 'N');
    $WaitForSingleObject->Call($hProcess, $inifinate);
}

#-------------------------------------------

