|
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
# 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,0,0,0
);
my $processinfo = pack("LLLL", 0,0,0,0);
my $dwCreationFlags = 16; # CREATE_NEW_CONSOLE
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 |