W:\dev\indigoperl\indigoperl/perl/lib/DSUtil.pm

#-------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); }

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

W:\dev\indigoperl\indigoperl/perl/lib/DSUtil.pm