f:\dev\dp\perl-5.6.0_install/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 ($key) = @_; # example IS::GetReg('HKLM\SOFTWARE\key\entryname'); # use value of undef to delete value

    my ($hkey, $type, $value);
    my $saveW = $^W; $^W = 0;
    $key =~ s%/%\\%g;
    $key =~ s/\\([^\\]+)$//;
    my ($entryname) = $1;
    my $topkey;
    if ($key =~ s/^(HKEY_CLASSES_ROOT\\)|(HKCR\\)//) {
        $topkey = &HKEY_LOCAL_MACHINE;
    }
    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::RegOpenKeyEx ( $topkey, $key, 0, &KEY_QUERY_VALUE, $hkey )
         || return undef;
    Win32::Registry::RegQueryValueEx( $hkey, $entryname, 0, $type, $value);
    #TODO FIX THIS
    #Win32::Registry::Close( $hkey );
    $^W = $saveW;
    return $value;
}

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

    my ($hkey, $disposition);
    $key =~ s%/%\\%g;
    $key =~ s/\\([^\\]+)$//;
    my ($entryname) = $1;
    my $topkey;
    if ($key =~ s/^(HKEY_CLASSES_ROOT\\)|(HKCR\\)//) {
        $topkey = &HKEY_LOCAL_MACHINE;
    }
    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;
    }
    my $saveW = $^W; $^W = 0;
    Win32::Registry::RegCreateKeyEx( $topkey, $key,
            0, 'NT Perl 5', REG_OPTION_NON_VOLATILE, &KEY_ALL_ACCESS, 0,
        $hkey, $disposition ) || 
            return print ("Error: RegCreateKeyEx " .  Win32::FormatMessage(Win32::GetLastError()));
    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_LOCAL_MACHINE;
    }
    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);
}

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

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

 f:\dev\dp\perl-5.6.0_install/lib/DSUtil.pm