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 = ®_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 |