summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl0/lib/Win32
diff options
context:
space:
mode:
authorSiep Kroonenberg <siepo@cybercomm.nl>2011-04-24 16:09:50 +0000
committerSiep Kroonenberg <siepo@cybercomm.nl>2011-04-24 16:09:50 +0000
commitbe4bfe8362d7eec07140f543f8d44120395de88b (patch)
tree5319d8f2eb70aee0c9767da1162f3f4beeb455bd /Master/tlpkg/tlperl0/lib/Win32
parent9d5bc14f41bbd9219da5d024b1d6a164b51c8525 (diff)
2nd try to remove old tlperl0
git-svn-id: svn://tug.org/texlive/trunk@22185 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl0/lib/Win32')
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/API.pm778
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/API/Callback.pm174
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/API/Struct.pm532
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/API/Test.pm111
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/API/Type.pm453
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/DBIODBC.pm248
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/EventLog.pm471
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe.pm308
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/Base.pm35
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/DataDirectory.pm13
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/DebugDirectory.pm19
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/DebugTable.pm12
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/IconFile.pm60
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/PE.pm24
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/PE/Header.pm26
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/PE/Header/PE32.pm69
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/Resource.pm38
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/Resource/GroupIcon.pm57
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/Resource/Icon.pm54
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/Resource/Manifest.pm60
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/Resource/Version.pm364
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/ResourceData.pm58
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/ResourceEntry.pm69
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/ResourceEntry/Id.pm47
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/ResourceEntry/Name.pm42
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/ResourceTable.pm35
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/Section.pm154
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/Section/Code.pm9
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/Section/Data.pm9
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/Section/Debug.pm9
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/Section/Exports.pm9
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/Section/Imports.pm9
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Exe/Section/Resources.pm260
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/File.pm118
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/File/Object.pm450
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Process.pm219
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/Shortcut.pm752
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/TieRegistry.pm3809
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Win32/WinError.pm1017
39 files changed, 0 insertions, 10981 deletions
diff --git a/Master/tlpkg/tlperl0/lib/Win32/API.pm b/Master/tlpkg/tlperl0/lib/Win32/API.pm
deleted file mode 100755
index 365ce6b46c5..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/API.pm
+++ /dev/null
@@ -1,778 +0,0 @@
-# See the bottom of this file for the POD documentation. Search for the
-# string '=head'.
-
-#######################################################################
-#
-# Win32::API - Perl Win32 API Import Facility
-#
-# Author: Aldo Calpini <dada@perl.it>
-# Maintainer: Cosimo Streppone <cosimo@cpan.org>
-#
-# Changes for gcc/cygwin: Daniel Risacher <magnus@alum.mit.edu>
-# ported from 0.41 based on Daniel's patch by Reini Urban <rurban@x-ray.at>
-#
-# $Id: API.pm 458 2009-01-17 17:27:43Z cosimo.streppone $
-#
-#######################################################################
-
-package Win32::API;
-
-require Exporter; # to export the constants to the main:: space
-require DynaLoader; # to dynuhlode the module.
-@ISA = qw( Exporter DynaLoader );
-
-use vars qw( $DEBUG );
-$DEBUG = 0;
-
-sub DEBUG {
- if ($Win32::API::DEBUG) {
- printf @_ if @_ or return 1;
- } else {
- return 0;
- }
-}
-
-use Win32::API::Type;
-use Win32::API::Struct;
-use File::Basename ();
-
-#######################################################################
-# STATIC OBJECT PROPERTIES
-#
-$VERSION = '0.59';
-
-#### some package-global hash to
-#### keep track of the imported
-#### libraries and procedures
-my %Libraries = ();
-my %Procedures = ();
-
-
-#######################################################################
-# dynamically load in the API extension module.
-#
-bootstrap Win32::API;
-
-#######################################################################
-# PUBLIC METHODS
-#
-sub new {
- my($class, $dll, $proc, $in, $out, $callconvention) = @_;
- my $hdll;
- my $self = {};
-
- if ($^O eq 'cygwin' and $dll ne File::Basename::basename($dll)) {
- # need to convert $dll to win32 path
- # isn't there an API for this?
- my $newdll = `cygpath -w "$dll"`;
- chomp $newdll;
- DEBUG "(PM)new: converted '$dll' to\n '$newdll'\n";
- $dll = $newdll;
- }
-
- #### avoid loading a library more than once
- if(exists($Libraries{$dll})) {
- DEBUG "Win32::API::new: Library '$dll' already loaded, handle=$Libraries{$dll}\n";
- $hdll = $Libraries{$dll};
- } else {
- DEBUG "Win32::API::new: Loading library '$dll'\n";
- $hdll = Win32::API::LoadLibrary($dll);
-# $Libraries{$dll} = $hdll;
- }
-
- #### if the dll can't be loaded, set $! to Win32's GetLastError()
- if(!$hdll) {
- $! = Win32::GetLastError();
- DEBUG "FAILED Loading library '$dll': $!\n";
- delete $Libraries{$dll};
- return undef;
- }
-
- #### determine if we have a prototype or not
- if( (not defined $in) and (not defined $out) ) {
- ($proc, $self->{in}, $self->{intypes}, $self->{out}, $self->{cdecl}) = parse_prototype( $proc );
- return undef unless $proc;
- $self->{proto} = 1;
- } else {
- $self->{in} = [];
- if(ref($in) eq 'ARRAY') {
- foreach (@$in) {
- push(@{ $self->{in} }, type_to_num($_));
- }
- } else {
- my @in = split '', $in;
- foreach (@in) {
- push(@{ $self->{in} }, type_to_num($_));
- }
- }
- $self->{out} = type_to_num($out);
- $self->{cdecl} = calltype_to_num($callconvention);
- }
-
- #### first try to import the function of given name...
- my $hproc = Win32::API::GetProcAddress($hdll, $proc);
-
- #### ...then try appending either A or W (for ASCII or Unicode)
- if(!$hproc) {
- my $tproc = $proc;
- $tproc .= (IsUnicode() ? "W" : "A");
- # print "Win32::API::new: procedure not found, trying '$tproc'...\n";
- $hproc = Win32::API::GetProcAddress($hdll, $tproc);
- }
-
- #### ...if all that fails, set $! accordingly
- if(!$hproc) {
- $! = Win32::GetLastError();
- DEBUG "FAILED GetProcAddress for Proc '$proc': $!\n";
- return undef;
- }
- DEBUG "GetProcAddress('$proc') = '$hproc'\n";
-
- #### ok, let's stuff the object
- $self->{procname} = $proc;
- $self->{dll} = $hdll;
- $self->{dllname} = $dll;
- $self->{proc} = $hproc;
-
- #### keep track of the imported function
- $Libraries{$dll} = $hdll;
- $Procedures{$dll}++;
-
- DEBUG "Object blessed!\n";
-
- #### cast the spell
- bless($self, $class);
- return $self;
-}
-
-sub Import {
- my($class, $dll, $proc, $in, $out, $callconvention) = @_;
- $Imported{"$dll:$proc"} = Win32::API->new($dll, $proc, $in, $out, $callconvention) or return 0;
- my $P = (caller)[0];
- eval qq(
- sub ${P}::$Imported{"$dll:$proc"}->{procname} { \$Win32::API::Imported{"$dll:$proc"}->Call(\@_); }
- );
- return $@ ? 0 : 1;
-}
-
-#######################################################################
-# PRIVATE METHODS
-#
-sub DESTROY {
- my($self) = @_;
-
- #### decrease this library's procedures reference count
- $Procedures{$self->{dllname}}--;
-
- #### once it reaches 0, free it
- if($Procedures{$self->{dllname}} == 0) {
- DEBUG "Win32::API::DESTROY: Freeing library '$self->{dllname}'\n";
- Win32::API::FreeLibrary($Libraries{$self->{dllname}});
- delete($Libraries{$self->{dllname}});
- }
-}
-
-# Convert calling convention string (_cdecl|__stdcall)
-# to an integer (1|0). Unknown counts as __stdcall
-#
-sub calltype_to_num {
- my $type = shift;
-
- if (!$type || $type eq "__stdcall") {
- return 0;
- }
- elsif ($type eq "_cdecl") {
- return 1;
- }
- else {
- warn "unknown calling convention: '$type'";
- return 0;
- }
-}
-
-sub type_to_num {
- my $type = shift;
- my $out = shift;
- my $num;
-
- if( $type eq 'N'
- or $type eq 'n'
- or $type eq 'l'
- or $type eq 'L'
- ) {
- $num = 1;
- } elsif($type eq 'P'
- or $type eq 'p'
- ) {
- $num = 2;
- } elsif($type eq 'I'
- or $type eq 'i'
- ) {
- $num = 3;
- } elsif($type eq 'f'
- or $type eq 'F'
- ) {
- $num = 4;
- } elsif($type eq 'D'
- or $type eq 'd'
- ) {
- $num = 5;
- } elsif($type eq 'c'
- or $type eq 'C'
- ) {
- $num = 6;
- } else {
- $num = 0;
- }
- unless(defined $out) {
- if( $type eq 's'
- or $type eq 'S'
- ) {
- $num = 51;
- } elsif($type eq 'b'
- or $type eq 'B'
- ) {
- $num = 22;
- } elsif($type eq 'k'
- or $type eq 'K'
- ) {
- $num = 101;
- }
- }
- return $num;
-}
-
-sub parse_prototype {
- my($proto) = @_;
-
- my @in_params = ();
- my @in_types = ();
- if($proto =~ /^\s*(\S+)(?:\s+(\w+))?\s+(\S+)\s*\(([^\)]*)\)/) {
- my $ret = $1;
- my $callconvention= $2;
- my $proc = $3;
- my $params = $4;
-
- $params =~ s/^\s+//;
- $params =~ s/\s+$//;
-
- DEBUG "(PM)parse_prototype: got PROC '%s'\n", $proc;
- DEBUG "(PM)parse_prototype: got PARAMS '%s'\n", $params;
-
- foreach my $param (split(/\s*,\s*/, $params)) {
- my($type, $name);
- if($param =~ /(\S+)\s+(\S+)/) {
- ($type, $name) = ($1, $2);
- }
-
- if(Win32::API::Type::is_known($type)) {
- if(Win32::API::Type::is_pointer($type)) {
- DEBUG "(PM)parse_prototype: IN='%s' PACKING='%s' API_TYPE=%d\n",
- $type,
- Win32::API::Type->packing( $type ),
- type_to_num('P');
- push(@in_params, type_to_num('P'));
- } else {
- DEBUG "(PM)parse_prototype: IN='%s' PACKING='%s' API_TYPE=%d\n",
- $type,
- Win32::API::Type->packing( $type ),
- type_to_num( Win32::API::Type->packing( $type ) );
- push(@in_params, type_to_num( Win32::API::Type->packing( $type ) ));
- }
- } elsif( Win32::API::Struct::is_known( $type ) ) {
- DEBUG "(PM)parse_prototype: IN='%s' PACKING='%s' API_TYPE=%d\n",
- $type, 'S', type_to_num('S');
- push(@in_params, type_to_num('S'));
- } else {
- warn "Win32::API::parse_prototype: WARNING unknown parameter type '$type'";
- push(@in_params, type_to_num('I'));
- }
- push(@in_types, $type);
-
- }
- DEBUG "parse_prototype: IN=[ @in_params ]\n";
-
-
-
- if(Win32::API::Type::is_known($ret)) {
- if(Win32::API::Type::is_pointer($ret)) {
- DEBUG "parse_prototype: OUT='%s' PACKING='%s' API_TYPE=%d\n",
- $ret,
- Win32::API::Type->packing( $ret ),
- type_to_num('P');
- return ( $proc, \@in_params, \@in_types, type_to_num('P'), calltype_to_num($callconvention) );
- } else {
- DEBUG "parse_prototype: OUT='%s' PACKING='%s' API_TYPE=%d\n",
- $ret,
- Win32::API::Type->packing( $ret ),
- type_to_num( Win32::API::Type->packing( $ret ) );
- return ( $proc, \@in_params, \@in_types, type_to_num(Win32::API::Type->packing($ret)), calltype_to_num($callconvention) );
- }
- } else {
- warn "Win32::API::parse_prototype: WARNING unknown output parameter type '$ret'";
- return ( $proc, \@in_params, \@in_types, type_to_num('I'), calltype_to_num($callconvention) );
- }
-
- } else {
- warn "Win32::API::parse_prototype: bad prototype '$proto'";
- return undef;
- }
-}
-
-1;
-
-__END__
-
-#######################################################################
-# DOCUMENTATION
-#
-
-=head1 NAME
-
-Win32::API - Perl Win32 API Import Facility
-
-=head1 SYNOPSIS
-
- #### Method 1: with prototype
-
- use Win32::API;
- $function = Win32::API->new(
- 'mydll, 'int sum_integers(int a, int b)',
- );
- $return = $function->Call(3, 2);
-
- #### Method 2: with parameter list
-
- use Win32::API;
- $function = Win32::API->new(
- 'mydll', 'sum_integers', 'II', 'I',
- );
- $return = $function->Call(3, 2);
-
- #### Method 3: with Import
-
- use Win32::API;
- Win32::API->Import(
- 'mydll', 'int sum_integers(int a, int b)',
- );
- $return = sum_integers(3, 2);
-
-
-=for LATER-UNIMPLEMENTED
- #### or
- use Win32::API mydll => 'int sum_integers(int a, int b)';
- $return = sum_integers(3, 2);
-
-
-=head1 ABSTRACT
-
-With this module you can import and call arbitrary functions
-from Win32's Dynamic Link Libraries (DLL), without having
-to write an XS extension. Note, however, that this module
-can't do everything. In fact, parameters input and output is
-limited to simpler cases.
-
-A regular B<XS> extension is always safer and faster anyway.
-
-The current version of Win32::API is always available at your
-nearest CPAN mirror:
-
- http://search.cpan.org/dist/Win32-API/
-
-A short example of how you can use this module (it just gets the PID of
-the current process, eg. same as Perl's internal C<$$>):
-
- use Win32::API;
- Win32::API->Import("kernel32", "int GetCurrentProcessId()");
- $PID = GetCurrentProcessId();
-
-The possibilities are nearly infinite (but not all are good :-).
-Enjoy it.
-
-=head1 DESCRIPTION
-
-To use this module put the following line at the beginning of your script:
-
- use Win32::API;
-
-You can now use the C<new()> function of the Win32::API module to create a
-new Win32::API object (see L<IMPORTING A FUNCTION>) and then invoke the
-C<Call()> method on this object to perform a call to the imported API
-(see L<CALLING AN IMPORTED FUNCTION>).
-
-Starting from version 0.40, you can also avoid creating a Win32::API object
-and instead automatically define a Perl sub with the same name of the API
-function you're importing. The details of the API definitions are the same,
-just the call is different:
-
- my $GetCurrentProcessId = Win32::API->new(
- "kernel32", "int GetCurrentProcessId()"
- );
- my $PID = $GetCurrentProcessId->Call();
-
- #### vs.
-
- Win32::API->Import("kernel32", "int GetCurrentProcessId()");
- $PID = GetCurrentProcessId();
-
-Note that C<Import> returns 1 on success and 0 on failure (in which case you
-can check the content of C<$^E>).
-
-=head2 IMPORTING A FUNCTION
-
-You can import a function from a 32 bit Dynamic Link Library (DLL) file
-with the C<new()> function. This will create a Perl object that contains the
-reference to that function, which you can later C<Call()>.
-
-What you need to know is the prototype of the function you're going to import
-(eg. the definition of the function expressed in C syntax).
-
-Starting from version 0.40, there are 2 different approaches for this step:
-(the preferred) one uses the prototype directly, while the other (now deprecated)
-one uses Win32::API's internal representation for parameters.
-
-=head2 IMPORTING A FUNCTION BY PROTOTYPE
-
-You need to pass 2 parameters:
-
-=over 4
-
-=item 1.
-
-The name of the library from which you want to import the function.
-
-=item 2.
-
-The C prototype of the function.
-
-=back
-
-When calling a function imported with a prototype, if you pass an
-undefined Perl scalar to one of its arguments, it will be
-automatically turned into a C C<NULL> value.
-
-See L<Win32::API::Type> for a list of the known parameter types and
-L<Win32::API::Struct> for information on how to define a structure.
-
-=head2 IMPORTING A FUNCTION WITH A PARAMETER LIST
-
-You need to pass 4 parameters:
-
-=over 4
-
-=item 1.
-The name of the library from which you want to import the function.
-
-=item 2.
-The name of the function (as exported by the library).
-
-=item 3.
-The number and types of the arguments the function expects as input.
-
-=item 4.
-The type of the value returned by the function.
-
-=item 5.
-And optionally you can specify the calling convention, this defaults to
-'__stdcall', alternatively you can specify '_cdecl'.
-
-=back
-
-To better explain their meaning, let's suppose that we
-want to import and call the Win32 API C<GetTempPath()>.
-This function is defined in C as:
-
- DWORD WINAPI GetTempPathA( DWORD nBufferLength, LPSTR lpBuffer );
-
-This is documented in the B<Win32 SDK Reference>; you can look
-for it on the Microsoft's WWW site, or in your C compiler's
-documentation, if you own one.
-
-=over 4
-
-=item B<1.>
-
-The first parameter is the name of the library file that
-exports this function; our function resides in the F<KERNEL32.DLL>
-system file.
-
-When specifying this name as parameter, the F<.DLL> extension
-is implicit, and if no path is given, the file is searched through
-a couple of directories, including:
-
-=over 4
-
-=item 1. The directory from which the application loaded.
-
-=item 2. The current directory.
-
-=item 3. The Windows system directory (eg. c:\windows\system or system32).
-
-=item 4. The Windows directory (eg. c:\windows).
-
-=item 5. The directories that are listed in the PATH environment variable.
-
-=back
-
-So, you don't have to write F<C:\windows\system\kernel32.dll>;
-only F<kernel32> is enough:
-
- $GetTempPath = new Win32::API('kernel32', ...
-
-=item B<2.>
-
-Now for the second parameter: the name of the function.
-It must be written exactly as it is exported
-by the library (case is significant here).
-If you are using Windows 95 or NT 4.0, you can use the B<Quick View>
-command on the DLL file to see the function it exports.
-Remember that you can only import functions from 32 bit DLLs:
-in Quick View, the file's characteristics should report
-somewhere "32 bit word machine"; as a rule of thumb,
-when you see that all the exported functions are in upper case,
-the DLL is a 16 bit one and you can't use it.
-If their capitalization looks correct, then it's probably a 32 bit
-DLL.
-
-Also note that many Win32 APIs are exported twice, with the addition of
-a final B<A> or B<W> to their name, for - respectively - the ASCII
-and the Unicode version.
-When a function name is not found, Win32::API will actually append
-an B<A> to the name and try again; if the extension is built on a
-Unicode system, then it will try with the B<W> instead.
-So our function name will be:
-
- $GetTempPath = new Win32::API('kernel32', 'GetTempPath', ...
-
-In our case C<GetTempPath> is really loaded as C<GetTempPathA>.
-
-=item B<3.>
-
-The third parameter, the input parameter list, specifies how many
-arguments the function wants, and their types. It can be passed as
-a single string, in which each character represents one parameter,
-or as a list reference. The following forms are valid:
-
- "abcd"
- [a, b, c, d]
- \@LIST
-
-But those are not:
-
- (a, b, c, d)
- @LIST
-
-The number of characters, or elements in the list, specifies the number
-of parameters, and each character or element specifies the type of an
-argument; allowed types are:
-
-=over 4
-
-=item C<I>:
-value is an integer (int)
-
-=item C<N>:
-value is a number (long)
-
-=item C<F>:
-value is a floating point number (float)
-
-=item C<D>:
-value is a double precision number (double)
-
-=item C<C>:
-value is a char (char)
-
-=item C<P>:
-value is a pointer (to a string, structure, etc...)
-
-=item C<S>:
-value is a Win32::API::Struct object (see below)
-
-=item C<K>:
-value is a Win32::API::Callback object (see L<Win32::API::Callback>)
-
-=back
-
-Our function needs two parameters: a number (C<DWORD>) and a pointer to a
-string (C<LPSTR>):
-
- $GetTempPath = new Win32::API('kernel32', 'GetTempPath', 'NP', ...
-
-=item B<4.>
-
-The fourth and final parameter is the type of the value returned by the
-function. It can be one of the types seen above, plus another type named B<V>
-(for C<void>), used for functions that do not return a value.
-In our example the value returned by GetTempPath() is a C<DWORD>, so
-our return type will be B<N>:
-
- $GetTempPath = new Win32::API('kernel32', 'GetTempPath', 'NP', 'N');
-
-Now the line is complete, and the GetTempPath() API is ready to be used
-in Perl. Before calling it, you should test that $GetTempPath is
-C<defined>, otherwise either the function or the library could not be
-loaded; in this case, C<$!> will be set to the error message reported
-by Windows.
-Our definition, with error checking added, should then look like this:
-
- $GetTempPath = new Win32::API('kernel32', 'GetTempPath', 'NP', 'N');
- if(not defined $GetTempPath) {
- die "Can't import API GetTempPath: $!\n";
- }
-
-=back
-
-=head2 CALLING AN IMPORTED FUNCTION
-
-To effectively make a call to an imported function you must use the
-Call() method on the Win32::API object you created.
-Continuing with the example from the previous paragraph,
-the GetTempPath() API can be called using the method:
-
- $GetTempPath->Call(...
-
-Of course, parameters have to be passed as defined in the import phase.
-In particular, if the number of parameters does not match (in the example,
-if GetTempPath() is called with more or less than two parameters),
-Perl will C<croak> an error message and C<die>.
-
-The two parameters needed here are the length of the buffer
-that will hold the returned temporary path, and a pointer to the
-buffer itself.
-For numerical parameters, you can use either a constant expression
-or a variable, while B<for pointers you must use a variable name> (no
-Perl references, just a plain variable name).
-Also note that B<memory must be allocated before calling the function>,
-just like in C.
-For example, to pass a buffer of 80 characters to GetTempPath(),
-it must be initialized before with:
-
- $lpBuffer = " " x 80;
-
-This allocates a string of 80 characters. If you don't do so, you'll
-probably get C<Runtime exception> errors, and generally nothing will
-work. The call should therefore include:
-
- $lpBuffer = " " x 80;
- $GetTempPath->Call(80, $lpBuffer);
-
-And the result will be stored in the $lpBuffer variable.
-Note that you don't need to pass a reference to the variable
-(eg. you B<don't need> C<\$lpBuffer>), even if its value will be set
-by the function.
-
-A little problem here is that Perl does not trim the variable,
-so $lpBuffer will still contain 80 characters in return; the exceeding
-characters will be spaces, because we said C<" " x 80>.
-
-In this case we're lucky enough, because the value returned by
-the GetTempPath() function is the length of the string, so to get
-the actual temporary path we can write:
-
- $lpBuffer = " " x 80;
- $return = $GetTempPath->Call(80, $lpBuffer);
- $TempPath = substr($lpBuffer, 0, $return);
-
-If you don't know the length of the string, you can usually
-cut it at the C<\0> (ASCII zero) character, which is the string
-delimiter in C:
-
- $TempPath = ((split(/\0/, $lpBuffer))[0];
- # or
- $lpBuffer =~ s/\0.*$//;
-
-=head2 USING STRUCTURES
-
-Starting from version 0.40, Win32::API comes with a support package
-named Win32::API::Struct. The package is loaded automatically with
-Win32::API, so you don't need to use it explicitly.
-
-With this module you can conveniently define structures and use
-them as parameters to Win32::API functions. A short example follows:
-
-
- # the 'POINT' structure is defined in C as:
- # typedef struct {
- # LONG x;
- # LONG y;
- # } POINT;
-
-
- #### define the structure
- Win32::API::Struct->typedef( POINT => qw{
- LONG x;
- LONG y;
- });
-
- #### import an API that uses this structure
- Win32::API->Import('user32', 'BOOL GetCursorPos(LPPOINT lpPoint)');
-
- #### create a 'POINT' object
- my $pt = Win32::API::Struct->new('POINT');
-
- #### call the function passing our structure object
- GetCursorPos($pt);
-
- #### and now, access its members
- print "The cursor is at: $pt->{x}, $pt->{y}\n";
-
-Note that this works only when the function wants a
-B<pointer to a structure>: as you can see, our structure is named
-'POINT', but the API used 'LPPOINT'. 'LP' is automatically added at
-the beginning of the structure name when feeding it to a Win32::API
-call.
-
-For more information, see also L<Win32::API::Struct>.
-
-If you don't want (or can't) use the C<Win32::API::Struct> facility,
-you can still use the low-level approach to use structures:
-
-=over 4
-
-=item 1.
-
-you have to pack() the required elements in a variable:
-
- $lpPoint = pack('LL', 0, 0); # store two LONGs
-
-=item 2.
-
-to access the values stored in a structure, unpack() it as required:
-
- ($x, $y) = unpack('LL', $lpPoint); # get the actual values
-
-=back
-
-The rest is left as an exercise to the reader...
-
-=head1 AUTHOR
-
-Aldo Calpini ( I<dada@perl.it> ).
-
-=head1 MAINTAINER
-
-Cosimo Streppone ( I<cosimo@cpan.org> )
-
-=head1 LICENSE
-
-To finally clarify this, C<Win32::API> is OSI-approved free software;
-you can redistribute it and/or modify it under the same terms as Perl
-itself.
-
-See L<http://dev.perl.org/licenses/artistic.html>
-
-=head1 CREDITS
-
-All the credits go to Andrea Frosini for the neat assembler trick
-that makes this thing work. I've also used some work by Dave Roth
-for the prototyping stuff. A big thank you also to Gurusamy Sarathy
-for his unvaluable help in XS development, and to all the Perl
-community for being what it is.
-
-Cosimo also wants to personally thank everyone that contributed
-to Win32::API with complaints, emails, patches, RT bug reports
-and so on.
-
-=cut
-
diff --git a/Master/tlpkg/tlperl0/lib/Win32/API/Callback.pm b/Master/tlpkg/tlperl0/lib/Win32/API/Callback.pm
deleted file mode 100755
index df15786591b..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/API/Callback.pm
+++ /dev/null
@@ -1,174 +0,0 @@
-# See the bottom of this file for the POD documentation. Search for the
-# string '=head'.
-
-#######################################################################
-#
-# Win32::API::Callback - Perl Win32 API Import Facility
-#
-# Author: Aldo Calpini <dada@perl.it>
-# Maintainer: Cosimo Streppone <cosimo@cpan.org>
-#
-# $Id: Callback.pm 458 2009-01-17 17:27:43Z cosimo.streppone $
-#
-#######################################################################
-
-package Win32::API::Callback;
-
-$VERSION = '0.59';
-
-require Exporter; # to export the constants to the main:: space
-require DynaLoader; # to dynuhlode the module.
-@ISA = qw( Exporter DynaLoader );
-
-sub DEBUG {
- if ($WIN32::API::DEBUG) {
- printf @_ if @_ or return 1;
- } else {
- return 0;
- }
-}
-
-use Win32::API;
-use Win32::API::Type;
-use Win32::API::Struct;
-
-#######################################################################
-# This AUTOLOAD is used to 'autoload' constants from the constant()
-# XS function. If a constant is not found then control is passed
-# to the AUTOLOAD in AutoLoader.
-#
-
-sub AUTOLOAD {
- my($constname);
- ($constname = $AUTOLOAD) =~ s/.*:://;
- #reset $! to zero to reset any current errors.
- $!=0;
- my $val = constant($constname, @_ ? $_[0] : 0);
- if ($! != 0) {
- if ($! =~ /Invalid/) {
- $AutoLoader::AUTOLOAD = $AUTOLOAD;
- goto &AutoLoader::AUTOLOAD;
- } else {
- ($pack,$file,$line) = caller;
- die "Your vendor has not defined Win32::API::Callback macro $constname, used at $file line $line.";
- }
- }
- eval "sub $AUTOLOAD { $val }";
- goto &$AUTOLOAD;
-}
-
-
-#######################################################################
-# dynamically load in the API extension module.
-#
-bootstrap Win32::API::Callback;
-
-#######################################################################
-# PUBLIC METHODS
-#
-sub new {
- my($class, $proc, $in, $out) = @_;
- my %self = ();
-
- # printf "(PM)Callback::new: got proc='%s', in='%s', out='%s'\n", $proc, $in, $out;
-
- $self{in} = [];
- if(ref($in) eq 'ARRAY') {
- foreach (@$in) {
- push(@{ $self{in} }, Win32::API::type_to_num($_));
- }
- } else {
- my @in = split '', $in;
- foreach (@in) {
- push(@{ $self{in} }, Win32::API::type_to_num($_));
- }
- }
- $self{out} = Win32::API::type_to_num($out);
- $self{sub} = $proc;
- my $self = bless \%self, $class;
-
- DEBUG "(PM)Callback::new: calling CallbackCreate($self)...\n";
- my $hproc = CallbackCreate($self);
-
- DEBUG "(PM)Callback::new: hproc=$hproc\n";
-
- #### ...if that fails, set $! accordingly
- if(!$hproc) {
- $! = Win32::GetLastError();
- return undef;
- }
-
- #### ok, let's stuff the object
- $self->{code} = $hproc;
- $self->{sub} = $proc;
-
- #### cast the spell
- return $self;
-}
-
-sub MakeStruct {
- my($self, $n, $addr) = @_;
- DEBUG "(PM)Win32::API::Callback::MakeStruct: got self='$self'\n";
- my $struct = Win32::API::Struct->new($self->{intypes}->[$n]);
- $struct->FromMemory($addr);
- return $struct;
-}
-
-1;
-
-__END__
-
-#######################################################################
-# DOCUMENTATION
-#
-
-=head1 NAME
-
-Win32::API::Callback - Callback support for Win32::API
-
-=head1 SYNOPSIS
-
- use Win32::API;
- use Win32::API::Callback;
-
- my $callback = Win32::API::Callback->new(
- sub { my($a, $b) = @_; return $a+$b; },
- "NN", "N",
- );
-
- Win32::API->Import(
- 'mydll', 'two_integers_cb', 'KNN', 'N',
- );
-
- $sum = two_integers_cb( $callback, 3, 2 );
-
-
-=head1 FOREWORDS
-
-=over 4
-
-=item *
-Support for this module is B<highly experimental> at this point.
-
-=item *
-I won't be surprised if it doesn't work for you.
-
-=item *
-Feedback is very appreciated.
-
-=item *
-Documentation is in the work. Either see the SYNOPSIS above
-or the samples in the F<samples> directory.
-
-=back
-
-=head1 AUTHOR
-
-Aldo Calpini ( I<dada@perl.it> ).
-
-=head1 MAINTAINER
-
-Cosimo Streppone ( I<cosimo@cpan.org> ).
-
-=cut
-
diff --git a/Master/tlpkg/tlperl0/lib/Win32/API/Struct.pm b/Master/tlpkg/tlperl0/lib/Win32/API/Struct.pm
deleted file mode 100755
index 9f706671a77..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/API/Struct.pm
+++ /dev/null
@@ -1,532 +0,0 @@
-package Win32::API::Struct;
-
-# See the bottom of this file for the POD documentation. Search for the
-# string '=head'.
-
-#######################################################################
-#
-# Win32::API::Struct - Perl Win32 API struct Facility
-#
-# Author: Aldo Calpini <dada@perl.it>
-# Maintainer: Cosimo Streppone <cosimo@cpan.org>
-#
-# $Id: Struct.pm 438 2008-10-02 22:51:55Z cosimo.streppone $
-#######################################################################
-
-$VERSION = '0.50';
-
-use Win32::API::Type;
-
-use Carp;
-
-require Exporter; # to export the constants to the main:: space
-require DynaLoader; # to dynuhlode the module.
-@ISA = qw( Exporter DynaLoader );
-
-my %Known = ();
-
-sub DEBUG {
- if ($Win32::API::DEBUG) {
- printf @_ if @_ or return 1;
- } else {
- return 0;
- }
-}
-
-sub typedef {
- my $class = shift;
- my $struct = shift;
- my($type, $name);
- my $self = {
- align => undef,
- typedef => [],
- };
- while(defined($type = shift)) {
- $name = shift;
- $name =~ s/;$//;
- push( @{ $self->{typedef} }, [ recognize($type, $name) ] );
- }
-
- $Known{$struct} = $self;
- return 1;
-}
-
-
-sub recognize {
- my($type, $name) = @_;
- my($size, $packing);
- if(exists $Known{$type}) {
- $packing = ">";
- return $name, $packing, $type;
- } else {
- $packing = Win32::API::Type::packing($type);
- return undef unless defined $packing;
- if($name =~ s/\[(.*)\]$//) {
- $size = $1;
- $packing = $packing."*".$size;
- }
- DEBUG "(PM)Struct::recognize got '$name', '$type' -> '$packing'\n";
- return $name, $packing, $type;
- }
-}
-
-sub new {
- my $class = shift;
- my($type, $name);
- my $self = {
- typedef => [],
- };
- if($#_ == 0) {
- if(exists $Known{$_[0]}) {
- DEBUG "(PM)Struct::new: got '$_[0]'\n";
- $self->{typedef} = $Known{$_[0]}->{typedef};
- foreach my $member (@{ $self->{typedef} }) {
- ($name, $packing, $type) = @$member;
- if($packing eq '>') {
- $self->{$name} = Win32::API::Struct->new($type);
- }
- }
- $self->{__typedef__} = $_[0];
- } else {
- carp "Unknown Win32::API::Struct '$_[0]'";
- return undef;
- }
- } else {
- while(defined($type = shift)) {
- $name = shift;
- # print "new: found member $name ($type)\n";
- if(not exists $Win32::API::Type::Known{$type}) {
- warn "Unknown Win32::API::Struct type '$type'";
- return undef;
- } else {
- push( @{ $self->{typedef} }, [ $name, $Win32::API::Type::Known{$type}, $type ] );
- }
- }
- }
- return bless $self;
-}
-
-sub members {
- my $self = shift;
- return map {$_->[0]} @{ $self->{typedef} };
-}
-
-sub sizeof {
- my $self = shift;
- my $size = 0;
- my $align = 0;
- my $first = undef;
- foreach my $member (@{ $self->{typedef} }) {
- my($name, $packing, $type) = @$member;
-
- if(ref( $self->{$name} ) eq "Win32::API::Struct") {
- $size += $self->{$name}->sizeof();
- # $align = $self->{$name}->sizeof() if $self->{$name}->sizeof() > $align;
- } else {
- if($packing =~ /\w\*(\d+)/) {
- $size += Win32::API::Type::sizeof($type) * $1;
- $first = Win32::API::Type::sizeof($type) * $1 unless defined $first;
- DEBUG "(PM)Struct::sizeof: sizeof with member($name) now = ". $size. "\n";
- } else {
- $size += Win32::API::Type::sizeof($type);
- $first = Win32::API::Type::sizeof($type) unless defined $first;
- $align = Win32::API::Type::sizeof($type)
- if Win32::API::Type::sizeof($type) > $align;
- DEBUG "(PM)Struct::sizeof: sizeof with member($name) now = ". $size. "\n";
- }
- }
- }
- DEBUG "(PM)Struct::sizeof first=$first align=$align\n";
- #DEBUG "(PM)Struct::sizeof returning %d\n", $first + (scalar(@{ $self->{typedef} })-1) * $align;
- #return $first + (scalar(@{ $self->{typedef} })-1) * $align;
- DEBUG "(PM)Struct::sizeof returning %d\n", scalar(@{ $self->{typedef} }) * $align;
- if(defined $align and $align > 0) {
- return scalar(@{ $self->{typedef} }) * $align;
- } else {
- return $size;
- }
- return $size;
-}
-
-sub align {
- my $self = shift;
- my $align = shift;
-
- if(not defined $align) {
- return $self->{align} unless $self->{align} eq 'auto';
- $align = 0;
- foreach my $member (@{ $self->{typedef} }) {
- my($name, $packing, $type) = @$member;
-
- if(ref( $self->{$name} ) eq "Win32::API::Struct") {
- #### ????
- } else {
- if($packing =~ /\w\*(\d+)/) {
- #### ????
- } else {
- $align = Win32::API::Type::sizeof($type)
- if Win32::API::Type::sizeof($type) > $align;
- }
- }
- }
- return $align;
- } else {
- $self->{align} = $align;
-
- }
-}
-
-sub getPack {
- my $self = shift;
- my $packing = "";
- my($type, $name);
- my @items = ();
- my @recipients = ();
-
- my $align = $self->align();
-
- foreach my $member (@{ $self->{typedef} }) {
- ($name, $type, $orig) = @$member;
- if($type eq '>') {
- my($subpacking, $subitems, $subrecipients) = $self->{$name}->getPack();
-
- DEBUG "(PM)Struct::getPack($self->{__typedef__}) ++ $subpacking\n";
-
- $packing .= $subpacking;
- push(@items, @$subitems);
- push(@recipients, @$subrecipients);
- } else {
- if($type =~ /\w\*(\d+)/) {
- my $size = $1;
- $type = "a$size";
- }
-
- DEBUG "(PM)Struct::getPack($self->{__typedef__}) ++ $type\n";
-
- if($type eq 'p') {
- $type = "L";
- push(@items, Win32::API::PointerTo($self->{$name}));
- } else {
- push(@items, $self->{$name});
- }
- $packing .= $type;
-
- if($Win32::API::Type::PackSize{$type} < $align) {
- $packing .= ("x" x ($align - $Win32::API::Type::PackSize{$type}));
- }
-
- push(@recipients, $self);
- }
- }
- DEBUG "(PM)Struct::getPack: $self->{__typedef__}(buffer) = pack($packing, @items)\n";
- return($packing, [@items], [@recipients]);
-}
-
-
-sub Pack {
- my $self = shift;
- my($packing, $items, $recipients) = $self->getPack();
- DEBUG "(PM)Struct::Pack: $self->{__typedef__}(buffer) = pack($packing, @$items)\n";
- $self->{buffer} = pack($packing, @$items);
- if(DEBUG) {
- for my $i (0..$self->sizeof-1) {
- printf " %3d: 0x%02x\n", $i, ord(substr($self->{buffer}, $i, 1));
- }
- }
- $self->{buffer_recipients} = $recipients
-}
-
-sub getUnpack {
- my $self = shift;
- my $packing = "";
- my($type, $name);
- my @items = ();
- my $align = $self->align();
- foreach my $member (@{ $self->{typedef} }) {
- ($name, $type, $orig) = @$member;
- if($type eq '>') {
- my($subpacking, @subitems) = $self->{$name}->getUnpack();
-
- DEBUG "(PM)Struct::getUnpack($self->{__typedef__}) ++ $subpacking\n";
- $packing .= $subpacking;
-
-
- push(@items, @subitems);
- } else {
- if($type =~ /\w\*(\d+)/) {
- my $size = $1;
- $type = "Z$size";
- }
-
- #if($type eq 'p') {
- # $packing .= 'Z*';
- # DEBUG "(PM)Struct::getUnpack($self->{__typedef__}) ++ Z*\n";
- #} else {
- $packing .= $type;
- DEBUG "(PM)Struct::getUnpack($self->{__typedef__}) ++ $type\n";
- #}
- if($type ne 'p' and $type !~ /^Z(\d+)/ and $Win32::API::Type::PackSize{$type} < $align) {
- DEBUG "(PM)Struct::getUnpack %s(%d) < %d\n",
- $type, $Win32::API::Type::PackSize{$type}, $align
- ;
- $packing .= ("x" x ($align - $Win32::API::Type::PackSize{$type}));
- }
-
- push(@items, $name);
- }
- }
- DEBUG "(PM)Struct::getUnpack($self->{__typedef__}): unpack($packing, @items)\n";
- return($packing, @items);
-}
-
-sub Unpack {
- my $self = shift;
- my($packing, @items) = $self->getUnpack();
- my @itemvalue = unpack($packing, $self->{buffer});
- DEBUG "(PM)Struct::Unpack: unpack($packing, buffer) = @itemvalue\n";
- foreach my $i (0..$#items) {
- my $recipient = $self->{buffer_recipients}->[$i];
- DEBUG "(PM)Struct::Unpack: %s(%s) = '%s' (0x%08x)\n",
- $recipient->{__typedef__},
- $items[$i],
- $itemvalue[$i],
- $itemvalue[$i],
- ;
- $recipient->{$items[$i]} = $itemvalue[$i];
- DEBUG "(PM)Struct::Unpack: self.$items[$i] = $self->{$items[$i]}\n";
- }
-}
-
-sub FromMemory {
- my($self, $addr) = @_;
- DEBUG "(PM)Struct::FromMemory: doing Pack\n";
- $self->Pack();
- DEBUG "(PM)Struct::FromMemory: doing GetMemory( 0x%08x, %d )\n", $addr, $self->sizeof;
- $self->{buffer} = Win32::API::ReadMemory( $addr, $self->sizeof );
- $self->Unpack();
- DEBUG "(PM)Struct::FromMemory: doing Unpack\n";
- DEBUG "(PM)Struct::FromMemory: structure is now:\n";
- $self->Dump() if DEBUG;
- DEBUG "\n";
-}
-
-sub Dump {
- my $self = shift;
- my $prefix = shift;
- foreach my $member (@{ $self->{typedef} }) {
- ($name, $packing, $type) = @$member;
- if( ref($self->{$name}) ) {
- $self->{$name}->Dump($name);
- } else {
- printf "%-20s %-20s %-20s\n", $prefix, $name, $self->{$name};
- }
- }
-}
-
-
-sub is_known {
- my $name = shift;
- if(exists $Known{ $name }) {
- return 1;
- } else {
- if($name =~ s/^LP//) {
- return exists $Known{ $name };
- }
- return 0;
- }
-}
-
-sub TIEHASH {
- return Win32::API::Struct::new(@_);
-}
-
-sub EXISTS {
-
-}
-
-sub FETCH {
- my $self = shift;
- my $key = shift;
-
- if($key eq 'sizeof') {
- return $self->sizeof;
- }
- my @members = map { $_->[0] } @{ $self->{typedef} };
- if(grep(/^\Q$key\E$/, @members)) {
- return $self->{$key};
- } else {
- warn "'$key' is not a member of Win32::API::Struct $self->{__typedef__}";
- }
-}
-
-sub STORE {
- my $self = shift;
- my($key, $val) = @_;
- my @members = map { $_->[0] } @{ $self->{typedef} };
- if(grep(/^\Q$key\E$/, @members)) {
- $self->{$key} = $val;
- } else {
- warn "'$key' is not a member of Win32::API::Struct $self->{__typedef__}";
- }
-}
-
-sub FIRSTKEY {
- my $self = shift;
- my @members = map { $_->[0] } @{ $self->{typedef} };
- return $members[0];
-}
-
-sub NEXTKEY {
- my $self = shift;
- my $key = shift;
- my @members = map { $_->[0] } @{ $self->{typedef} };
- for my $i (0..$#members-1) {
- return $members[$i+1] if $members[$i] eq $key;
- }
- return undef;
-}
-
-1;
-
-#######################################################################
-# DOCUMENTATION
-#
-
-=head1 NAME
-
-Win32::API::Struct - C struct support package for Win32::API
-
-=head1 SYNOPSIS
-
- use Win32::API;
-
- Win32::API::Struct->typedef( 'POINT', qw(
- LONG x;
- LONG y;
- ));
-
- my $Point = Win32::API::Struct->new( 'POINT' );
- $Point->{x} = 1024;
- $Point->{y} = 768;
-
- #### alternatively
-
- tie %Point, 'Win32::API::Struct', 'POINT';
- $Point{x} = 1024;
- $Point{y} = 768;
-
-
-=head1 ABSTRACT
-
-This module enables you to define C structs for use with
-Win32::API.
-
-See L<Win32::API> for more info about its usage.
-
-=head1 DESCRIPTION
-
-This module is automatically imported by Win32::API, so you don't
-need to 'use' it explicitly. The main methods are C<typedef> and
-C<new>, which are documented below.
-
-=over 4
-
-=item C<typedef NAME, TYPE, MEMBER, TYPE, MEMBER, ...>
-
-This method defines a structure named C<NAME>. The definition consists
-of types and member names, just like in C. In fact, most of the
-times you can cut the C definition for a structure and paste it
-verbatim to your script, enclosing it in a C<qw()> block. The
-function takes care of removing the semicolon after the member
-name.
-
-The synopsis example could be written like this:
-
- Win32::API::Struct->typedef('POINT', 'LONG', 'x', 'LONG', 'y');
-
-But it could also be written like this (note the indirect object
-syntax), which is pretty cool:
-
- typedef Win32::API::Struct POINT => qw{
- LONG x;
- LONG y;
- };
-
-Also note that C<typedef> automatically defines an 'LPNAME' type,
-which holds a pointer to your structure. In the example above,
-'LPPOINT' is also defined and can be used in a call to a
-Win32::API (in fact, this is what you're really going to use when
-doing API calls).
-
-=item C<new NAME>
-
-This creates a structure (a Win32::API::Struct object) of the
-type C<NAME> (it must have been defined with C<typedef>). In Perl,
-when you create a structure, all the members are undefined. But
-when you use that structure in C (eg. a Win32::API call), you
-can safely assume that they will be treated as zero (or NULL).
-
-=item C<sizeof>
-
-This returns the size, in bytes, of the structure. Acts just like
-the C function of the same name. It is particularly useful for
-structures that need a member to be initialized to the structure's
-own size.
-
-=item C<align [SIZE]>
-
-Sets or returns the structure alignment (eg. how the structure is
-stored in memory). This is a very advanced option, and you normally
-don't need to mess with it.
-All structures in the Win32 Platform SDK should work without it.
-But if you define your own structure, you may need to give it an
-explicit alignment. In most cases, passing a C<SIZE> of 'auto'
-should keep the world happy.
-
-=back
-
-=head2 THE C<tie> INTERFACE
-
-Instead of creating an object with the C<new> method, you can
-tie a hash, which will hold the desired structure, using the
-C<tie> builtin function:
-
- tie %structure, Win32::API::Struct => 'NAME';
-
-The differences between the tied and non-tied approaches are:
-
-=over 4
-
-=item *
-with tied structures, you can access members directly as
-hash lookups, eg.
-
- # tied # non-tied
- $Point{x} vs. $Point->{x}
-
-=item *
-with tied structures, when you try to fetch or store a
-member that is not part of the structure, it will result
-in a warning, eg.
-
- print $Point{z};
- # this will warn: 'z' is not a member of Win32::API::Struct POINT
-
-=item *
-when you pass a tied structure as a Win32::API parameter,
-remember to backslash it, eg.
-
- # tied # non-tied
- GetCursorPos( \%Point ) vs. GetCursorPos( $Point )
-
-=back
-
-=head1 AUTHOR
-
-Aldo Calpini ( I<dada@perl.it> ).
-
-=head1 MAINTAINER
-
-Cosimo Streppone ( I<cosimo@cpan.org> ).
-
-=cut
diff --git a/Master/tlpkg/tlperl0/lib/Win32/API/Test.pm b/Master/tlpkg/tlperl0/lib/Win32/API/Test.pm
deleted file mode 100755
index 0b21ced6927..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/API/Test.pm
+++ /dev/null
@@ -1,111 +0,0 @@
-#
-# Win32::API::Test - Test helper package for Win32::API
-#
-# Cosimo Streppone <cosimo@cpan.org>
-#
-# $Id: Test.pm 438 2008-10-02 22:51:55Z cosimo.streppone $
-
-package Win32::API::Test;
-
-sub compiler_name () {
- use Config;
- my $cc = $Config{ccname};
- if($cc eq 'cl' || $cc eq 'cl.exe')
- {
- $cc = 'cl';
- }
- return($cc);
-}
-
-sub compiler_version () {
- use Config;
- my $ver = $Config{ccversion} || 0;
- if( $ver =~ /^(\d+\.\d+)/ )
- {
- $ver = 0 + $1;
- }
- return($ver);
-}
-
-#
-# Run the compiler and get version from there...
-# User might be running a compiler different from
-# that used to build perl.
-# For example, Cosimo does. For testing, of course.
-#
-sub compiler_version_from_shell () {
- my $cc = compiler_name();
- my $ver;
- # MSVC
- if($cc eq 'cl')
- {
- my @ver = `$cc 2>&1`; # Interesting output in STDERR
- $ver = join('',@ver);
- #print 'VER:'.$ver.':'."\n";
- if($ver =~ /Version (\d[\d\.]+)/ms )
- {
- $ver = $1;
- }
- }
- # GCC
- elsif($cc eq 'cc' || $cc eq 'gcc' || $cc eq 'winegcc' )
- {
- $ver = join('', `$cc --version`);
- if($ver =~ /gcc.*(\d[\d+]+)/ms )
- {
- $ver = $1;
- }
- }
- # Borland C
- elsif($cc eq 'bcc32' || $cc eq 'bcc')
- {
- $ver = join('', `$cc 2>&1`);
- if($ver =~ /Borland C\+\+ (\d[\d\.]+)/ms )
- {
- $ver = $1;
- }
- }
- return($ver);
-}
-
-sub find_test_dll () {
- require File::Spec;
- my $dll_name = $_[0];
- my @paths = qw(.. ../t ../t/dll . ./dll ./t/dll);
- while(my $path = shift @paths)
- {
- $dll = File::Spec->catfile($path, $dll_name);
- return $dll if -s $dll;
- }
- return(undef);
-}
-
-1;
-
-__END__
-
-
-#######################################################################
-# DOCUMENTATION
-#
-
-=head1 NAME
-
-Win32::API::Test - Test helper package for Win32::API
-
-=head1 SYNOPSIS
-
- my $test_dll = Win32::API::Test::find_test_dll('API_test.dll');
-
-Check the t/*.t test scripts for more details.
-
-=head1 DESCRIPTION
-
-Simple package to hold Win32::API test suite helper functions.
-No more, no less.
-
-=head1 AUTHOR
-
-Cosimo Streppone ( I<cosimo@cpan.org> )
-
-=cut
diff --git a/Master/tlpkg/tlperl0/lib/Win32/API/Type.pm b/Master/tlpkg/tlperl0/lib/Win32/API/Type.pm
deleted file mode 100755
index 48f0ce1a32f..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/API/Type.pm
+++ /dev/null
@@ -1,453 +0,0 @@
-package Win32::API::Type;
-
-# See the bottom of this file for the POD documentation. Search for the
-# string '=head'.
-
-#######################################################################
-#
-# Win32::API::Type - Perl Win32 API type definitions
-#
-# Author: Aldo Calpini <dada@perl.it>
-# Maintainer: Cosimo Streppone <cosimo@cpan.org>
-#
-# $Id: Type.pm 458 2009-01-17 17:27:43Z cosimo.streppone $
-#
-#######################################################################
-
-$VERSION = '0.59';
-
-use Carp;
-
-require Exporter; # to export the constants to the main:: space
-require DynaLoader; # to dynuhlode the module.
-@ISA = qw( Exporter DynaLoader );
-
-use vars qw( %Known %PackSize %Modifier %Pointer );
-
-sub DEBUG {
- if ($Win32::API::DEBUG) {
- printf @_ if @_ or return 1;
- } else {
- return 0;
- }
-}
-
-%Known = ();
-%PackSize = ();
-%Modifier = ();
-%Pointer = ();
-
-# Initialize data structures at startup.
-# Aldo wants to keep the <DATA> approach.
-#
-my $section = 'nothing';
-foreach (<DATA>) {
- next if /^\s*#/ or /^\s*$/;
- chomp;
- if( /\[(.+)\]/) {
- $section = $1;
- next;
- }
- if($section eq 'TYPE') {
- my($name, $packing) = split(/\s+/);
- # DEBUG "(PM)Type::INIT: Known('$name') => '$packing'\n";
- $Known{$name} = $packing;
- } elsif($section eq 'PACKSIZE') {
- my($packing, $size) = split(/\s+/);
- # DEBUG "(PM)Type::INIT: PackSize('$packing') => '$size'\n";
- $PackSize{$packing} = $size;
- } elsif($section eq 'MODIFIER') {
- my($modifier, $mapto) = split(/\s+/, $_, 2);
- my %maps = ();
- foreach my $item (split(/\s+/, $mapto)) {
- my($k, $v) = split(/=/, $item);
- $maps{$k} = $v;
- }
- # DEBUG "(PM)Type::INIT: Modifier('$modifier') => '%maps'\n";
- $Modifier{$modifier} = { %maps };
- } elsif($section eq 'POINTER') {
- my($pointer, $pointto) = split(/\s+/);
- # DEBUG "(PM)Type::INIT: Pointer('$pointer') => '$pointto'\n";
- $Pointer{$pointer} = $pointto;
- }
-}
-close(DATA);
-
-sub new {
- my $class = shift;
- my($type) = @_;
- my $packing = packing($type);
- my $size = sizeof($type);
- my $self = {
- type => $type,
- packing => $packing,
- size => $size,
- };
- return bless $self;
-}
-
-sub typedef {
- my $class = shift;
- my($name, $type) = @_;
- my $packing = packing($type, $name);
- DEBUG "(PM)Type::typedef: packing='$packing'\n";
- my $size = sizeof($type);
- $Known{$name} = $packing;
- return 1;
-}
-
-
-sub is_known {
- my $self = shift;
- my $type = shift;
- $type = $self unless defined $type;
- if(ref($type) =~ /Win32::API::Type/) {
- return 1;
- } else {
- return defined packing($type);
- }
-}
-
-sub sizeof {
- my $self = shift;
- my $type = shift;
- $type = $self unless defined $type;
- if(ref($type) =~ /Win32::API::Type/) {
- return $self->{size};
- } else {
- my $packing = packing($type);
- if($packing =~ /(\w)\*(\d+)/) {
- return $PackSize{ $1 } * $2;
- } else {
- return $PackSize{ $packing };
- }
- }
-}
-
-sub packing {
- # DEBUG "(PM)Type::packing: called by ". join("::", (caller(1))[0,3]). "\n";
- my $self = shift;
- my $is_pointer = 0;
- if(ref($self) =~ /Win32::API::Type/) {
- # DEBUG "(PM)Type::packing: got an object\n";
- return $self->{packing};
- }
- my $type = ($self eq 'Win32::API::Type') ? shift : $self;
- my $name = shift;
-
- # DEBUG "(PM)Type::packing: got '$type', '$name'\n";
- my($modifier, $size, $packing);
- if(exists $Pointer{$type}) {
- # DEBUG "(PM)Type::packing: got '$type', is really '$Pointer{$type}'\n";
- $type = $Pointer{$type};
- $is_pointer = 1;
- } elsif($type =~ /(\w+)\s+(\w+)/) {
- $modifier = $1;
- $type = $2;
- # DEBUG "(PM)packing: got modifier '$modifier', type '$type'\n";
- }
-
- $type =~ s/\*$//;
-
- if(exists $Known{$type}) {
- if(defined $name and $name =~ s/\[(.*)\]$//) {
- $size = $1;
- $packing = $Known{$type}[0]."*".$size;
- # DEBUG "(PM)Type::packing: composite packing: '$packing' '$size'\n";
- } else {
- $packing = $Known{$type};
- if($is_pointer and $packing eq 'c') {
- $packing = "p";
- }
- # DEBUG "(PM)Type::packing: simple packing: '$packing'\n";
- }
- if(defined $modifier and exists $Modifier{$modifier}->{$type}) {
- # DEBUG "(PM)Type::packing: applying modifier '$modifier' -> '$Modifier{$modifier}->{$type}'\n";
- $packing = $Modifier{$modifier}->{$type};
- }
- return $packing;
- } else {
- # DEBUG "(PM)Type::packing: NOT FOUND\n";
- return undef;
- }
-}
-
-
-sub is_pointer {
- my $self = shift;
- my $type = shift;
- $type = $self unless defined $type;
- if(ref($type) =~ /Win32::API::Type/) {
- return 1;
- } else {
- if($type =~ /\*$/) {
- return 1;
- } else {
- return exists $Pointer{$type};
- }
- }
-}
-
-sub Pack {
- my ($type, $arg) = @_;
-
- my $pack_type = packing($type);
-
- if($pack_type eq 'p') {
- $pack_type = 'Z*';
- }
-
- $arg = pack($pack_type, $arg);
-
- return $arg;
-}
-
-sub Unpack {
- my ($type, $arg) = @_;
-
- my $pack_type = packing($type);
-
- if($pack_type eq 'p') {
- DEBUG "(PM)Type::Unpack: got packing 'p': is a pointer\n";
- $pack_type = 'Z*';
- }
-
- DEBUG "(PM)Type::Unpack: unpacking '$pack_type' '$arg'\n";
- $arg = unpack($pack_type, $arg);
- DEBUG "(PM)Type::Unpack: returning '" . ($arg || '') . "'\n";
- return $arg;
-}
-
-1;
-
-#######################################################################
-# DOCUMENTATION
-#
-
-=head1 NAME
-
-Win32::API::Type - C type support package for Win32::API
-
-=head1 SYNOPSIS
-
- use Win32::API;
-
- Win32::API::Type->typedef( 'my_number', 'LONG' );
-
-
-=head1 ABSTRACT
-
-This module is a support package for Win32::API that implements
-C types for the import with prototype functionality.
-
-See L<Win32::API> for more info about its usage.
-
-=head1 DESCRIPTION
-
-This module is automatically imported by Win32::API, so you don't
-need to 'use' it explicitly. These are the methods of this package:
-
-=over 4
-
-=item C<typedef NAME, TYPE>
-
-This method defines a new type named C<NAME>. This actually just
-creates an alias for the already-defined type C<TYPE>, which you
-can use as a parameter in a Win32::API call.
-
-=item C<sizeof TYPE>
-
-This returns the size, in bytes, of C<TYPE>. Acts just like
-the C function of the same name.
-
-=item C<is_known TYPE>
-
-Returns true if C<TYPE> is known by Win32::API::Type, false
-otherwise.
-
-=back
-
-=head2 SUPPORTED TYPES
-
-This module should recognize all the types defined in the
-Win32 Platform SDK header files.
-Please see the source for this module, in the C<__DATA__> section,
-for the full list.
-
-=head1 AUTHOR
-
-Aldo Calpini ( I<dada@perl.it> ).
-
-=head1 MAINTAINER
-
-Cosimo Streppone ( I<cosimo@cpan.org> ).
-
-=cut
-
-
-__DATA__
-
-[TYPE]
-ATOM s
-BOOL L
-BOOLEAN c
-BYTE C
-CHAR c
-COLORREF L
-DWORD L
-DWORD32 L
-DWORD64 Q
-FLOAT f
-HACCEL L
-HANDLE L
-HBITMAP L
-HBRUSH L
-HCOLORSPACE L
-HCONV L
-HCONVLIST L
-HCURSOR L
-HDC L
-HDDEDATA L
-HDESK L
-HDROP L
-HDWP L
-HENHMETAFILE L
-HFILE L
-HFONT L
-HGDIOBJ L
-HGLOBAL L
-HHOOK L
-HICON L
-HIMC L
-HINSTANCE L
-HKEY L
-HKL L
-HLOCAL L
-HMENU L
-HMETAFILE L
-HMODULE L
-HPALETTE L
-HPEN L
-HRGN L
-HRSRC L
-HSZ L
-HWINSTA L
-HWND L
-INT i
-INT32 i
-INT64 q
-LANGID s
-LCID L
-LCSCSTYPE L
-LCSGAMUTMATCH L
-LCTYPE L
-LONG l
-LONG32 l
-LONG64 q
-LONGLONG q
-LPARAM L
-LRESULT L
-REGSAM L
-SC_HANDLE L
-SC_LOCK L
-SERVICE_STATUS_HANDLE L
-SHORT s
-SIZE_T L
-SSIZE_T L
-TBYTE c
-TCHAR C
-UCHAR C
-UINT I
-UINT_PTR L
-UINT32 I
-UINT64 Q
-ULONG L
-ULONG32 L
-ULONG64 Q
-ULONGLONG Q
-USHORT S
-WCHAR S
-WORD S
-WPARAM L
-VOID c
-
-int i
-long l
-float f
-double d
-char c
-
-#CRITICAL_SECTION 24 -- a structure
-#LUID ? 8 -- a structure
-#VOID 0
-#CONST 4
-#FILE_SEGMENT_ELEMENT 8 -- a structure
-
-[PACKSIZE]
-c 1
-C 1
-d 8
-f 4
-i 4
-I 4
-l 4
-L 4
-q 8
-Q 8
-s 2
-S 2
-p 4
-
-[MODIFIER]
-unsigned int=I long=L short=S char=C
-
-[POINTER]
-INT_PTR INT
-LPBOOL BOOL
-LPBYTE BYTE
-LPCOLORREF COLORREF
-LPCSTR CHAR
-#LPCTSTR CHAR or WCHAR
-LPCTSTR CHAR
-LPCVOID any
-LPCWSTR WCHAR
-LPDOUBLE double
-LPDWORD DWORD
-LPHANDLE HANDLE
-LPINT INT
-LPLONG LONG
-LPSTR CHAR
-#LPTSTR CHAR or WCHAR
-LPTSTR CHAR
-LPVOID VOID
-LPWORD WORD
-LPWSTR WCHAR
-
-PBOOL BOOL
-PBOOLEAN BOOL
-PBYTE BYTE
-PCHAR CHAR
-PCSTR CSTR
-PCWCH CWCH
-PCWSTR CWSTR
-PDWORD DWORD
-PFLOAT FLOAT
-PHANDLE HANDLE
-PHKEY HKEY
-PINT INT
-PLCID LCID
-PLONG LONG
-PSHORT SHORT
-PSTR CHAR
-#PTBYTE TBYTE --
-#PTCHAR TCHAR --
-#PTSTR CHAR or WCHAR
-PTSTR CHAR
-PUCHAR UCHAR
-PUINT UINT
-PULONG ULONG
-PUSHORT USHORT
-PVOID VOID
-PWCHAR WCHAR
-PWORD WORD
-PWSTR WCHAR
diff --git a/Master/tlpkg/tlperl0/lib/Win32/DBIODBC.pm b/Master/tlpkg/tlperl0/lib/Win32/DBIODBC.pm
deleted file mode 100755
index e3262c09d99..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/DBIODBC.pm
+++ /dev/null
@@ -1,248 +0,0 @@
-package # hide this package from CPAN indexer
- Win32::ODBC;
-
-#use strict;
-
-use DBI;
-
-# once we've been loaded we don't want perl to load the real Win32::ODBC
-$INC{'Win32/ODBC.pm'} = $INC{'Win32/DBIODBC.pm'} || 1;
-
-#my $db = new Win32::ODBC("DSN=$self->{'DSN'};UID=$self->{'UID'};PWD=$self->{'PWD'};");
-
-#EMU --- my $db = new Win32::ODBC("DSN=$DSN;UID=$login;PWD=$password;");
-sub new
-{
- shift;
- my $connect_line= shift;
-
-# [R] self-hack to allow empty UID and PWD
- my $temp_connect_line;
- $connect_line=~/DSN=\w+/;
- $temp_connect_line="$&;";
- if ($connect_line=~/UID=\w?/)
- {$temp_connect_line.="$&;";}
- else {$temp_connect_line.="UID=;";};
- if ($connect_line=~/PWD=\w?/)
- {$temp_connect_line.="$&;";}
- else {$temp_connect_line.="PWD=;";};
- $connect_line=$temp_connect_line;
-# -[R]-
-
- my $self= {};
-
-
- $_=$connect_line;
- /^(DSN=)(.*)(;UID=)(.*)(;PWD=)(.*)(;)$/;
-
- #---- DBI CONNECTION VARIABLES
-
- $self->{ODBC_DSN}=$2;
- $self->{ODBC_UID}=$4;
- $self->{ODBC_PWD}=$6;
-
-
- #---- DBI CONNECTION VARIABLES
- $self->{DBI_DBNAME}=$self->{ODBC_DSN};
- $self->{DBI_USER}=$self->{ODBC_UID};
- $self->{DBI_PASSWORD}=$self->{ODBC_PWD};
- $self->{DBI_DBD}='ODBC';
-
- #---- DBI CONNECTION
- $self->{'DBI_DBH'}=DBI->connect($self->{'DBI_DBNAME'},
- $self->{'DBI_USER'},$self->{'DBI_PASSWORD'},$self->{'DBI_DBD'});
-
- warn "Error($DBI::err) : $DBI::errstr\n" if ! $self->{'DBI_DBH'};
-
-
- #---- RETURN
-
- bless $self;
-}
-
-
-#EMU --- $db->Sql('SELECT * FROM DUAL');
-sub Sql
-{
- my $self= shift;
- my $SQL_statment=shift;
-
- # print " SQL : $SQL_statment \n";
-
- $self->{'DBI_SQL_STATMENT'}=$SQL_statment;
-
- my $dbh=$self->{'DBI_DBH'};
-
- # print " DBH : $dbh \n";
-
- my $sth=$dbh->prepare("$SQL_statment");
-
- # print " STH : $sth \n";
-
- $self->{'DBI_STH'}=$sth;
-
- if ($sth)
- {
- $sth->execute();
- }
-
- #--- GET ERROR MESSAGES
- $self->{DBI_ERR}=$DBI::err;
- $self->{DBI_ERRSTR}=$DBI::errstr;
-
- if ($sth)
- {
- #--- GET COLUMNS NAMES
- $self->{'DBI_NAME'} = $sth->{NAME};
- }
-
-# [R] provide compatibility with Win32::ODBC's way of identifying erraneous SQL statements
- return ($self->{'DBI_ERR'})?1:undef;
-# -[R]-
-}
-
-
-#EMU --- $db->FetchRow())
-sub FetchRow
-{
- my $self= shift;
-
- my $sth=$self->{'DBI_STH'};
- if ($sth)
- {
- my @row=$sth->fetchrow_array;
- $self->{'DBI_ROW'}=\@row;
-
- if (scalar(@row)>0)
- {
- #-- the row of result is not nul
- #-- return somthing nothing will be return else
- return 1;
- }
- }
- return undef;
-}
-
-# [R] provide compatibility with Win32::ODBC's Data() method.
-sub Data
-{
- my $self=shift;
- my @array=@{$self->{'DBI_ROW'}};
- foreach my $element (@array)
- {
- # remove padding of spaces by DBI
- $element=~s/(\s*$)//;
- };
- return (wantarray())?@array:join('', @array);
-};
-# -[R]-
-
-#EMU --- %record = $db->DataHash;
-sub DataHash
-{
- my $self= shift;
-
- my $p_name=$self->{'DBI_NAME'};
- my $p_row=$self->{'DBI_ROW'};
-
- my @name=@$p_name;
- my @row=@$p_row;
-
- my %DataHash;
-#print @name; print "\n"; print @row;
-# [R] new code that seems to work consistent with Win32::ODBC
- while (@name)
- {
- my $name=shift(@name);
- my $value=shift(@row);
-
- # remove padding of spaces by DBI
- $name=~s/(\s*$)//;
- $value=~s/(\s*$)//;
-
- $DataHash{$name}=$value;
- };
-# -[R]-
-
-# [R] old code that didn't appear to work
-# foreach my $name (@name)
-# {
-# $name=~s/(^\s*)|(\s*$)//;
-# my @arr=@$name;
-# foreach (@arr)
-# {
-# print "lot $name name col $_ or ROW= 0 $row[0] 1 $row[1] 2 $row[2] \n ";
-# $DataHash{$name}=shift(@row);
-# }
-# }
-# -[R]-
-
- #--- Return Hash
- return %DataHash;
-}
-
-
-#EMU --- $db->Error()
-sub Error
-{
- my $self= shift;
-
- if ($self->{'DBI_ERR'} ne '')
- {
- #--- Return error message
- $self->{'DBI_ERRSTR'};
- }
-
- #-- else good no error message
-
-}
-
-# [R] provide compatibility with Win32::ODBC's Close() method.
-sub Close
-{
- my $self=shift;
-
- my $dbh=$self->{'DBI_DBH'};
- $dbh->disconnect;
-}
-# -[R]-
-
-1;
-
-__END__
-
-# [R] to -[R]- indicate sections edited by me, Roy Lee
-
-=head1 NAME
-
-Win32::DBIODBC - Win32::ODBC emulation layer for the DBI
-
-=head1 SYNOPSIS
-
- use Win32::DBIODBC; # instead of use Win32::ODBC
-
-=head1 DESCRIPTION
-
-This is a I<very> basic I<very> alpha quality Win32::ODBC emulation
-for the DBI. To use it just replace
-
- use Win32::ODBC;
-
-in your scripts with
-
- use Win32::DBIODBC;
-
-or, while experimenting, you can pre-load this module without changing your
-scripts by doing
-
- perl -MWin32::DBIODBC your_script_name
-
-=head1 TO DO
-
-Error handling is virtually non-existant.
-
-=head1 AUTHOR
-
-Tom Horen <tho@melexis.com>
-
-=cut
diff --git a/Master/tlpkg/tlperl0/lib/Win32/EventLog.pm b/Master/tlpkg/tlperl0/lib/Win32/EventLog.pm
deleted file mode 100755
index bf840723a6a..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/EventLog.pm
+++ /dev/null
@@ -1,471 +0,0 @@
-#
-# EventLog.pm
-#
-# Creates an object oriented interface to the Windows NT Evenlog
-# Written by Jesse Dougherty
-#
-
-package Win32::EventLog;
-
-use strict;
-use vars qw($VERSION $AUTOLOAD @ISA @EXPORT $GetMessageText);
-$VERSION = '0.076';
-
-require Exporter;
-require DynaLoader;
-
-die "The Win32::Eventlog module works only on Windows NT"
- unless Win32::IsWinNT();
-
-@ISA= qw(Exporter DynaLoader);
-@EXPORT = qw(
- EVENTLOG_AUDIT_FAILURE
- EVENTLOG_AUDIT_SUCCESS
- EVENTLOG_BACKWARDS_READ
- EVENTLOG_END_ALL_PAIRED_EVENTS
- EVENTLOG_END_PAIRED_EVENT
- EVENTLOG_ERROR_TYPE
- EVENTLOG_FORWARDS_READ
- EVENTLOG_INFORMATION_TYPE
- EVENTLOG_PAIRED_EVENT_ACTIVE
- EVENTLOG_PAIRED_EVENT_INACTIVE
- EVENTLOG_SEEK_READ
- EVENTLOG_SEQUENTIAL_READ
- EVENTLOG_START_PAIRED_EVENT
- EVENTLOG_SUCCESS
- EVENTLOG_WARNING_TYPE
-);
-
-$GetMessageText=0;
-
-sub AUTOLOAD {
- my($constname);
- ($constname = $AUTOLOAD) =~ s/.*:://;
- # reset $! to zero to reset any current errors.
- local $! = 0;
- my $val = constant($constname, @_ ? $_[0] : 0);
- if ($!) {
- if ($! =~ /Invalid/) {
- $AutoLoader::AUTOLOAD = $AUTOLOAD;
- goto &AutoLoader::AUTOLOAD;
- }
- else {
- my ($pack,$file,$line) = caller;
- die "Unknown Win32::EventLog macro $constname, at $file line $line.\n";
- }
- }
- eval "sub $AUTOLOAD { $val }";
- goto &$AUTOLOAD;
-}
-
-#
-# new()
-#
-# Win32::EventLog->new("source name", "ServerName");
-#
-sub new {
- die "usage: PACKAGE->new(SOURCENAME[, SERVERNAME])\n" unless @_ > 1;
- my ($class,$source,$server) = @_;
- my $handle;
-
- # Create new handle
- if ($source !~ /\\/) {
- OpenEventLog($handle, $server, $source);
- }
- else {
- OpenBackupEventLog($handle, $server, $source);
- }
- return bless {handle => $handle,
- Source => $source,
- Computer => $server} => $class;
-}
-
-sub DESTROY {shift->Close}
-
-#
-# Open (the rather braindead old way)
-# A variable initialized to empty must be supplied as the first
-# arg, followed by whatever new() takes
-#
-sub Open {
- $_[0] = Win32::EventLog->new($_[1],$_[2]);
-}
-
-sub OpenBackup {
- my ($class,$source,$server) = @_;
- OpenBackupEventLog(my $handle, $server, $source);
- return bless {handle => $handle,
- Source => $source,
- Computer => $server} => $class;
-}
-
-sub Backup {
- die " usage: OBJECT->Backup(FILENAME)\n" unless @_ == 2;
- my ($self,$file) = @_;
- return BackupEventLog($self->{handle}, $file);
-}
-
-sub Close {
- my $self = shift;
- CloseEventLog($self->{handle});
- $self->{handle} = 0;
-}
-
-# Read
-# Note: the EventInfo arguement requires a hash reference.
-sub Read {
- my $self = shift;
-
- die "usage: OBJECT->Read(FLAGS, RECORDOFFSET, HASHREF)\n" unless @_ == 3;
-
- my ($readflags,$recordoffset) = @_;
- # The following is stolen shamelessly from Wyt's tests for the registry.
- my $result = ReadEventLog($self->{handle}, $readflags, $recordoffset,
- my $header, my $source, my $computer, my $sid,
- my $data, my $strings);
- my ($length,
- $reserved,
- $recordnumber,
- $timegenerated,
- $timewritten,
- $eventid,
- $eventtype,
- $numstrings,
- $eventcategory,
- $reservedflags,
- $closingrecordnumber,
- $stringoffset,
- $usersidlength,
- $usersidoffset,
- $datalength,
- $dataoffset) = unpack('l6s4l6', $header);
-
- # make a hash out of the values returned from ReadEventLog.
- my %h = ( Source => $source,
- Computer => $computer,
- Length => $datalength,
- Category => $eventcategory,
- RecordNumber => $recordnumber,
- TimeGenerated => $timegenerated,
- Timewritten => $timewritten,
- EventID => $eventid,
- EventType => $eventtype,
- ClosingRecordNumber => $closingrecordnumber,
- User => $sid,
- Strings => $strings,
- Data => $data,
- );
-
- # get the text message here
- if ($result and $GetMessageText) {
- GetEventLogText($source, $eventid, $strings, $numstrings, my $message);
- $h{Message} = $message;
- }
-
- if (ref($_[2]) eq 'HASH') {
- %{$_[2]} = %h; # this needed for Read(...,\%foo) case
- }
- else {
- $_[2] = \%h;
- }
- return $result;
-}
-
-sub GetMessageText {
- my $self = shift;
- local $^W;
- GetEventLogText($self->{Source},
- $self->{EventID},
- $self->{Strings},
- $self->{Strings} =~ tr/\0/\0/,
- my $message);
-
- $self->{Message} = $message;
- return $message;
-}
-
-sub Report {
- die "usage: OBJECT->Report( HASHREF )\n" unless @_ == 2;
- my ($self,$EventInfo) = @_;
-
- die "Win32::EventLog::Report requires a hash reference as arg 2\n"
- unless ref($EventInfo) eq "HASH";
-
- my $computer = $EventInfo->{Computer} ? $EventInfo->{Computer}
- : $self->{Computer};
- my $source = exists($EventInfo->{Source}) ? $EventInfo->{Source}
- : $self->{Source};
-
- return WriteEventLog($computer, $source, $EventInfo->{EventType},
- $EventInfo->{Category}, $EventInfo->{EventID}, 0,
- $EventInfo->{Data}, split(/\0/, $EventInfo->{Strings}));
-
-}
-
-sub GetOldest {
- my $self = shift;
- die "usage: OBJECT->GetOldest( SCALAREF )\n" unless @_ == 1;
- return GetOldestEventLogRecord($self->{handle},$_[0]);
-}
-
-sub GetNumber {
- my $self = shift;
- die "usage: OBJECT->GetNumber( SCALARREF )\n" unless @_ == 1;
- return GetNumberOfEventLogRecords($self->{handle}, $_[0]);
-}
-
-sub Clear {
- my ($self,$file) = @_;
- die "usage: OBJECT->Clear( FILENAME )\n" unless @_ == 2;
- return ClearEventLog($self->{handle}, $file);
-}
-
-bootstrap Win32::EventLog;
-
-1;
-__END__
-
-=head1 NAME
-
-Win32::EventLog - Process Win32 Event Logs from Perl
-
-=head1 SYNOPSIS
-
- use Win32::EventLog
- $handle=Win32::EventLog->new("Application");
-
-=head1 DESCRIPTION
-
-This module implements most of the functionality available from the
-Win32 API for accessing and manipulating Win32 Event Logs. The access
-to the EventLog routines is divided into those that relate to an
-EventLog object and its associated methods and those that relate other
-EventLog tasks (like adding an EventLog record).
-
-=head1 The EventLog Object and its Methods
-
-The following methods are available to open, read, close and backup
-EventLogs.
-
-=over 4
-
-=item Win32::EventLog->new(SOURCENAME [,SERVERNAME]);
-
-The new() method creates a new EventLog object and returns a handle
-to it. This hande is then used to call the methods below.
-
-The method is overloaded in that if the supplied SOURCENAME
-argument contains one or more literal '\' characters (an illegal
-character in a SOURCENAME), it assumes that you are trying to open
-a backup eventlog and uses SOURCENAME as the backup eventlog to
-open. Note that when opening a backup eventlog, the SERVERNAME
-argument is ignored (as it is in the underlying Win32 API). For
-EventLogs on remote machines, the SOURCENAME parameter must
-therefore be specified as a UNC path.
-
-=item $handle->Backup(FILENAME);
-
-The Backup() method backs up the EventLog represented by $handle. It
-takes a single arguemt, FILENAME. When $handle represents an
-EventLog on a remote machine, FILENAME is filename on the remote
-machine and cannot be a UNC path (i.e you must use F<C:\TEMP\App.EVT>).
-The method will fail if the log file already exists.
-
-=item $handle->Read(FLAGS, OFFSET, HASHREF);
-
-The Read() method read an EventLog entry from the EventLog represented
-by $handle.
-
-=item $handle->Close();
-
-The Close() method closes the EventLog represented by $handle. After
-Close() has been called, any further attempt to use the EventLog
-represented by $handle will fail.
-
-=item $handle->GetOldest(SCALARREF);
-
-The GetOldest() method number of the the oldest EventLog record in
-the EventLog represented by $handle. This is required to correctly
-compute the OFFSET required by the Read() method.
-
-=item $handle->GetNumber(SCALARREF);
-
-The GetNumber() method returns the number of EventLog records in
-the EventLog represented by $handle. The number of the most recent
-record in the EventLog is therefore computed by
-
- $handle->GetOldest($oldest);
- $handle->GetNumber($lastRec);
- $lastRecOffset=$oldest+$lastRec;
-
-=item $handle->Clear(FILENAME);
-
-The Clear() method clears the EventLog represented by $handle. If
-you provide a non-null FILENAME, the EventLog will be backed up
-into FILENAME before the EventLog is cleared. The method will fail
-if FILENAME is specified and the file refered to exists. Note also
-that FILENAME specifies a file local to the machine on which the
-EventLog resides and cannot be specified as a UNC name.
-
-=item $handle->Report(HASHREF);
-
-The Report() method generates an EventLog entry. The HASHREF should
-contain the following keys:
-
-=over 4
-
-=item C<Computer>
-
-The C<Computer> field specfies which computer you want the EventLog
-entry recorded. If this key doesn't exist, the server name used to
-create the $handle is used.
-
-=item C<Source>
-
-The C<Source> field specifies the source that generated the EventLog
-entry. If this key doesn't exist, the source name used to create the
-$handle is used.
-
-=item C<EventType>
-
-The C<EventType> field should be one of the constants
-
-=over 4
-
-=item C<EVENTLOG_ERROR_TYPE>
-
-An Error event is being logged.
-
-=item C<EVENTLOG_WARNING_TYPE>
-
-A Warning event is being logged.
-
-=item C<EVENTLOG_INFORMATION_TYPE>
-
-An Information event is being logged.
-
-=item C<EVENTLOG_AUDIT_SUCCESS>
-
-A Success Audit event is being logged (typically in the Security
-EventLog).
-
-=item C<EVENTLOG_AUDIT_FAILURE>
-
-A Failure Audit event is being logged (typically in the Security
-EventLog).
-
-=back
-
-These constants are exported into the main namespace by default.
-
-=item C<Category>
-
-The C<Category> field can have any value you want. It is specific to
-the particular Source.
-
-=item C<EventID>
-
-The C<EventID> field should contain the ID of the message that this
-event pertains too. This assumes that you have an associated message
-file (indirectly referenced by the field C<Source>).
-
-=item C<Data>
-
-The C<Data> field contains raw data associated with this event.
-
-=item C<Strings>
-
-The C<Strings> field contains the single string that itself contains
-NUL terminated sub-strings. This are used with the EventID to generate
-the message as seen from (for example) the Event Viewer application.
-
-=back
-
-=back
-
-=head1 Other Win32::EventLog functions.
-
-The following functions are part of the Win32::EventLog package but
-are not callable from an EventLog object.
-
-=over 4
-
-=item GetMessageText(HASHREF);
-
-The GetMessageText() function assumes that HASHREF was obtained by
-a call to C<$handle-E<gt>Read()>. It returns the formatted string that
-represents the fully resolved text of the EventLog message (such as
-would be seen in the Windows NT Event Viewer). For convenience, the
-key 'Message' in the supplied HASHREF is also set to the return value
-of this function.
-
-If you set the variable $Win32::EventLog::GetMessageText to 1 then
-each call to C<$handle-E<gt>Read()> will call this function automatically.
-
-=back
-
-=head1 Example 1
-
-The following example illustrates the way in which the EventLog module
-can be used. It opens the System EventLog and reads through it from
-oldest to newest records. For each record from the B<Source> EventLog
-it extracts the full text of the Entry and prints the EventLog message
-text out.
-
- use Win32::EventLog;
-
- $handle=Win32::EventLog->new("System", $ENV{ComputerName})
- or die "Can't open Application EventLog\n";
- $handle->GetNumber($recs)
- or die "Can't get number of EventLog records\n";
- $handle->GetOldest($base)
- or die "Can't get number of oldest EventLog record\n";
-
- while ($x < $recs) {
- $handle->Read(EVENTLOG_FORWARDS_READ|EVENTLOG_SEEK_READ,
- $base+$x,
- $hashRef)
- or die "Can't read EventLog entry #$x\n";
- if ($hashRef->{Source} eq "EventLog") {
- Win32::EventLog::GetMessageText($hashRef);
- print "Entry $x: $hashRef->{Message}\n";
- }
- $x++;
- }
-
-=head1 Example 2
-
-To backup and clear the EventLogs on a remote machine, do the following :-
-
- use Win32::EventLog;
-
- $myServer="\\\\my-server"; # your servername here.
- my($date)=join("-", ((split(/\s+/, scalar(localtime)))[0,1,2,4]));
- my($dest);
-
- for my $eventLog ("Application", "System", "Security") {
- $handle=Win32::EventLog->new($eventLog, $myServer)
- or die "Can't open Application EventLog on $myServer\n";
-
- $dest="C:\\BackupEventLogs\\$eventLog\\$date.evt";
- $handle->Backup($dest)
- or warn "Could not backup and clear the $eventLog EventLog on $myServer ($^E)\n";
-
- $handle->Close;
- }
-
-Note that only the Clear method is required. Note also that if the
-file $dest exists, the function will fail.
-
-=head1 BUGS
-
-None currently known.
-
-The test script for 'make test' should be re-written to use the
-EventLog object.
-
-=head1 AUTHOR
-
-Original code by Jesse Dougherty for HiP Communications. Additional
-fixes and updates attributed to Martin Pauley
-<martin.pauley@ulsterbank.ltd.uk>) and Bret Giddings (bret@essex.ac.uk).
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe.pm
deleted file mode 100755
index 023946025c7..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe.pm
+++ /dev/null
@@ -1,308 +0,0 @@
-package Win32::Exe;
-$Win32::Exe::VERSION = '0.11';
-
-=head1 NAME
-
-Win32::Exe - Manipulate Win32 executable files
-
-=head1 VERSION
-
-This document describes version 0.10 of Win32::Exe, released
-January 14, 2007.
-
-=head1 SYNOPSIS
-
- use Win32::Exe;
- my $exe = Win32::Exe->new('c:/windows/notepad.exe');
-
- # Get version information
- print $exe->version_info->get('FileDescription'), ": ",
- $exe->version_info->get('LegalCopyright'), "\n";
-
- # Dump icons in an executable
- foreach my $icon ($exe->icons) {
- printf "Icon: %s x %s (%s colors)\n",
- $icon->Width, $icon->Height, 2 ** $icon->BitCount;
- }
-
- # Import icons from a .exe or .ico file and writes back the file
- $exe->update( icon => '/c/windows/taskman.exe' );
-
- # Change it to a console application, then save to another .exe
- $exe->SetSubsystem('console');
- $exe->write('c:/windows/another.exe');
-
- # Add a manifest section
- $exe->update( manifest => $mymanifestxml );
- # or a default
- $exe->update( defaultmanifest => 1 );
-
-
-=head1 DESCRIPTION
-
-This module parses and manipulating Win32 PE/COFF executable headers,
-including version information, icons and other resources.
-
-More documentation will be provided in due time. For now, please look
-at the test files in the source distributions F<t/> directory for examples
-of using this module.
-
-=cut
-
-use strict;
-use base 'Win32::Exe::Base';
-use constant FORMAT => (
- Magic => 'a2', # "MZ"
- _ => 'a58',
- PosPE => 'V',
- _ => 'a{($PosPE > 64) ? $PosPE - 64 : "*"}',
- PESig => 'a4',
- Data => 'a*',
-);
-use constant DELEGATE_SUBS => (
- 'IconFile' => [ 'dump_iconfile', 'write_iconfile' ],
-);
-use constant DISPATCH_FIELD => 'PESig';
-use constant DISPATCH_TABLE => (
- "PE\0\0" => "PE",
- '*' => sub { die "Incorrect PE header -- not a valid .exe file" },
-);
-use constant DEBUG_INDEX => 6;
-use constant DEBUG_ENTRY_SIZE => 28;
-
-use File::Basename ();
-use Win32::Exe::IconFile;
-use Win32::Exe::DebugTable;
-
-sub resource_section {
- my ($self) = @_;
- $self->first_member('Resources');
-}
-
-sub sections {
- my ($self) = @_;
- my $method = (wantarray ? 'members' : 'first_member');
- return $self->members('Section');
-}
-
-sub data_directories {
- my ($self) = @_;
- return $self->members('DataDirectory');
-}
-
-sub update_debug_directory {
- my ($self, $boundary, $extra) = @_;
-
- $self->SetSymbolTable( $self->SymbolTable + $extra )
- if ($boundary <= $self->SymbolTable);
-
- my @dirs = $self->data_directories;
- return if DEBUG_INDEX > $#dirs;
-
- my $dir = $dirs[DEBUG_INDEX] or return;
- my $size = $dir->Size;
- my $addr = $dir->VirtualAddress;
-
- return unless $size or $addr;
-
- my $count = $size / DEBUG_ENTRY_SIZE or return;
-
- (($size % DEBUG_ENTRY_SIZE) == 0) or return;
-
- foreach my $section ($self->sections) {
- my $offset = $section->FileOffset;
- my $f_size = $section->FileSize;
- my $v_addr = $section->VirtualAddress;
-
- next unless $v_addr <= $addr;
- next unless $addr < ($v_addr + $f_size);
- next unless ($addr + $size) < ($v_addr + $f_size);
-
- $offset += $addr - $v_addr;
- my $data = $self->substr($offset, $size);
-
- my $table = Win32::Exe::DebugTable->new(\$data);
-
- foreach my $dir ($table->members) {
- next unless $boundary <= $dir->Offset;
-
- $dir->SetOffset($dir->Offset + $extra);
- $dir->SetVirtualAddress($dir->VirtualAddress + $extra)
- if $dir->VirtualAddress > 0;
- }
-
- $self->substr($offset, $size, $table->dump);
- last;
- }
-}
-
-sub default_info {
- my $self = shift;
-
- my $filename = File::Basename::basename($self->filename);
-
- return join(';',
- "CompanyName=",
- "FileDescription=",
- "FileVersion=0.0.0.0",
- "InternalName=$filename",
- "LegalCopyright=",
- "LegalTrademarks=",
- "OriginalFilename=$filename",
- "ProductName=",
- "ProductVersion=0.0.0.0",
- );
-}
-
-sub update {
- my ($self, %args) = @_;
-
- if ($args{defaultmanifest}) {
- $self->add_default_manifest();
- }
-
- if (my $manifest = $args{manifest}) {
- $self->set_manifest($manifest);
- }
-
- if (my $icon = $args{icon}) {
- my @icons = Win32::Exe::IconFile->new($icon)->icons;
- $self->set_icons(\@icons) if @icons;
- }
-
- if (my $info = $args{info}) {
- my @info = ($self->default_info, @$info);
-
- my @pairs;
- foreach my $pairs (map split(/\s*;\s*(?=[\w\\\/]+\s*=)/, $_), @info) {
- my ($key, $val) = split(/\s*=\s*/, $pairs, 2);
- next if $key =~ /language/i;
-
- if ($key =~ /^(product|file)version$/i) {
- $key = "\u$1Version";
- $val =~ /^(?:\d+\.)+\d+$/ or die "$key cannot be '$val'";
- $val .= '.0' while $val =~ y/.,// < 3;
-
- push(@pairs,
- [ $key => $val ],
- [ "/StringFileInfo/#1/$key", $val ]);
- }
- else {
- push(@pairs, [ $key => $val ]);
- }
- }
-
- $self->set_version_info(\@pairs) if @pairs;
- }
-
- die "'gui' and 'console' cannot both be true"
- if $args{gui} and $args{console};
-
- $self->SetSubsystem("windows") if $args{gui};
- $self->SetSubsystem("console") if $args{console};
- $self->write;
-}
-
-sub icons {
- my ($self) = @_;
- my $rsrc = $self->resource_section or return;
- my @icons = map $_->members, $rsrc->objects('GroupIcon');
- wantarray ? @icons : \@icons;
-}
-
-sub set_icons {
- my ($self, $icons) = @_;
-
- my $rsrc = $self->resource_section;
- my $name = eval { $rsrc->first_object('GroupIcon')->PathName }
- || '/#RT_GROUP_ICON/#1/#0';
-
- $rsrc->remove('/#RT_GROUP_ICON');
- $rsrc->remove('/#RT_ICON');
-
- my $group = $self->require_class('Resource::GroupIcon')->new;
- $group->SetPathName($name);
- $group->set_parent($rsrc);
- $rsrc->insert($group->PathName, $group);
-
- $group->set_icons($icons);
- $group->refresh;
-}
-
-sub version_info {
- my ($self) = @_;
- my $rsrc = $self->resource_section or return;
-
- # XXX - return a hash in list context?
-
- return $rsrc->first_object('Version');
-}
-
-sub set_version_info {
- my ($self, $pairs) = @_;
- my $rsrc = $self->resource_section or return;
- my $version = $rsrc->first_object('Version');
- $version->set(@$_) for @$pairs;
- $version->refresh;
-}
-
-sub manifest {
- my ($self) = @_;
- my $rsrc = $self->resource_section or return;
- if( my $obj = $rsrc->first_object('Manifest') ) {
- return $obj;
- } else {
- return $self->require_class('Resource::Manifest')->new;
- }
-}
-
-sub set_manifest {
- my ($self, $xml) = @_;
- my $rsrc = $self->resource_section;
- my $name = eval { $rsrc->first_object('Manifest')->PathName } || '/#RT_MANIFEST/#1/#0';
- $rsrc->remove( $name );
- my $manifest = $self->require_class('Resource::Manifest')->new;
- $manifest->SetPathName( $name );
- $manifest->set_parent( $rsrc );
- $manifest->update_manifest( $xml );
- $rsrc->insert($manifest->PathName, $manifest);
- $rsrc->refresh;
-}
-
-sub add_default_manifest {
- my ($self) = @_;
- my $rsrc = $self->resource_section;
- my $name = eval { $rsrc->first_object('Manifest')->PathName } || '/#RT_MANIFEST/#1/#0';
- $rsrc->remove( $name );
- my $manifest = $self->require_class('Resource::Manifest')->new;
- my $xml = $manifest->default_manifest;
- $manifest->SetPathName( $name );
- $manifest->set_parent( $rsrc );
- $manifest->update_manifest( $xml );
- $rsrc->insert($manifest->PathName, $manifest);
- $rsrc->refresh;
- $self->write;
-}
-
-1;
-
-__END__
-
-=head1 AUTHORS
-
-Audrey Tang E<lt>cpan@audreyt.orgE<gt>
-
-Mark Dootson
-
-Steffen Mueller E<lt>smueller@cpan.orgE<gt>
-
-=head1 COPYRIGHT
-
-Copyright 2004-2007 by Audrey Tang E<lt>cpan@audreyt.orgE<gt>.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-See L<http://www.perl.com/perl/misc/Artistic.html>
-
-=cut
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/Base.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/Base.pm
deleted file mode 100755
index a90ec19c451..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/Base.pm
+++ /dev/null
@@ -1,35 +0,0 @@
-# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/Base.pm $ $Author: autrijus $
-# $Revision: #8 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
-
-package Win32::Exe::Base;
-
-use strict;
-use base 'Parse::Binary';
-use constant BASE_CLASS => 'Win32::Exe';
-use constant FORMAT => (
- Data => 'a',
-);
-
-sub align {
- my ($self, $value, $boundary) = @_;
- my $n = ($value % $boundary) or return $value;
- return($value + $boundary - $n);
-}
-
-sub pad {
- my ($self, $value, $bounary) = @_;
- my $x = length($value) % $bounary or return '';
- return "\0" x ($bounary - $x);
-}
-
-sub decode_ucs2 {
- my ($self, $string) = @_;
- return join('', map chr($_), unpack("v*", $string));
-}
-
-sub encode_ucs2 {
- my ($self, $string) = @_;
- return pack("v*", map ord($_), split(//, $string));
-}
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/DataDirectory.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/DataDirectory.pm
deleted file mode 100755
index e544ed372a3..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/DataDirectory.pm
+++ /dev/null
@@ -1,13 +0,0 @@
-# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/DataDirectory.pm $ $Author: autrijus $
-# $Revision: #6 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
-
-package Win32::Exe::DataDirectory;
-
-use strict;
-use base 'Win32::Exe::Base';
-use constant FORMAT => (
- VirtualAddress => 'V',
- Size => 'V',
-);
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/DebugDirectory.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/DebugDirectory.pm
deleted file mode 100755
index f87cc0062be..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/DebugDirectory.pm
+++ /dev/null
@@ -1,19 +0,0 @@
-# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/DebugDirectory.pm $ $Author: autrijus $
-# $Revision: #5 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
-
-package Win32::Exe::DebugDirectory;
-
-use strict;
-use base 'Win32::Exe::Base';
-use constant FORMAT => (
- Flags => 'V',
- TimeStamp => 'V',
- VersionMajor => 'v',
- VersionMinor => 'v',
- Type => 'V',
- Size => 'V',
- VirtualAddress => 'V',
- Offset => 'V',
-);
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/DebugTable.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/DebugTable.pm
deleted file mode 100755
index c861ee2397b..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/DebugTable.pm
+++ /dev/null
@@ -1,12 +0,0 @@
-# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/DebugTable.pm $ $Author: autrijus $
-# $Revision: #6 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
-
-package Win32::Exe::DebugTable;
-
-use strict;
-use base 'Win32::Exe::Base';
-use constant FORMAT => (
- 'DebugDirectory' => [ 'a28', '*', 1 ],
-);
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/IconFile.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/IconFile.pm
deleted file mode 100755
index 8c24160951d..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/IconFile.pm
+++ /dev/null
@@ -1,60 +0,0 @@
-# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/IconFile.pm $ $Author: autrijus $
-# $Revision: #9 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
-
-package Win32::Exe::IconFile;
-
-use strict;
-use base 'Win32::Exe::Base';
-use constant FORMAT => (
- Magic => 'a2',
- Type => 'v',
- Count => 'v',
- 'Resource::Icon' => [ 'a16', '{$Count}', 1 ],
- Data => 'a*',
-);
-use constant DEFAULT_ARGS => (
- Magic => "\0\0",
- Type => 1,
- Count => 0,
- Data => '',
-);
-use constant DISPATCH_FIELD => 'Magic';
-use constant DISPATCH_TABLE => (
- "\0\0" => '',
- "MZ" => '__BASE__',
- '*' => sub { die "Invalid icon file header: $_[1]" },
-);
-
-sub icons {
- my $self = shift;
- $self->members(@_);
-}
-
-sub set_icons {
- my ($self, $icons) = @_;
- $self->SetCount(scalar @$icons);
- $self->set_members('Resource::Icon' => $icons);
- $self->refresh;
-
- foreach my $idx (0 .. $#{$icons}) {
- $self->icons->[$idx]->SetImageOffset(length($self->dump));
- $self->SetData( $self->Data . $icons->[$idx]->Data );
- }
-
- $self->refresh;
-}
-
-sub dump_iconfile {
- my $self = shift;
- my @icons = $self->icons;
- my $obj = $self->require_class('IconFile')->new;
- $obj->set_icons(\@icons);
- return $obj->dump;
-}
-
-sub write_iconfile {
- my ($self, $filename) = @_;
- $self->write_file($filename, $self->dump_iconfile);
-}
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/PE.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/PE.pm
deleted file mode 100755
index 55251562786..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/PE.pm
+++ /dev/null
@@ -1,24 +0,0 @@
-# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/PE.pm $ $Author: autrijus $
-# $Revision: #6 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
-
-package Win32::Exe::PE;
-
-use strict;
-use base 'Win32::Exe';
-use constant SUBFORMAT => (
- Machine => 'v',
- NumSections => 'v',
- TimeStamp => 'V',
- SymbolTable => 'V',
- _ => 'a4',
- OptHeaderSize => 'v',
- Characteristics => 'v',
- Data => 'a*',
-);
-use constant DISPATCH_FIELD => 'OptHeaderSize';
-use constant DISPATCH_TABLE => (
- '0' => '',
- '*' => 'PE::Header',
-);
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/PE/Header.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/PE/Header.pm
deleted file mode 100755
index 03888fedbd8..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/PE/Header.pm
+++ /dev/null
@@ -1,26 +0,0 @@
-# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/PE/Header.pm $ $Author: autrijus $
-# $Revision: #5 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
-
-package Win32::Exe::PE::Header;
-
-use strict;
-use base 'Win32::Exe::PE';
-use constant SUBFORMAT => (
- Magic2 => 'v',
- LMajor => 'C',
- LMinor => 'C',
- CodeSize => 'V',
- IDataSize => 'V',
- UDataSize => 'V',
- EntryPointRVA => 'V',
- BaseOfCode => 'V',
- Data => 'a*',
-);
-use constant MEMBER_CLASS => 'Data';
-use constant DISPATCH_FIELD => 'Magic2';
-use constant DISPATCH_TABLE => (
- 0x20b => 'PE::Header::PE32Plus',
- '*' => 'PE::Header::PE32',
-);
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/PE/Header/PE32.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/PE/Header/PE32.pm
deleted file mode 100755
index ad8e641f40b..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/PE/Header/PE32.pm
+++ /dev/null
@@ -1,69 +0,0 @@
-# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/PE/Header/PE32.pm $ $Author: autrijus $
-# $Revision: #8 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
-
-package Win32::Exe::PE::Header::PE32;
-
-use strict;
-use base 'Win32::Exe::PE::Header';
-use constant SUBFORMAT => (
- BaseOfData => 'V',
- ImageBase => 'V',
- SectionAlign => 'V',
- FileAlign => 'V',
- OSMajor => 'v',
- OSMinor => 'v',
- UserMajor => 'v',
- UserMinor => 'v',
- SubsysMajor => 'v',
- SubsysMinor => 'v',
- _ => 'a4',
- ImageSize => 'V',
- HeaderSize => 'V',
- FileChecksum => 'V',
- SubsystemTypeId => 'v',
- DLLFlags => 'v',
- StackReserve => 'V',
- StackCommit => 'V',
- HeapReserve => 'V',
- HeapCommit => 'V',
- LoaderFlags => 'V',
- NumDataDirs => 'V',
- 'DataDirectory' => [
- 'a8', '{$NumDataDirs}', 1
- ],
- 'Section' => [
- 'a40', '{$NumSections}', 1
- ],
- Data => 'a*',
-);
-use constant SUBSYSTEM_TYPES => [qw(
- _ native windows console _
- _ _ posix _ windowsce
-)];
-use constant ST_TO_ID => {
- map { (SUBSYSTEM_TYPES->[$_] => $_) } (0 .. $#{+SUBSYSTEM_TYPES})
-};
-use constant ID_TO_ST => { reverse %{+ST_TO_ID} };
-
-sub st_to_id {
- my ($self, $name) = @_;
- return $name unless $name =~ /\D/;
- return(+ST_TO_ID->{lc($name)} || die "No such type: $name");
-}
-
-sub id_to_st {
- my ($self, $id) = @_;
- return(+ID_TO_ST->{$id} || $id);
-}
-
-sub Subsystem {
- my ($self) = @_;
- return $self->id_to_st($self->SubsystemTypeId);
-}
-
-sub SetSubsystem {
- my ($self, $type) = @_;
- $self->SetSubsystemTypeId($self->st_to_id($type));
-}
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/Resource.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/Resource.pm
deleted file mode 100755
index 433be495ea6..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/Resource.pm
+++ /dev/null
@@ -1,38 +0,0 @@
-# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/Resource.pm $ $Author: autrijus $
-# $Revision: #7 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
-
-package Win32::Exe::Resource;
-
-use strict;
-use base 'Win32::Exe::Base';
-
-sub object {
- my ($self) = @_;
- return $self;
-}
-
-sub path {
- my ($self) = @_;
- return $self->parent->path;
-}
-
-sub CodePage {
- return 1252;
-}
-
-sub PathName {
- my ($self) = @_;
- return $self->{pathname} || $self->first_parent('ResourceEntry')->PathName;
-}
-
-sub SetPathName {
- my ($self, $value) = @_;
- $self->{pathname} = $value;
-}
-
-sub Data {
- my ($self) = @_;
- return $self->dump;
-}
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/Resource/GroupIcon.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/Resource/GroupIcon.pm
deleted file mode 100755
index c2349ec7383..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/Resource/GroupIcon.pm
+++ /dev/null
@@ -1,57 +0,0 @@
-# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/Resource/GroupIcon.pm $ $Author: autrijus $
-# $Revision: #5 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
-
-package Win32::Exe::Resource::GroupIcon;
-
-use strict;
-use base 'Win32::Exe::Resource';
-use constant FORMAT => (
- Magic => 'a2',
- Type => 'v',
- Count => 'v',
- 'Resource::Icon' => [ 'a14', '{$Count}', 1 ],
-);
-use constant DEFAULT_ARGS => (
- Magic => "\0\0",
- Type => 1,
- Count => 0,
-);
-use constant DELEGATE_SUBS => (
- 'IconFile' => [ 'dump_iconfile', 'write_iconfile' ],
-);
-
-sub icons {
- my $self = shift;
- $self->members(@_);
-}
-
-sub set_icons {
- my ($self, $icons) = @_;
-
- $self->SetCount(scalar @$icons);
- $self->set_members('Resource::Icon' => $icons);
-
- my $rsrc = $self->first_parent('Resources') or return;
-
- foreach my $idx (0 .. $#{$icons}) {
- my $icon = $self->icons->[$idx];
- $icon->SetId($idx+1);
- $rsrc->insert($self->icon_name($icon->Id), $icons->[$idx]);
- }
-}
-
-sub substr {
- my ($self, $id) = @_;
- my $section = $self->first_parent('Resources');
- return $section->res_data($self->icon_name($id));
-}
-
-sub icon_name {
- my ($self, $id) = @_;
- my @icon_name = split("/", $self->PathName, -1);
- $icon_name[1] = "#RT_ICON";
- $icon_name[2] = "#$id";
- return join("/", @icon_name);
-}
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/Resource/Icon.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/Resource/Icon.pm
deleted file mode 100755
index a6b5348acbf..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/Resource/Icon.pm
+++ /dev/null
@@ -1,54 +0,0 @@
-# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/Resource/Icon.pm $ $Author: autrijus $
-# $Revision: #6 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
-
-package Win32::Exe::Resource::Icon;
-
-use strict;
-use base 'Win32::Exe::Resource';
-use constant FORMAT => (
- Width => 'C',
- Height => 'C',
- ColorCount => 'C',
- _ => 'C',
- Planes => 'v',
- BitCount => 'v',
- ImageSize => 'V',
- I_RVA1 => 'v',
- I_RVA2 => 'v',
-);
-
-sub Id {
- my ($self) = @_;
- return $self->I_RVA1;
-}
-
-sub SetId {
- my ($self, $value) = @_;
- return $self->SetI_RVA1($value);
-}
-
-sub ImageOffset {
- my ($self) = @_;
- return $self->I_RVA1 + (($self->I_RVA2 || 0) * 65536);
-}
-
-sub SetImageOffset {
- my ($self, $value) = @_;
- $self->SetI_RVA1($value % 65536);
- $self->SetI_RVA2(int($value / 65536));
-}
-
-sub Data {
- my ($self) = @_;
- return $self->parent->substr($self->ImageOffset, $self->ImageSize);
-}
-
-sub dump {
- my ($self) = @_;
- my $parent = $self->parent;
- my $dump = $self->SUPER::dump;
- substr($dump, -2, 2, '') unless $parent->is_type('IconFile');
- return $dump;
-}
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/Resource/Manifest.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/Resource/Manifest.pm
deleted file mode 100755
index 28d6ecaeff4..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/Resource/Manifest.pm
+++ /dev/null
@@ -1,60 +0,0 @@
-package Win32::Exe::Resource::Manifest;
-
-use strict;
-use base 'Win32::Exe::Resource';
-use constant FORMAT => (
- Data => 'a*',
-);
-
-sub get_manifest {
- my ($self ) = @_;
- return $self->dump;
-}
-
-sub set_manifest {
- my ( $self, $xmltext ) = @_;
- $self->SetData( $self->encode_manifest($xmltext) );
- my $rsrc = $self->first_parent('Resources');
- $rsrc->remove("/#RT_MANIFEST");
- $rsrc->insert("/#RT_MANIFEST/#1/#0" => $self);
- $rsrc->refresh;
-}
-
-sub update_manifest {
- my ( $self, $xmltext ) = @_;
- $self->SetData( $self->encode_manifest($xmltext) );
-}
-
-sub encode_manifest {
- my ($self, $string) = @_;
- return pack("a*", $string);
-}
-
-sub default_manifest {
- my ( $self ) = @_;
- my $defman = <<'W32EXEDEFAULTMANIFEST'
-<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
-<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
- <assemblyIdentity processorArchitecture="x86" version="0.0.0.0" type="win32" name="Win32.Exe.Application" />
- <description>Win32.Exe.Application</description>
- <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
- <security>
- <requestedPrivileges>
- <requestedExecutionLevel level="asInvoker" uiAccess="false" />
- </requestedPrivileges>
- </security>
- </trustInfo>
- <dependency>
- <dependentAssembly>
- <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" publicKeyToken="6595b64144ccf1df" language="*" processorArchitecture="x86" />
- </dependentAssembly>
- </dependency>
-</assembly>
-W32EXEDEFAULTMANIFEST
-;
-
-
- return $defman;
-}
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/Resource/Version.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/Resource/Version.pm
deleted file mode 100755
index 98adfbb9b22..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/Resource/Version.pm
+++ /dev/null
@@ -1,364 +0,0 @@
-# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/Resource/Version.pm $ $Author: autrijus $
-# $Revision: #6 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
-
-package Win32::Exe::Resource::Version;
-
-use strict;
-use base 'Win32::Exe::Resource';
-use constant FORMAT => (
- Data => 'a*',
-);
-use constant FIXED_INFO => [qw(
- Signature StrucVersion FileVersionMS FileVersionLS
- ProductVersionMS ProductVersionLS FileFlagsMask FileFlags
- FileOS FileType FileSubtype FileDateMS FileDateLS
-)];
-use constant STRING_INFO => [qw(
- Comments CompanyName FileDescription FileVersion InternalName
- LegalCopyright LegalTrademarks OriginalFilename PrivateBuild
- ProductName ProductVersion SpecialBuild FileNumber ProductNumber
-)];
-use constant FI_TO_ID => {
- map { (FIXED_INFO->[$_] => $_) } (0 .. $#{+FIXED_INFO})
-};
-use constant LC_TO_SI => {
- (map { (lc($_) => $_) } @{+STRING_INFO}, keys %{+FI_TO_ID}),
- (map { (lc($_) => $_) } map { /^(.+)MS$/ ? $1 : () } keys %{+FI_TO_ID}),
-};
-
-sub fi_to_id {
- my ($self, $name) = @_;
- return(+FI_TO_ID->{$name});
-}
-
-sub lc_to_si {
- my ($self, $name) = @_;
- return(+LC_TO_SI->{lc($name)} || $name);
-}
-
-sub info {
- my ($self) = @_;
- return $self->{info};
-}
-
-sub set_info {
- my ($self, $info) = @_;
- $self->{info} = $info;
-}
-
-sub initialize {
- my ($self) = @_;
- $self->set_info($self->decode_info($self->Data));
- die 'Invalid structure' unless $self->check;
-}
-
-sub refresh {
- my ($self) = @_;
- $self->SetData($self->encode_info($self->info));
- my $rsrc = $self->first_parent('Resources');
- $rsrc->remove("/#RT_VERSION");
- $rsrc->insert("/#RT_VERSION/#1/#0" => $self);
- $rsrc->refresh;
- $self->initialize;
-}
-
-sub encode_info {
- my ($self, $info) = @_;
-
- my $key = shift(@$info);
- $key = $self->encode_ucs2("$key\0");
-
- my $val = shift(@$info);
- my ($type, $vallen);
-
- if (ref $val) {
- $type = 0; # binary
- $val = pack('V*', @$val);
- $vallen = length($val);
- }
- elsif (length $val) {
- $type = 1; # text;
- $val = $self->encode_ucs2("$val\0");
- $vallen = length($val) / 2;
- }
- else {
- $type = 1;
- $vallen = 0;
- }
-
- my @sub_objects;
- foreach my $sub_info (@$info) {
- my $obj = $self->encode_info($sub_info);
- push(@sub_objects, $obj);
- }
-
- my $buf = pack('v3', 0, $vallen, $type) . $key;
- $buf .= $self->pad($buf, 4);
- $buf .= $val;
-
- foreach my $sub_object (@sub_objects) {
- $buf .= $self->pad($buf, 4);
- $buf .= $sub_object;
- }
-
- substr($buf, 0, 2, pack('v', length($buf)));
- return $buf;
-}
-
-sub decode_info {
- my $self = shift;
- my $level = $_[1] || 1;
-
- my ($len, $vallen, $type) = unpack('v3', $_[0]);
- die 'No record length' unless $len;
- die 'Long length' if $len > length($_[0]);
-
- my $buf = substr($_[0], 0, $len);
- substr($_[0], 0, $self->align($len, 4)) = '';
-
- my $endkey = index($buf, "\0\0", 6);
- while ($endkey > 0 and ($endkey % 2)) {
- $endkey = index($buf, "\0\0", $endkey + 1);
- }
-
- die 'Invalid endkey' if $endkey < 6 or $endkey > $len - $vallen;;
-
- my $key = substr($buf, 6, $endkey - 6);
- my $u8_key = $self->decode_ucs2($key);
-
- my @res = ($u8_key);
- $endkey = $self->align($endkey + 2, 4);
- substr($buf, 0, $endkey, '');
-
- if ($vallen) {
- $vallen *= 2 if $level == 4; # only for strings
- my $val = substr($buf, 0, $vallen);
- if ($type) {
- $val = $self->decode_ucs2($val);
- $val =~ s/\0\z//;
- }
- else {
- $val = [ unpack('V*', $val) ];
- }
- push(@res, $val);
- $vallen = $self->align($vallen, 4);
-
- substr($buf, 0, $vallen) = '';
- }
- else {
- push(@res, '');
- }
-
- while (length $buf) {
- push(@res, $self->decode_info($buf, $level + 1));
- }
-
- return \@res;
-}
-
-sub empty_info {
- [ 'VS_VERSION_INFO', [ 0xFEEF04BD, 1 << 16, (0) x 11 ] ];
-}
-
-sub check_info {
- my ($self, $info) = @_;
- return 0 unless $info->[0] eq 'VS_VERSION_INFO';
- return 0 unless ref($info->[1]);
- return 0 unless $info->[1][0] == 0xFEEF04BD;
- return 0 unless $self->check_sub_info($info);
- return 1;
-}
-
-sub check_sub_info {
- my ($self, $info) = @_;
- return unless UNIVERSAL::isa($info, 'ARRAY');
- return if @$info < 2;
- return unless defined($info->[0]) and defined($info->[1]);
- return unless !ref($info->[0]) and length($info->[0]);
- return unless !ref($info->[1]) or UNIVERSAL::isa($info->[1], 'ARRAY');
- foreach my $idx (2 .. @$info - 1) {
- return 0 unless $self->check_sub_info($info->[$idx]);
- }
- return 1;
-}
-
-sub get {
- my ($self, $name) = @_;
- $name =~ s!\\!/!g;
- $name = $self->lc_to_si($name);
- my $info = $self->info;
-
- if ($name eq '/') {
- return undef unless ref $info->[1];
- return $info->[1];
- }
-
- my $fixed = $self->fi_to_id($name);
- if (defined $fixed) {
- my $struct = $info->[1];
- return undef unless $struct && ref($struct);
- return $struct->[$fixed];
- }
-
- $fixed = $self->fi_to_id($name.'MS');
- if (defined $fixed) {
- my $struct = $info->[1];
- return undef unless $struct && ref($struct);
- my $ms = $struct->[$fixed];
- my $ls = $struct->[ $self->fi_to_id($name.'LS') ];
- return join(',', $self->split_dword($ms), $self->split_dword($ls));
- }
-
- my $s;
- if ($name =~ s!^/!!) {
- $s = $info;
- while ($name =~ s!^([^/]+)/!!) {
- $s = $self->find_info($s, $1) or return undef;
- }
- }
- else {
- $s = $self->find_info($info, 'StringFileInfo') or return undef;
- if (my $cur_trans = $self->{cur_trans}) {
- $s = $self->find_info($s, $cur_trans, 1) or return undef;
- }
- else {
- $s = $s->[2] or return undef;
- $self->{cur_trans} = $s->[0];
- }
- }
-
- $s = $self->find_info($s, $name) or return undef;
- return $s->[1];
-}
-
-sub set {
- my ($self, $name, $value) = @_;
- $name =~ s!\\!/!g;
- $name = $self->lc_to_si($name);
- my $info = $self->info;
-
- if ($name eq '/') {
- if (!defined $value) {
- $info->[1] = '';
- }
- elsif (UNIVERSAL::isa($value, 'ARRAY') and @$value == 13) {
- $info->[1] = $value;
- }
- else {
- die 'Invalid array assigned';
- }
- }
-
- my $fixed = $self->fi_to_id($name);
- if (defined $fixed) {
- $value = oct($value) if $value =~ /^0/;
- $info->[1][$fixed] = $value;
- return;
- }
-
- $fixed = $self->fi_to_id($name.'MS');
- if (defined $fixed) {
- my @value = split(/[,.]/, $value, -1);
- if (@value == 4) {
- $value[0] = ($value[0] << 16) | $value[1];
- $value[1] = ($value[2] << 16) | $value[3];
- splice(@value, 2);
- }
-
- die 'Invalid MS/LS value' if @value != 2;
- $info->[1][$fixed] = $value[0] || 0;
- $info->[1][$self->fi_to_id($name.'LS')] = $value[1] || 0;
- return;
- }
-
- my $container = $info;
-
- if ($name =~ s!^/!!) {
- while ($name =~ s!^([^/]+)/!!) {
- my $n = $1;
- my $s = $self->find_info($container, $n);
- unless ($s) {
- $s = [ $n => '' ];
- push(@$container, $s);
- }
- $container = $s;
- }
- }
- else {
- my $s = $self->find_info($container, 'StringFileInfo');
- unless ($s) {
- $s = [ StringFileInfo => '' ];
- push(@$container, $s);
- }
- $container = $s;
-
- my $cur_trans = $self->{cur_trans};
- unless ($cur_trans) {
- if (@$container > 2) {
- $cur_trans = $container->[2][0];
- }
- else {
- $cur_trans = '000004B0'; # Language Neutral && CP 1200 = Unicode
- }
- $self->{cur_trans} = $cur_trans;
- }
-
- $s = $self->find_info($container, $cur_trans, 1);
- unless ($s) {
- $s = [ $cur_trans => '' ];
- push(@$container, $s);
- }
- $container = $s;
- }
-
- my ($kv, $kv_index) = $self->find_info($container, $name);
- unless ($kv) {
- push(@$container, [ $name => $value ]) if defined $value;
- return;
- }
-
- if (defined $value) {
- $kv->[1] = $value;
- }
- else {
- splice(@$container, $kv_index, 1);
- }
-}
-
-sub check {
- my $self = shift;
- return $self->check_info($self->info);
-}
-
-sub find_info {
- my ($self, $info, $name, $ignore) = @_;
- my $index;
-
- if ($name =~ /^#(\d+)$/) {
- $index = $1 - 1 + 2;
- $index = undef if $index < 2 || $index >= @$info;
- }
- else {
- for (2 .. @$info - 1) {
- my $e = $info->[$_];
- if ($e->[0] eq $name or $ignore && lc($e->[0]) eq lc($name)) {
- $index = $_;
- last;
- }
- }
- }
- if ($index) {
- return $info->[$index] unless wantarray;
- return ($info->[$index], $index);
- }
-
- return undef unless wantarray;
- return (undef, undef);
-}
-
-sub split_dword {
- my ($self, $dword) = @_;
- return ($dword >> 16), ($dword & 0xFFFF);
-}
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/ResourceData.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/ResourceData.pm
deleted file mode 100755
index b33647d519c..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/ResourceData.pm
+++ /dev/null
@@ -1,58 +0,0 @@
-# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/ResourceData.pm $ $Author: autrijus $
-# $Revision: #6 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
-
-package Win32::Exe::ResourceData;
-
-use strict;
-use base 'Win32::Exe::Base';
-use constant FORMAT => (
- VirtualAddress => 'V',
- Size => 'V',
- CodePage => 'V',
-);
-
-sub Data {
- my ($self) = @_;
- return $self->{data} if defined $self->{data};
-
- my $section = $self->first_parent('Resources');
- my $addr = $self->VirtualAddress or return;
- return $section->substr(
- $addr - $section->VirtualAddress,
- $self->Size
- );
-}
-
-sub SetData {
- my ($self, $data) = @_;
- $self->{data} = $data;
-}
-
-sub object {
- my ($self) = @_;
- return $self->{object};
-}
-
-sub path {
- my ($self) = @_;
- return $self->parent->path;
-}
-
-sub initialize {
- my ($self) = @_;
-
- my ($base) = $self->path or return;
- $base =~ /^#RT_(?!ICON$)(\w+)$/ or return;
- $self->VirtualAddress or return;
-
- my $data = $self->Data;
- my $class = ucfirst(lc($1));
- $class =~ s/_(\w)/\U$1/g;
- $class = $self->require_class("Resource::$class") or return;
-
- my $obj = $class->new(\$data, { parent => $self });
- $obj->initialize;
- $self->{object} = $obj;
-}
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/ResourceEntry.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/ResourceEntry.pm
deleted file mode 100755
index a44a65daf3d..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/ResourceEntry.pm
+++ /dev/null
@@ -1,69 +0,0 @@
-# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/ResourceEntry.pm $ $Author: autrijus $
-# $Revision: #7 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
-
-package Win32::Exe::ResourceEntry;
-
-use strict;
-use base 'Win32::Exe::Base';
-use constant FORMAT => (
- Data => 'V',
- E_RVA => 'V',
-);
-use constant HIGH_BIT => 0x80_00_00_00;
-use Win32::Exe::ResourceData;
-
-sub high_bit {
- my ($self) = @_;
- return +HIGH_BIT;
-}
-
-sub path {
- my ($self) = @_;
- return $self->parent->path;
-}
-
-sub PathName {
- my ($self) = @_;
- return join('/', '', $self->path, $self->Name);
-}
-
-sub VirtualAddress {
- my ($self) = @_;
- $self->E_RVA & ~($self->high_bit);
-}
-
-sub SetVirtualAddress {
- my ($self, $data) = @_;
- $self->SetE_RVA($data | $self->IsDirectory);
-}
-
-sub IsDirectory {
- my ($self) = @_;
- $self->E_RVA & ($self->high_bit);
-}
-
-sub initialize {
- my ($self) = @_;
- my $section = $self->first_parent('Resources');
- my $data = $section->substr($self->VirtualAddress, 12);
- my $res_data = Win32::Exe::ResourceData->new(\$data, { parent => $self });
- $res_data->initialize;
- $self->{res_data} = $res_data;
-}
-
-sub Data {
- my ($self) = @_;
- return $self->{res_data}->Data;
-}
-
-sub CodePage {
- my ($self) = @_;
- return $self->{res_data}->CodePage;
-}
-
-sub object {
- my ($self) = @_;
- return $self->{res_data}->object;
-}
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/ResourceEntry/Id.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/ResourceEntry/Id.pm
deleted file mode 100755
index 39e35b4000d..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/ResourceEntry/Id.pm
+++ /dev/null
@@ -1,47 +0,0 @@
-# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/ResourceEntry/Id.pm $ $Author: autrijus $
-# $Revision: #6 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
-
-package Win32::Exe::ResourceEntry::Id;
-
-use strict;
-use base 'Win32::Exe::ResourceEntry';
-use constant SUBFORMAT => (
- Id => 'V',
-);
-use constant RESOURCE_TYPES => [qw(
- _ CURSOR BITMAP ICON MENU
- DIALOG STRING FONTDIR FONT ACCELERATOR
- RCDATA MESSAGETABLE GROUP_CURSOR _ GROUP_ICON
- _ VERSION DLGINCLUDE _ PLUGPLAY
- VXD ANICURSOR ANIICON HTML MANIFEST
-)];
-use constant RT_TO_ID => {
- map { ('RT_'.RESOURCE_TYPES->[$_] => $_) }
- (0 .. $#{+RESOURCE_TYPES})
-};
-use constant ID_TO_RT => { reverse %{+RT_TO_ID} };
-
-sub Name {
- my ($self) = @_;
- my $id = $_[0]->Id;
- $id = $self->id_to_rt($id) if $self->parent->depth < 1;
- return "#$id";
-}
-
-sub SetName {
- my ($self, $name) = @_;
- $name =~ s/^#//;
- $self->SetId( $self->rt_to_id($name) );
-}
-
-sub id_to_rt {
- my ($self, $id) = @_;
- return(+ID_TO_RT->{$id} || $id);
-}
-
-sub rt_to_id {
- my ($self, $rt) = @_;
- return(+RT_TO_ID->{$rt} || $rt);
-}
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/ResourceEntry/Name.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/ResourceEntry/Name.pm
deleted file mode 100755
index 8f6cd1d8784..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/ResourceEntry/Name.pm
+++ /dev/null
@@ -1,42 +0,0 @@
-# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/ResourceEntry/Name.pm $ $Author: autrijus $
-# $Revision: #6 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
-
-package Win32::Exe::ResourceEntry::Name;
-
-use strict;
-use base 'Win32::Exe::ResourceEntry';
-use constant SUBFORMAT => (
- N_RVA => 'V',
-);
-
-sub NameAddress {
- my ($self) = @_;
- $self->N_RVA & ~($self->high_bit);
-}
-
-sub SetNameAddress {
- my ($self, $data) = @_;
- $self->SetN_RVA($data | $self->IsDirectory);
-}
-
-sub IsEscaped {
- my ($self) = @_;
- $self->N_RVA & ($self->high_bit);
-}
-
-sub Name {
- my ($self) = @_;
- my $section = $self->first_parent('Resources');
- my $addr = $self->NameAddress;
- my $size = unpack('v', $section->substr($addr, 2));
- my $ustr = $section->substr($addr + 2, $size * 2);
- my $name = $self->decode_ucs2($ustr);
- $name =~ s{([%#/])}{sprintf('%%%02X', ord($1))}eg;
- return $name;
-}
-
-sub SetName {
- die "XXX unimplemented";
-}
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/ResourceTable.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/ResourceTable.pm
deleted file mode 100755
index 7fe9fa1d5dd..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/ResourceTable.pm
+++ /dev/null
@@ -1,35 +0,0 @@
-# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/ResourceTable.pm $ $Author: autrijus $
-# $Revision: #5 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
-
-package Win32::Exe::ResourceTable;
-
-use strict;
-use base 'Win32::Exe::Base';
-use constant FORMAT => (
- DebugDirectory => 'V',
- TimeStamp => 'V',
- VersionMajor => 'v',
- VersionMinor => 'v',
- NumNameEntry => 'v',
- NumIdEntry => 'v',
- 'ResourceEntry::Name' => [ 'a8', '{$NumNameEntry}', 1 ],
- 'ResourceEntry::Id' => [ 'a8', '{$NumIdEntry}', 1 ],
-);
-
-sub set_path {
- my ($self, $path) = @_;
- $self->{path} = $path;
-}
-
-sub path {
- my ($self) = @_;
- wantarray ? @{$self->{path}} : $self->{path};
-}
-
-sub depth {
- my ($self) = @_;
- scalar @{$self->{path}};
-}
-
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/Section.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/Section.pm
deleted file mode 100755
index d08f91590f7..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/Section.pm
+++ /dev/null
@@ -1,154 +0,0 @@
-# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/Section.pm $ $Author: autrijus $
-# $Revision: #9 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
-
-package Win32::Exe::Section;
-
-use strict;
-use base 'Win32::Exe::Base';
-use constant FORMAT => (
- Name => 'Z8',
- VirtualSize => 'V',
- VirtualAddress => 'V',
- FileSize => 'V',
- FileOffset => 'V',
- RelocOffset => 'V',
- LineNumOffset => 'V',
- NumReloc => 'v',
- NumLineNum => 'v',
- Flags => 'V',
-);
-use constant DISPATCH_FIELD => 'Name';
-use constant DISPATCH_TABLE => (
- '.text' => 'Section::Code',
- '.debug' => 'Section::Debug',
- '.data' => 'Section::Data',
- '.rdata' => 'Section::Data',
- '.bss' => 'Section::Data',
- '.edata' => 'Section::Exports',
- '.idata' => 'Section::Imports',
- '.rsrc' => 'Section::Resources',
-);
-
-use constant CONTAINS_CODE => 0x20;
-use constant CONTAINS_IDATA => 0x40;
-use constant CONTAINS_UDATA => 0x80;
-
-sub Data {
- my ($self) = @_;
- $self->{data} ||= do {
- my $v_size = $self->VirtualSize;
- my $f_size = $self->FileSize or return("\0" x $v_size);
-
- $f_size = $v_size if $v_size < $f_size;
-
- my $data = $self->parent->substr($self->FileOffset, $f_size);
- $data .= ("\x0" x ($v_size - length($data)));
- $data;
- }
-}
-
-sub SetData {
- my ($self, $data) = @_;
- my $pad_size = length($1) if $data =~ s/(\0*)\z//;
-
- my $exe = $self->parent;
- $exe->OptHeaderSize == 224 or die "Unsupported binary format";
-
- my $index = $self->sibling_index;
- my $data_size = length($data);
-
- my $f_size = $self->align($data_size, $exe->FileAlign);
- my $v_size = $self->align($data_size, $exe->SectionAlign);
- my $f_extra = $f_size - $self->FileSize;
- my $v_extra = $v_size - $self->align($self->VirtualSize, $exe->SectionAlign);
-
- $self->pad_data($f_extra, $v_extra) if $f_extra;
-
- $self->SetVirtualSize($data_size + $pad_size);
- $data .= ("\0" x ($self->FileSize - $data_size));
-
- $exe->substr($self->FileOffset, length($data), $data);
- $self->update_size;
-}
-
-sub update_size {
- my ($self) = @_;
-
- my $exe = $self->parent;
- my $v_addr = $self->VirtualAddress;
- my $v_size = $self->VirtualSize;
-
- foreach my $dir ($exe->data_directories) {
- next unless $dir->VirtualAddress == $v_addr;
- $dir->SetSize($v_size);
- $dir->refresh;
- }
-}
-
-sub pad_data {
- my ($self, $f_extra, $v_extra) = @_;
-
- my $exe = $self->parent;
- my $offset = $self->FileOffset + $self->FileSize;
-
- $exe->update_debug_directory($offset, $f_extra);
-
- my $exe_size = $exe->size;
- if ($exe_size > $offset) {
- my $buf = $exe->substr($offset, ($exe_size - $offset));
- $exe->substr($offset + $f_extra, length($buf), $buf);
- }
-
- $exe->set_size($exe_size + $f_extra);
- if ($f_extra > 0) {
- $exe->SetData($exe->Data . ("\0" x $f_extra));
- }
- else {
- $exe->SetData(substr($exe->Data, 0, $f_extra));
- }
-
- my $index = $self->sibling_index;
- foreach my $section (@{$self->siblings}) {
- next if $section->sibling_index <= $index;
- $section->update_offset($f_extra, $v_extra);
- }
-
- $self->SetFileSize($self->FileSize + $f_extra);
- $exe->SetImageSize($exe->ImageSize + $v_extra);
-
- my $flags = $self->Flags;
- $exe->SetCodeSize($exe->CodeSize + $f_extra) if $flags & CONTAINS_CODE;
- $exe->SetIDataSize($exe->IDataSize + $f_extra) if $flags & CONTAINS_IDATA;
- $exe->SetUDataSize($exe->UDataSize + $f_extra) if $flags & CONTAINS_UDATA;
-}
-
-sub update_offset {
- my ($self, $f_extra, $v_extra) = @_;
- return unless $f_extra > 0;
-
- my $exe = $self->parent;
- my $v_addr = $self->VirtualAddress;
-
- $self->SetVirtualAddress( $v_addr + $v_extra );
- $self->SetFileOffset( $self->FileOffset + $f_extra );
-
- foreach my $dir ($exe->data_directories) {
- next unless $dir->VirtualAddress == $v_addr;
- $dir->SetVirtualAddress($self->VirtualAddress);
- }
-}
-
-sub substr {
- my $self = shift;
- my $data = $self->Data;
- my $offset = shift;
- my $length = @_ ? shift(@_) : (length($data) - $offset);
- my $replace = shift;
-
- return substr($data, $offset, $length) if !defined $replace;
-
- substr($data, $offset, $length, $replace);
- $self->SetData($data);
-}
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/Section/Code.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/Section/Code.pm
deleted file mode 100755
index 726707c3064..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/Section/Code.pm
+++ /dev/null
@@ -1,9 +0,0 @@
-# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/Section/Code.pm $ $Author: autrijus $
-# $Revision: #4 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
-
-package Win32::Exe::Section::Code;
-
-use strict;
-use base 'Win32::Exe::Section';
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/Section/Data.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/Section/Data.pm
deleted file mode 100755
index 033d8f504e3..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/Section/Data.pm
+++ /dev/null
@@ -1,9 +0,0 @@
-# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/Section/Data.pm $ $Author: autrijus $
-# $Revision: #4 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
-
-package Win32::Exe::Section::Data;
-
-use strict;
-use base 'Win32::Exe::Section';
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/Section/Debug.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/Section/Debug.pm
deleted file mode 100755
index e59ac4b3287..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/Section/Debug.pm
+++ /dev/null
@@ -1,9 +0,0 @@
-# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/Section/Debug.pm $ $Author: autrijus $
-# $Revision: #4 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
-
-package Win32::Exe::Section::Debug;
-
-use strict;
-use base 'Win32::Exe::Section';
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/Section/Exports.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/Section/Exports.pm
deleted file mode 100755
index 9d1d5117555..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/Section/Exports.pm
+++ /dev/null
@@ -1,9 +0,0 @@
-# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/Section/Exports.pm $ $Author: autrijus $
-# $Revision: #4 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
-
-package Win32::Exe::Section::Exports;
-
-use strict;
-use base 'Win32::Exe::Section';
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/Section/Imports.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/Section/Imports.pm
deleted file mode 100755
index e736a043f15..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/Section/Imports.pm
+++ /dev/null
@@ -1,9 +0,0 @@
-# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/Section/Imports.pm $ $Author: autrijus $
-# $Revision: #4 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
-
-package Win32::Exe::Section::Imports;
-
-use strict;
-use base 'Win32::Exe::Section';
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Exe/Section/Resources.pm b/Master/tlpkg/tlperl0/lib/Win32/Exe/Section/Resources.pm
deleted file mode 100755
index afbc41e7309..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Exe/Section/Resources.pm
+++ /dev/null
@@ -1,260 +0,0 @@
-# $File: //local/member/autrijus/Win32-Exe/lib/Win32/Exe/Section/Resources.pm $ $Author: autrijus $
-# $Revision: #10 $ $Change: 1130 $ $Date: 2004-02-17T15:40:29.640821Z $
-
-package Win32::Exe::Section::Resources;
-
-use strict;
-use base 'Win32::Exe::Section';
-use constant DELEGATE_SUBS => (
- 'ResourceEntry' => [ 'high_bit' ],
- 'ResourceEntry::Id' => [ 'rt_to_id', 'id_to_rt' ],
-);
-
-sub initialize {
- my $self = shift;
- $self->make_table(0);
- return $self;
-}
-
-sub table {
- my $self = shift;
- return $self->{table};
-}
-
-sub make_table {
- my ($self, $offset, @path) = @_;
- my $image = $self->substr($offset);
- my $table = $self->require_class('ResourceTable')->new(
- \$image, {
- parent => $self,
- path => \@path
- },
- );
-
- foreach my $entry ($table->members) {
- if ($entry->IsDirectory) {
- $self->make_table($entry->VirtualAddress, @path, $entry->Name);
- }
- else {
- $self->{table}{$entry->PathName} = $entry;
- }
- }
-}
-
-sub names {
- my ($self) = @_;
- my @rv = sort keys %{$self->{table}};
- wantarray ? @rv : \@rv;
-}
-
-sub resources {
- my ($self, $name) = @_;
- my @rv = map $self->{table}{$_}, $self->names;
- wantarray ? @rv : \@rv;
-}
-
-sub remove {
- my ($self, $name) = @_;
- delete $self->{table}{$_} for grep /^\Q$name\E/, $self->names;
-}
-
-sub insert {
- my ($self, $name, $res) = @_;
- $self->{table}{$name} = $res;
-}
-
-sub res {
- my ($self, $name) = @_;
- return $self->{table}{$name};
-}
-
-sub res_data {
- my ($self, $name) = @_;
- my $res = $self->res($name) or return;
- return $res->Data;
-}
-
-sub res_codepage {
- my ($self, $name) = @_;
- my $res = $self->res($name) or return;
- return $res->CodePage;
-}
-
-sub res_object {
- my ($self, $name) = @_;
- my $res = $self->res($name) or return;
- return $res->object;
-}
-
-sub res_image {
- my ($self, $name) = @_;
- my $res = $self->res($name) or return;
- my $object = $res->object or return $res->Data;
- return $object->dump;
-}
-
-sub first_object {
- my ($self, $type) = @_;
- foreach my $object (grep $_, map $_->object, $self->resources) {
- return $object if !$type or $object->is_type($type);
- }
- return undef;
-}
-
-sub objects {
- my ($self, $type) = @_;
- return grep { $type ? $_->is_type($type) : 1 }
- grep { $_ } map { $_->object } $self->resources;
-}
-
-sub refresh {
- my $self = shift;
-
- my $res_num = @{$self->resources} or return pack('V*', (0) x 4);
- my $entry_size = $self->entry_size(scalar $self->names);
- my $data_entry_size = 16 * $res_num;
-
- my %str_addr;
- my $str_image = '';
- my $str_offset = $entry_size + $data_entry_size;
-
- foreach my $name ($self->names) {
- $name =~ s!^/!!;
- foreach my $chunk (split("/", $name, -1)) {
- $chunk =~ /^#/ and next;
- $chunk =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
- next if exists $str_addr{$chunk};
-
- die "String too long" if length($chunk) > 0xFFFF;
-
- my $addr = length($str_image);
- my $str = $self->encode_ucs2($chunk);
- $str_image .= pack('v', length($str) / 2) . $str;
-
- $str_addr{$chunk} = $addr + $str_offset;
- }
- }
- $str_image .= $self->pad($str_image, 8);
-
- my %data_entry_addr;
- my $data_entry_image = '';
- my $data_image = '';
- my $data_offset = $str_offset + length($str_image);
-
- foreach my $name ($self->names) {
- $data_entry_addr{$name} = $entry_size + length($data_entry_image);
-
- my $data_addr = $data_offset + length($data_image) + $self->VirtualAddress;
- $data_entry_image .= pack(
- 'V4',
- $data_addr,
- length($self->res_data($name)),
- $self->res_codepage($name),
- 0,
- );
- $data_image .= $self->res_data($name);
- $data_image .= $self->pad($data_image, 8);
- }
-
- my $entry_image = '';
- $self->make_entry(
- \$entry_image,
- '',
- [$self->names],
- \%str_addr,
- \%data_entry_addr,
- );
-
- length($entry_image) == $entry_size or die "Wrong size";
-
- $self->SetData(
- join('', $entry_image, $data_entry_image, $str_image, $data_image)
- );
-}
-
-sub entry_size {
- my ($self, $names) = @_;
-
- my %entries;
- foreach my $name (grep length, @$names) {
- $name =~ m!^/([^/]*)(.*)! or next;
- push(@{ $entries{$1} }, $2);
- }
-
- my $count = keys %entries or return 0;
- my $size = 8 * ($count + 2);
- $size += $self->entry_size($_) for values %entries;
- return $size;
-}
-
-sub make_entry {
- my ($self, $image_ref, $prefix, $names, $str_addr, $data_entry_addr) = @_;
-
- if (@$names == 1 and !length($names->[0])) {
- return $data_entry_addr->{$prefix};
- }
-
- my %entries;
- foreach my $name (@$names) {
- $name =~ m!^/([^/]*)(.*)! or next;
- my ($path, $name) = ($1, $2);
- my $type = ($path =~ /^#/) ? 'id' : 'name';
- push(@{ $entries{$type}{$path} }, $name);
- }
-
- my $addr = length($$image_ref);
- my $num_name = keys %{ $entries{name} };
- my $num_id = keys %{ $entries{id} };
- $$image_ref .= pack('V3vv', 0, 0, 0, $num_name, $num_id);
-
- my $entry_offset = length($$image_ref);
- $$image_ref .= pack('V*', (0) x (($num_name + $num_id) * 2));
-
- foreach my $entry ($self->sort_entry(\%entries)) {
- my ($type, $name) = @$entry;
- my $id;
- if ($type eq 'id') {
- $id = $name;
- $id =~ s/^#//;
- $id = $self->rt_to_id($id);
- }
- else {
- (my $n = $name) =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
- $id = $str_addr->{$n} | $self->high_bit;
- }
-
- my $rva = $self->make_entry(
- $image_ref,
- "$prefix/$name",
- $entries{$type}{$name},
- $str_addr,
- $data_entry_addr,
- );
-
- substr($$image_ref, $entry_offset, 8) = pack('VV', $id, $rva);
- $entry_offset += 8;
- }
-
- return ($addr | $self->high_bit);
-}
-
-sub sort_entry {
- my ($self, $entries) = @_;
-
- my @names = map { $_->[1] } sort { $a->[0] cmp $b->[0] } map {
- my $name = lc($_);
- $name =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
- [ $name => $_ ];
- } keys %{ $entries->{name} };
-
- my @ids = map "#$_", sort {
- $self->rt_to_id($a) <=> $self->rt_to_id($b)
- } map substr($_, 1), keys %{ $entries->{id} };
-
- return(
- (map [ name => $_ ], @names),
- (map [ id => $_ ], @ids),
- );
-}
-
-1;
diff --git a/Master/tlpkg/tlperl0/lib/Win32/File.pm b/Master/tlpkg/tlperl0/lib/Win32/File.pm
deleted file mode 100755
index 811e3ccb114..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/File.pm
+++ /dev/null
@@ -1,118 +0,0 @@
-package Win32::File;
-
-#
-# File.pm
-# Written by Douglas_Lankshear@ActiveWare.com
-#
-# subsequent hacks:
-# Gurusamy Sarathy
-#
-
-$VERSION = '0.06';
-
-require Exporter;
-require DynaLoader;
-
-@ISA= qw( Exporter DynaLoader );
-@EXPORT = qw(
- ARCHIVE
- COMPRESSED
- DIRECTORY
- HIDDEN
- NORMAL
- OFFLINE
- READONLY
- SYSTEM
- TEMPORARY
- );
-@EXPORT_OK = qw(GetAttributes SetAttributes);
-
-=head1 NAME
-
-Win32::File - Manage file attributes in perl
-
-=head1 SYNOPSIS
-
- use Win32::File;
-
-=head1 DESCRIPTION
-
-This module offers the retrieval and setting of file attributes.
-
-=head1 Functions
-
-=head2 NOTE
-
-All of the functions return FALSE (0) if they fail, unless otherwise noted.
-The function names are exported into the caller's namespace by request.
-
-=over 10
-
-=item GetAttributes(filename, returnedAttributes)
-
-Gets the attributes of a file or directory. returnedAttributes will be set
-to the OR-ed combination of the filename attributes.
-
-=item SetAttributes(filename, newAttributes)
-
-Sets the attributes of a file or directory. newAttributes must be an OR-ed
-combination of the attributes.
-
-=back
-
-=head1 Constants
-
-The following constants are exported by default.
-
-=over 10
-
-=item ARCHIVE
-
-=item COMPRESSED
-
-=item DIRECTORY
-
-=item HIDDEN
-
-=item NORMAL
-
-=item OFFLINE
-
-=item READONLY
-
-=item SYSTEM
-
-=item TEMPORARY
-
-=back
-
-=cut
-
-sub AUTOLOAD
-{
- my($constname);
- ($constname = $AUTOLOAD) =~ s/.*:://;
- #reset $! to zero to reset any current errors.
- local $! = 0;
- my $val = constant($constname);
- if($! != 0)
- {
- if($! =~ /Invalid/)
- {
- $AutoLoader::AUTOLOAD = $AUTOLOAD;
- goto &AutoLoader::AUTOLOAD;
- }
- else
- {
- ($pack,$file,$line) = caller;
- die "Your vendor has not defined Win32::File macro $constname, used in $file at line $line.";
- }
- }
- eval "sub $AUTOLOAD { $val }";
- goto &$AUTOLOAD;
-}
-
-bootstrap Win32::File;
-
-1;
-__END__
diff --git a/Master/tlpkg/tlperl0/lib/Win32/File/Object.pm b/Master/tlpkg/tlperl0/lib/Win32/File/Object.pm
deleted file mode 100755
index bb4aa90ecdc..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/File/Object.pm
+++ /dev/null
@@ -1,450 +0,0 @@
-package Win32::File::Object;
-
-=pod
-
-=head1 NAME
-
-Win32::File::Object - Simplified object abstraction over Win32::File
-
-=head1 SYNOPSIS
-
- # Get a handle for the file.
- my $object = Win32::File::Object->new( $filename, $autowrite );
-
- # Read a property flag for the file.
- my $readonly = $object->readonly;
-
- # Set a propertly flag for the file.
- $object->readonly(1);
-
- # If autowrite is false, write the changes to the file.
- $object->write;
-
-=head1 DESCRIPTION
-
-L<Win32::File> is an interface to the Win32 API for file
-attributes.
-
-Unfortunately it is a B<direct> interface to the underlying Win32 API,
-with a completely non-Perlish interface involving CamelCase function
-names, bit-field flags and return-by-param.
-
-B<Win32::File::Object> is a straight-forward object-oriented Perlish
-wrapper around the raw underlying API wrapper.
-
-=head1 METHODS
-
-=cut
-
-use 5.006;
-use strict;
-use Carp ();
-use Win32::File ();
-
-use vars qw{$VERSION};
-BEGIN {
- $VERSION = '0.02';
-}
-
-
-
-
-
-#####################################################################
-# Constructor
-
-=pod
-
-=head2 new
-
- my $file = Win32::File::Object->new( $path, $autowrite );
-
-The C<new> constructor creates a new handle to the Win32 filesystem
-attributes of an existing file or directory.
-
-The compulsory C<$filename> parameter is the name of the file or
-directory to create the handle on.
-
-The optional C<$autowrite> parameter, if true, indicates that the
-object should write the filesystem attributes to the file every
-time the method is called to set the property.
-
-If the C<$autowrite> param is false or not provided, you will
-need to call an explicit C<write> method in order to apply the
-changes to the file.
-
-=cut
-
-sub new {
- my $class = shift;
- my $path = shift;
- my $autowrite = !! shift;
- unless ( $path ) {
- Carp::croak("Did not provide a file name");
- }
- unless ( -f $path ) {
- Carp::croak("File '$path' does not exist");
- }
-
- # Create the object
- my $self = bless {
- path => $path,
- autowrite => $autowrite,
- rollback => ! 1,
- }, $class;
-
- # Get the attributes
- $self->read;
-
- return $self;
-}
-
-=pod
-
-=head2 path
-
-The C<path> accessor returns the original file path as provided to
-the constructor as a string.
-
-=cut
-
-sub path {
- $_[0]->{path};
-}
-
-=pod
-
-=head2 autowrite
-
-The C<autowrite> accessor returns true if the object will
-automatically write changes to the filesystem, or false if
-not.
-
-=cut
-
-sub autowrite {
- $_[0]->{autowrite};
-}
-
-
-
-
-
-#####################################################################
-# Main Methods
-
-=pod
-
-=head2 read
-
-the C<read> method reads (updates) the filesystem attributes, in case
-they have been updated since the object was originally created.
-
-Returns true on success or throws an exception (dies) on error.
-
-=cut
-
-sub read {
- my $self = shift;
-
- # Read the bitfield
- my $bits;
- my $path = $self->path;
- unless ( Win32::File::GetAttributes( $self->path => $bits ) ) {
- Carp::croak("GetAttributes failed for '$path'");
- }
-
- # Read the flags
- $self->{archive} = ( $bits & Win32::File::ARCHIVE() ) ? 1 : 0;
- $self->{compressed} = ( $bits & Win32::File::COMPRESSED() ) ? 1 : 0;
- $self->{directory} = ( $bits & Win32::File::DIRECTORY() ) ? 1 : 0;
- $self->{hidden} = ( $bits & Win32::File::HIDDEN() ) ? 1 : 0;
- $self->{normal} = ( $bits & Win32::File::NORMAL() ) ? 1 : 0;
- $self->{offline} = ( $bits & Win32::File::OFFLINE() ) ? 1 : 0;
- $self->{readonly} = ( $bits & Win32::File::READONLY() ) ? 1 : 0;
- $self->{system} = ( $bits & Win32::File::SYSTEM() ) ? 1 : 0;
- $self->{temporary} = ( $bits & Win32::File::TEMPORARY() ) ? 1 : 0;
-
- return 1;
-}
-
-=pod
-
-=head2 write
-
-the C<write> method writes the object attributes back to the filesystem.
-
-Returns true on success or throws an exception (dies) on error.
-
-=cut
-
-sub write {
- my $self = shift;
-
- # Generate the bitfield from the attributes
- my $bits = 0;
- if ( $self->archive ) {
- $bits += Win32::File::ARCHIVE();
- }
- if ( $self->compressed ) {
- $bits += Win32::File::COMPRESSED();
- }
- if ( $self->directory ) {
- $bits += Win32::File::DIRECTORY();
- }
- if ( $self->hidden ) {
- $bits += Win32::File::HIDDEN();
- }
- if ( $self->normal ) {
- $bits += Win32::File::NORMAL();
- }
- if ( $self->offline ) {
- $bits += Win32::File::OFFLINE();
- }
- if ( $self->readonly ) {
- $bits += Win32::File::READONLY();
- }
- if ( $self->system ) {
- $bits += Win32::File::SYSTEM();
- }
- if ( $self->temporary ) {
- $bits += Win32::File::TEMPORARY();
- }
-
- # Apply the attributes to the file
- my $path = $self->path;
- unless ( Win32::File::SetAttributes( $path, $bits ) ) {
- Carp::croak("SetAttributes failed for '$path'");
- }
-
- return 1;
-}
-
-
-
-
-
-#####################################################################
-# Attribute Methods
-
-=pod
-
-=head2 archive
-
- # Get the value
- my $archive = $file->archive;
-
- # Set the value
- $file->archive(1);
-
-The C<archive> accessor gets or set the Win32 "archive" status for
-the file.
-
-=cut
-
-sub archive {
- shift->_attr( archive => @_ );
-}
-
-=pod
-
-=head2 compressed
-
- # Get the value
- my $compressed = $file->compressed;
-
- # Set the value
- $file->compressed(1);
-
-The C<compressed> accessor gets or set the Win32 "compressed" status
-for the file.
-
-=cut
-
-sub compressed {
- shift->_attr( compressed => @_ );
-}
-
-=pod
-
-=head2 directory
-
- # Get the value
- my $directory = $file->directory;
-
- # Set the value
- $file->directory(1);
-
-The C<directory> accessor gets or set the Win32 "directory" status for
-the file.
-
-=cut
-
-sub directory {
- shift->_attr( directory => @_ );
-}
-
-=pod
-
-=head2 hidden
-
- # Get the value
- my $hidden = $file->hidden;
-
- # Set the value
- $file->hidden(1);
-
-The C<hidden> accessor gets or set the Win32 "hidden" status for
-the file.
-
-=cut
-
-sub hidden {
- shift->_attr( hidden => @_ );
-}
-
-=pod
-
-=head2 normal
-
- # Get the value
- my $normal = $file->normal;
-
- # Set the value
- $file->normal(1);
-
-The C<normal> accessor gets or set the Win32 "normal" status for
-the file.
-
-=cut
-
-sub normal {
- shift->_attr( normal => @_ );
-}
-
-=pod
-
-=head2 offline
-
- # Get the value
- my $offline = $file->offline;
-
- # Set the value
- $file->offline(1);
-
-The C<offline> accessor gets or set the Win32 "offline" status for
-the file.
-
-=cut
-
-sub offline {
- shift->_attr( offline => @_ );
-}
-
-=pod
-
-=head2 readonly
-
- # Get the value
- my $readonly = $file->readonly;
-
- # Set the value
- $file->readonly(1);
-
-The C<readonly> accessor gets or set the Win32 "readonly" status for
-the file.
-
-=cut
-
-sub readonly {
- shift->_attr( readonly => @_ );
-}
-
-=pod
-
-=head2 system
-
- # Get the value
- my $system = $file->system;
-
- # Set the value
- $file->system(1);
-
-The C<system> accessor gets or set the Win32 "system" status for
-the file.
-
-=cut
-
-sub system {
- shift->_attr( system => @_ );
-}
-
-=pod
-
-=head2 temporary
-
- # Get the value
- my $temporary = $file->temporary;
-
- # Set the value
- $file->temporary(1);
-
-The C<temporary> accessor gets or set the Win32 "temporary" status for
-the file.
-
-=cut
-
-sub temporary {
- shift->_attr( temporary => @_ );
-}
-
-sub _attr {
- my $self = shift;
- my $name = shift;
- my $new = $_[0] ? 1 : 0;
- return $self->{$name} unless @_;
- return $self->{$name} if $new == $self->{$name};
-
- # Set the rollback if needed
- if ( $self->{rollback} and ! exists $self->{rollback}->{$name} ) {
- $self->{rollback}->{$name} = $new;
- }
-
- # Set the new value
- $self->{$name} = $new;
- $self->write if $self->autowrite;
-
- return $self->{$name};
-}
-
-1;
-
-=pod
-
-=head1 SUPPORT
-
-Bugs should be reported via the CPAN bug tracker at
-
-L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Win32-File-Object>
-
-For other issues, or commercial enhancement or support, contact the author.
-
-=head1 AUTHOR
-
-Adam Kennedy E<lt>adamk@cpan.orgE<gt>
-
-=head1 SEE ALSO
-
-L<Win32::File>
-
-=head1 COPYRIGHT
-
-Copyright 2008 - 2009 Adam Kennedy.
-
-This program is free software; you can redistribute
-it and/or modify it under the same terms as Perl itself.
-
-The full text of the license can be found in the
-LICENSE file included with this module.
-
-=cut
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Process.pm b/Master/tlpkg/tlperl0/lib/Win32/Process.pm
deleted file mode 100755
index 24c017a94a4..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Process.pm
+++ /dev/null
@@ -1,219 +0,0 @@
-package Win32::Process;
-
-require Exporter;
-require DynaLoader;
-@ISA = qw(Exporter DynaLoader);
-
-$VERSION = '0.14';
-
-# Items to export into callers namespace by default. Note: do not export
-# names by default without a very good reason. Use EXPORT_OK instead.
-# Do not simply export all your public functions/methods/constants.
-@EXPORT = qw(
- CREATE_DEFAULT_ERROR_MODE
- CREATE_NEW_CONSOLE
- CREATE_NEW_PROCESS_GROUP
- CREATE_NO_WINDOW
- CREATE_SEPARATE_WOW_VDM
- CREATE_SUSPENDED
- CREATE_UNICODE_ENVIRONMENT
- DEBUG_ONLY_THIS_PROCESS
- DEBUG_PROCESS
- DETACHED_PROCESS
- HIGH_PRIORITY_CLASS
- IDLE_PRIORITY_CLASS
- INFINITE
- NORMAL_PRIORITY_CLASS
- REALTIME_PRIORITY_CLASS
- THREAD_PRIORITY_ABOVE_NORMAL
- THREAD_PRIORITY_BELOW_NORMAL
- THREAD_PRIORITY_ERROR_RETURN
- THREAD_PRIORITY_HIGHEST
- THREAD_PRIORITY_IDLE
- THREAD_PRIORITY_LOWEST
- THREAD_PRIORITY_NORMAL
- THREAD_PRIORITY_TIME_CRITICAL
-);
-
-@EXPORT_OK = qw(
- STILL_ACTIVE
- ABOVE_NORMAL_PRIORITY_CLASS
- BELOW_NORMAL_PRIORITY_CLASS
-);
-
-sub AUTOLOAD {
- # This AUTOLOAD is used to 'autoload' constants from the constant()
- # XS function.
- my($constname);
- ($constname = $AUTOLOAD) =~ s/.*:://;
- local $! = 0;
- my $val = constant($constname);
- if ($! != 0) {
- my ($pack,$file,$line) = caller;
- die "Your vendor has not defined Win32::Process macro $constname, used at $file line $line.";
- }
- eval "sub $AUTOLOAD { $val }";
- goto &$AUTOLOAD;
-} # end AUTOLOAD
-
-bootstrap Win32::Process;
-
-# Win32::IPC > 1.02 uses the get_Win32_IPC_HANDLE method:
-*get_Win32_IPC_HANDLE = \&get_process_handle;
-
-1;
-__END__
-
-=head1 NAME
-
-Win32::Process - Create and manipulate processes.
-
-=head1 SYNOPSIS
-
- use Win32::Process;
- use Win32;
-
- sub ErrorReport{
- print Win32::FormatMessage( Win32::GetLastError() );
- }
-
- Win32::Process::Create($ProcessObj,
- "C:\\winnt\\system32\\notepad.exe",
- "notepad temp.txt",
- 0,
- NORMAL_PRIORITY_CLASS,
- ".")|| die ErrorReport();
-
- $ProcessObj->Suspend();
- $ProcessObj->Resume();
- $ProcessObj->Wait(INFINITE);
-
-=head1 DESCRIPTION
-
-This module provides access to the process control functions in the
-Win32 API.
-
-=head1 METHODS
-
-=over 8
-
-=item Win32::Process::Create($obj,$appname,$cmdline,$iflags,$cflags,$curdir)
-
-Creates a new process.
-
- Args:
-
- $obj container for process object
- $appname full path name of executable module
- $cmdline command line args
- $iflags flag: inherit calling processes handles or not
- $cflags flags for creation (see exported vars below)
- $curdir working dir of new process
-
-Returns non-zero on success, 0 on failure.
-
-=item Win32::Process::Open($obj,$pid,$iflags)
-
-Creates a handle Perl can use to an existing process as identified by $pid.
-The $iflags is the inherit flag that is passed to OpenProcess. Currently
-Win32::Process objects created using Win32::Process::Open cannot Suspend
-or Resume the process. All other calls should work.
-
-Win32::Process::Open returns non-zero on success, 0 on failure.
-
-=item Win32::Process::KillProcess($pid, $exitcode)
-
-Terminates any process identified by $pid. $exitcode will be set to
-the exit code of the process.
-
-=item $ProcessObj->Suspend()
-
-Suspend the process associated with the $ProcessObj.
-
-=item $ProcessObj->Resume()
-
-Resume a suspended process.
-
-=item $ProcessObj->Kill($exitcode)
-
-Kill the associated process, have it terminate with exit code $ExitCode.
-
-=item $ProcessObj->GetPriorityClass($class)
-
-Get the priority class of the process.
-
-=item $ProcessObj->SetPriorityClass($class)
-
-Set the priority class of the process (see exported values below for
-options). Note that the ABOVE_NORMAL_PRIORITY_CLASS and
-BELOW_NORMAL_PRIORITY_CLASS classes only work on Windows 2000
-and later.
-
-=item $ProcessObj->GetProcessAffinityMask($processAffinityMask, $systemAffinityMask)
-
-Get the process affinity mask. This is a bitvector in which each bit
-represents the processors that a process is allowed to run on.
-
-=item $ProcessObj->SetProcessAffinityMask($processAffinityMask)
-
-Set the process affinity mask. Only available on Windows NT.
-
-=item $ProcessObj->GetExitCode($exitcode)
-
-Retrieve the exitcode of the process. Will return STILL_ACTIVE if the
-process is still running. The STILL_ACTIVE constant is only exported
-by explicit request.
-
-=item $ProcessObj->Wait($timeout)
-
-Wait for the process to die. $timeout should be specified in milliseconds.
-To wait forever, specify the constant C<INFINITE>.
-
-=item $ProcessObj->GetProcessID()
-
-Returns the Process ID.
-
-=item Win32::Process::GetCurrentProcessID()
-
-Returns the current process ID, which is the same as $$. But not on cygwin,
-where $$ is the cygwin-internal PID and not the windows PID.
-On cygwin GetCurrentProcessID() returns the windows PID as needed for all
-the Win32::Process functions.
-
-=back
-
-=head1 EXPORTS
-
-The following constants are exported by default:
-
- CREATE_DEFAULT_ERROR_MODE
- CREATE_NEW_CONSOLE
- CREATE_NEW_PROCESS_GROUP
- CREATE_NO_WINDOW
- CREATE_SEPARATE_WOW_VDM
- CREATE_SUSPENDED
- CREATE_UNICODE_ENVIRONMENT
- DEBUG_ONLY_THIS_PROCESS
- DEBUG_PROCESS
- DETACHED_PROCESS
- HIGH_PRIORITY_CLASS
- IDLE_PRIORITY_CLASS
- INFINITE
- NORMAL_PRIORITY_CLASS
- REALTIME_PRIORITY_CLASS
- THREAD_PRIORITY_ABOVE_NORMAL
- THREAD_PRIORITY_BELOW_NORMAL
- THREAD_PRIORITY_ERROR_RETURN
- THREAD_PRIORITY_HIGHEST
- THREAD_PRIORITY_IDLE
- THREAD_PRIORITY_LOWEST
- THREAD_PRIORITY_NORMAL
- THREAD_PRIORITY_TIME_CRITICAL
-
-The following additional constants are exported by request only:
-
- ABOVE_NORMAL_PRIORITY_CLASS
- BELOW_NORMAL_PRIORITY_CLASS
- STILL_ACTIVE
-
-=cut
diff --git a/Master/tlpkg/tlperl0/lib/Win32/Shortcut.pm b/Master/tlpkg/tlperl0/lib/Win32/Shortcut.pm
deleted file mode 100755
index 00200dead1f..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/Shortcut.pm
+++ /dev/null
@@ -1,752 +0,0 @@
-package Win32::Shortcut;
-#######################################################################
-#
-# Win32::Shortcut - Perl Module for Shell Link Interface
-# ^^^^^^^^^^^^^^^
-# This module creates an object oriented interface to the Win32
-# Shell Links (IShellLink interface).
-#
-#######################################################################
-
-$VERSION = "0.07";
-
-require Exporter;
-require DynaLoader;
-
-@ISA= qw( Exporter DynaLoader );
-@EXPORT = qw(
- SW_SHOWMAXIMIZED
- SW_SHOWMINNOACTIVE
- SW_SHOWNORMAL
-);
-
-
-#######################################################################
-# This AUTOLOAD is used to 'autoload' constants from the constant()
-# XS function. If a constant is not found then control is passed
-# to the AUTOLOAD in AutoLoader.
-#
-
-sub AUTOLOAD {
- my($constname);
- ($constname = $AUTOLOAD) =~ s/.*:://;
- #reset $! to zero to reset any current errors.
- local $!;
- my $val = constant($constname, @_ ? $_[0] : 0);
- if ($!) {
- my(undef, $file, $line) = caller;
- die "Win32::Shortcut::$constname is not defined, used at $file line $line.";
- }
- eval "sub $AUTOLOAD { $val }";
- goto &$AUTOLOAD;
-}
-
-
-#######################################################################
-# PUBLIC METHODS
-#
-
-#========
-sub new {
-#========
- my($class, $file) = @_;
- my($ilink, $ifile) = _Instance();
- return unless $ilink && $ifile;
-
- my $self = bless {
- ilink => $ilink,
- ifile => $ifile,
- File => "",
- Path => "",
- Arguments => "",
- WorkingDirectory => "",
- Description => "",
- ShowCmd => 0,
- Hotkey => 0,
- IconLocation => "",
- IconNumber => 0,
- };
-
-
- if ($file) {
- $self->{File} = $file;
- $self->Load($file);
- }
-
- return $self;
-}
-
-#=========
-sub Load {
-#=========
- my($self, $file) = @_;
- return undef unless ref($self);
-
- my $result = _Load($self->{'ilink'}, $self->{'ifile'}, $file);
-
- if ($result) {
-
- # fill the properties of $self
- $self->{'File'} = $file;
- $self->{'Path'} = _GetPath($self->{'ilink'}, $self->{'ifile'},0);
- $self->{'ShortPath'} = _GetPath($self->{'ilink'}, $self->{'ifile'},1);
- $self->{'Arguments'} = _GetArguments($self->{'ilink'}, $self->{'ifile'});
- $self->{'WorkingDirectory'} = _GetWorkingDirectory($self->{'ilink'}, $self->{'ifile'});
- $self->{'Description'} = _GetDescription($self->{'ilink'}, $self->{'ifile'});
- $self->{'ShowCmd'} = _GetShowCmd($self->{'ilink'}, $self->{'ifile'});
- $self->{'Hotkey'} = _GetHotkey($self->{'ilink'}, $self->{'ifile'});
- ($self->{'IconLocation'},
- $self->{'IconNumber'}) = _GetIconLocation($self->{'ilink'}, $self->{'ifile'});
- }
- return $result;
-}
-
-
-#========
-sub Set {
-#========
- my($self, $path, $arguments, $dir, $description, $show, $hotkey,
- $iconlocation, $iconnumber) = @_;
- return undef unless ref($self);
-
- $self->{'Path'} = $path;
- $self->{'Arguments'} = $arguments;
- $self->{'WorkingDirectory'} = $dir;
- $self->{'Description'} = $description;
- $self->{'ShowCmd'} = $show;
- $self->{'Hotkey'} = $hotkey;
- $self->{'IconLocation'} = $iconlocation;
- $self->{'IconNumber'} = $iconnumber;
- return 1;
-}
-
-
-#=========
-sub Save {
-#=========
- my($self, $file) = @_;
- return unless ref($self);
-
- $file = $self->{'File'} unless $file;
- return unless $file;
-
- require Win32 unless defined &Win32::GetFullPathName;
- $file = Win32::GetFullPathName($file);
-
- _SetPath($self->{'ilink'}, $self->{'ifile'}, $self->{'Path'});
- _SetArguments($self->{'ilink'}, $self->{'ifile'}, $self->{'Arguments'});
- _SetWorkingDirectory($self->{'ilink'}, $self->{'ifile'}, $self->{'WorkingDirectory'});
- _SetDescription($self->{'ilink'}, $self->{'ifile'}, $self->{'Description'});
- _SetShowCmd($self->{'ilink'}, $self->{'ifile'}, $self->{'ShowCmd'});
- _SetHotkey($self->{'ilink'}, $self->{'ifile'}, $self->{'Hotkey'});
- _SetIconLocation($self->{'ilink'}, $self->{'ifile'},
- $self->{'IconLocation'}, $self->{'IconNumber'});
-
- my $result = _Save($self->{'ilink'}, $self->{'ifile'}, $file);
- if ($result) {
- $self->{'File'} = $file unless $self->{'File'};
- }
- return $result;
-}
-
-#============
-sub Resolve {
-#============
- my($self, $flags) = @_;
- return undef unless ref($self);
- $flags = 1 unless defined($flags);
- my $result = _Resolve($self->{'ilink'}, $self->{'ifile'}, $flags);
- return $result;
-}
-
-
-#==========
-sub Close {
-#==========
- my($self) = @_;
- return undef unless ref($self);
-
- my $result = _Release($self->{'ilink'}, $self->{'ifile'});
- $self->{'released'} = 1;
- return $result;
-}
-
-#=========
-sub Path {
-#=========
- my($self, $value) = @_;
- return undef unless ref($self);
-
- if(not defined($value)) {
- return $self->{'Path'};
- } else {
- $self->{'Path'} = $value;
- }
- return $self->{'Path'};
-}
-
-#==============
-sub ShortPath {
-#==============
- my($self) = @_;
- return undef unless ref($self);
- return $self->{'ShortPath'};
-}
-
-#==============
-sub Arguments {
-#==============
- my($self, $value) = @_;
- return undef unless ref($self);
-
- if(not defined($value)) {
- return $self->{'Arguments'};
- } else {
- $self->{'Arguments'} = $value;
- }
- return $self->{'Arguments'};
-}
-
-#=====================
-sub WorkingDirectory {
-#=====================
- my($self, $value) = @_;
- return undef unless ref($self);
-
- if(not defined($value)) {
- return $self->{'WorkingDirectory'};
- } else {
- $self->{'WorkingDirectory'} = $value;
- }
- return $self->{'WorkingDirectory'};
-}
-
-
-#================
-sub Description {
-#================
- my($self, $value) = @_;
- return undef unless ref($self);
-
- if(not defined($value)) {
- return $self->{'Description'};
- } else {
- $self->{'Description'} = $value;
- }
- return $self->{'Description'};
-}
-
-#============
-sub ShowCmd {
-#============
- my($self, $value) = @_;
- return undef unless ref($self);
-
- if(not defined($value)) {
- return $self->{'ShowCmd'};
- } else {
- $self->{'ShowCmd'} = $value;
- }
- return $self->{'ShowCmd'};
-}
-
-#===========
-sub Hotkey {
-#===========
- my($self, $value) = @_;
- return undef unless ref($self);
-
- if(not defined($value)) {
- return $self->{'Hotkey'};
- } else {
- $self->{'Hotkey'} = $value;
- }
- return $self->{'Hotkey'};
-}
-
-#=================
-sub IconLocation {
-#=================
- my($self, $value) = @_;
- return undef unless ref($self);
-
- if(not defined($value)) {
- return $self->{'IconLocation'};
- } else {
- $self->{'IconLocation'} = $value;
- }
- return $self->{'IconLocation'};
-}
-
-#===============
-sub IconNumber {
-#===============
- my($self, $value) = @_;
- return undef unless ref($self);
-
- if(not defined($value)) {
- return $self->{'IconNumber'};
- } else {
- $self->{'IconNumber'} = $value;
- }
- return $self->{'IconNumber'};
-}
-
-#============
-sub Version {
-#============
- # [dada] to get rid of the "used only once" warning...
- return $VERSION;
-}
-
-
-#######################################################################
-# PRIVATE METHODS
-#
-
-#============
-sub DESTROY {
-#============
- my($self) = @_;
-
- if (not $self->{'released'}) {
- _Release($self->{'ilink'}, $self->{'ifile'});
- $self->{'released'} = 1;
- }
-}
-
-bootstrap Win32::Shortcut;
-
-1;
-
-__END__
-
-=head1 NAME
-
-Win32::Shortcut - Perl Module to deal with Windows Shortcuts
-
-=head1 SYNOPSIS
-
-This module implements the Win32 IShellLink Interface to allow
-management of shortcut files from Perl.
-
- use Win32::Shortcut;
-
- $LINK = Win32::Shortcut->new();
- $LINK->{'Path'} = "C:\\Directory\\Target.exe";
- $LINK->{'Description'} = "Target executable";
- $LINK->Save("Target.lnk");
- $LINK->Close();
-
-=head1 REFERENCE
-
-=head2 General Usage
-
-To use this module, first add the following line at the beginning of
-your script:
-
- use Win32::Shortcut;
-
-Then, use this command to create a shortcut object:
-
- $LINK = Win32::Shortcut->new();
-
-This function will create a C<$LINK> object on which you can apply the
-Methods and Properties explained later.
-
-The object is not yet a shortcut file; it is just the definition of a
-shortcut. Basically, you can do 2 things:
-
-=over
-
-=item 1. Load a shortcut file into the object.
-
-=item 2. Save the object into a shortcut file.
-
-=back
-
-For the rest, the object can be accessed as it were a normal
-associative array reference. It has the following keys (here referred
-as properties):
-
- $LINK->{'File'}
- $LINK->{'Path'} $LINK->Path()
- $LINK->{'ShortPath'}
- $LINK->{'WorkingDirectory'} $LINK->WorkingDirectory()
- $LINK->{'Arguments'} $LINK->Arguments()
- $LINK->{'Description'} $LINK->Description()
- $LINK->{'ShowCmd'} $LINK->ShowCmd()
- $LINK->{'Hotkey'} $LINK->Hotkey()
- $LINK->{'IconLocation'} $LINK->IconLocation()
- $LINK->{'IconNumber'} $LINK->IconNumber()
-
-Thus, assuming you have a shortcut file named C<test.lnk> in your
-current directory, this simple script will tell you where this shortcut
-points to:
-
- use Win32::Shortcut;
- $LINK = Win32::Shortcut->new();
- $LINK->Load("test.lnk");
- print "Shortcut to: $LINK->{'Path'} $LINK->{'Arguments'} \n";
- $LINK->Close();
-
-But you can also modify its values:
-
- use Win32::Shortcut;
- $LINK = Win32::Shortcut->new();
- $LINK->Load("test.lnk");
- $LINK->{'Path'} =~ s/C:/D:/i; # move the target from C: to D:
- $LINK->{'ShowCmd'} = SW_NORMAL; # runs in a normal window
-
-and then you can save your changes to the shortcut file with this
-command:
-
- $LINK->Save();
- $LINK->Close();
-
-or you can save it with another name, creating a new shortcut file:
-
- $LINK->Save("test2.lnk");
- $LINK->Close();
-
-Finally, you can create a completely new shortcut:
-
- $LINK = Win32::Shortcut->new();
- $LINK->{'Path'} = "C:\\PERL5\\BIN\\PERL.EXE";
- $LINK->{'Arguments'} = "-v";
- $LINK->{'WorkingDirectory'} = "C:\PERL5\\BIN";
- $LINK->{'Description'} = "Prints out the version of Perl";
- $LINK->{'ShowCmd'} = SW_SHOWMAXIMIZED;
- $LINK->Save("Perl Version Info.lnk");
- $LINK->Close();
-
-Note also that in the examples above the two lines:
-
- $LINK = Win32::Shortcut->new();
- $LINK->Load("test.lnk");
-
-can be collapsed to:
-
- $LINK = Win32::Shortcut->new("test.lnk");
-
-
-=head2 Methods
-
-=over
-
-=item B<Close>
-
-Closes a shortcut object. Note that it is not "strictly" required to
-close the objects you created, since the Win32::Shortcut objects are
-automatically closed when the program ends (or when you elsehow destroy
-such an object).
-
-Note also that a shortcut is not automatically saved when it is closed,
-even if you modified it. You have to call Save in order to apply
-modifications to a shortcut file.
-
-Example:
-
- $LINK->Close();
-
-=item B<Load> I<file>
-
-Loads the content of the shortcut file named I<file> in a shortcut
-object and fill the properties of the object with its values. Will
-return B<undef> on errors, or a true value if everything was
-successful.
-
-Example:
-
- $LINK->Load("test.lnk") or print "test.lnk not found!";
-
- print join("\n", $LINK->Path,
- $LINK->ShortPath,
- $LINK->Arguments,
- $LINK->WorkingDirectory,
- $LINK->Description,
- $LINK->ShowCmd,
- $LINK->Hotkey,
- $LINK->IconLocation,
- $LINK->IconNumber);
- }
-
-=item B<new Win32::Shortcut> I<[file]>
-
-Creates a new shortcut object. If a filename is passed in I<file>,
-automatically Loads this file also. Returns the object created or
-B<undef> on errors.
-
-Example:
-
- $LINK = Win32::Shortcut->new();
-
- $RegEdit = Win32::Shortcut->new("Registry Editor.lnk");
- die "File not found" if not $RegEdit;
-
-=item B<Resolve> I<[flag]>
-
-Attempts to automatically resolve a shortcut and returns the resolved
-path, or B<undef> on errors; in case no resolution was made, the path
-is returned unchanged. Note that the path is automatically updated in
-the Path property of the shortcut.
-
-By default this method acts quietly, but if you pass a value of 0
-(zero) in the I<flag> parameter, it will eventually post a dialog box
-prompting the user for more information.
-
-Example:
-
- # if the target doesn't exist...
- if(! -f $LINK->Path) {
- # save the actual target for comparison
- $oldpath = $LINK->Path;
-
- # try to resolve it (with dialog box)
- $newpath = $LINK->Resolve(0);
-
- die "Not resolved..." if $newpath == $oldpath;
- }
-
-=item B<Save> I<[file]>
-
-Saves the content of the shortcut object into the file named I<file>.
-If I<file> is omitted, it is taken from the File property of the object
-(which, if not changed, is the name of the last Loaded file).
-
-If no file was loaded and the File property doesn't contain a valid
-filename, the method will return B<undef>, which will also be returned
-on errors. A true value will be returned if everything was successful.
-
-Example:
-
- $LINK->Save();
- $LINK->Save("Copy of " . $LINK->{'File'});
-
-=item B<Set> I<path, arguments, workingdirectory, description, showcmd,
-hotkey, iconlocation, iconnumber>
-
-Sets all the properties of the shortcut object with a single command.
-This method is supplied for convenience only, you can also set those
-values changing the values of the properties.
-
-Example:
-
- $LINK->Set("C:\\PERL5\\BIN\\PERL.EXE",
- "-v",
- "C:\\PERL5\\BIN",
- "Prints out the version of Perl",
- SW_SHOWMAXIMIZED,
- hex('0x0337'),
- "C:\\WINDOWS\\SYSTEM\\COOL.DLL",
- 1);
-
- # it is the same of...
- $LINK->Path("C:\\PERL5\\BIN\\PERL.EXE");
- $LINK->Arguments("-v");
- $LINK->WorkingDirectory("C:\\PERL5\\BIN");
- $LINK->Description("Prints out the version of Perl");
- $LINK->ShowCmd(SW_SHOWMAXIMIZED);
- $LINK->Hotkey(hex('0x0337'));
- $LINK->IconLocation("C:\\WINDOWS\\SYSTEM\\COOL.DLL");
- $LINK->IconNumber(1);
-
-=back
-
-=head2 Properties
-
-The properties of a shortcut object can be accessed as:
-
- $OBJECT->{'property'}
-
-Eg., assuming that you have created a shortcut object with:
-
- $LINK=new Win32::Shortcut();
-
-you can for example see its description with:
-
- print $LINK->{'Description'};
-
-You can of course also set it:
-
- $LINK->{'Description'}="This is a description";
-
-From version 0.02, those properties have also a corresponding method
-(subroutine), so you can write the 2 lines above using this syntax too:
-
- print $LINK->Description;
- $LINK->Description("This is a description");
-
-The properties of a shortcut reflect the content of the Shortcut
-Properties Dialog Box, which can be obtained by clicking the third
-mouse button on a shortcut file in the Windows 95 (or NT 4.0) Explorer
-and choosing "Properties" (well, I hope you already knew :).
-
-The fields corresponding to the single properties are marked in B<bold>
-in the following list.
-
-=over
-
-=item B<Arguments>
-
-The arguments associated with the shell link object. They will be
-passed to the targeted program (see Path) when it gets executed. In
-fact, joined with Path, this parameter forms the "B<Target>" field of a
-Shortcut Properties Dialog Box.
-
-=item B<Description>
-
-An optional description given to the shortcut. Seems to be missing in
-the Shortcut Properties Dialog Box (not yet implemented?).
-
-=item B<File>
-
-The filename of the shortcut file opened with Load, and/or the filename
-under which the shortcut will be saved with Save (if the I<file>
-argument is not specified).
-
-=item B<Hotkey>
-
-The hotkey associated to the shortcut, in the form of a 2-byte number
-of which the first byte identifies the modifiers (Ctrl, Alt, Shift...
-but I didn't find out how it works) and the second is the ASCII code of
-the character key. Correspond to the "B<Shortcut key>" field of a
-Shortcut Properties Dialog Box.
-
-=item B<IconLocation>
-
-The file that contain the icon for the shortcut. Seems actually to
-always return nothing (YMMV, I hope...).
-
-=item B<IconNumber>
-
-The number of the icon for the shortcut in the file pointed by
-IconLocation, in case more that one icon is contained in that file (I
-suppose this, documentation isn't so clear at this point).
-
-=item B<Path>
-
-The target of the shortcut. This is (joined with Arguments) the content
-of the "B<Target>" field in a Shortcut Properties Dialog Box.
-
-=item B<ShortPath>
-
-Same as Path, but expressed in a DOS-readable format (8.3 characters
-filenames). It is available as read-only (well, you can change it, but
-it has no effect on the shortcut; change Path instead) once you Load a
-shortcut file.
-
-=item B<ShowCmd>
-
-The condition of the window in which the program will be executed (can
-be Normal, Minimized or Maximized). Correspond to the "B<Run>" field of
-a Shortcut Properties Dialog Box.
-
-Allowed values are:
-
-B<Value> B<Meaning> B<Constant>
-
- 1 Normal Window SW_SHOWNORMAL
- 3 Maximized SW_SHOWMAXIMIZED
- 7 Minimized SW_SHOWMINNOACTIVE
-
-Any other value (theoretically should) result in a Normal Window
-display.
-
-=item B<WorkingDirectory>
-
-The directory in which the targeted program will be executed.
-Correspond to the "B<Start in>" field of a Shortcut Properties Dialog
-Box.
-
-=back
-
-=head2 Constants
-
-The following constants are exported in the main namespace of your
-script using Win32::Shortcut:
-
-=over
-
-=item * SW_SHOWNORMAL
-
-=item * SW_SHOWMAXIMIZED
-
-=item * SW_SHOWMINNOACTIVE
-
-=back
-
-Those constants are the allowed values for the ShowCmd property.
-
-
-
-=head1 VERSION HISTORY
-
-B<0.03 (07 Apr 1997)>
-
-=over
-
-=item * The PLL file now comes in 2 versions, one for Perl version
-5.001 (build 110) and one for Perl version 5.003 (build 300 and higher,
-EXCEPT 304).
-
-=item * Added an installation program which will automatically copy the
-right files in the right place.
-
-=back
-
-B<0.02 (21 Jan 1997)>
-
-=over
-
-=item * Added methods matching properties to reduce typing overhead
-(eg. Alt-123 and 125...).
-
-=back
-
-B<0.01 (15 Jan 1997)>
-
-=over
-
-=item *
-
-First public release.
-
-=item *
-
-Added "Set" and "Resolve" and the properties "Hotkey", "IconLocation"
-and "IconNumber".
-
-=back
-
-B<0.01a (10 Jan 1997)>
-
-=over
-
-=item *
-
-First implementation of the IShellLink interface (wow, it works!); can
-"Load", "Save", and modify properties of shortcut files.
-
-=back
-
-=head1 AUTHOR
-
-Aldo Calpini L<dada@perl.it>
-
-=head1 CREDITS
-
-Thanks to: Jesse Dougherty, Dave Roth, ActiveWare, and the
-Perl-Win32-Users community.
-
-=head1 DISCLAIMER
-
-I<This program is FREE; you can redistribute, modify, disassemble, or
-even reverse engineer this software at your will. Keep in mind,
-however, that NOTHING IS GUARANTEED to work and everything you do is AT
-YOUR OWN RISK - I will not take responsability for any damage, loss of
-money and/or health that may arise from the use of this program!>
-
-This is distributed under the terms of Larry Wall's Artistic License.
-
-=cut
diff --git a/Master/tlpkg/tlperl0/lib/Win32/TieRegistry.pm b/Master/tlpkg/tlperl0/lib/Win32/TieRegistry.pm
deleted file mode 100755
index 19f9fdf4ae5..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/TieRegistry.pm
+++ /dev/null
@@ -1,3809 +0,0 @@
-package Win32::TieRegistry;
-
-# Win32/TieRegistry.pm -- Perl module to easily use a Registry
-# (on Win32 systems so far).
-# by Tye McQueen, tye@metronet.com, see http://www.metronet.com/~tye/.
-
-#
-# Skip to "=head" line for user documentation.
-#
-use 5.006;
-use strict;
-use Carp;
-use Tie::Hash ();
-
-use vars qw( $PACK $VERSION @ISA @EXPORT @EXPORT_OK );
-BEGIN {
- $PACK = 'Win32::TieRegistry';
- $VERSION = '0.26';
- @ISA = 'Tie::Hash';
-}
-
-# Required other modules:
-use Win32API::Registry 0.24 qw( :KEY_ :HKEY_ :REG_ );
-
-#Optional other modules:
-use vars qw( $_NoMoreItems $_FileNotFound $_TooSmall $_MoreData $_SetDualVar );
-
-if ( eval { require Win32::WinError } ) {
- $_NoMoreItems = Win32::WinError::constant("ERROR_NO_MORE_ITEMS",0);
- $_FileNotFound = Win32::WinError::constant("ERROR_FILE_NOT_FOUND",0);
- $_TooSmall = Win32::WinError::constant("ERROR_INSUFFICIENT_BUFFER",0);
- $_MoreData = Win32::WinError::constant("ERROR_MORE_DATA",0);
-} else {
- $_NoMoreItems = "^No more data";
- $_FileNotFound = "cannot find the file";
- $_TooSmall = " data area passed to ";
- $_MoreData = "^more data is avail";
-}
-if ( $_SetDualVar = eval { require SetDualVar } ) {
- import SetDualVar;
-}
-
-#Implementation details:
-# When opened:
-# HANDLE long; actual handle value
-# MACHINE string; name of remote machine ("" if local)
-# PATH list ref; machine-relative full path for this key:
-# ["LMachine","System","Disk"]
-# ["HKEY_LOCAL_MACHINE","System","Disk"]
-# DELIM char; delimiter used to separate subkeys (def="\\")
-# OS_DELIM char; always "\\" for Win32
-# ACCESS long; usually KEY_ALL_ACCESS, perhaps KEY_READ, etc.
-# ROOTS string; var name for "Lmachine"->HKEY_LOCAL_MACHINE map
-# FLAGS int; bits to control certain options
-# Often:
-# VALUES ref to list of value names (data/type never cached)
-# SUBKEYS ref to list of subkey names
-# SUBCLASSES ref to list of subkey classes
-# SUBTIMES ref to list of subkey write times
-# MEMBERS ref to list of subkey_name.DELIM's, DELIM.value_name's
-# MEMBHASH hash ref to with MEMBERS as keys and 1's as values
-# Once Key "Info" requested:
-# Class CntSubKeys CntValues MaxSubKeyLen MaxSubClassLen
-# MaxValNameLen MaxValDataLen SecurityLen LastWrite
-# If is tied to a hash and iterating over key values:
-# PREVIDX int; index of last MEMBERS element return
-# If is the key object returned by Load():
-# UNLOADME list ref; information about Load()ed key
-# If is a subkey of a "loaded" key other than the one returned by Load():
-# DEPENDON obj ref; object that can't be destroyed before us
-
-
-#Package-local variables:
-
-# Option flag bits:
-use vars qw(
- $Flag_ArrVal $Flag_TieVal $Flag_DualTyp $Flag_DualBin
- $Flag_FastDel $Flag_HexDWord $Flag_Split $Flag_FixNulls
-);
-BEGIN {
- $Flag_ArrVal = 0x0001;
- $Flag_TieVal = 0x0002;
- $Flag_FastDel = 0x0004;
- $Flag_HexDWord = 0x0008;
- $Flag_Split = 0x0010;
- $Flag_DualTyp = 0x0020;
- $Flag_DualBin = 0x0040;
- $Flag_FixNulls = 0x0080;
-}
-
-use vars qw( $RegObj %_Roots %RegHash $Registry );
-
-# Short-hand for HKEY_* constants:
-%_Roots= (
- "Classes" => HKEY_CLASSES_ROOT,
- "CUser" => HKEY_CURRENT_USER,
- "LMachine" => HKEY_LOCAL_MACHINE,
- "Users" => HKEY_USERS,
- "PerfData" => HKEY_PERFORMANCE_DATA, # Too picky to be useful
- "CConfig" => HKEY_CURRENT_CONFIG,
- "DynData" => HKEY_DYN_DATA, # Too picky to be useful
-);
-
-# Basic master Registry object:
-$RegObj= {};
-@$RegObj{qw( HANDLE MACHINE PATH DELIM OS_DELIM ACCESS FLAGS ROOTS )}= (
- "NONE", "", [], "\\", "\\",
- KEY_READ|KEY_WRITE, $Flag_HexDWord|$Flag_FixNulls, "${PACK}::_Roots" );
-$RegObj->{FLAGS} |= $Flag_DualTyp|$Flag_DualBin if $_SetDualVar;
-bless $RegObj;
-
-# Fill cache for master Registry object:
-@$RegObj{qw( VALUES SUBKEYS SUBCLASSES SUBTIMES )}= (
- [], [ keys(%_Roots) ], [], [] );
-grep( s#$#$RegObj->{DELIM}#,
- @{ $RegObj->{MEMBERS}= [ @{$RegObj->{SUBKEYS}} ] } );
-@$RegObj{qw( Class MaxSubKeyLen MaxSubClassLen MaxValNameLen
- MaxValDataLen SecurityLen LastWrite CntSubKeys CntValues )}=
- ( "", 0, 0, 0, 0, 0, 0, 0, 0 );
-
-# Create master Registry tied hash:
-$RegObj->Tie( \%RegHash );
-
-# Create master Registry combination object and tied hash reference:
-$Registry= \%RegHash;
-bless $Registry;
-
-
-# Preloaded methods go here.
-
-
-# Map option names to name of subroutine that controls that option:
-use vars qw( @_opt_subs %_opt_subs );
-@_opt_subs= qw( Delimiter ArrayValues TieValues SplitMultis DWordsToHex
- FastDelete FixSzNulls DualTypes DualBinVals AllowLoad AllowSave );
-@_opt_subs{@_opt_subs}= @_opt_subs;
-
-sub import
-{
- my $pkg = shift(@_);
- my $level = $Exporter::ExportLevel;
- my $expto = caller($level);
- my @export = ();
- my @consts = ();
- my $registry = $Registry->Clone;
- local( $_ );
- while( @_ ) {
- $_= shift(@_);
- if( /^\$(\w+::)*\w+$/ ) {
- push( @export, "ObjVar" ) if /^\$RegObj$/;
- push( @export, $_ );
- } elsif( /^\%(\w+::)*\w+$/ ) {
- push( @export, $_ );
- } elsif( /^[$%]/ ) {
- croak "${PACK}->import: Invalid variable name ($_)";
- } elsif( /^:/ || /^(H?KEY|REG)_/ ) {
- push( @consts, $_ );
- } elsif( ! @_ ) {
- croak "${PACK}->import: Missing argument after option ($_)";
- } elsif( exists $_opt_subs{$_} ) {
- $_= $_opt_subs{$_};
- $registry->$_( shift(@_) );
- } elsif( /^TiedRef$/ ) {
- $_= shift(@_);
- if( ! ref($_) && /^(\$?)(\w+::)*\w+$/ ) {
- $_= '$'.$_ unless '$' eq $1;
- } elsif( "SCALAR" ne ref($_) ) {
- croak "${PACK}->import: Invalid var after TiedRef ($_)";
- }
- push( @export, $_ );
- } elsif( /^TiedHash$/ ) {
- $_= shift(@_);
- if( ! ref($_) && /^(\%?)(\w+::)*\w+$/ ) {
- $_= '%'.$_ unless '%' eq $1;
- } elsif( "HASH" ne ref($_) ) {
- croak "${PACK}->import: Invalid var after TiedHash ($_)";
- }
- push( @export, $_ );
- } elsif( /^ObjectRef$/ ) {
- $_= shift(@_);
- if( ! ref($_) && /^(\$?)(\w+::)*\w+$/ ) {
- push( @export, "ObjVar" );
- $_= '$'.$_ unless '$' eq $1;
- } elsif( "SCALAR" eq ref($_) ) {
- push( @export, "ObjRef" );
- } else {
- croak "${PACK}->import: Invalid var after ObjectRef ($_)";
- }
- push( @export, $_ );
- } elsif( /^ExportLevel$/ ) {
- $level= shift(@_);
- $expto= caller($level);
- } elsif( /^ExportTo$/ ) {
- undef $level;
- $expto= caller($level);
- } else {
- croak "${PACK}->import: Invalid option ($_)";
- }
- }
- Win32API::Registry->export( $expto, @consts ) if @consts;
- @export= ('$Registry') unless @export;
- while( @export ) {
- $_= shift( @export );
- if( /^\$((?:\w+::)*)(\w+)$/ ) {
- my( $pack, $sym )= ( $1, $2 );
- $pack= $expto unless defined($pack) && "" ne $pack;
- no strict 'refs';
- *{"${pack}::$sym"}= \${"${pack}::$sym"};
- ${"${pack}::$sym"}= $registry;
- } elsif( /^\%((?:\w+::)*)(\w+)$/ ) {
- my( $pack, $sym )= ( $1, $2 );
- $pack= $expto unless defined($pack) && "" ne $pack;
- no strict 'refs';
- *{"${pack}::$sym"}= \%{"${pack}::$sym"};
- $registry->Tie( \%{"${pack}::$sym"} );
- } elsif( "SCALAR" eq ref($_) ) {
- $$_= $registry;
- } elsif( "HASH" eq ref($_) ) {
- $registry->Tie( $_ );
- } elsif( /^ObjVar$/ ) {
- $_= shift( @_ );
- /^\$((?:\w+::)*)(\w+)$/;
- my( $pack, $sym )= ( $1, $2 );
- $pack= $expto unless defined($pack) && "" ne $pack;
- no strict 'refs';
- *{"${pack}::$sym"}= \${"${pack}::$sym"};
- ${"${pack}::$sym"}= $registry->ObjectRef;
- } elsif( /^ObjRef$/ ) {
- ${shift(@_)}= $registry->ObjectRef;
- } else {
- die "Impossible var to export ($_)";
- }
- }
-}
-
-
-use vars qw( @_new_Opts %_new_Opts );
-@_new_Opts= qw( ACCESS DELIM MACHINE DEPENDON );
-@_new_Opts{@_new_Opts}= (1) x @_new_Opts;
-
-sub _new
-{
- my $this= shift( @_ );
- $this= tied(%$this) if ref($this) && tied(%$this);
- my $class= ref($this) || $this;
- my $self= {};
- my( $handle, $rpath, $opts )= @_;
- if( @_ < 2 || "ARRAY" ne ref($rpath) || 3 < @_
- || 3 == @_ && "HASH" ne ref($opts) ) {
- croak "Usage: ${PACK}->_new( \$handle, \\\@path, {OPT=>VAL,...} );\n",
- " options: @_new_Opts\nCalled";
- }
- @$self{qw( HANDLE PATH )}= ( $handle, $rpath );
- @$self{qw( MACHINE ACCESS DELIM OS_DELIM ROOTS FLAGS )}=
- ( $this->Machine, $this->Access, $this->Delimiter,
- $this->OS_Delimiter, $this->_Roots, $this->_Flags );
- if( ref($opts) ) {
- my @err= grep( ! $_new_Opts{$_}, keys(%$opts) );
- @err and croak "${PACK}->_new: Invalid options (@err)";
- @$self{ keys(%$opts) }= values(%$opts);
- }
- bless $self, $class;
- return $self;
-}
-
-
-sub _split
-{
- my $self= shift( @_ );
- $self= tied(%$self) if tied(%$self);
- my $path= shift( @_ );
- my $delim= @_ ? shift(@_) : $self->Delimiter;
- my $list= [ split( /\Q$delim/, $path ) ];
- return $list;
-}
-
-
-sub _rootKey
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- my $keyPath= shift(@_);
- my $delim= @_ ? shift(@_) : $self->Delimiter;
- my( $root, $subPath );
- if( "ARRAY" eq ref($keyPath) ) {
- $subPath= $keyPath;
- } else {
- $subPath= $self->_split( $keyPath, $delim );
- }
- $root= shift( @$subPath );
- if( $root =~ /^HKEY_/ ) {
- my $handle= Win32API::Registry::constant($root,0);
- $handle or croak "Invalid HKEY_ constant ($root): $!";
- return( $self->_new( $handle, [$root], {DELIM=>$delim} ),
- $subPath );
- } elsif( $root =~ /^([-+]|0x)?\d/ ) {
- return( $self->_new( $root, [sprintf("0x%lX",$root)],
- {DELIM=>$delim} ),
- $subPath );
- } else {
- my $roots= $self->Roots;
- if( $roots->{$root} ) {
- return( $self->_new( $roots->{$root}, [$root], {DELIM=>$delim} ),
- $subPath );
- }
- croak "No such root key ($root)";
- }
-}
-
-
-sub _open
-{
- my $this = shift(@_);
- $this = tied(%$this) if ref($this) && tied(%$this);
- my $subPath = shift(@_);
- my $sam = @_ ? shift(@_) : $this->Access;
- my $subKey = join( $this->OS_Delimiter, @$subPath );
- my $handle = 0;
- $this->RegOpenKeyEx( $subKey, 0, $sam, $handle ) or return ();
- return $this->_new( $handle, [ @{$this->_Path}, @$subPath ],
- { ACCESS=>$sam, ( defined($this->{UNLOADME}) ? ("DEPENDON",$this)
- : defined($this->{DEPENDON}) ? ("DEPENDON",$this->{DEPENDON}) : () )
- } );
-}
-
-
-sub ObjectRef
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- return $self;
-}
-
-
-sub _constant
-{
- my( $name, $desc )= @_;
- my $value= Win32API::Registry::constant( $name, 0 );
- my $func= (caller(1))[3];
- if( 0 == $value ) {
- if( $! =~ /invalid/i ) {
- croak "$func: Invalid $desc ($name)";
- } elsif( 0 != $! ) {
- croak "$func: \u$desc ($name) not support on this platform";
- }
- }
- return $value;
-}
-
-
-sub _connect
-{
- my $this= shift(@_);
- $this= tied(%$this) if ref($this) && tied(%$this);
- my $subPath= pop(@_);
- $subPath= $this->_split( $subPath ) unless ref($subPath);
- my $machine= @_ ? shift(@_) : shift(@$subPath);
- my $handle= 0;
- my( $temp )= $this->_rootKey( [@$subPath] );
- $temp->RegConnectRegistry( $machine, $temp->Handle, $handle )
- or return ();
- my $self= $this->_new( $handle, [shift(@$subPath)], {MACHINE=>$machine} );
- return( $self, $subPath );
-}
-
-
-use vars qw( @Connect_Opts %Connect_Opts );
-@Connect_Opts= qw(Access Delimiter);
-@Connect_Opts{@Connect_Opts}= (1) x @Connect_Opts;
-
-sub Connect
-{
- my $this= shift(@_);
- my $tied= ref($this) && tied(%$this);
- $this= tied(%$this) if $tied;
- my( $machine, $key, $opts )= @_;
- my $delim= "";
- my $sam;
- my $subPath;
- if( @_ < 2 || 3 < @_
- || 3 == @_ && "HASH" ne ref($opts) ) {
- croak "Usage: \$obj= ${PACK}->Connect(",
- " \$Machine, \$subKey, { OPT=>VAL,... } );\n",
- " options: @Connect_Opts\nCalled";
- }
- if( ref($opts) ) {
- my @err= grep( ! $Connect_Opts{$_}, keys(%$opts) );
- @err and croak "${PACK}->Connect: Invalid options (@err)";
- }
- $delim= "$opts->{Delimiter}" if defined($opts->{Delimiter});
- $delim= $this->Delimiter if "" eq $delim;
- $sam= defined($opts->{Access}) ? $opts->{Access} : $this->Access;
- $sam= _constant($sam,"key access type") if $sam =~ /^KEY_/;
- ( $this, $subPath )= $this->_connect( $machine, $key );
- return () unless defined($this);
- my $self= $this->_open( $subPath, $sam );
- return () unless defined($self);
- $self->Delimiter( $delim );
- $self= $self->TiedRef if $tied;
- return $self;
-}
-
-
-my @_newVirtual_keys= qw( MEMBERS VALUES SUBKEYS SUBTIMES SUBCLASSES
- Class SecurityLen LastWrite CntValues CntSubKeys
- MaxValNameLen MaxValDataLen MaxSubKeyLen MaxSubClassLen );
-
-sub _newVirtual
-{
- my $self= shift(@_);
- my( $rPath, $root, $opts )= @_;
- my $new= $self->_new( "NONE", $rPath, $opts )
- or return ();
- @{$new}{@_newVirtual_keys}= @{$root->ObjectRef}{@_newVirtual_keys};
- return $new;
-}
-
-
-#$key= new Win32::TieRegistry "LMachine/System/Disk";
-#$key= new Win32::TieRegistry "//Server1/LMachine/System/Disk";
-#Win32::TieRegistry->new( HKEY_LOCAL_MACHINE, {DELIM=>"/",ACCESS=>KEY_READ} );
-#Win32::TieRegistry->new( [ HKEY_LOCAL_MACHINE, ".../..." ], {DELIM=>$DELIM} );
-#$key->new( ... );
-
-use vars qw( @new_Opts %new_Opts );
-@new_Opts= qw(Access Delimiter);
-@new_Opts{@new_Opts}= (1) x @new_Opts;
-
-sub new
-{
- my $this= shift( @_ );
- $this= tied(%$this) if ref($this) && tied(%$this);
- if( ! ref($this) ) {
- no strict "refs";
- my $self= ${"${this}::Registry"};
- croak "${this}->new failed since ${PACK}::new sees that ",
- "\$${this}::Registry is not an object."
- if ! ref($self);
- $this= $self->Clone;
- }
- my( $subKey, $opts )= @_;
- my $delim= "";
- my $dlen;
- my $sam;
- my $subPath;
- if( @_ < 1 || 2 < @_
- || 2 == @_ && "HASH" ne ref($opts) ) {
- croak "Usage: \$obj= ${PACK}->new( \$subKey, { OPT=>VAL,... } );\n",
- " options: @new_Opts\nCalled";
- }
- if( defined($opts) ) {
- my @err= grep( ! $new_Opts{$_}, keys(%$opts) );
- @err and die "${PACK}->new: Invalid options (@err)";
- }
- $delim= "$opts->{Delimiter}" if defined($opts->{Delimiter});
- $delim= $this->Delimiter if "" eq $delim;
- $dlen= length($delim);
- $sam= defined($opts->{Access}) ? $opts->{Access} : $this->Access;
- $sam= _constant($sam,"key access type") if $sam =~ /^KEY_/;
- if( "ARRAY" eq ref($subKey) ) {
- $subPath= $subKey;
- if( "NONE" eq $this->Handle && @$subPath ) {
- ( $this, $subPath )= $this->_rootKey( $subPath );
- }
- } elsif( $delim x 2 eq substr($subKey,0,2*$dlen) ) {
- my $path= $this->_split( substr($subKey,2*$dlen), $delim );
- my $mach= shift(@$path);
- if( ! @$path ) {
- return $this->_newVirtual( $path, $Registry,
- {MACHINE=>$mach,DELIM=>$delim,ACCESS=>$sam} );
- }
- ( $this, $subPath )= $this->_connect( $mach, $path );
- return () if ! defined($this);
- if( 0 == @$subPath ) {
- $this->Delimiter( $delim );
- return $this;
- }
- } elsif( $delim eq substr($subKey,0,$dlen) ) {
- ( $this, $subPath )= $this->_rootKey( substr($subKey,$dlen), $delim );
- } elsif( "NONE" eq $this->Handle && "" ne $subKey ) {
- my( $mach )= $this->Machine;
- if( $mach ) {
- ( $this, $subPath )= $this->_connect( $mach, $subKey );
- } else {
- ( $this, $subPath )= $this->_rootKey( $subKey, $delim );
- }
- } else {
- $subPath= $this->_split( $subKey, $delim );
- }
- return () unless defined($this);
- if( 0 == @$subPath && "NONE" eq $this->Handle ) {
- return $this->_newVirtual( $this->_Path, $this,
- { DELIM=>$delim, ACCESS=>$sam } );
- }
- my $self= $this->_open( $subPath, $sam );
- return () unless defined($self);
- $self->Delimiter( $delim );
- return $self;
-}
-
-
-sub Open
-{
- my $self= shift(@_);
- my $tied= ref($self) && tied(%$self);
- $self= tied(%$self) if $tied;
- $self= $self->new( @_ );
- $self= $self->TiedRef if defined($self) && $tied;
- return $self;
-}
-
-
-sub Clone
-{
- my $self= shift( @_ );
- my $new= $self->Open("");
- return $new;
-}
-
-
-{ my @flush;
- sub Flush
- {
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- my( $flush )= @_;
- @_ and croak "Usage: \$key->Flush( \$bFlush );";
- return 0 if "NONE" eq $self->Handle;
- @flush= qw( VALUES SUBKEYS SUBCLASSES SUBTIMES MEMBERS Class
- CntSubKeys CntValues MaxSubKeyLen MaxSubClassLen
- MaxValNameLen MaxValDataLen SecurityLen LastWrite PREVIDX )
- unless @flush;
- delete( @$self{@flush} );
- if( defined($flush) && $flush ) {
- return $self->RegFlushKey();
- } else {
- return 1;
- }
- }
-}
-
-
-sub _DualVal
-{
- my( $hRef, $num )= @_;
- if( $_SetDualVar && $$hRef{$num} ) {
- &SetDualVar( $num, "$$hRef{$num}", 0+$num );
- }
- return $num;
-}
-
-
-use vars qw( @_RegDataTypes %_RegDataTypes );
-@_RegDataTypes= qw( REG_SZ REG_EXPAND_SZ REG_BINARY REG_LINK REG_MULTI_SZ
- REG_DWORD_LITTLE_ENDIAN REG_DWORD_BIG_ENDIAN REG_DWORD
- REG_RESOURCE_LIST REG_FULL_RESOURCE_DESCRIPTOR
- REG_RESOURCE_REQUIREMENTS_LIST REG_NONE );
-# Make sure that REG_DWORD appears _after_ other REG_DWORD_*
-# items above and that REG_NONE appears _last_.
-foreach( @_RegDataTypes ) {
- $_RegDataTypes{Win32API::Registry::constant($_,0)}= $_;
-}
-
-sub GetValue
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- 1 == @_ or croak "Usage: (\$data,\$type)= \$key->GetValue('ValName');";
- my( $valName )= @_;
- my( $valType, $valData, $dLen )= (0,"",0);
- return () if "NONE" eq $self->Handle;
- $self->RegQueryValueEx( $valName, [], $valType, $valData,
- $dLen= ( defined($self->{MaxValDataLen}) ? $self->{MaxValDataLen} : 0 )
- ) or return ();
- if( REG_DWORD == $valType ) {
- my $val= unpack("L",$valData);
- $valData= sprintf "0x%08.8lX", $val if $self->DWordsToHex;
- &SetDualVar( $valData, $valData, $val ) if $self->DualBinVals
- } elsif( REG_BINARY == $valType && length($valData) <= 4 ) {
- &SetDualVar( $valData, $valData, hex reverse unpack("h*",$valData) )
- if $self->DualBinVals;
- } elsif( ( REG_SZ == $valType || REG_EXPAND_SZ == $valType )
- && $self->FixSzNulls ) {
- substr($valData,-1)= "" if "\0" eq substr($valData,-1);
- } elsif( REG_MULTI_SZ == $valType && $self->SplitMultis ) {
- ## $valData =~ s/\0\0$//; # Why does this often fail??
- substr($valData,-2)= "" if "\0\0" eq substr($valData,-2);
- $valData= [ split( /\0/, $valData, -1 ) ]
- }
- if( ! wantarray ) {
- return $valData;
- } elsif( ! $self->DualTypes ) {
- return( $valData, $valType );
- } else {
- return( $valData, _DualVal( \%_RegDataTypes, $valType ) );
- }
-}
-
-
-sub _ErrNum
-{
- # return $^E;
- return Win32::GetLastError();
-}
-
-
-sub _ErrMsg
-{
- # return $^E;
- return Win32::FormatMessage( Win32::GetLastError() );
-}
-
-sub _Err
-{
- my $err;
- # return $^E;
- return _ErrMsg if ! $_SetDualVar;
- return &SetDualVar( $err, _ErrMsg, _ErrNum );
-}
-
-sub _NoMoreItems
-{
- return
- $_NoMoreItems =~ /^\d/
- ? _ErrNum == $_NoMoreItems
- : _ErrMsg =~ /$_NoMoreItems/io;
-}
-
-
-sub _FileNotFound
-{
- return
- $_FileNotFound =~ /^\d/
- ? _ErrNum == $_FileNotFound
- : _ErrMsg =~ /$_FileNotFound/io;
-}
-
-
-sub _TooSmall
-{
- return
- $_TooSmall =~ /^\d/
- ? _ErrNum == $_TooSmall
- : _ErrMsg =~ /$_TooSmall/io;
-}
-
-
-sub _MoreData
-{
- return
- $_MoreData =~ /^\d/
- ? _ErrNum == $_MoreData
- : _ErrMsg =~ /$_MoreData/io;
-}
-
-
-sub _enumValues
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- my( @names )= ();
- my $pos= 0;
- my $name= "";
- my $nlen= 1+$self->Information("MaxValNameLen");
- while( $self->RegEnumValue($pos++,$name,$nlen,[],[],[],[]) ) {
- push( @names, $name );
- }
- if( ! _NoMoreItems() ) {
- return ();
- }
- $self->{VALUES}= \@names;
- return 1;
-}
-
-
-sub ValueNames
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- @_ and croak "Usage: \@names= \$key->ValueNames;";
- $self->_enumValues unless $self->{VALUES};
- return @{$self->{VALUES}};
-}
-
-
-sub _enumSubKeys
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- my( @subkeys, @classes, @times )= ();
- my $pos= 0;
- my( $subkey, $class, $time )= ("","","");
- my( $namSiz, $clsSiz )= $self->Information(
- qw( MaxSubKeyLen MaxSubClassLen ));
- $namSiz++; $clsSiz++;
- while( $self->RegEnumKeyEx(
- $pos++, $subkey, $namSiz, [], $class, $clsSiz, $time ) ) {
- push( @subkeys, $subkey );
- push( @classes, $class );
- push( @times, $time );
- }
- if( ! _NoMoreItems() ) {
- return ();
- }
- $self->{SUBKEYS}= \@subkeys;
- $self->{SUBCLASSES}= \@classes;
- $self->{SUBTIMES}= \@times;
- return 1;
-}
-
-
-sub SubKeyNames
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- @_ and croak "Usage: \@names= \$key->SubKeyNames;";
- $self->_enumSubKeys unless $self->{SUBKEYS};
- return @{$self->{SUBKEYS}};
-}
-
-
-sub SubKeyClasses
-{
- my $self= shift(@_);
- @_ and croak "Usage: \@classes= \$key->SubKeyClasses;";
- $self->_enumSubKeys unless $self->{SUBCLASSES};
- return @{$self->{SUBCLASSES}};
-}
-
-
-sub SubKeyTimes
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- @_ and croak "Usage: \@times= \$key->SubKeyTimes;";
- $self->_enumSubKeys unless $self->{SUBTIMES};
- return @{$self->{SUBTIMES}};
-}
-
-
-sub _MemberNames
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- @_ and croak "Usage: \$arrayRef= \$key->_MemberNames;";
- if( ! $self->{MEMBERS} ) {
- $self->_enumValues unless $self->{VALUES};
- $self->_enumSubKeys unless $self->{SUBKEYS};
- my( @members )= ( map( $_.$self->{DELIM}, @{$self->{SUBKEYS}} ),
- map( $self->{DELIM}.$_, @{$self->{VALUES}} ) );
- $self->{MEMBERS}= \@members;
- }
- return $self->{MEMBERS};
-}
-
-
-sub _MembersHash
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- @_ and croak "Usage: \$hashRef= \$key->_MembersHash;";
- if( ! $self->{MEMBHASH} ) {
- my $aRef= $self->_MemberNames;
- $self->{MEMBHASH}= {};
- @{$self->{MEMBHASH}}{@$aRef}= (1) x @$aRef;
- }
- return $self->{MEMBHASH};
-}
-
-
-sub MemberNames
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- @_ and croak "Usage: \@members= \$key->MemberNames;";
- return @{$self->_MemberNames};
-}
-
-
-sub Information
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- my( $time, $nkeys, $nvals, $xsec, $xkey, $xcls, $xname, $xdata )=
- ("",0,0,0,0,0,0,0);
- my $clen= 8;
- if( ! $self->RegQueryInfoKey( [], [], $nkeys, $xkey, $xcls,
- $nvals, $xname, $xdata, $xsec, $time ) ) {
- return ();
- }
- if( defined($self->{Class}) ) {
- $clen= length($self->{Class});
- } else {
- $self->{Class}= "";
- }
- while( ! $self->RegQueryInfoKey( $self->{Class}, $clen,
- [],[],[],[],[],[],[],[],[])
- && _MoreData ) {
- $clen *= 2;
- }
- my( %info );
- @info{ qw( LastWrite CntSubKeys CntValues SecurityLen
- MaxValDataLen MaxSubKeyLen MaxSubClassLen MaxValNameLen )
- }= ( $time, $nkeys, $nvals, $xsec,
- $xdata, $xkey, $xcls, $xname );
- if( @_ ) {
- my( %check );
- @check{keys(%info)}= keys(%info);
- my( @err )= grep( ! $check{$_}, @_ );
- if( @err ) {
- croak "${PACK}::Information- Invalid info requested (@err)";
- }
- return @info{@_};
- } else {
- return %info;
- }
-}
-
-
-sub Delimiter
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- $self= $RegObj unless ref($self);
- my( $oldDelim )= $self->{DELIM};
- if( 1 == @_ && "" ne "$_[0]" ) {
- delete $self->{MEMBERS};
- delete $self->{MEMBHASH};
- $self->{DELIM}= "$_[0]";
- } elsif( 0 != @_ ) {
- croak "Usage: \$oldDelim= \$key->Delimiter(\$newDelim);";
- }
- return $oldDelim;
-}
-
-
-sub Handle
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- @_ and croak "Usage: \$handle= \$key->Handle;";
- $self= $RegObj unless ref($self);
- return $self->{HANDLE};
-}
-
-
-sub Path
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- @_ and croak "Usage: \$path= \$key->Path;";
- my $delim= $self->{DELIM};
- $self= $RegObj unless ref($self);
- if( "" eq $self->{MACHINE} ) {
- return( $delim . join( $delim, @{$self->{PATH}} ) . $delim );
- } else {
- return( $delim x 2
- . join( $delim, $self->{MACHINE}, @{$self->{PATH}} )
- . $delim );
- }
-}
-
-
-sub _Path
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- @_ and croak "Usage: \$arrRef= \$key->_Path;";
- $self= $RegObj unless ref($self);
- return $self->{PATH};
-}
-
-
-sub Machine
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- @_ and croak "Usage: \$machine= \$key->Machine;";
- $self= $RegObj unless ref($self);
- return $self->{MACHINE};
-}
-
-
-sub Access
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- @_ and croak "Usage: \$access= \$key->Access;";
- $self= $RegObj unless ref($self);
- return $self->{ACCESS};
-}
-
-
-sub OS_Delimiter
-{
- my $self= shift(@_);
- @_ and croak "Usage: \$backslash= \$key->OS_Delimiter;";
- return $self->{OS_DELIM};
-}
-
-
-sub _Roots
-{
- my $self= shift(@_);
- $self= tied(%$self) if ref($self) && tied(%$self);
- @_ and croak "Usage: \$varName= \$key->_Roots;";
- $self= $RegObj unless ref($self);
- return $self->{ROOTS};
-}
-
-
-sub Roots
-{
- my $self= shift(@_);
- $self= tied(%$self) if ref($self) && tied(%$self);
- @_ and croak "Usage: \$hashRef= \$key->Roots;";
- $self= $RegObj unless ref($self);
- return eval "\\%$self->{ROOTS}";
-}
-
-
-sub TIEHASH
-{
- my( $this )= shift(@_);
- $this= tied(%$this) if ref($this) && tied(%$this);
- my( $key )= @_;
- if( 1 == @_ && ref($key) && "$key" =~ /=/ ) {
- return $key; # $key is already an object (blessed reference).
- }
- return $this->new( @_ );
-}
-
-
-sub Tie
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- my( $hRef )= @_;
- if( 1 != @_ || ! ref($hRef) || "$hRef" !~ /(^|=)HASH\(/ ) {
- croak "Usage: \$key->Tie(\\\%hash);";
- }
- return tie %$hRef, ref($self), $self;
-}
-
-
-sub TiedRef
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- my $hRef= @_ ? shift(@_) : {};
- return () if ! defined($self);
- $self->Tie($hRef);
- bless $hRef, ref($self);
- return $hRef;
-}
-
-
-sub _Flags
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- my $oldFlags= $self->{FLAGS};
- if( 1 == @_ ) {
- $self->{FLAGS}= shift(@_);
- } elsif( 0 != @_ ) {
- croak "Usage: \$oldBits= \$key->_Flags(\$newBits);";
- }
- return $oldFlags;
-}
-
-
-sub ArrayValues
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- my $oldFlag= $Flag_ArrVal == ( $Flag_ArrVal & $self->{FLAGS} );
- if( 1 == @_ ) {
- my $bool= shift(@_);
- if( $bool ) {
- $self->{FLAGS} |= $Flag_ArrVal;
- } else {
- $self->{FLAGS} &= ~( $Flag_ArrVal | $Flag_TieVal );
- }
- } elsif( 0 != @_ ) {
- croak "Usage: \$oldBool= \$key->ArrayValues(\$newBool);";
- }
- return $oldFlag;
-}
-
-
-sub TieValues
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- my $oldFlag= $Flag_TieVal == ( $Flag_TieVal & $self->{FLAGS} );
- if( 1 == @_ ) {
- my $bool= shift(@_);
- if( $bool ) {
- croak "${PACK}->TieValues cannot be enabled with this version";
- $self->{FLAGS} |= $Flag_TieVal;
- } else {
- $self->{FLAGS} &= ~$Flag_TieVal;
- }
- } elsif( 0 != @_ ) {
- croak "Usage: \$oldBool= \$key->TieValues(\$newBool);";
- }
- return $oldFlag;
-}
-
-
-sub FastDelete
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- my $oldFlag= $Flag_FastDel == ( $Flag_FastDel & $self->{FLAGS} );
- if( 1 == @_ ) {
- my $bool= shift(@_);
- if( $bool ) {
- $self->{FLAGS} |= $Flag_FastDel;
- } else {
- $self->{FLAGS} &= ~$Flag_FastDel;
- }
- } elsif( 0 != @_ ) {
- croak "Usage: \$oldBool= \$key->FastDelete(\$newBool);";
- }
- return $oldFlag;
-}
-
-
-sub SplitMultis
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- my $oldFlag= $Flag_Split == ( $Flag_Split & $self->{FLAGS} );
- if( 1 == @_ ) {
- my $bool= shift(@_);
- if( $bool ) {
- $self->{FLAGS} |= $Flag_Split;
- } else {
- $self->{FLAGS} &= ~$Flag_Split;
- }
- } elsif( 0 != @_ ) {
- croak "Usage: \$oldBool= \$key->SplitMultis(\$newBool);";
- }
- return $oldFlag;
-}
-
-
-sub DWordsToHex
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- my $oldFlag= $Flag_HexDWord == ( $Flag_HexDWord & $self->{FLAGS} );
- if( 1 == @_ ) {
- my $bool= shift(@_);
- if( $bool ) {
- $self->{FLAGS} |= $Flag_HexDWord;
- } else {
- $self->{FLAGS} &= ~$Flag_HexDWord;
- }
- } elsif( 0 != @_ ) {
- croak "Usage: \$oldBool= \$key->DWordsToHex(\$newBool);";
- }
- return $oldFlag;
-}
-
-
-sub FixSzNulls
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- my $oldFlag= $Flag_FixNulls == ( $Flag_FixNulls & $self->{FLAGS} );
- if( 1 == @_ ) {
- my $bool= shift(@_);
- if( $bool ) {
- $self->{FLAGS} |= $Flag_FixNulls;
- } else {
- $self->{FLAGS} &= ~$Flag_FixNulls;
- }
- } elsif( 0 != @_ ) {
- croak "Usage: \$oldBool= \$key->FixSzNulls(\$newBool);";
- }
- return $oldFlag;
-}
-
-
-sub DualTypes
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- my $oldFlag= $Flag_DualTyp == ( $Flag_DualTyp & $self->{FLAGS} );
- if( 1 == @_ ) {
- my $bool= shift(@_);
- if( $bool ) {
- croak "${PACK}->DualTypes cannot be enabled since ",
- "SetDualVar module not installed"
- unless $_SetDualVar;
- $self->{FLAGS} |= $Flag_DualTyp;
- } else {
- $self->{FLAGS} &= ~$Flag_DualTyp;
- }
- } elsif( 0 != @_ ) {
- croak "Usage: \$oldBool= \$key->DualTypes(\$newBool);";
- }
- return $oldFlag;
-}
-
-
-sub DualBinVals
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- my $oldFlag= $Flag_DualBin == ( $Flag_DualBin & $self->{FLAGS} );
- if( 1 == @_ ) {
- my $bool= shift(@_);
- if( $bool ) {
- croak "${PACK}->DualBinVals cannot be enabled since ",
- "SetDualVar module not installed"
- unless $_SetDualVar;
- $self->{FLAGS} |= $Flag_DualBin;
- } else {
- $self->{FLAGS} &= ~$Flag_DualBin;
- }
- } elsif( 0 != @_ ) {
- croak "Usage: \$oldBool= \$key->DualBinVals(\$newBool);";
- }
- return $oldFlag;
-}
-
-
-sub GetOptions
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- my( $opt, $meth );
- if( ! @_ || 1 == @_ && "HASH" eq ref($_[0]) ) {
- my $href= @_ ? $_[0] : {};
- foreach $opt ( grep !/^Allow/, @_opt_subs ) {
- $meth= $_opt_subs{$opt};
- $href->{$opt}= $self->$meth();
- }
- return @_ ? $self : $href;
- }
- my @old;
- foreach $opt ( @_ ) {
- $meth= $_opt_subs{$opt};
- if( defined $meth ) {
- if( $opt eq "AllowLoad" || $opt eq "AllowSave" ) {
- croak "${PACK}->GetOptions: Getting current setting of $opt ",
- "not supported in this release";
- }
- push( @old, $self->$meth() );
- } else {
- croak "${PACK}->GetOptions: Invalid option ($opt) ",
- "not one of ( ", join(" ",grep !/^Allow/, @_opt_subs), " )";
- }
- }
- return wantarray ? @old : $old[-1];
-}
-
-
-sub SetOptions
-{
- my $self= shift(@_);
- # Don't get object if hash ref so "ref" returns original ref.
- my( $opt, $meth, @old );
- while( @_ ) {
- $opt= shift(@_);
- $meth= $_opt_subs{$opt};
- if( ! @_ ) {
- croak "${PACK}->SetOptions: Option value missing ",
- "after option name ($opt)";
- } elsif( defined $meth ) {
- push( @old, $self->$meth( shift(@_) ) );
- } elsif( $opt eq substr("reference",0,length($opt)) ) {
- shift(@_) if @_;
- push( @old, $self );
- } else {
- croak "${PACK}->SetOptions: Invalid option ($opt) ",
- "not one of ( @_opt_subs )";
- }
- }
- return wantarray ? @old : $old[-1];
-}
-
-
-sub _parseTiedEnt
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- my $ent= shift(@_);
- my $delim= shift(@_);
- my $dlen= length( $delim );
- my $parent= @_ ? shift(@_) : 0;
- my $off;
- if( $delim x 2 eq substr($ent,0,2*$dlen) && "NONE" eq $self->Handle ) {
- if( 0 <= ( $off= index( $ent, $delim x 2, 2*$dlen ) ) ) {
- return( substr( $ent, 0, $off ), substr( $ent, 2*$dlen+$off ) );
- } elsif( $delim eq substr($ent,-$dlen) ) {
- return( substr($ent,0,-$dlen) );
- } elsif( 2*$dlen <= ( $off= rindex( $ent, $delim ) ) ) {
- return( substr( $ent, 0, $off ),
- undef, substr( $ent, $dlen+$off ) );
- } elsif( $parent ) {
- return();
- } else {
- return( $ent );
- }
- } elsif( $delim eq substr($ent,0,$dlen) && "NONE" ne $self->Handle ) {
- return( undef, substr($ent,$dlen) );
- } elsif( $self->{MEMBERS} && $self->_MembersHash->{$ent} ) {
- return( substr($ent,0,-$dlen) );
- } elsif( 0 <= ( $off= index( $ent, $delim x 2 ) ) ) {
- return( substr( $ent, 0, $off ), substr( $ent, 2*$dlen+$off ) );
- } elsif( $delim eq substr($ent,-$dlen) ) {
- if( $parent
- && 0 <= ( $off= rindex( $ent, $delim, length($ent)-2*$dlen ) ) ) {
- return( substr($ent,0,$off),
- undef, undef, substr($ent,$dlen+$off,-$dlen) );
- } else {
- return( substr($ent,0,-$dlen) );
- }
- } elsif( 0 <= ( $off= rindex( $ent, $delim ) ) ) {
- return(
- substr( $ent, 0, $off ), undef, substr( $ent, $dlen+$off ) );
- } else {
- return( undef, undef, $ent );
- }
-}
-
-
-sub _FetchValue
-{
- my $self= shift( @_ );
- my( $val, $createKey )= @_;
- my( $data, $type );
- if( ( $data, $type )= $self->GetValue( $val ) ) {
- return $self->ArrayValues ? [ $data, $type ]
- : wantarray ? ( $data, $type )
- : $data;
- } elsif( $createKey and $data= $self->new($val) ) {
- return $data->TiedRef;
- } else {
- return ();
- }
-}
-
-
-sub FETCH
-{
- my $self= shift(@_);
- my $ent= shift(@_);
- my $delim= $self->Delimiter;
- my( $key, $val, $ambig )= $self->_parseTiedEnt( $ent, $delim, 0 );
- my $sub;
- if( defined($key) ) {
- if( defined($self->{MEMBHASH})
- && $self->{MEMBHASH}->{$key.$delim}
- && 0 <= index($key,$delim) ) {
- return ()
- unless $sub= $self->new( $key,
- {"Delimiter"=>$self->OS_Delimiter} );
- $sub->Delimiter($delim);
- } else {
- return ()
- unless $sub= $self->new( $key );
- }
- } else {
- $sub= $self;
- }
- if( defined($val) ) {
- return $sub->_FetchValue( $val );
- } elsif( ! defined($ambig) ) {
- return $sub->TiedRef;
- } elsif( defined($key) ) {
- return $sub->FETCH( $ambig );
- } else {
- return $sub->_FetchValue( $ambig, "" ne $ambig );
- }
-}
-
-
-sub _FetchOld
-{
- my( $self, $key )= @_;
- my $old= $self->FETCH($key);
- if( $old ) {
- my $copy= {};
- %$copy= %$old;
- return $copy;
- }
- # return $^E;
- return _Err;
-}
-
-
-sub DELETE
-{
- my $self= shift(@_);
- my $ent= shift(@_);
- my $delim= $self->Delimiter;
- my( $key, $val, $ambig, $subkey )= $self->_parseTiedEnt( $ent, $delim, 1 );
- my $sub;
- my $fast= defined(wantarray) ? $self->FastDelete : 2;
- my $old= 1; # Value returned if FastDelete is set.
- if( defined($key)
- && ( defined($val) || defined($ambig) || defined($subkey) ) ) {
- return ()
- unless $sub= $self->new( $key );
- } else {
- $sub= $self;
- }
- if( defined($val) ) {
- $old= $sub->GetValue($val) || _Err unless 2 <= $fast;
- $sub->RegDeleteValue( $val );
- } elsif( defined($subkey) ) {
- $old= $sub->_FetchOld( $subkey.$delim ) unless $fast;
- $sub->RegDeleteKey( $subkey );
- } elsif( defined($ambig) ) {
- if( defined($key) ) {
- $old= $sub->DELETE($ambig);
- } else {
- $old= $sub->GetValue($ambig) || _Err unless 2 <= $fast;
- if( defined( $old ) ) {
- $sub->RegDeleteValue( $ambig );
- } else {
- $old= $sub->_FetchOld( $ambig.$delim ) unless $fast;
- $sub->RegDeleteKey( $ambig );
- }
- }
- } elsif( defined($key) ) {
- $old= $sub->_FetchOld( $key.$delim ) unless $fast;
- $sub->RegDeleteKey( $key );
- } else {
- croak "${PACK}->DELETE: Key ($ent) can never be deleted";
- }
- return $old;
-}
-
-
-sub SetValue
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- my $name= shift(@_);
- my $data= shift(@_);
- my( $type )= @_;
- my $size;
- if( ! defined($type) ) {
- if( "ARRAY" eq ref($data) ) {
- croak "${PACK}->SetValue: Value is array reference but ",
- "no data type given"
- unless 2 == @$data;
- ( $data, $type )= @$data;
- } else {
- $type= REG_SZ;
- }
- }
- $type= _constant($type,"registry value data type") if $type =~ /^REG_/;
- if( REG_MULTI_SZ == $type && "ARRAY" eq ref($data) ) {
- $data= join( "\0", @$data ) . "\0\0";
- ## $data= pack( "a*" x (1+@$data), map( $_."\0", @$data, "" ) );
- } elsif( ( REG_SZ == $type || REG_EXPAND_SZ == $type )
- && $self->FixSzNulls ) {
- $data .= "\0" unless "\0" eq substr($data,0,-1);
- } elsif( REG_DWORD == $type && $data =~ /^0x[0-9a-fA-F]{3,}$/ ) {
- $data= pack( "L", hex($data) );
- # We could to $data=pack("L",$data) for REG_DWORD but I see
- # no nice way to always destinguish when to do this or not.
- }
- return $self->RegSetValueEx( $name, 0, $type, $data, length($data) );
-}
-
-
-sub StoreKey
-{
- my $this= shift(@_);
- $this= tied(%$this) if ref($this) && tied(%$this);
- my $subKey= shift(@_);
- my $data= shift(@_);
- my $ent;
- my $self;
- if( ! ref($data) || "$data" !~ /(^|=)HASH/ ) {
- croak "${PACK}->StoreKey: For ", $this->Path.$subKey, ",\n",
- " subkey data must be a HASH reference";
- }
- if( defined( $$data{""} ) && "HASH" eq ref($$data{""}) ) {
- $self= $this->CreateKey( $subKey, delete $$data{""} );
- } else {
- $self= $this->CreateKey( $subKey );
- }
- return () if ! defined($self);
- foreach $ent ( keys(%$data) ) {
- return ()
- unless $self->STORE( $ent, $$data{$ent} );
- }
- return $self;
-}
-
-
-# = { "" => {OPT=>VAL}, "val"=>[], "key"=>{} } creates a new key
-# = "string" creates a new REG_SZ value
-# = [ data, type ] creates a new value
-sub STORE
-{
- my $self= shift(@_);
- my $ent= shift(@_);
- my $data= shift(@_);
- my $delim= $self->Delimiter;
- my( $key, $val, $ambig, $subkey )= $self->_parseTiedEnt( $ent, $delim, 1 );
- my $sub;
- if( defined($key)
- && ( defined($val) || defined($ambig) || defined($subkey) ) ) {
- return ()
- unless $sub= $self->new( $key );
- } else {
- $sub= $self;
- }
- if( defined($val) ) {
- croak "${PACK}->STORE: For ", $sub->Path.$delim.$val, ",\n",
- " value data cannot be a HASH reference"
- if ref($data) && "$data" =~ /(^|=)HASH/;
- $sub->SetValue( $val, $data );
- } elsif( defined($subkey) ) {
- croak "${PACK}->STORE: For ", $sub->Path.$subkey.$delim, ",\n",
- " subkey data must be a HASH reference"
- unless ref($data) && "$data" =~ /(^|=)HASH/;
- $sub->StoreKey( $subkey, $data );
- } elsif( defined($ambig) ) {
- if( ref($data) && "$data" =~ /(^|=)HASH/ ) {
- $sub->StoreKey( $ambig, $data );
- } else {
- $sub->SetValue( $ambig, $data );
- }
- } elsif( defined($key) ) {
- croak "${PACK}->STORE: For ", $sub->Path.$key.$delim, ",\n",
- " subkey data must be a HASH reference"
- unless ref($data) && "$data" =~ /(^|=)HASH/;
- $sub->StoreKey( $key, $data );
- } else {
- croak "${PACK}->STORE: Key ($ent) can never be created nor set";
- }
-}
-
-
-sub EXISTS
-{
- my $self= shift(@_);
- my $ent= shift(@_);
- return defined( $self->FETCH($ent) );
-}
-
-
-sub FIRSTKEY
-{
- my $self= shift(@_);
- my $members= $self->_MemberNames;
- $self->{PREVIDX}= 0;
- return @{$members} ? $members->[0] : undef;
-}
-
-
-sub NEXTKEY
-{
- my $self= shift(@_);
- my $prev= shift(@_);
- my $idx= $self->{PREVIDX};
- my $members= $self->_MemberNames;
- if( ! defined($idx) || $prev ne $members->[$idx] ) {
- $idx= 0;
- while( $idx < @$members && $prev ne $members->[$idx] ) {
- $idx++;
- }
- }
- $self->{PREVIDX}= ++$idx;
- return $members->[$idx];
-}
-
-
-sub DESTROY
-{
- my $self= shift(@_);
- return if tied(%$self);
- my $unload;
- eval { $unload= $self->{UNLOADME}; 1 }
- or return;
- my $debug= $ENV{DEBUG_TIE_REGISTRY};
- if( defined($debug) ) {
- if( 1 < $debug ) {
- my $hand= $self->Handle;
- my $dep= $self->{DEPENDON};
- carp "${PACK} destroying ", $self->Path, " (",
- "NONE" eq $hand ? $hand : sprintf("0x%lX",$hand), ")",
- defined($dep) ? (" [depends on ",$dep->Path,"]") : ();
- } else {
- warn "${PACK} destroying ", $self->Path, ".\n";
- }
- }
- $self->RegCloseKey
- unless "NONE" eq $self->Handle;
- if( defined($unload) ) {
- if( defined($debug) && 1 < $debug ) {
- my( $obj, $subKey, $file )= @$unload;
- warn "Unloading ", $self->Path,
- " (from ", $obj->Path, ", $subKey)...\n";
- }
- $self->UnLoad
- || warn "Couldn't unload ", $self->Path, ": ", _ErrMsg, "\n";
- ## carp "Never unloaded ${PACK}::Load($$unload[2])";
- }
- #delete $self->{DEPENDON};
-}
-
-
-use vars qw( @CreateKey_Opts %CreateKey_Opts %_KeyDispNames );
-@CreateKey_Opts= qw( Access Class Options Delimiter
- Disposition Security Volatile Backup );
-@CreateKey_Opts{@CreateKey_Opts}= (1) x @CreateKey_Opts;
-%_KeyDispNames= ( REG_CREATED_NEW_KEY() => "REG_CREATED_NEW_KEY",
- REG_OPENED_EXISTING_KEY() => "REG_OPENED_EXISTING_KEY" );
-
-sub CreateKey
-{
- my $self= shift(@_);
- my $tied= tied(%$self);
- $self= tied(%$self) if $tied;
- my( $subKey, $opts )= @_;
- my( $sam )= $self->Access;
- my( $delim )= $self->Delimiter;
- my( $class )= "";
- my( $flags )= 0;
- my( $secure )= [];
- my( $garb )= [];
- my( $result )= \$garb;
- my( $handle )= 0;
- if( @_ < 1 || 2 < @_
- || 2 == @_ && "HASH" ne ref($opts) ) {
- croak "Usage: \$new= \$old->CreateKey( \$subKey, {OPT=>VAL,...} );\n",
- " options: @CreateKey_Opts\nCalled";
- }
- if( defined($opts) ) {
- $sam= $opts->{"Access"} if defined($opts->{"Access"});
- $class= $opts->{Class} if defined($opts->{Class});
- $flags= $opts->{Options} if defined($opts->{Options});
- $delim= $opts->{"Delimiter"} if defined($opts->{"Delimiter"});
- $secure= $opts->{Security} if defined($opts->{Security});
- if( defined($opts->{Disposition}) ) {
- "SCALAR" eq ref($opts->{Disposition})
- or croak "${PACK}->CreateKey option `Disposition'",
- " must provide a scalar reference";
- $result= $opts->{Disposition};
- }
- if( 0 == $flags ) {
- $flags |= REG_OPTION_VOLATILE
- if defined($opts->{Volatile}) && $opts->{Volatile};
- $flags |= REG_OPTION_BACKUP_RESTORE
- if defined($opts->{Backup}) && $opts->{Backup};
- }
- }
- my $subPath= ref($subKey) ? $subKey : $self->_split($subKey,$delim);
- $subKey= join( $self->OS_Delimiter, @$subPath );
- $self->RegCreateKeyEx( $subKey, 0, $class, $flags, $sam,
- $secure, $handle, $$result )
- or return ();
- if( ! ref($$result) && $self->DualTypes ) {
- $$result= _DualVal( \%_KeyDispNames, $$result );
- }
- my $new= $self->_new( $handle, [ @{$self->_Path}, @{$subPath} ] );
- $new->{ACCESS}= $sam;
- $new->{DELIM}= $delim;
- $new= $new->TiedRef if $tied;
- return $new;
-}
-
-
-use vars qw( $Load_Cnt @Load_Opts %Load_Opts );
-$Load_Cnt= 0;
-@Load_Opts= qw(NewSubKey);
-@Load_Opts{@Load_Opts}= (1) x @Load_Opts;
-
-sub Load
-{
- my $this= shift(@_);
- my $tied= ref($this) && tied(%$this);
- $this= tied(%$this) if $tied;
- my( $file, $subKey, $opts )= @_;
- if( 2 == @_ && "HASH" eq ref($subKey) ) {
- $opts= $subKey;
- undef $subKey;
- }
- @_ < 1 || 3 < @_ || defined($opts) && "HASH" ne ref($opts)
- and croak "Usage: \$key= ",
- "${PACK}->Load( \$fileName, [\$newSubKey,] {OPT=>VAL...} );\n",
- " options: @Load_Opts @new_Opts\nCalled";
- if( defined($opts) && exists($opts->{NewSubKey}) ) {
- $subKey= delete $opts->{NewSubKey};
- }
- if( ! defined( $subKey ) ) {
- if( "" ne $this->Machine ) {
- ( $this )= $this->_connect( [$this->Machine,"LMachine"] );
- } else {
- ( $this )= $this->_rootKey( "LMachine" ); # Could also be "Users"
- }
- $subKey= "PerlTie:$$." . ++$Load_Cnt;
- }
- $this->RegLoadKey( $subKey, $file )
- or return ();
- my $self= $this->new( $subKey, defined($opts) ? $opts : () );
- if( ! defined( $self ) ) {
- { my $err= Win32::GetLastError();
- #{ local( $^E ); #}
- $this->RegUnLoadKey( $subKey ) or carp
- "Can't unload $subKey from ", $this->Path, ": ", _ErrMsg, "\n";
- Win32::SetLastError($err);
- }
- return ();
- }
- $self->{UNLOADME}= [ $this, $subKey, $file ];
- $self= $self->TiedRef if $tied;
- return $self;
-}
-
-
-sub UnLoad
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- @_ and croak "Usage: \$key->UnLoad;";
- my $unload= $self->{UNLOADME};
- "ARRAY" eq ref($unload)
- or croak "${PACK}->UnLoad called on a key which was not Load()ed";
- my( $obj, $subKey, $file )= @$unload;
- $self->RegCloseKey;
- return Win32API::Registry::RegUnLoadKey( $obj->Handle, $subKey );
-}
-
-
-sub AllowSave
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- return $self->AllowPriv( "SeBackupPrivilege", @_ );
-}
-
-
-sub AllowLoad
-{
- my $self= shift(@_);
- $self= tied(%$self) if tied(%$self);
- return $self->AllowPriv( "SeRestorePrivilege", @_ );
-}
-
-
-# RegNotifyChangeKeyValue( hKey, bWatchSubtree, iNotifyFilter, hEvent, bAsync )
-
-
-sub RegCloseKey { my $self= shift(@_);
- Win32API::Registry::RegCloseKey $self->Handle, @_; }
-sub RegConnectRegistry { my $self= shift(@_);
- Win32API::Registry::RegConnectRegistry @_; }
-sub RegCreateKey { my $self= shift(@_);
- Win32API::Registry::RegCreateKey $self->Handle, @_; }
-sub RegCreateKeyEx { my $self= shift(@_);
- Win32API::Registry::RegCreateKeyEx $self->Handle, @_; }
-sub RegDeleteKey { my $self= shift(@_);
- Win32API::Registry::RegDeleteKey $self->Handle, @_; }
-sub RegDeleteValue { my $self= shift(@_);
- Win32API::Registry::RegDeleteValue $self->Handle, @_; }
-sub RegEnumKey { my $self= shift(@_);
- Win32API::Registry::RegEnumKey $self->Handle, @_; }
-sub RegEnumKeyEx { my $self= shift(@_);
- Win32API::Registry::RegEnumKeyEx $self->Handle, @_; }
-sub RegEnumValue { my $self= shift(@_);
- Win32API::Registry::RegEnumValue $self->Handle, @_; }
-sub RegFlushKey { my $self= shift(@_);
- Win32API::Registry::RegFlushKey $self->Handle, @_; }
-sub RegGetKeySecurity { my $self= shift(@_);
- Win32API::Registry::RegGetKeySecurity $self->Handle, @_; }
-sub RegLoadKey { my $self= shift(@_);
- Win32API::Registry::RegLoadKey $self->Handle, @_; }
-sub RegNotifyChangeKeyValue { my $self= shift(@_);
- Win32API::Registry::RegNotifyChangeKeyValue $self->Handle, @_; }
-sub RegOpenKey { my $self= shift(@_);
- Win32API::Registry::RegOpenKey $self->Handle, @_; }
-sub RegOpenKeyEx { my $self= shift(@_);
- Win32API::Registry::RegOpenKeyEx $self->Handle, @_; }
-sub RegQueryInfoKey { my $self= shift(@_);
- Win32API::Registry::RegQueryInfoKey $self->Handle, @_; }
-sub RegQueryMultipleValues { my $self= shift(@_);
- Win32API::Registry::RegQueryMultipleValues $self->Handle, @_; }
-sub RegQueryValue { my $self= shift(@_);
- Win32API::Registry::RegQueryValue $self->Handle, @_; }
-sub RegQueryValueEx { my $self= shift(@_);
- Win32API::Registry::RegQueryValueEx $self->Handle, @_; }
-sub RegReplaceKey { my $self= shift(@_);
- Win32API::Registry::RegReplaceKey $self->Handle, @_; }
-sub RegRestoreKey { my $self= shift(@_);
- Win32API::Registry::RegRestoreKey $self->Handle, @_; }
-sub RegSaveKey { my $self= shift(@_);
- Win32API::Registry::RegSaveKey $self->Handle, @_; }
-sub RegSetKeySecurity { my $self= shift(@_);
- Win32API::Registry::RegSetKeySecurity $self->Handle, @_; }
-sub RegSetValue { my $self= shift(@_);
- Win32API::Registry::RegSetValue $self->Handle, @_; }
-sub RegSetValueEx { my $self= shift(@_);
- Win32API::Registry::RegSetValueEx $self->Handle, @_; }
-sub RegUnLoadKey { my $self= shift(@_);
- Win32API::Registry::RegUnLoadKey $self->Handle, @_; }
-sub AllowPriv { my $self= shift(@_);
- Win32API::Registry::AllowPriv @_; }
-
-
-# Autoload methods go after =cut, and are processed by the autosplit program.
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-Win32::TieRegistry - Manipulate the Win32 Registry
-
-=head1 SYNOPSIS
-
- use Win32::TieRegistry 0.20 ( UseOptionName=>UseOptionValue[,...] );
-
- $Registry->SomeMethodCall(arg1,...);
-
- $subKey= $Registry->{"Key\\SubKey\\"};
- $valueData= $Registry->{"Key\\SubKey\\\\ValueName"};
- $Registry->{"Key\\SubKey\\"}= { "NewSubKey" => {...} };
- $Registry->{"Key\\SubKey\\\\ValueName"}= "NewValueData";
- $Registry->{"\\ValueName"}= [ pack("fmt",$data), REG_DATATYPE ];
-
-=head1 EXAMPLES
-
- use Win32::TieRegistry( Delimiter=>"#", ArrayValues=>0 );
- $pound= $Registry->Delimiter("/");
- $diskKey= $Registry->{"LMachine/System/Disk/"}
- or die "Can't read LMachine/System/Disk key: $^E\n";
- $data= $key->{"/Information"}
- or die "Can't read LMachine/System/Disk//Information value: $^E\n";
- $remoteKey= $Registry->{"//ServerA/LMachine/System/"}
- or die "Can't read //ServerA/LMachine/System/ key: $^E\n";
- $remoteData= $remoteKey->{"Disk//Information"}
- or die "Can't read ServerA's System/Disk//Information value: $^E\n";
- foreach $entry ( keys(%$diskKey) ) {
- ...
- }
- foreach $subKey ( $diskKey->SubKeyNames ) {
- ...
- }
- $diskKey->AllowSave( 1 );
- $diskKey->RegSaveKey( "C:/TEMP/DiskReg", [] );
-
-=head1 DESCRIPTION
-
-The I<Win32::TieRegistry> module lets you manipulate the Registry
-via objects [as in "object oriented"] or via tied hashes. But
-you will probably mostly use a combination reference, that is, a
-reference to a tied hash that has also been made an object so that
-you can mix both access methods [as shown above].
-
-If you did not get this module as part of L<libwin32>, you might
-want to get a recent version of L<libwin32> from CPAN which should
-include this module and the I<Win32API::Registry> module that it
-uses.
-
-Skip to the L<SUMMARY> section if you just want to dive in and start
-using the Registry from Perl.
-
-Accessing and manipulating the registry is extremely simple using
-I<Win32::TieRegistry>. A single, simple expression can return
-you almost any bit of information stored in the Registry.
-I<Win32::TieRegistry> also gives you full access to the "raw"
-underlying API calls so that you can do anything with the Registry
-in Perl that you could do in C. But the "simple" interface has
-been carefully designed to handle almost all operations itself
-without imposing arbitrary limits while providing sensible
-defaults so you can list only the parameters you care about.
-
-But first, an overview of the Registry itself.
-
-=head2 The Registry
-
-The Registry is a forest: a collection of several tree structures.
-The root of each tree is a key. These root keys are identified by
-predefined constants whose names start with "HKEY_". Although all
-keys have a few attributes associated with each [a class, a time
-stamp, and security information], the most important aspect of keys
-is that each can contain subkeys and can contain values.
-
-Each subkey has a name: a string which cannot be blank and cannot
-contain the delimiter character [backslash: C<'\\'>] nor nul
-[C<'\0'>]. Each subkey is also a key and so can contain subkeys
-and values [and has a class, time stamp, and security information].
-
-Each value has a name: a string which B<can> be blank and B<can>
-contain the delimiter character [backslash: C<'\\'>] and any
-character except for null, C<'\0'>. Each value also has data
-associated with it. Each value's data is a contiguous chunk of
-bytes, which is exactly what a Perl string value is so Perl
-strings will usually be used to represent value data.
-
-Each value also has a data type which says how to interpret the
-value data. The primary data types are:
-
-=over
-
-=item REG_SZ
-
-A null-terminated string.
-
-=item REG_EXPAND_SZ
-
-A null-terminated string which contains substrings consisting of a
-percent sign [C<'%'>], an environment variable name, then a percent
-sign, that should be replaced with the value associate with that
-environment variable. The system does I<not> automatically do this
-substitution.
-
-=item REG_BINARY
-
-Some arbitrary binary value. You can think of these as being
-"packed" into a string.
-
-If your system has the L<SetDualVar> module installed,
-the C<DualBinVals()> option wasn't turned off, and you
-fetch a C<REG_BINARY> value of 4 bytes or fewer, then
-you can use the returned value in a numeric context to
-get at the "unpacked" numeric value. See C<GetValue()>
-for more information.
-
-=item REG_MULTI_SZ
-
-Several null-terminated strings concatenated together with an
-extra trailing C<'\0'> at the end of the list. Note that the list
-can include empty strings so use the value's length to determine
-the end of the list, not the first occurrence of C<'\0\0'>.
-It is best to set the C<SplitMultis()> option so I<Win32::TieRegistry>
-will split these values into an array of strings for you.
-
-=item REG_DWORD
-
-A long [4-byte] integer value. These values are expected either
-packed into a 4-character string or as a hex string of B<more than>
-4 characters [but I<not> as a numeric value, unfortunately, as there is
-no sure way to tell a numeric value from a packed 4-byte string that
-just happens to be a string containing a valid numeric value].
-
-How such values are returned depends on the C<DualBinVals()> and
-C<DWordsToHex()> options. See C<GetValue()> for details.
-
-=back
-
-In the underlying Registry calls, most places which take a
-subkey name also allow you to pass in a subkey "path" -- a
-string of several subkey names separated by the delimiter
-character, backslash [C<'\\'>]. For example, doing
-C<RegOpenKeyEx(HKEY_LOCAL_MACHINE,"SYSTEM\\DISK",...)> is much
-like opening the C<"SYSTEM"> subkey of C<HKEY_LOCAL_MACHINE>,
-then opening its C<"DISK"> subkey, then closing the C<"SYSTEM">
-subkey.
-
-All of the I<Win32::TieRegistry> features allow you to use your
-own delimiter in place of the system's delimiter, [C<'\\'>]. In
-most of our examples we will use a forward slash [C<'/'>] as our
-delimiter as it is easier to read and less error prone to use when
-writing Perl code since you have to type two backslashes for each
-backslash you want in a string. Note that this is true even when
-using single quotes -- C<'\\HostName\LMachine\'> is an invalid
-string and must be written as C<'\\\\HostName\\LMachine\\'>.
-
-You can also connect to the registry of other computers on your
-network. This will be discussed more later.
-
-Although the Registry does not have a single root key, the
-I<Win32::TieRegistry> module creates a virtual root key for you
-which has all of the I<HKEY_*> keys as subkeys.
-
-=head2 Tied Hashes Documentation
-
-Before you can use a tied hash, you must create one. One way to
-do that is via:
-
- use Win32::TieRegistry ( TiedHash => '%RegHash' );
-
-which exports a C<%RegHash> variable into your package and ties it
-to the virtual root key of the Registry. An alternate method is:
-
- my %RegHash;
- use Win32::TieRegistry ( TiedHash => \%RegHash );
-
-There are also several ways you can tie a hash variable to any
-other key of the Registry, which are discussed later.
-
-Note that you will most likely use C<$Registry> instead of using
-a tied hash. C<$Registry> is a reference to a hash that has
-been tied to the virtual root of your computer's Registry [as if,
-C<$Registry= \%RegHash>]. So you would use C<$Registry-E<gt>{Key}>
-rather than C<$RegHash{Key}> and use C<keys %{$Registry}> rather
-than C<keys %RegHash>, for example.
-
-For each hash which has been tied to a Registry key, the Perl
-C<keys> function will return a list containing the name of each
-of the key's subkeys with a delimiter character appended to it and
-containing the name of each of the key's values with a delimiter
-prepended to it. For example:
-
- keys( %{ $Registry->{"HKEY_CLASSES_ROOT\\batfile\\"} } )
-
-might yield the following list value:
-
- ( "DefaultIcon\\", # The subkey named "DefaultIcon"
- "shell\\", # The subkey named "shell"
- "shellex\\", # The subkey named "shellex"
- "\\", # The default value [named ""]
- "\\EditFlags" ) # The value named "EditFlags"
-
-For the virtual root key, short-hand subkey names are used as
-shown below. You can use the short-hand name, the regular
-I<HKEY_*> name, or any numeric value to access these keys, but
-the short-hand names are all that will be returned by the C<keys>
-function.
-
-=over
-
-=item "Classes" for HKEY_CLASSES_ROOT
-
-Contains mappings between file name extensions and the uses
-for such files along with configuration information for COM
-[MicroSoft's Common Object Model] objects. Usually a link to
-the C<"SOFTWARE\\Classes"> subkey of the C<HKEY_LOCAL_MACHINE>
-key.
-
-=item "CUser" for HKEY_CURRENT_USER
-
-Contains information specific to the currently logged-in user.
-Mostly software configuration information. Usually a link to
-a subkey of the C<HKEY_USERS> key.
-
-=item "LMachine" for HKEY_LOCAL_MACHINE
-
-Contains all manner of information about the computer.
-
-=item "Users" for HKEY_USERS
-
-Contains one subkey, C<".DEFAULT">, which gets copied to a new
-subkey whenever a new user is added. Also contains a subkey for
-each user of the system, though only those for active users
-[usually only one] are loaded at any given time.
-
-=item "PerfData" for HKEY_PERFORMANCE_DATA
-
-Used to access data about system performance. Access via this key
-is "special" and all but the most carefully constructed calls will
-fail, usually with C<ERROR_INSUFFICIENT_BUFFER>. For example, you
-can't enumerate key names without also enumerating values which
-require huge buffers but the exact buffer size required cannot be
-determined beforehand because C<RegQueryInfoKey()> B<always> fails
-with C<ERROR_INSUFFICIENT_BUFFER> for C<HKEY_PERFORMANCE_DATA> no
-matter how it is called. So it is currently not very useful to
-tie a hash to this key. You can use it to create an object to use
-for making carefully constructed calls to the underlying Reg*()
-routines.
-
-=item "CConfig" for HKEY_CURRENT_CONFIG
-
-Contains minimal information about the computer's current
-configuration that is required very early in the boot process.
-For example, setting for the display adapter such as screen
-resolution and refresh rate are found in here.
-
-=item "DynData" for HKEY_DYN_DATA
-
-Dynamic data. We have found no documentation for this key.
-
-=back
-
-A tied hash is much like a regular hash variable in Perl -- you give
-it a key string inside braces, [C<{> and C<}>], and it gives you
-back a value [or lets you set a value]. For I<Win32::TieRegistry>
-hashes, there are two types of values that will be returned.
-
-=over
-
-=item SubKeys
-
-If you give it a string which represents a subkey, then it will
-give you back a reference to a hash which has been tied to that
-subkey. It can't return the hash itself, so it returns a
-reference to it. It also blesses that reference so that it is
-also an object so you can use it to call method functions.
-
-=item Values
-
-If you give it a string which is a value name, then it will give
-you back a string which is the data for that value. Alternately,
-you can request that it give you both the data value string and
-the data value type [we discuss how to request this later]. In
-this case, it would return a reference to an array where the value
-data string is element C<[0]> and the value data type is element
-C<[1]>.
-
-=back
-
-The key string which you use in the tied hash must be interpreted
-to determine whether it is a value name or a key name or a path
-that combines several of these or even other things. There are
-two simple rules that make this interpretation easy and
-unambiguous:
-
- Put a delimiter after each key name.
- Put a delimiter in front of each value name.
-
-Exactly how the key string will be intepreted is governed by the
-following cases, in the order listed. These cases are designed
-to "do what you mean". Most of the time you won't have to think
-about them, especially if you follow the two simple rules above.
-After the list of cases we give several examples which should be
-clear enough so feel free to skip to them unless you are worried
-about the details.
-
-=over
-
-=item Remote machines
-
-If the hash is tied to the virtual root of the registry [or the
-virtual root of a remote machine's registry], then we treat hash
-key strings which start with the delimiter character specially.
-
-If the hash key string starts with two delimiters in a row, then
-those should be immediately followed by the name of a remote
-machine whose registry we wish to connect to. That can be
-followed by a delimiter and more subkey names, etc. If the
-machine name is not following by anything, then a virtual root
-for the remote machine's registry is created, a hash is tied to
-it, and a reference to that hash it is returned.
-
-=item Hash key string starts with the delimiter
-
-If the hash is tied to a virtual root key, then the leading
-delimiter is ignored. It should be followed by a valid Registry
-root key name [either a short-hand name like C<"LMachine">, an
-I<HKEY_*> value, or a numeric value]. This alternate notation is
-allowed in order to be more consistant with the C<Open()> method
-function.
-
-For all other Registry keys, the leading delimiter indicates
-that the rest of the string is a value name. The leading
-delimiter is stripped and the rest of the string [which can
-be empty and can contain more delimiters] is used as a value
-name with no further parsing.
-
-=item Exact match with direct subkey name followed by delimiter
-
-If you have already called the Perl C<keys> function on the tied
-hash [or have already called C<MemberNames> on the object] and the
-hash key string exactly matches one of the strings returned, then
-no further parsing is done. In other words, if the key string
-exactly matches the name of a direct subkey with a delimiter
-appended, then a reference to a hash tied to that subkey is
-returned [but only if C<keys> or C<MemberNames> has already
-been called for that tied hash].
-
-This is only important if you have selected a delimiter other than
-the system default delimiter and one of the subkey names contains
-the delimiter you have chosen. This rule allows you to deal with
-subkeys which contain your chosen delimiter in their name as long
-as you only traverse subkeys one level at a time and always
-enumerate the list of members before doing so.
-
-The main advantage of this is that Perl code which recursively
-traverses a hash will work on hashes tied to Registry keys even if
-a non-default delimiter has been selected.
-
-=item Hash key string contains two delimiters in a row
-
-If the hash key string contains two [or more] delimiters in a row,
-then the string is split between the first pair of delimiters.
-The first part is interpreted as a subkey name or a path of subkey
-names separated by delimiters and with a trailing delimiter. The
-second part is interpreted as a value name with one leading
-delimiter [any extra delimiters are considered part of the value
-name].
-
-=item Hash key string ends with a delimiter
-
-If the key string ends with a delimiter, then it is treated
-as a subkey name or path of subkey names separated by delimiters.
-
-=item Hash key string contains a delimiter
-
-If the key string contains a delimiter, then it is split after
-the last delimiter. The first part is treated as a subkey name or
-path of subkey names separated by delimiters. The second part
-is ambiguous and is treated as outlined in the next item.
-
-=item Hash key string contains no delimiters
-
-If the hash key string contains no delimiters, then it is ambiguous.
-
-If you are reading from the hash [fetching], then we first use the
-key string as a value name. If there is a value with a matching
-name in the Registry key which the hash is tied to, then the value
-data string [and possibly the value data type] is returned.
-Otherwise, we retry by using the hash key string as a subkey name.
-If there is a subkey with a matching name, then we return a
-reference to a hash tied to that subkey. Otherwise we return
-C<undef>.
-
-If you are writing to the hash [storing], then we use the key
-string as a subkey name only if the value you are storing is a
-reference to a hash value. Otherwise we use the key string as
-a value name.
-
-=back
-
-=head3 Examples
-
-Here are some examples showing different ways of accessing Registry
-information using references to tied hashes:
-
-=over
-
-=item Canonical value fetch
-
- $tip18= $Registry->{"HKEY_LOCAL_MACHINE\\Software\\Microsoft\\"
- . 'Windows\\CurrentVersion\\Explorer\\Tips\\\\18'};
-
-Should return the text of important tip number 18. Note that two
-backslashes, C<"\\">, are required to get a single backslash into
-a Perl double-quoted or single-qouted string. Note that C<"\\">
-is appended to each key name [C<"HKEY_LOCAL_MACHINE"> through
-C<"Tips">] and C<"\\"> is prepended to the value name, C<"18">.
-
-=item Changing your delimiter
-
- $Registry->Delimiter("/");
- $tip18= $Registry->{"HKEY_LOCAL_MACHINE/Software/Microsoft/"
- . 'Windows/CurrentVersion/Explorer/Tips//18'};
-
-This usually makes things easier to read when working in Perl.
-All remaining examples will assume the delimiter has been changed
-as above.
-
-=item Using intermediate keys
-
- $ms= $Registry->{"LMachine/Software/Microsoft/"};
- $tips= $ms->{"Windows/CurrentVersion/Explorer/Tips/"};
- $tip18= $winlogon->{"/18"};
-
-Same as above but opens more keys into the Registry which lets you
-efficiently re-access those intermediate keys. This is slightly
-less efficient if you never reuse those intermediate keys.
-
-=item Chaining in a single statement
-
- $tip18= $Registry->{"LMachine/Software/Microsoft/"}->
- {"Windows/CurrentVersion/Explorer/Tips/"}->{"/18"};
-
-Like above, this creates intermediate key objects then uses
-them to access other data. Once this statement finishes, the
-intermediate key objects are destroyed. Several handles into
-the Registry are opened and closed by this statement so it is
-less efficient but there are times when this will be useful.
-
-=item Even less efficient example of chaining
-
- $tip18= $Registry->{"LMachine/Software/Microsoft"}->
- {"Windows/CurrentVersion/Explorer/Tips"}->{"/18"};
-
-Because we left off the trailing delimiters, I<Win32::TieRegistry>
-doesn't know whether final names, C<"Microsoft"> and C<"Tips">,
-are subkey names or value names. So this statement ends up
-executing the same code as the next one.
-
-=item What the above really does
-
- $tip18= $Registry->{"LMachine/Software/"}->{"Microsoft"}->
- {"Windows/CurrentVersion/Explorer/"}->{"Tips"}->{"/18"};
-
-With more chains to go through, more temporary objects are created
-and later destroyed than in our first chaining example. Also,
-when C<"Microsoft"> is looked up, I<Win32::TieRegistry> first
-tries to open it as a value and fails then tries it as a subkey.
-The same is true for when it looks up C<"Tips">.
-
-=item Getting all of the tips
-
- $tips= $Registry->{"LMachine/Software/Microsoft/"}->
- {"Windows/CurrentVersion/Explorer/Tips/"}
- or die "Can't find the Windows tips: $^E\n";
- foreach( keys %$tips ) {
- print "$_: ", $tips->{$_}, "\n";
- }
-
-First notice that we actually check for failure for the first
-time. We are assuming that the C<"Tips"> key contains no subkeys.
-Otherwise the C<print> statement would show something like
-C<"Win32::TieRegistry=HASH(0xc03ebc)"> for each subkey.
-
-The output from the above code will start something like:
-
- /0: If you don't know how to do something,[...]
-
-=back
-
-=head3 Deleting items
-
-You can use the Perl C<delete> function to delete a value from a
-Registry key or to delete a subkey as long that subkey contains
-no subkeys of its own. See L<More Examples>, below, for more
-information.
-
-=head3 Storing items
-
-You can use the Perl assignment operator [C<=>] to create new
-keys, create new values, or replace values. The values you store
-should be in the same format as the values you would fetch from a
-tied hash. For example, you can use a single assignment statement
-to copy an entire Registry tree. The following statement:
-
- $Registry->{"LMachine/Software/Classes/Tie_Registry/"}=
- $Registry->{"LMachine/Software/Classes/batfile/"};
-
-creates a C<"Tie_Registry"> subkey under the C<"Software\\Classes">
-subkey of the C<HKEY_LOCAL_MACHINE> key. Then it populates it
-with copies of all of the subkeys and values in the C<"batfile">
-subkey and all of its subkeys. Note that you need to have
-called C<$Registry-E<gt>ArrayValues(1)> for the proper value data
-type information to be copied. Note also that this release of
-I<Win32::TieRegistry> does not copy key attributes such as class
-name and security information [this is planned for a future release].
-
-The following statement creates a whole subtree in the Registry:
-
- $Registry->{"LMachine/Software/FooCorp/"}= {
- "FooWriter/" => {
- "/Version" => "4.032",
- "Startup/" => {
- "/Title" => "Foo Writer Deluxe ][",
- "/WindowSize" => [ pack("LL",$wid,$ht), "REG_BINARY" ],
- "/TaskBarIcon" => [ "0x0001", "REG_DWORD" ],
- },
- "Compatibility/" => {
- "/AutoConvert" => "Always",
- "/Default Palette" => "Windows Colors",
- },
- },
- "/License", => "0123-9C8EF1-09-FC",
- };
-
-Note that all but the last Registry key used on the left-hand
-side of the assignment [that is, "LMachine/Software/" but not
-"FooCorp/"] must already exist for this statement to succeed.
-
-By using the leading a trailing delimiters on each subkey name and
-value name, I<Win32::TieRegistry> will tell you if you try to assign
-subkey information to a value or visa-versa.
-
-=head3 More examples
-
-=over
-
-=item Adding a new tip
-
- $tips= $Registry->{"LMachine/Software/Microsoft/"}->
- {"Windows/CurrentVersion/Explorer/Tips/"}
- or die "Can't find the Windows tips: $^E\n";
- $tips{'/186'}= "Be very careful when making changes to the Registry!";
-
-=item Deleting our new tip
-
- $tips= $Registry->{"LMachine/Software/Microsoft/"}->
- {"Windows/CurrentVersion/Explorer/Tips/"}
- or die "Can't find the Windows tips: $^E\n";
- $tip186= delete $tips{'/186'};
-
-Note that Perl's C<delete> function returns the value that was deleted.
-
-=item Adding a new tip differently
-
- $Registry->{"LMachine/Software/Microsoft/" .
- "Windows/CurrentVersion/Explorer/Tips//186"}=
- "Be very careful when making changes to the Registry!";
-
-=item Deleting differently
-
- $tip186= delete $Registry->{"LMachine/Software/Microsoft/Windows/" .
- "CurrentVersion/Explorer/Tips//186"};
-
-Note that this only deletes the tail of what we looked up, the
-C<"186"> value, not any of the keys listed.
-
-=item Deleting a key
-
-WARNING: The following code will delete all information about the
-current user's tip preferences. Actually executing this command
-would probably cause the user to see the Welcome screen the next
-time they log in and may cause more serious problems. This
-statement is shown as an example only and should not be used when
-experimenting.
-
- $tips= delete $Registry->{"CUser/Software/Microsoft/Windows/" .
- "CurrentVersion/Explorer/Tips/"};
-
-This deletes the C<"Tips"> key and the values it contains. The
-C<delete> function will return a reference to a hash [not a tied
-hash] containing the value names and value data that were deleted.
-
-The information to be returned is copied from the Registry into a
-regular Perl hash before the key is deleted. If the key has many
-subkeys, this copying could take a significant amount of memory
-and/or processor time. So you can disable this process by calling
-the C<FastDelete> member function:
-
- $prevSetting= $regKey->FastDelete(1);
-
-which will cause all subsequent delete operations via C<$regKey>
-to simply return a true value if they succeed. This optimization
-is automatically done if you use C<delete> in a void context.
-
-=item Technical notes on deleting
-
-If you use C<delete> to delete a Registry key or value and use
-the return value, then I<Win32::TieRegistry> usually looks up the
-current contents of that key or value so they can be returned if
-the deletion is successful. If the deletion succeeds but the
-attempt to lookup the old contents failed, then the return value
-of C<delete> will be C<$^E> from the failed part of the operation.
-
-=item Undeleting a key
-
- $Registry->{"LMachine/Software/Microsoft/Windows/" .
- "CurrentVersion/Explorer/Tips/"}= $tips;
-
-This adds back what we just deleted. Note that this version of
-I<Win32::TieRegistry> will use defaults for the key attributes
-[such as class name and security] and will not restore the
-previous attributes.
-
-=item Not deleting a key
-
-WARNING: Actually executing the following code could cause
-serious problems. This statement is shown as an example only and
-should not be used when experimenting.
-
- $res= delete $Registry->{"CUser/Software/Microsoft/Windows/"}
- defined($res) || die "Can't delete URL key: $^E\n";
-
-Since the "Windows" key should contain subkeys, that C<delete>
-statement should make no changes to the Registry, return C<undef>,
-and set C<$^E> to "Access is denied".
-
-=item Not deleting again
-
- $tips= $Registry->{"CUser/Software/Microsoft/Windows/" .
- "CurrentVersion/Explorer/Tips/"};
- delete $tips;
-
-The Perl C<delete> function requires that its argument be an
-expression that ends in a hash element lookup [or hash slice],
-which is not the case here. The C<delete> function doesn't
-know which hash $tips came from and so can't delete it.
-
-=back
-
-=head2 Objects Documentation
-
-The following member functions are defined for use on
-I<Win32::TieRegistry> objects:
-
-=over
-
-=item new
-
-The C<new> method creates a new I<Win32::TieRegistry> object.
-C<new> is mostly a synonym for C<Open()> so see C<Open()> below for
-information on what arguments to pass in. Examples:
-
- $machKey= new Win32::TieRegistry "LMachine"
- or die "Can't access HKEY_LOCAL_MACHINE key: $^E\n";
- $userKey= Win32::TieRegistry->new("CUser")
- or die "Can't access HKEY_CURRENT_USER key: $^E\n";
-
-Note that calling C<new> via a reference to a tied hash returns
-a simple object, not a reference to a tied hash.
-
-=item Open
-
-=item $subKey= $key->Open( $sSubKey, $rhOptions )
-
-The C<Open> method opens a Registry key and returns a new
-I<Win32::TieRegistry> object associated with that Registry key.
-If C<Open> is called via a reference to a tied hash, then C<Open>
-returns another reference to a tied hash. Otherwise C<Open>
-returns a simple object and you should then use C<TiedRef> to get
-a reference to a tied hash.
-
-C<$sSubKey> is a string specifying a subkey to be opened.
-Alternately C<$sSubKey> can be a reference to an array value
-containing the list of increasingly deep subkeys specifying the
-path to the subkey to be opened.
-
-C<$rhOptions> is an optional reference to a hash containing extra
-options. The C<Open> method supports two options, C<"Delimiter">
-and C<"Access">, and C<$rhOptions> should have only have zero or
-more of these strings as keys. See the "Examples" section below
-for more information.
-
-The C<"Delimiter"> option specifies what string [usually a single
-character] will be used as the delimiter to be appended to subkey
-names and prepended to value names. If this option is not specified,
-the new key [C<$subKey>] inherits the delimiter of the old key
-[C<$key>].
-
-The C<"Access"> option specifies what level of access to the
-Registry key you wish to have once it has been opened. If this
-option is not specified, the new key [C<$subKey>] is opened with
-the same access level used when the old key [C<$key>] was opened.
-The virtual root of the Registry pretends it was opened with
-access C<KEY_READ()|KEY_WRITE()> so this is the default access when
-opening keys directory via C<$Registry>. If you don't plan on
-modifying a key, you should open it with C<KEY_READ> access as
-you may not have C<KEY_WRITE> access to it or some of its subkeys.
-
-If the C<"Access"> option value is a string that starts with
-C<"KEY_">, then it should match B<one> of the predefined access
-levels [probably C<"KEY_READ">, C<"KEY_WRITE">, or
-C<"KEY_ALL_ACCESS">] exported by the I<Win32API::Registry> module.
-Otherwise, a numeric value is expected. For maximum flexibility,
-include C<use Win32::TieRegistry qw(:KEY_);>, for example, near
-the top of your script so you can specify more complicated access
-levels such as C<KEY_READ()|KEY_WRITE()>.
-
-If C<$sSubKey> does not begin with the delimiter [or C<$sSubKey>
-is an array reference], then the path to the subkey to be opened
-will be relative to the path of the original key [C<$key>]. If
-C<$sSubKey> begins with a single delimiter, then the path to the
-subkey to be opened will be relative to the virtual root of the
-Registry on whichever machine the original key resides. If
-C<$sSubKey> begins with two consectutive delimiters, then those
-must be followed by a machine name which causes the C<Connect()>
-method function to be called.
-
-Examples:
-
- $machKey= $Registry->Open( "LMachine", {Access=>KEY_READ(),Delimiter=>"/"} )
- or die "Can't open HKEY_LOCAL_MACHINE key: $^E\n";
- $swKey= $machKey->Open( "Software" );
- $logonKey= $swKey->Open( "Microsoft/Windows NT/CurrentVersion/Winlogon/" );
- $NTversKey= $swKey->Open( ["Microsoft","Windows NT","CurrentVersion"] );
- $versKey= $swKey->Open( qw(Microsoft Windows CurrentVersion) );
-
- $remoteKey= $Registry->Open( "//HostA/LMachine/System/", {Delimiter=>"/"} )
- or die "Can't connect to HostA or can't open subkey: $^E\n";
-
-=item Clone
-
-=item $copy= $key->Clone
-
-Creates a new object that is associated with the same Registry key
-as the invoking object.
-
-=item Connect
-
-=item $remoteKey= $Registry->Connect( $sMachineName, $sKeyPath, $rhOptions )
-
-The C<Connect> method connects to the Registry of a remote machine,
-and opens a key within it, then returns a new I<Win32::TieRegistry>
-object associated with that remote Registry key. If C<Connect>
-was called using a reference to a tied hash, then the return value
-will also be a reference to a tied hash [or C<undef>]. Otherwise,
-if you wish to use the returned object as a tied hash [not just as
-an object], then use the C<TiedRef> method function after C<Connect>.
-
-C<$sMachineName> is the name of the remote machine. You don't have
-to preceed the machine name with two delimiter characters.
-
-C<$sKeyPath> is a string specifying the remote key to be opened.
-Alternately C<$sKeyPath> can be a reference to an array value
-containing the list of increasingly deep keys specifying the path
-to the key to be opened.
-
-C<$rhOptions> is an optional reference to a hash containing extra
-options. The C<Connect> method supports two options, C<"Delimiter">
-and C<"Access">. See the C<Open> method documentation for more
-information on these options.
-
-C<$sKeyPath> is already relative to the virtual root of the Registry
-of the remote machine. A single leading delimiter on C<sKeyPath>
-will be ignored and is not required.
-
-C<$sKeyPath> can be empty in which case C<Connect> will return an
-object representing the virtual root key of the remote Registry.
-Each subsequent use of C<Open> on this virtual root key will call
-the system C<RegConnectRegistry> function.
-
-The C<Connect> method can be called via any I<Win32::TieRegistry>
-object, not just C<$Registry>. Attributes such as the desired
-level of access and the delimiter will be inherited from the
-object used but the C<$sKeyPath> will always be relative to the
-virtual root of the remote machine's registry.
-
-Examples:
-
- $remMachKey= $Registry->Connect( "HostA", "LMachine", {Delimiter->"/"} )
- or die "Can't connect to HostA's HKEY_LOCAL_MACHINE key: $^E\n";
-
- $remVersKey= $remMachKey->Connect( "www.microsoft.com",
- "LMachine/Software/Microsoft/Inetsrv/CurrentVersion/",
- { Access=>KEY_READ, Delimiter=>"/" } )
- or die "Can't check what version of IIS Microsoft is running: $^E\n";
-
- $remVersKey= $remMachKey->Connect( "www",
- qw(LMachine Software Microsoft Inetsrv CurrentVersion) )
- or die "Can't check what version of IIS we are running: $^E\n";
-
-=item ObjectRef
-
-=item $object_ref= $obj_or_hash_ref->ObjectRef
-
-For a simple object, just returns itself [C<$obj == $obj->ObjectRef>].
-
-For a reference to a tied hash [if it is also an object], C<ObjectRef>
-returns the simple object that the hash is tied to.
-
-This is primarilly useful when debugging since typing C<x $Registry>
-will try to display your I<entire> registry contents to your screen.
-But the debugger command C<x $Registry->ObjectRef> will just dump
-the implementation details of the underlying object to your screen.
-
-=item Flush( $bFlush )
-
-Flushes all cached information about the Registry key so that future
-uses will get fresh data from the Registry.
-
-If the optional C<$bFlush> is specified and a true value, then
-C<RegFlushKey()> will be called, which is almost never necessary.
-
-=item GetValue
-
-=item $ValueData= $key->GetValue( $sValueName )
-
-=item ($ValueData,$ValueType)= $key->GetValue( $sValueName )
-
-Gets a Registry value's data and data type.
-
-C<$ValueData> is usually just a Perl string that contains the
-value data [packed into it]. For certain types of data, however,
-C<$ValueData> may be processed as described below.
-
-C<$ValueType> is the C<REG_*> constant describing the type of value
-data stored in C<$ValueData>. If the C<DualTypes()> option is on,
-then C<$ValueType> will be a dual value. That is, when used in a
-numeric context, C<$ValueType> will give the numeric value of a
-C<REG_*> constant. However, when used in a non-numeric context,
-C<$ValueType> will return the name of the C<REG_*> constant, for
-example C<"REG_SZ"> [note the quotes]. So both of the following
-can be true at the same time:
-
- $ValueType == REG_SZ()
- $ValueType eq "REG_SZ"
-
-=over
-
-=item REG_SZ and REG_EXPAND_SZ
-
-If the C<FixSzNulls()> option is on, then the trailing C<'\0'> will be
-stripped [unless there isn't one] before values of type C<REG_SZ>
-and C<REG_EXPAND_SZ> are returned. Note that C<SetValue()> will add
-a trailing C<'\0'> under similar circumstances.
-
-=item REG_MULTI_SZ
-
-If the C<SplitMultis()> option is on, then values of this type are
-returned as a reference to an array containing the strings. For
-example, a value that, with C<SplitMultis()> off, would be returned as:
-
- "Value1\000Value2\000\000"
-
-would be returned, with C<SplitMultis()> on, as:
-
- [ "Value1", "Value2" ]
-
-=item REG_DWORD
-
-If the C<DualBinVals()> option is on, then the value is returned
-as a scalar containing both a string and a number [much like
-the C<$!> variable -- see the L<SetDualVar> module for more
-information] where the number part is the "unpacked" value.
-Use the returned value in a numeric context to access this part
-of the value. For example:
-
- $num= 0 + $Registry->{"CUser/Console//ColorTable01"};
-
-If the C<DWordsToHex()> option is off, the string part of the
-returned value is a packed, 4-byte string [use C<unpack("L",$value)>
-to get the numeric value.
-
-If C<DWordsToHex()> is on, the string part of the returned value is
-a 10-character hex strings [with leading "0x"]. You can use
-C<hex($value)> to get the numeric value.
-
-Note that C<SetValue()> will properly understand each of these
-returned value formats no matter how C<DualBinVals()> is set.
-
-=back
-
-=item ValueNames
-
-=item @names= $key->ValueNames
-
-Returns the list of value names stored directly in a Registry key.
-Note that the names returned do I<not> have a delimiter prepended
-to them like with C<MemberNames()> and tied hashes.
-
-Once you request this information, it is cached in the object and
-future requests will always return the same list unless C<Flush()>
-has been called.
-
-=item SubKeyNames
-
-=item @key_names= $key->SubKeyNames
-
-Returns the list of subkey names stored directly in a Registry key.
-Note that the names returned do I<not> have a delimiter appended
-to them like with C<MemberNames()> and tied hashes.
-
-Once you request this information, it is cached in the object and
-future requests will always return the same list unless C<Flush()>
-has been called.
-
-=item SubKeyClasses
-
-=item @classes= $key->SubKeyClasses
-
-Returns the list of classes for subkeys stored directly in a
-Registry key. The classes are returned in the same order as
-the subkey names returned by C<SubKeyNames()>.
-
-=item SubKeyTimes
-
-=item @times= $key->SubKeyTimes
-
-Returns the list of last-modified times for subkeys stored
-directly in a Registry key. The times are returned in the same
-order as the subkey names returned by C<SubKeyNames()>. Each
-time is a C<FILETIME> structure packed into a Perl string.
-
-Once you request this information, it is cached in the object and
-future requests will always return the same list unless C<Flush()>
-has been called.
-
-=item MemberNames
-
-=item @members= $key->MemberNames
-
-Returns the list of subkey names and value names stored directly
-in a Registry key. Subkey names have a delimiter appended to the
-end and value names have a delimiter prepended to the front.
-
-Note that a value name could end in a delimiter [or could be C<"">
-so that the member name returned is just a delimiter] so the
-presence or absence of the leading delimiter is what should be
-used to determine whether a particular name is for a subkey or a
-value, not the presence or absence of a trailing delimiter.
-
-Once you request this information, it is cached in the object and
-future requests will always return the same list unless C<Flush()>
-has been called.
-
-=item Information
-
-=item %info= $key->Information
-
-=item @items= $key->Information( @itemNames );
-
-Returns the following information about a Registry key:
-
-=over
-
-=item LastWrite
-
-A C<FILETIME> structure indicating when the key was last modified
-and packed into a Perl string.
-
-=item CntSubKeys
-
-The number of subkeys stored directly in this key.
-
-=item CntValues
-
-The number of values stored directly in this key.
-
-=item SecurityLen
-
-The length [in bytes] of the largest[?] C<SECURITY_DESCRIPTOR>
-associated with the Registry key.
-
-=item MaxValDataLen
-
-The length [in bytes] of the longest value data associated with
-a value stored in this key.
-
-=item MaxSubKeyLen
-
-The length [in chars] of the longest subkey name associated with
-a subkey stored in this key.
-
-=item MaxSubClassLen
-
-The length [in chars] of the longest class name associated with
-a subkey stored directly in this key.
-
-=item MaxValNameLen
-
-The length [in chars] of the longest value name associated with
-a value stored in this key.
-
-=back
-
-With no arguments, returns a hash [not a reference to a hash] where
-the keys are the names for the items given above and the values
-are the information describe above. For example:
-
- %info= ( "CntValues" => 25, # Key contains 25 values.
- "MaxValNameLen" => 20, # One of which has a 20-char name.
- "MaxValDataLen" => 42, # One of which has a 42-byte value.
- "CntSubKeys" => 1, # Key has 1 immediate subkey.
- "MaxSubKeyLen" => 13, # One of which has a 12-char name.
- "MaxSubClassLen" => 0, # All of which have class names of "".
- "SecurityLen" => 232, # One SECURITY_DESCRIPTOR is 232 bytes.
- "LastWrite" => "\x90mZ\cX{\xA3\xBD\cA\c@\cA"
- # Key was last modifed 1998/06/01 16:29:32 GMT
- );
-
-With arguments, each one must be the name of a item given above.
-The return value is the information associated with the listed
-names. In other words:
-
- return $key->Information( @names );
-
-returns the same list as:
-
- %info= $key->Information;
- return @info{@names};
-
-=item Delimiter
-
-=item $oldDelim= $key->Delimiter
-
-=item $oldDelim= $key->Delimiter( $newDelim )
-
-Gets and possibly changes the delimiter used for this object. The
-delimiter is appended to subkey names and prepended to value names
-in many return values. It is also used when parsing keys passed
-to tied hashes.
-
-The delimiter defaults to backslash (C<'\\'>) but is inherited from
-the object used to create a new object and can be specified by an
-option when a new object is created.
-
-=item Handle
-
-=item $handle= $key->Handle
-
-Returns the raw C<HKEY> handle for the associated Registry key as
-an integer value. This value can then be used to Reg*() calls
-from I<Win32API::Registry>. However, it is usually easier to just
-call the I<Win32API::Registry> calls directly via:
-
- $key->RegNotifyChangeKeyValue( ... );
-
-For the virtual root of the local or a remote Registry,
-C<Handle()> return C<"NONE">.
-
-=item Path
-
-=item $path= $key->Path
-
-Returns a string describing the path of key names to this
-Registry key. The string is built so that if it were passed
-to C<$Registry->Open()>, it would reopen the same Registry key
-[except in the rare case where one of the key names contains
-C<$key->Delimiter>].
-
-=item Machine
-
-=item $computerName= $key->Machine
-
-Returns the name of the computer [or "machine"] on which this Registry
-key resides. Returns C<""> for local Registry keys.
-
-=item Access
-
-Returns the numeric value of the bit mask used to specify the
-types of access requested when this Registry key was opened. Can
-be compared to C<KEY_*> values.
-
-=item OS_Delimiter
-
-Returns the delimiter used by the operating system's RegOpenKeyEx()
-call. For Win32, this is always backslash (C<"\\">).
-
-=item Roots
-
-Returns the mapping from root key names like C<"LMachine"> to their
-associated C<HKEY_*> constants. Primarily for internal use and
-subject to change.
-
-=item Tie
-
-=item $key->Tie( \%hash );
-
-Ties the referenced hash to that Registry key. Pretty much the
-same as
-
- tie %hash, ref($key), $key;
-
-Since C<ref($key)> is the class [package] to tie the hash to and
-C<TIEHASH()> just returns its argument, C<$key>, [without calling
-C<new()>] when it sees that it is already a blessed object.
-
-=item TiedRef
-
-=item $TiedHashRef= $hash_or_obj_ref->TiedRef
-
-For a simple object, returns a reference to a hash tied to the
-object. Used to promote a simple object into a combined object
-and hash ref.
-
-If already a reference to a tied hash [that is also an object],
-it just returns itself [C<$ref == $ref->TiedRef>].
-
-Mostly used internally.
-
-=item ArrayValues
-
-=item $oldBool= $key->ArrayValues
-
-=item $oldBool= $key->ArrayValues( $newBool )
-
-Gets the current setting of the C<ArrayValues> option and possibly
-turns it on or off.
-
-When off, Registry values fetched via a tied hash are returned as
-just a value scalar [the same as C<GetValue()> in a scalar context].
-When on, they are returned as a reference to an array containing
-the value data as the C<[0]> element and the data type as the C<[1]>
-element.
-
-=item TieValues
-
-=item $oldBool= TieValues
-
-=item $oldBool= TieValues( $newBool )
-
-Gets the current setting of the C<TieValues> option and possibly
-turns it on or off.
-
-Turning this option on is not yet supported in this release of
-I<Win32::TieRegistry>. In a future release, turning this option
-on will cause Registry values returned from a tied hash to be
-a tied array that you can use to modify the value in the Registry.
-
-=item FastDelete
-
-=item $oldBool= $key->FastDelete
-
-=item $oldBool= $key->FastDelete( $newBool )
-
-Gets the current setting of the C<FastDelete> option and possibly
-turns it on or off.
-
-When on, successfully deleting a Registry key [via a tied hash]
-simply returns C<1>.
-
-When off, successfully deleting a Registry key [via a tied hash
-and not in a void context] returns a reference to a hash that
-contains the values present in the key when it was deleted. This
-hash is just like that returned when referencing the key before it
-was deleted except that it is an ordinary hash, not one tied to
-the I<Win32::TieRegistry> package.
-
-Note that deleting either a Registry key or value via a tied hash
-I<in a void context> prevents any overhead in trying to build an
-appropriate return value.
-
-Note that deleting a Registry I<value> via a tied hash [not in
-a void context] returns the value data even if <FastDelete> is on.
-
-=item SplitMultis
-
-=item $oldBool= $key->SplitMultis
-
-=item $oldBool= $key->SplitMultis( $newBool )
-
-Gets the current setting of the C<SplitMultis> option and possibly
-turns it on or off.
-
-If on, Registry values of type C<REG_MULTI_SZ> are returned as
-a reference to an array of strings. See C<GetValue()> for more
-information.
-
-=item DWordsToHex
-
-=item $oldBool= $key->DWordsToHex
-
-=item $oldBool= $key->DWordsToHex( $newBool )
-
-Gets the current setting of the C<DWordsToHex> option and possibly
-turns it on or off.
-
-If on, Registry values of type C<REG_DWORD> are returned as a hex
-string with leading C<"0x"> and longer than 4 characters. See
-C<GetValue()> for more information.
-
-=item FixSzNulls
-
-=item $oldBool= $key->FixSzNulls
-
-=item $oldBool= $key->FixSzNulls( $newBool )
-
-Gets the current setting of the C<FixSzNulls> option and possibly
-turns it on or off.
-
-If on, Registry values of type C<REG_SZ> and C<REG_EXPAND_SZ> have
-trailing C<'\0'>s added before they are set and stripped before
-they are returned. See C<GetValue()> and C<SetValue()> for more
-information.
-
-=item DualTypes
-
-=item $oldBool= $key->DualTypes
-
-=item $oldBool= $key->DualTypes( $newBool )
-
-Gets the current setting of the C<DualTypes> option and possibly
-turns it on or off.
-
-If on, data types are returned as a combined numeric/string value
-holding both the numeric value of a C<REG_*> constant and the
-string value of the constant's name. See C<GetValue()> for
-more information.
-
-=item DualBinVals
-
-=item $oldBool= $key->DualBinVals
-
-=item $oldBool= $key->DualBinVals( $newBool )
-
-Gets the current setting of the C<DualBinVals> option and possibly
-turns it on or off.
-
-If on, Registry value data of type C<REG_BINARY> and no more than
-4 bytes long and Registry values of type C<REG_DWORD> are returned
-as a combined numeric/string value where the numeric value is the
-"unpacked" binary value as returned by:
-
- hex reverse unpack( "h*", $valData )
-
-on a "little-endian" computer. [Would be C<hex unpack("H*",$valData)>
-on a "big-endian" computer if this module is ever ported to one.]
-
-See C<GetValue()> for more information.
-
-=item GetOptions
-
-=item @oldOptValues= $key->GetOptions( @optionNames )
-
-=item $refHashOfOldOpts= $key->GetOptions()
-
-=item $key->GetOptions( \%hashForOldOpts )
-
-Returns the current setting of any of the following options:
-
- Delimiter FixSzNulls DWordsToHex
- ArrayValues SplitMultis DualBinVals
- TieValues FastDelete DualTypes
-
-Pass in one or more of the above names (as strings) to get back
-an array of the corresponding current settings in the same order:
-
- my( $fastDel, $delim )= $key->GetOptions("FastDelete","Delimiter");
-
-Pass in no arguments to get back a reference to a hash where
-the above option names are the keys and the values are
-the corresponding current settings for each option:
-
- my $href= $key->GetOptions();
- my $delim= $href->{Delimiter};
-
-Pass in a single reference to a hash to have the above key/value
-pairs I<added> to the referenced hash. For this case, the
-return value is the original object so further methods can be
-chained after the call to GetOptions:
-
- my %oldOpts;
- $key->GetOptions( \%oldOpts )->SetOptions( Delimiter => "/" );
-
-=item SetOptions
-
-=item @oldOpts= $key->SetOptions( optNames=>$optValue,... )
-
-Changes the current setting of any of the following options,
-returning the previous setting(s):
-
- Delimiter FixSzNulls DWordsToHex AllowLoad
- ArrayValues SplitMultis DualBinVals AllowSave
- TieValues FastDelete DualTypes
-
-For C<AllowLoad> and C<AllowSave>, instead of the previous
-setting, C<SetOptions> returns whether or not the change was
-successful.
-
-In a scalar context, returns only the last item. The last
-option can also be specified as C<"ref"> or C<"r"> [which doesn't
-need to be followed by a value] to allow chaining:
-
- $key->SetOptions(AllowSave=>1,"ref")->RegSaveKey(...)
-
-=item SetValue
-
-=item $okay= $key->SetValue( $ValueName, $ValueData );
-
-=item $okay= $key->SetValue( $ValueName, $ValueData, $ValueType );
-
-Adds or replaces a Registry value. Returns a true value if
-successfully, false otherwise.
-
-C<$ValueName> is the name of the value to add or replace and
-should I<not> have a delimiter prepended to it. Case is ignored.
-
-C<$ValueType> is assumed to be C<REG_SZ> if it is omitted. Otherwise,
-it should be one the C<REG_*> constants.
-
-C<$ValueData> is the data to be stored in the value, probably packed
-into a Perl string. Other supported formats for value data are
-listed below for each posible C<$ValueType>.
-
-=over
-
-=item REG_SZ or REG_EXPAND_SZ
-
-The only special processing for these values is the addition of
-the required trailing C<'\0'> if it is missing. This can be
-turned off by disabling the C<FixSzNulls> option.
-
-=item REG_MULTI_SZ
-
-These values can also be specified as a reference to a list of
-strings. For example, the following two lines are equivalent:
-
- $key->SetValue( "Val1\000Value2\000LastVal\000\000", "REG_MULTI_SZ" );
- $key->SetValue( ["Val1","Value2","LastVal"], "REG_MULTI_SZ" );
-
-Note that if the required two trailing nulls (C<"\000\000">) are
-missing, then this release of C<SetValue()> will I<not> add them.
-
-=item REG_DWORD
-
-These values can also be specified as a hex value with the leading
-C<"0x"> included and totaling I<more than> 4 bytes. These will be
-packed into a 4-byte string via:
-
- $data= pack( "L", hex($data) );
-
-=item REG_BINARY
-
-This value type is listed just to emphasize that no alternate
-format is supported for it. In particular, you should I<not> pass
-in a numeric value for this type of data. C<SetValue()> cannot
-distinguish such from a packed string that just happens to match
-a numeric value and so will treat it as a packed string.
-
-=back
-
-An alternate calling format:
-
- $okay= $key->SetValue( $ValueName, [ $ValueData, $ValueType ] );
-
-[two arguments, the second of which is a reference to an array
-containing the value data and value type] is supported to ease
-using tied hashes with C<SetValue()>.
-
-=item CreateKey
-
-=item $newKey= $key->CreateKey( $subKey );
-
-=item $newKey= $key->CreateKey( $subKey, { Option=>OptVal,... } );
-
-Creates a Registry key or just updates attributes of one. Calls
-C<RegCreateKeyEx()> then, if it succeeded, creates an object
-associated with the [possibly new] subkey.
-
-C<$subKey> is the name of a subkey [or a path to one] to be
-created or updated. It can also be a reference to an array
-containing a list of subkey names.
-
-The second argument, if it exists, should be a reference to a
-hash specifying options either to be passed to C<RegCreateKeyEx()>
-or to be used when creating the associated object. The following
-items are the supported keys for this options hash:
-
-=over
-
-=item Delimiter
-
-Specifies the delimiter to be used to parse C<$subKey> and to be
-used in the new object. Defaults to C<$key->Delimiter>.
-
-=item Access
-
-Specifies the types of access requested when the subkey is opened.
-Should be a numeric bit mask that combines one or more C<KEY_*>
-constant values.
-
-=item Class
-
-The name to assign as the class of the new or updated subkey.
-Defaults to C<""> as we have never seen a use for this information.
-
-=item Disposition
-
-Lets you specify a reference to a scalar where, upon success, will be
-stored either C<REG_CREATED_NEW_KEY()> or C<REG_OPENED_EXISTING_KEY()>
-depending on whether a new key was created or an existing key was
-opened.
-
-If you, for example, did C<use Win32::TieRegistry qw(REG_CREATED_NEW_KEY)>
-then you can use C<REG_CREATED_NEW_KEY()> to compare against the numeric
-value stored in the referenced scalar.
-
-If the C<DualTypes> option is enabled, then in addition to the
-numeric value described above, the referenced scalar will also
-have a string value equal to either C<"REG_CREATED_NEW_KEY"> or
-C<"REG_OPENED_EXISTING_KEY">, as appropriate.
-
-=item Security
-
-Lets you specify a C<SECURITY_ATTRIBUTES> structure packed into a
-Perl string. See C<Win32API::Registry::RegCreateKeyEx()> for more
-information.
-
-=item Volatile
-
-If true, specifies that the new key should be volatile, that is,
-stored only in memory and not backed by a hive file [and not saved
-if the computer is rebooted]. This option is ignored under
-Windows 95. Specifying C<Volatile=E<gt>1> is the same as
-specifying C<Options=E<gt>REG_OPTION_VOLATILE>.
-
-=item Backup
-
-If true, specifies that the new key should be opened for
-backup/restore access. The C<Access> option is ignored. If the
-calling process has enabled C<"SeBackupPrivilege">, then the
-subkey is opened with C<KEY_READ> access as the C<"LocalSystem">
-user which should have access to all subkeys. If the calling
-process has enabled C<"SeRestorePrivilege">, then the subkey is
-opened with C<KEY_WRITE> access as the C<"LocalSystem"> user which
-should have access to all subkeys.
-
-This option is ignored under Windows 95. Specifying C<Backup=E<gt>1>
-is the same as specifying C<Options=E<gt>REG_OPTION_BACKUP_RESTORE>.
-
-=item Options
-
-Lets you specify options to the C<RegOpenKeyEx()> call. The value
-for this option should be a numeric value combining zero or more
-of the C<REG_OPTION_*> bit masks. You may with to used the
-C<Volatile> and/or C<Backup> options instead of this one.
-
-=back
-
-=item StoreKey
-
-=item $newKey= $key->StoreKey( $subKey, \%Contents );
-
-Primarily for internal use.
-
-Used to create or update a Registry key and any number of subkeys
-or values under it or its subkeys.
-
-C<$subKey> is the name of a subkey to be created [or a path of
-subkey names separated by delimiters]. If that subkey already
-exists, then it is updated.
-
-C<\%Contents> is a reference to a hash containing pairs of
-value names with value data and/or subkey names with hash
-references similar to C<\%Contents>. Each of these cause
-a value or subkey of C<$subKey> to be created or updated.
-
-If C<$Contents{""}> exists and is a reference to a hash, then
-it used as the options argument when C<CreateKey()> is called
-for C<$subKey>. This allows you to specify ...
-
- if( defined( $$data{""} ) && "HASH" eq ref($$data{""}) ) {
- $self= $this->CreateKey( $subKey, delete $$data{""} );
-
-=item Load
-
-=item $newKey= $key->Load( $file )
-
-=item $newKey= $key->Load( $file, $newSubKey )
-
-=item $newKey= $key->Load( $file, $newSubKey, { Option=>OptVal... } )
-
-=item $newKey= $key->Load( $file, { Option=>OptVal... } )
-
-Loads a hive file into a Registry. That is, creates a new subkey
-and associates a hive file with it.
-
-C<$file> is a hive file, that is a file created by calling
-C<RegSaveKey()>. The C<$file> path is interpreted relative to
-C<%SystemRoot%/System32/config> on the machine where C<$key>
-resides.
-
-C<$newSubKey> is the name to be given to the new subkey. If
-C<$newSubKey> is specified, then C<$key> must be
-C<HKEY_LOCAL_MACHINE> or C<HKEY_USERS> of the local computer
-or a remote computer and C<$newSubKey> should not contain any
-occurrences of either the delimiter or the OS delimiter.
-
-If C<$newSubKey> is not specified, then it is as if C<$key>
-was C<$Registry-E<gt>{LMachine}> and C<$newSubKey> is
-C<"PerlTie:999"> where C<"999"> is actually a sequence number
-incremented each time this process calls C<Load()>.
-
-You can specify as the last argument a reference to a hash
-containing options. You can specify the same options that you
-can specify to C<Open()>. See C<Open()> for more information on
-those. In addition, you can specify the option C<"NewSubKey">.
-The value of this option is interpretted exactly as if it was
-specified as the C<$newSubKey> parameter and overrides the
-C<$newSubKey> if one was specified.
-
-The hive is automatically unloaded when the returned object
-[C<$newKey>] is destroyed. Registry key objects opened within
-the hive will keep a reference to the C<$newKey> object so that
-it will not be destroyed before these keys are closed.
-
-=item UnLoad
-
-=item $okay= $key->UnLoad
-
-Unloads a hive that was loaded via C<Load()>. Cannot unload other
-hives. C<$key> must be the return from a previous call to C<Load()>.
-C<$key> is closed and then the hive is unloaded.
-
-=item AllowSave
-
-=item $okay= AllowSave( $bool )
-
-Enables or disables the C<"ReBackupPrivilege"> privilege for the
-current process. You will probably have to enable this privilege
-before you can use C<RegSaveKey()>.
-
-The return value indicates whether the operation succeeded, not
-whether the privilege was previously enabled.
-
-=item AllowLoad
-
-=item $okay= AllowLoad( $bool )
-
-Enables or disables the C<"ReRestorePrivilege"> privilege for the
-current process. You will probably have to enable this privilege
-before you can use C<RegLoadKey()>, C<RegUnLoadKey()>,
-C<RegReplaceKey()>, or C<RegRestoreKey> and thus C<Load()> and
-C<UnLoad()>.
-
-The return value indicates whether the operation succeeded, not
-whether the privilege was previously enabled.
-
-=back
-
-=head2 Exports [C<use> and C<import()>]
-
-To have nothing imported into your package, use something like:
-
- use Win32::TieRegistry 0.20 ();
-
-which would verify that you have at least version 0.20 but wouldn't
-call C<import()>. The F<Changes> file can be useful in figuring out
-which, if any, prior versions of I<Win32::TieRegistry> you want to
-support in your script.
-
-The code
-
- use Win32::TieRegistry;
-
-imports the variable C<$Registry> into your package and sets it
-to be a reference to a hash tied to a copy of the master Registry
-virtual root object with the default options. One disadvantage
-to this "default" usage is that Perl does not support checking
-the module version when you use it.
-
-Alternately, you can specify a list of arguments on the C<use>
-line that will be passed to the C<Win32::TieRegistry->import()>
-method to control what items to import into your package. These
-arguments fall into the following broad categories:
-
-=over
-
-=item Import a reference to a hash tied to a Registry virtual root
-
-You can request that a scalar variable be imported (possibly)
-and set to be a reference to a hash tied to a Registry virtual root
-using any of the following types of arguments or argument pairs:
-
-=over
-
-=item "TiedRef", '$scalar'
-
-=item "TiedRef", '$pack::scalar'
-
-=item "TiedRef", 'scalar'
-
-=item "TiedRef", 'pack::scalar'
-
-All of the above import a scalar named C<$scalar> into your package
-(or the package named "pack") and then sets it.
-
-=item '$scalar'
-
-=item '$pack::scalar'
-
-These are equivalent to the previous items to support a more
-traditional appearance to the list of exports. Note that the
-scalar name cannot be "RegObj" here.
-
-=item "TiedRef", \$scalar
-
-=item \$scalar
-
-These versions don't import anything but set the referenced C<$scalar>.
-
-=back
-
-=item Import a hash tied to the Registry virtual root
-
-You can request that a hash variable be imported (possibly)
-and tied to a Registry virtual root using any of the following
-types of arguments or argument pairs:
-
-=over
-
-=item "TiedHash", '%hash'
-
-=item "TiedHash", '%pack::hash'
-
-=item "TiedHash", 'hash'
-
-=item "TiedHash", 'pack::hash'
-
-All of the above import a hash named C<%hash> into your package
-(or the package named "pack") and then sets it.
-
-=item '%hash'
-
-=item '%pack::hash'
-
-These are equivalent to the previous items to support a more
-traditional appearance to the list of exports.
-
-=item "TiedHash", \%hash
-
-=item \%hash
-
-These versions don't import anything but set the referenced C<%hash>.
-
-=back
-
-=item Import a Registry virtual root object
-
-You can request that a scalar variable be imported (possibly)
-and set to be a Registry virtual root object using any of the
-following types of arguments or argument pairs:
-
-=over
-
-=item "ObjectRef", '$scalar'
-
-=item "ObjectRef", '$pack::scalar'
-
-=item "ObjectRef", 'scalar'
-
-=item "ObjectRef", 'pack::scalar'
-
-All of the above import a scalar named C<$scalar> into your package
-(or the package named "pack") and then sets it.
-
-=item '$RegObj'
-
-This is equivalent to the previous items for backward compatibility.
-
-=item "ObjectRef", \$scalar
-
-This version doesn't import anything but sets the referenced C<$scalar>.
-
-=back
-
-=item Import constant(s) exported by I<Win32API::Registry>
-
-You can list any constants that are exported by I<Win32API::Registry>
-to have them imported into your package. These constants have names
-starting with "KEY_" or "REG_" (or even "HKEY_").
-
-You can also specify C<":KEY_">, C<":REG_">, and even C<":HKEY_"> to
-import a whole set of constants.
-
-See I<Win32API::Registry> documentation for more information.
-
-=item Options
-
-You can list any option names that can be listed in the C<SetOptions()>
-method call, each folowed by the value to use for that option.
-A Registry virtual root object is created, all of these options are
-set for it, then each variable to be imported/set is associated with
-this object.
-
-In addition, the following special options are supported:
-
-=over
-
-=item ExportLevel
-
-Whether to import variables into your package or some
-package that uses your package. Defaults to the value of
-C<$Exporter::ExportLevel> and has the same meaning. See
-the L<Exporter> module for more information.
-
-=item ExportTo
-
-The name of the package to import variables and constants into.
-Overrides I<ExportLevel>.
-
-=back
-
-=back
-
-=head3 Specifying constants in your Perl code
-
-This module was written with a strong emphasis on the convenience of
-the module user. Therefore, most places where you can specify a
-constant like C<REG_SZ()> also allow you to specify a string
-containing the name of the constant, C<"REG_SZ">. This is convenient
-because you may not have imported that symbolic constant.
-
-Perl also emphasizes programmer convenience so the code C<REG_SZ>
-can be used to mean C<REG_SZ()> or C<"REG_SZ"> or be illegal.
-Note that using C<&REG_SZ> (as we've seen in much Win32 Perl code)
-is not a good idea since it passes the current C<@_> to the
-C<constant()> routine of the module which, at the least, can give
-you a warning under B<-w>.
-
-Although greatly a matter of style, the "safest" practice is probably
-to specifically list all constants in the C<use Win32::TieRegistry>
-statement, specify C<use strict> [or at least C<use strict qw(subs)>],
-and use bare constant names when you want the numeric value. This will
-detect mispelled constant names at compile time.
-
- use strict;
- my $Registry;
- use Win32::TieRegistry 0.20 (
- TiedRef => \$Registry, Delimiter => "/", ArrayValues => 1,
- SplitMultis => 1, AllowLoad => 1,
- qw( REG_SZ REG_EXPAND_SZ REG_DWORD REG_BINARY REG_MULTI_SZ
- KEY_READ KEY_WRITE KEY_ALL_ACCESS ),
- );
- $Registry->{"LMachine/Software/FooCorp/"}= {
- "FooWriter/" => {
- "/Fonts" => [ ["Times","Courier","Lucinda"], REG_MULTI_SZ ],
- "/WindowSize" => [ pack("LL",24,80), REG_BINARY ],
- "/TaskBarIcon" => [ "0x0001", REG_DWORD ],
- },
- } or die "Can't create Software/FooCorp/: $^E\n";
-
-If you don't want to C<use strict qw(subs)>, the second safest practice
-is similar to the above but use the C<REG_SZ()> form for constants
-when possible and quoted constant names when required. Note that
-C<qw()> is a form of quoting.
-
- use Win32::TieRegistry 0.20 qw(
- TiedRef $Registry
- Delimiter / ArrayValues 1 SplitMultis 1 AllowLoad 1
- REG_SZ REG_EXPAND_SZ REG_DWORD REG_BINARY REG_MULTI_SZ
- KEY_READ KEY_WRITE KEY_ALL_ACCESS
- );
- $Registry->{"LMachine/Software/FooCorp/"}= {
- "FooWriter/" => {
- "/Fonts" => [ ["Times","Courier","Lucinda"], REG_MULTI_SZ() ],
- "/WindowSize" => [ pack("LL",24,80), REG_BINARY() ],
- "/TaskBarIcon" => [ "0x0001", REG_DWORD() ],
- },
- } or die "Can't create Software/FooCorp/: $^E\n";
-
-The examples in this document mostly use quoted constant names
-(C<"REG_SZ">) since that works regardless of which constants
-you imported and whether or not you have C<use strict> in your
-script. It is not the best choice for you to use for real
-scripts (vs. examples) because it is less efficient and is not
-supported by most other similar modules.
-
-=head1 SUMMARY
-
-Most things can be done most easily via tied hashes. Skip down to the
-the L<Tied Hashes Summary> to get started quickly.
-
-=head2 Objects Summary
-
-Here are quick examples that document the most common functionality
-of all of the method functions [except for a few almost useless ones].
-
- # Just another way of saying Open():
- $key= new Win32::TieRegistry "LMachine\\Software\\",
- { Access=>KEY_READ()|KEY_WRITE(), Delimiter=>"\\" };
-
- # Open a Registry key:
- $subKey= $key->Open( "SubKey/SubSubKey/",
- { Access=>KEY_ALL_ACCESS, Delimiter=>"/" } );
-
- # Connect to a remote Registry key:
- $remKey= $Registry->Connect( "MachineName", "LMachine/",
- { Access=>KEY_READ, Delimiter=>"/" } );
-
- # Get value data:
- $valueString= $key->GetValue("ValueName");
- ( $valueString, $valueType )= $key->GetValue("ValueName");
-
- # Get list of value names:
- @valueNames= $key->ValueNames;
-
- # Get list of subkey names:
- @subKeyNames= $key->SubKeyNames;
-
- # Get combined list of value names (with leading delimiters)
- # and subkey names (with trailing delimiters):
- @memberNames= $key->MemberNames;
-
- # Get all information about a key:
- %keyInfo= $key->Information;
- # keys(%keyInfo)= qw( Class LastWrite SecurityLen
- # CntSubKeys MaxSubKeyLen MaxSubClassLen
- # CntValues MaxValNameLen MaxValDataLen );
-
- # Get selected information about a key:
- ( $class, $cntSubKeys )= $key->Information( "Class", "CntSubKeys" );
-
- # Get and/or set delimiter:
- $delim= $key->Delimiter;
- $oldDelim= $key->Delimiter( $newDelim );
-
- # Get "path" for an open key:
- $path= $key->Path;
- # For example, "/CUser/Control Panel/Mouse/"
- # or "//HostName/LMachine/System/DISK/".
-
- # Get name of machine where key is from:
- $mach= $key->Machine;
- # Will usually be "" indicating key is on local machine.
-
- # Control different options (see main documentation for descriptions):
- $oldBool= $key->ArrayValues( $newBool );
- $oldBool= $key->FastDelete( $newBool );
- $oldBool= $key->FixSzNulls( $newBool );
- $oldBool= $key->SplitMultis( $newBool );
- $oldBool= $key->DWordsToHex( $newBool );
- $oldBool= $key->DualBinVals( $newBool );
- $oldBool= $key->DualTypes( $newBool );
- @oldBools= $key->SetOptions( ArrayValues=>1, FastDelete=>1, FixSzNulls=>0,
- Delimiter=>"/", AllowLoad=>1, AllowSave=>1 );
- @oldBools= $key->GetOptions( ArrayValues, FastDelete, FixSzNulls );
-
- # Add or set a value:
- $key->SetValue( "ValueName", $valueDataString );
- $key->SetValue( "ValueName", pack($format,$valueData), "REG_BINARY" );
-
- # Add or set a key:
- $key->CreateKey( "SubKeyName" );
- $key->CreateKey( "SubKeyName",
- { Access=>"KEY_ALL_ACCESS", Class=>"ClassName",
- Delimiter=>"/", Volatile=>1, Backup=>1 } );
-
- # Load an off-line Registry hive file into the on-line Registry:
- $newKey= $Registry->Load( "C:/Path/To/Hive/FileName" );
- $newKey= $key->Load( "C:/Path/To/Hive/FileName", "NewSubKeyName",
- { Access=>"KEY_READ" } );
- # Unload a Registry hive file loaded via the Load() method:
- $newKey->UnLoad;
-
- # (Dis)Allow yourself to load Registry hive files:
- $success= $Registry->AllowLoad( $bool );
-
- # (Dis)Allow yourself to save a Registry key to a hive file:
- $success= $Registry->AllowSave( $bool );
-
- # Save a Registry key to a new hive file:
- $key->RegSaveKey( "C:/Path/To/Hive/FileName", [] );
-
-=head3 Other Useful Methods
-
-See I<Win32API::Registry> for more information on these methods.
-These methods are provided for coding convenience and are
-identical to the I<Win32API::Registry> functions except that these
-don't take a handle to a Registry key, instead getting the handle
-from the invoking object [C<$key>].
-
- $key->RegGetKeySecurity( $iSecInfo, $sSecDesc, $lenSecDesc );
- $key->RegLoadKey( $sSubKeyName, $sPathToFile );
- $key->RegNotifyChangeKeyValue(
- $bWatchSubtree, $iNotifyFilter, $hEvent, $bAsync );
- $key->RegQueryMultipleValues(
- $structValueEnts, $cntValueEnts, $Buffer, $lenBuffer );
- $key->RegReplaceKey( $sSubKeyName, $sPathToNewFile, $sPathToBackupFile );
- $key->RegRestoreKey( $sPathToFile, $iFlags );
- $key->RegSetKeySecurity( $iSecInfo, $sSecDesc );
- $key->RegUnLoadKey( $sSubKeyName );
-
-=head2 Tied Hashes Summary
-
-For fast learners, this may be the only section you need to read.
-Always append one delimiter to the end of each Registry key name
-and prepend one delimiter to the front of each Registry value name.
-
-=head3 Opening keys
-
- use Win32::TieRegistry ( Delimiter=>"/", ArrayValues=>1 );
- $Registry->Delimiter("/"); # Set delimiter to "/".
- $swKey= $Registry->{"LMachine/Software/"};
- $winKey= $swKey->{"Microsoft/Windows/CurrentVersion/"};
- $userKey= $Registry->
- {"CUser/Software/Microsoft/Windows/CurrentVersion/"};
- $remoteKey= $Registry->{"//HostName/LMachine/"};
-
-=head3 Reading values
-
- $progDir= $winKey->{"/ProgramFilesDir"}; # "C:\\Program Files"
- $tip21= $winKey->{"Explorer/Tips//21"}; # Text of tip #21.
-
- $winKey->ArrayValues(1);
- ( $devPath, $type )= $winKey->{"/DevicePath"};
- # $devPath eq "%SystemRoot%\\inf"
- # $type eq "REG_EXPAND_SZ" [if you have SetDualVar.pm installed]
- # $type == REG_EXPAND_SZ() [if did C<use Win32::TieRegistry qw(:REG_)>]
-
-=head3 Setting values
-
- $winKey->{"Setup//SourcePath"}= "\\\\SwServer\\SwShare\\Windows";
- # Simple. Assumes data type of REG_SZ.
-
- $winKey->{"Setup//Installation Sources"}=
- [ "D:\x00\\\\SwServer\\SwShare\\Windows\0\0", "REG_MULTI_SZ" ];
- # "\x00" and "\0" used to mark ends of each string and end of list.
-
- $winKey->{"Setup//Installation Sources"}=
- [ ["D:","\\\\SwServer\\SwShare\\Windows"], "REG_MULTI_SZ" ];
- # Alternate method that is easier to read.
-
- $userKey->{"Explorer/Tips//DisplayInitialTipWindow"}=
- [ pack("L",0), "REG_DWORD" ];
- $userKey->{"Explorer/Tips//Next"}= [ pack("S",3), "REG_BINARY" ];
- $userKey->{"Explorer/Tips//Show"}= [ pack("L",0), "REG_BINARY" ];
-
-=head3 Adding keys
-
- $swKey->{"FooCorp/"}= {
- "FooWriter/" => {
- "/Version" => "4.032",
- "Startup/" => {
- "/Title" => "Foo Writer Deluxe ][",
- "/WindowSize" => [ pack("LL",$wid,$ht), "REG_BINARY" ],
- "/TaskBarIcon" => [ "0x0001", "REG_DWORD" ],
- },
- "Compatibility/" => {
- "/AutoConvert" => "Always",
- "/Default Palette" => "Windows Colors",
- },
- },
- "/License", => "0123-9C8EF1-09-FC",
- };
-
-=head3 Listing all subkeys and values
-
- @members= keys( %{$swKey} );
- @subKeys= grep( m#^/#, keys( %{$swKey->{"Classes/batfile/"}} ) );
- # @subKeys= ( "/", "/EditFlags" );
- @valueNames= grep( ! m#^/#, keys( %{$swKey->{"Classes/batfile/"}} ) );
- # @valueNames= ( "DefaultIcon/", "shell/", "shellex/" );
-
-=head3 Deleting values or keys with no subkeys
-
- $oldValue= delete $userKey->{"Explorer/Tips//Next"};
-
- $oldValues= delete $userKey->{"Explorer/Tips/"};
- # $oldValues will be reference to hash containing deleted keys values.
-
-=head3 Closing keys
-
- undef $swKey; # Explicit way to close a key.
- $winKey= "Anything else"; # Implicitly closes a key.
- exit 0; # Implicitly closes all keys.
-
-=head2 Tie::Registry
-
-This module was originally called I<Tie::Registry>. Changing code
-that used I<Tie::Registry> over to I<Win32::TieRegistry> is trivial
-as the module name should only be mentioned once, in the C<use>
-line. However, finding all of the places that used I<Tie::Registry>
-may not be completely trivial so we have included F<Tie/Registry.pm>
-which you can install to provide backward compatibility.
-
-=head1 AUTHOR
-
-Tye McQueen. See http://www.metronet.com/~tye/ or e-mail
-tye@metronet.com with bug reports.
-
-=head1 SEE ALSO
-
-I<Win32API::Registry> - Provides access to C<Reg*()>, C<HKEY_*>,
-C<KEY_*>, C<REG_*> [required].
-
-I<Win32::WinError> - Defines C<ERROR_*> values [optional].
-
-L<SetDualVar> - For returning C<REG_*> values as combined
-string/integer values [optional].
-
-=head1 BUGS
-
-Perl5.004_02 has bugs that make I<Win32::TieRegistry> fail in
-strange and subtle ways.
-
-Using I<Win32::TieRegistry> with versions of Perl prior to 5.005
-can be tricky or impossible. Most notes about this have been
-removed from the documentation (they get rather complicated
-and confusing). This includes references to C<$^E> perhaps not
-being meaningful.
-
-Because Perl hashes are case sensitive, certain lookups are also
-case sensistive. In particular, the root keys ("Classes", "CUser",
-"LMachine", "Users", "PerfData", "CConfig", "DynData", and HKEY_*)
-must always be entered without changing between upper and lower
-case letters. Also, the special rule for matching subkey names
-that contain the user-selected delimiter only works if case is
-matched. All other key name and value name lookups should be case
-insensitive because the underlying Reg*() calls ignore case.
-
-Information about each key is cached when using a tied hash.
-This cache is not flushed nor updated when changes are made,
-I<even when the same tied hash is used> to make the changes.
-
-Current implementations of Perl's "global destruction" phase can
-cause objects returned by C<Load()> to be destroyed while keys
-within the hive are still open, if the objects still exist when
-the script starts to exit. When this happens, the automatic
-C<UnLoad()> will report a failure and the hive will remain loaded
-in the Registry.
-
-Trying to C<Load()> a hive file that is located on a remote network
-share may silently delete all data from the hive. This is a bug
-in the Win32 APIs, not any Perl code or modules. This module does
-not try to protect you from this bug.
-
-There is no test suite.
-
-=head1 FUTURE DIRECTIONS
-
-The following items are desired by the author and may appear in a
-future release of this module.
-
-=over
-
-=item TieValues option
-
-Currently described in main documentation but no yet implemented.
-
-=item AutoRefresh option
-
-Trigger use of C<RegNotifyChangeKeyValue()> to keep tied hash
-caches up-to-date even when other programs make changes.
-
-=item Error options
-
-Allow the user to have unchecked calls (calls in a "void context")
-to automatically report errors via C<warn> or C<die>.
-
-For complex operations, such a copying an entire subtree, provide
-access to detailed information about errors (and perhaps some
-warnings) that were encountered. Let the user control whether
-the complex operation continues in spite of errors.
-
-=back
-
-=head1 COPYRIGHT
-
-Copyright 1999 - 2006 Tye McQueen.
-
-Some parts copyright 2007 - 2009 Adam Kennedy.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-=cut
-
-# Autoload not currently supported by Perl under Windows.
diff --git a/Master/tlpkg/tlperl0/lib/Win32/WinError.pm b/Master/tlpkg/tlperl0/lib/Win32/WinError.pm
deleted file mode 100755
index 4ea0091685d..00000000000
--- a/Master/tlpkg/tlperl0/lib/Win32/WinError.pm
+++ /dev/null
@@ -1,1017 +0,0 @@
-package Win32::WinError;
-
-require Exporter;
-require DynaLoader;
-
-$VERSION = '0.03';
-
-@ISA = qw(Exporter DynaLoader);
-# Items to export into callers namespace by default. Note: do not export
-# names by default without a very good reason. Use EXPORT_OK instead.
-# Do not simply export all your public functions/methods/constants.
-@EXPORT = qw(
- GetLastError
- CACHE_E_FIRST
- CACHE_E_LAST
- CACHE_E_NOCACHE_UPDATED
- CACHE_S_FIRST
- CACHE_S_FORMATETC_NOTSUPPORTED
- CACHE_S_LAST
- CACHE_S_SAMECACHE
- CACHE_S_SOMECACHES_NOTUPDATED
- CLASSFACTORY_E_FIRST
- CLASSFACTORY_E_LAST
- CLASSFACTORY_S_FIRST
- CLASSFACTORY_S_LAST
- CLASS_E_CLASSNOTAVAILABLE
- CLASS_E_NOAGGREGATION
- CLIENTSITE_E_FIRST
- CLIENTSITE_E_LAST
- CLIENTSITE_S_FIRST
- CLIENTSITE_S_LAST
- CLIPBRD_E_BAD_DATA
- CLIPBRD_E_CANT_CLOSE
- CLIPBRD_E_CANT_EMPTY
- CLIPBRD_E_CANT_OPEN
- CLIPBRD_E_CANT_SET
- CLIPBRD_E_FIRST
- CLIPBRD_E_LAST
- CLIPBRD_S_FIRST
- CLIPBRD_S_LAST
- CONVERT10_E_FIRST
- CONVERT10_E_LAST
- CONVERT10_E_OLESTREAM_BITMAP_TO_DIB
- CONVERT10_E_OLESTREAM_FMT
- CONVERT10_E_OLESTREAM_GET
- CONVERT10_E_OLESTREAM_PUT
- CONVERT10_E_STG_DIB_TO_BITMAP
- CONVERT10_E_STG_FMT
- CONVERT10_E_STG_NO_STD_STREAM
- CONVERT10_S_FIRST
- CONVERT10_S_LAST
- CONVERT10_S_NO_PRESENTATION
- CO_E_ALREADYINITIALIZED
- CO_E_APPDIDNTREG
- CO_E_APPNOTFOUND
- CO_E_APPSINGLEUSE
- CO_E_BAD_PATH
- CO_E_CANTDETERMINECLASS
- CO_E_CLASSSTRING
- CO_E_CLASS_CREATE_FAILED
- CO_E_DLLNOTFOUND
- CO_E_ERRORINAPP
- CO_E_ERRORINDLL
- CO_E_FIRST
- CO_E_IIDSTRING
- CO_E_INIT_CLASS_CACHE
- CO_E_INIT_MEMORY_ALLOCATOR
- CO_E_INIT_ONLY_SINGLE_THREADED
- CO_E_INIT_RPC_CHANNEL
- CO_E_INIT_SCM_EXEC_FAILURE
- CO_E_INIT_SCM_FILE_MAPPING_EXISTS
- CO_E_INIT_SCM_MAP_VIEW_OF_FILE
- CO_E_INIT_SCM_MUTEX_EXISTS
- CO_E_INIT_SHARED_ALLOCATOR
- CO_E_INIT_TLS
- CO_E_INIT_TLS_CHANNEL_CONTROL
- CO_E_INIT_TLS_SET_CHANNEL_CONTROL
- CO_E_INIT_UNACCEPTED_USER_ALLOCATOR
- CO_E_LAST
- CO_E_NOTINITIALIZED
- CO_E_OBJISREG
- CO_E_OBJNOTCONNECTED
- CO_E_OBJNOTREG
- CO_E_OBJSRV_RPC_FAILURE
- CO_E_RELEASED
- CO_E_SCM_ERROR
- CO_E_SCM_RPC_FAILURE
- CO_E_SERVER_EXEC_FAILURE
- CO_E_SERVER_STOPPING
- CO_E_WRONGOSFORAPP
- CO_S_FIRST
- CO_S_LAST
- DATA_E_FIRST
- DATA_E_LAST
- DATA_S_FIRST
- DATA_S_LAST
- DATA_S_SAMEFORMATETC
- DISP_E_ARRAYISLOCKED
- DISP_E_BADCALLEE
- DISP_E_BADINDEX
- DISP_E_BADPARAMCOUNT
- DISP_E_BADVARTYPE
- DISP_E_EXCEPTION
- DISP_E_MEMBERNOTFOUND
- DISP_E_NONAMEDARGS
- DISP_E_NOTACOLLECTION
- DISP_E_OVERFLOW
- DISP_E_PARAMNOTFOUND
- DISP_E_PARAMNOTOPTIONAL
- DISP_E_TYPEMISMATCH
- DISP_E_UNKNOWNINTERFACE
- DISP_E_UNKNOWNLCID
- DISP_E_UNKNOWNNAME
- DRAGDROP_E_ALREADYREGISTERED
- DRAGDROP_E_FIRST
- DRAGDROP_E_INVALIDHWND
- DRAGDROP_E_LAST
- DRAGDROP_E_NOTREGISTERED
- DRAGDROP_S_CANCEL
- DRAGDROP_S_DROP
- DRAGDROP_S_FIRST
- DRAGDROP_S_LAST
- DRAGDROP_S_USEDEFAULTCURSORS
- DV_E_CLIPFORMAT
- DV_E_DVASPECT
- DV_E_DVTARGETDEVICE
- DV_E_DVTARGETDEVICE_SIZE
- DV_E_FORMATETC
- DV_E_LINDEX
- DV_E_NOIVIEWOBJECT
- DV_E_STATDATA
- DV_E_STGMEDIUM
- DV_E_TYMED
- ENUM_E_FIRST
- ENUM_E_LAST
- ENUM_S_FIRST
- ENUM_S_LAST
- EPT_S_CANT_CREATE
- EPT_S_CANT_PERFORM_OP
- EPT_S_INVALID_ENTRY
- EPT_S_NOT_REGISTERED
- ERROR_ACCESS_DENIED
- ERROR_ACCOUNT_DISABLED
- ERROR_ACCOUNT_EXPIRED
- ERROR_ACCOUNT_LOCKED_OUT
- ERROR_ACCOUNT_RESTRICTION
- ERROR_ACTIVE_CONNECTIONS
- ERROR_ADAP_HDW_ERR
- ERROR_ADDRESS_ALREADY_ASSOCIATED
- ERROR_ADDRESS_NOT_ASSOCIATED
- ERROR_ALIAS_EXISTS
- ERROR_ALLOTTED_SPACE_EXCEEDED
- ERROR_ALREADY_ASSIGNED
- ERROR_ALREADY_EXISTS
- ERROR_ALREADY_REGISTERED
- ERROR_ALREADY_RUNNING_LKG
- ERROR_ALREADY_WAITING
- ERROR_ARENA_TRASHED
- ERROR_ARITHMETIC_OVERFLOW
- ERROR_ATOMIC_LOCKS_NOT_SUPPORTED
- ERROR_AUTODATASEG_EXCEEDS_64k
- ERROR_BADDB
- ERROR_BADKEY
- ERROR_BAD_ARGUMENTS
- ERROR_BAD_COMMAND
- ERROR_BAD_DESCRIPTOR_FORMAT
- ERROR_BAD_DEVICE
- ERROR_BAD_DEV_TYPE
- ERROR_BAD_DRIVER
- ERROR_BAD_DRIVER_LEVEL
- ERROR_BAD_ENVIRONMENT
- ERROR_BAD_EXE_FORMAT
- ERROR_BAD_FORMAT
- ERROR_BAD_IMPERSONATION_LEVEL
- ERROR_BAD_INHERITANCE_ACL
- ERROR_BAD_LENGTH
- ERROR_BAD_LOGON_SESSION_STATE
- ERROR_BAD_NETPATH
- ERROR_BAD_NET_NAME
- ERROR_BAD_NET_RESP
- ERROR_BAD_PATHNAME
- ERROR_BAD_PIPE
- ERROR_BAD_PROFILE
- ERROR_BAD_PROVIDER
- ERROR_BAD_REM_ADAP
- ERROR_BAD_THREADID_ADDR
- ERROR_BAD_TOKEN_TYPE
- ERROR_BAD_UNIT
- ERROR_BAD_USERNAME
- ERROR_BAD_VALIDATION_CLASS
- ERROR_BEGINNING_OF_MEDIA
- ERROR_BOOT_ALREADY_ACCEPTED
- ERROR_BROKEN_PIPE
- ERROR_BUFFER_OVERFLOW
- ERROR_BUSY
- ERROR_BUSY_DRIVE
- ERROR_BUS_RESET
- ERROR_CALL_NOT_IMPLEMENTED
- ERROR_CANCELLED
- ERROR_CANCEL_VIOLATION
- ERROR_CANNOT_COPY
- ERROR_CANNOT_FIND_WND_CLASS
- ERROR_CANNOT_IMPERSONATE
- ERROR_CANNOT_MAKE
- ERROR_CANNOT_OPEN_PROFILE
- ERROR_CANTOPEN
- ERROR_CANTREAD
- ERROR_CANTWRITE
- ERROR_CANT_ACCESS_DOMAIN_INFO
- ERROR_CANT_DISABLE_MANDATORY
- ERROR_CANT_OPEN_ANONYMOUS
- ERROR_CAN_NOT_COMPLETE
- ERROR_CAN_NOT_DEL_LOCAL_WINS
- ERROR_CHILD_MUST_BE_VOLATILE
- ERROR_CHILD_NOT_COMPLETE
- ERROR_CHILD_WINDOW_MENU
- ERROR_CIRCULAR_DEPENDENCY
- ERROR_CLASS_ALREADY_EXISTS
- ERROR_CLASS_DOES_NOT_EXIST
- ERROR_CLASS_HAS_WINDOWS
- ERROR_CLIPBOARD_NOT_OPEN
- ERROR_CLIPPING_NOT_SUPPORTED
- ERROR_CONNECTION_ABORTED
- ERROR_CONNECTION_ACTIVE
- ERROR_CONNECTION_COUNT_LIMIT
- ERROR_CONNECTION_INVALID
- ERROR_CONNECTION_REFUSED
- ERROR_CONNECTION_UNAVAIL
- ERROR_CONTROL_ID_NOT_FOUND
- ERROR_COUNTER_TIMEOUT
- ERROR_CRC
- ERROR_CURRENT_DIRECTORY
- ERROR_DATABASE_DOES_NOT_EXIST
- ERROR_DC_NOT_FOUND
- ERROR_DEPENDENT_SERVICES_RUNNING
- ERROR_DESTROY_OBJECT_OF_OTHER_THREAD
- ERROR_DEVICE_ALREADY_REMEMBERED
- ERROR_DEVICE_IN_USE
- ERROR_DEVICE_NOT_PARTITIONED
- ERROR_DEV_NOT_EXIST
- ERROR_DIRECTORY
- ERROR_DIRECT_ACCESS_HANDLE
- ERROR_DIR_NOT_EMPTY
- ERROR_DIR_NOT_ROOT
- ERROR_DISCARDED
- ERROR_DISK_CHANGE
- ERROR_DISK_CORRUPT
- ERROR_DISK_FULL
- ERROR_DISK_OPERATION_FAILED
- ERROR_DISK_RECALIBRATE_FAILED
- ERROR_DISK_RESET_FAILED
- ERROR_DLL_INIT_FAILED
- ERROR_DOMAIN_CONTROLLER_NOT_FOUND
- ERROR_DOMAIN_EXISTS
- ERROR_DOMAIN_LIMIT_EXCEEDED
- ERROR_DOMAIN_TRUST_INCONSISTENT
- ERROR_DRIVE_LOCKED
- ERROR_DUPLICATE_SERVICE_NAME
- ERROR_DUP_DOMAINNAME
- ERROR_DUP_NAME
- ERROR_DYNLINK_FROM_INVALID_RING
- ERROR_EAS_DIDNT_FIT
- ERROR_EAS_NOT_SUPPORTED
- ERROR_EA_ACCESS_DENIED
- ERROR_EA_FILE_CORRUPT
- ERROR_EA_LIST_INCONSISTENT
- ERROR_EA_TABLE_FULL
- ERROR_END_OF_MEDIA
- ERROR_ENVVAR_NOT_FOUND
- ERROR_EOM_OVERFLOW
- ERROR_EVENTLOG_CANT_START
- ERROR_EVENTLOG_FILE_CHANGED
- ERROR_EVENTLOG_FILE_CORRUPT
- ERROR_EXCEPTION_IN_SERVICE
- ERROR_EXCL_SEM_ALREADY_OWNED
- ERROR_EXE_MARKED_INVALID
- ERROR_EXTENDED_ERROR
- ERROR_FAILED_SERVICE_CONTROLLER_CONNECT
- ERROR_FAIL_I24
- ERROR_FILEMARK_DETECTED
- ERROR_FILENAME_EXCED_RANGE
- ERROR_FILE_CORRUPT
- ERROR_FILE_EXISTS
- ERROR_FILE_INVALID
- ERROR_FILE_NOT_FOUND
- ERROR_FLOPPY_BAD_REGISTERS
- ERROR_FLOPPY_ID_MARK_NOT_FOUND
- ERROR_FLOPPY_UNKNOWN_ERROR
- ERROR_FLOPPY_WRONG_CYLINDER
- ERROR_FULLSCREEN_MODE
- ERROR_FULL_BACKUP
- ERROR_GENERIC_NOT_MAPPED
- ERROR_GEN_FAILURE
- ERROR_GLOBAL_ONLY_HOOK
- ERROR_GRACEFUL_DISCONNECT
- ERROR_GROUP_EXISTS
- ERROR_HANDLE_DISK_FULL
- ERROR_HANDLE_EOF
- ERROR_HOOK_NEEDS_HMOD
- ERROR_HOOK_NOT_INSTALLED
- ERROR_HOST_UNREACHABLE
- ERROR_HOTKEY_ALREADY_REGISTERED
- ERROR_HOTKEY_NOT_REGISTERED
- ERROR_HWNDS_HAVE_DIFF_PARENT
- ERROR_ILL_FORMED_PASSWORD
- ERROR_INCORRECT_ADDRESS
- ERROR_INC_BACKUP
- ERROR_INFLOOP_IN_RELOC_CHAIN
- ERROR_INSUFFICIENT_BUFFER
- ERROR_INTERNAL_DB_CORRUPTION
- ERROR_INTERNAL_DB_ERROR
- ERROR_INTERNAL_ERROR
- ERROR_INVALID_ACCEL_HANDLE
- ERROR_INVALID_ACCESS
- ERROR_INVALID_ACCOUNT_NAME
- ERROR_INVALID_ACL
- ERROR_INVALID_ADDRESS
- ERROR_INVALID_AT_INTERRUPT_TIME
- ERROR_INVALID_BLOCK
- ERROR_INVALID_BLOCK_LENGTH
- ERROR_INVALID_CATEGORY
- ERROR_INVALID_COMBOBOX_MESSAGE
- ERROR_INVALID_COMPUTERNAME
- ERROR_INVALID_CURSOR_HANDLE
- ERROR_INVALID_DATA
- ERROR_INVALID_DATATYPE
- ERROR_INVALID_DOMAINNAME
- ERROR_INVALID_DOMAIN_ROLE
- ERROR_INVALID_DOMAIN_STATE
- ERROR_INVALID_DRIVE
- ERROR_INVALID_DWP_HANDLE
- ERROR_INVALID_EA_HANDLE
- ERROR_INVALID_EA_NAME
- ERROR_INVALID_EDIT_HEIGHT
- ERROR_INVALID_ENVIRONMENT
- ERROR_INVALID_EVENTNAME
- ERROR_INVALID_EVENT_COUNT
- ERROR_INVALID_EXE_SIGNATURE
- ERROR_INVALID_FILTER_PROC
- ERROR_INVALID_FLAGS
- ERROR_INVALID_FLAG_NUMBER
- ERROR_INVALID_FORM_NAME
- ERROR_INVALID_FORM_SIZE
- ERROR_INVALID_FUNCTION
- ERROR_INVALID_GROUPNAME
- ERROR_INVALID_GROUP_ATTRIBUTES
- ERROR_INVALID_GW_COMMAND
- ERROR_INVALID_HANDLE
- ERROR_INVALID_HOOK_FILTER
- ERROR_INVALID_HOOK_HANDLE
- ERROR_INVALID_ICON_HANDLE
- ERROR_INVALID_ID_AUTHORITY
- ERROR_INVALID_INDEX
- ERROR_INVALID_LB_MESSAGE
- ERROR_INVALID_LEVEL
- ERROR_INVALID_LIST_FORMAT
- ERROR_INVALID_LOGON_HOURS
- ERROR_INVALID_LOGON_TYPE
- ERROR_INVALID_MEMBER
- ERROR_INVALID_MENU_HANDLE
- ERROR_INVALID_MESSAGE
- ERROR_INVALID_MESSAGEDEST
- ERROR_INVALID_MESSAGENAME
- ERROR_INVALID_MINALLOCSIZE
- ERROR_INVALID_MODULETYPE
- ERROR_INVALID_MSGBOX_STYLE
- ERROR_INVALID_NAME
- ERROR_INVALID_NETNAME
- ERROR_INVALID_ORDINAL
- ERROR_INVALID_OWNER
- ERROR_INVALID_PARAMETER
- ERROR_INVALID_PASSWORD
- ERROR_INVALID_PASSWORDNAME
- ERROR_INVALID_PIXEL_FORMAT
- ERROR_INVALID_PRIMARY_GROUP
- ERROR_INVALID_PRINTER_COMMAND
- ERROR_INVALID_PRINTER_NAME
- ERROR_INVALID_PRINTER_STATE
- ERROR_INVALID_PRIORITY
- ERROR_INVALID_SCROLLBAR_RANGE
- ERROR_INVALID_SECURITY_DESCR
- ERROR_INVALID_SEGDPL
- ERROR_INVALID_SEGMENT_NUMBER
- ERROR_INVALID_SEPARATOR_FILE
- ERROR_INVALID_SERVER_STATE
- ERROR_INVALID_SERVICENAME
- ERROR_INVALID_SERVICE_ACCOUNT
- ERROR_INVALID_SERVICE_CONTROL
- ERROR_INVALID_SERVICE_LOCK
- ERROR_INVALID_SHARENAME
- ERROR_INVALID_SHOWWIN_COMMAND
- ERROR_INVALID_SID
- ERROR_INVALID_SIGNAL_NUMBER
- ERROR_INVALID_SPI_VALUE
- ERROR_INVALID_STACKSEG
- ERROR_INVALID_STARTING_CODESEG
- ERROR_INVALID_SUB_AUTHORITY
- ERROR_INVALID_TARGET_HANDLE
- ERROR_INVALID_THREAD_ID
- ERROR_INVALID_TIME
- ERROR_INVALID_USER_BUFFER
- ERROR_INVALID_VERIFY_SWITCH
- ERROR_INVALID_WINDOW_HANDLE
- ERROR_INVALID_WINDOW_STYLE
- ERROR_INVALID_WORKSTATION
- ERROR_IOPL_NOT_ENABLED
- ERROR_IO_DEVICE
- ERROR_IO_INCOMPLETE
- ERROR_IO_PENDING
- ERROR_IRQ_BUSY
- ERROR_IS_JOINED
- ERROR_IS_JOIN_PATH
- ERROR_IS_JOIN_TARGET
- ERROR_IS_SUBSTED
- ERROR_IS_SUBST_PATH
- ERROR_IS_SUBST_TARGET
- ERROR_ITERATED_DATA_EXCEEDS_64k
- ERROR_JOIN_TO_JOIN
- ERROR_JOIN_TO_SUBST
- ERROR_JOURNAL_HOOK_SET
- ERROR_KEY_DELETED
- ERROR_KEY_HAS_CHILDREN
- ERROR_LABEL_TOO_LONG
- ERROR_LAST_ADMIN
- ERROR_LB_WITHOUT_TABSTOPS
- ERROR_LISTBOX_ID_NOT_FOUND
- ERROR_LM_CROSS_ENCRYPTION_REQUIRED
- ERROR_LOCAL_USER_SESSION_KEY
- ERROR_LOCKED
- ERROR_LOCK_FAILED
- ERROR_LOCK_VIOLATION
- ERROR_LOGIN_TIME_RESTRICTION
- ERROR_LOGIN_WKSTA_RESTRICTION
- ERROR_LOGON_FAILURE
- ERROR_LOGON_NOT_GRANTED
- ERROR_LOGON_SESSION_COLLISION
- ERROR_LOGON_SESSION_EXISTS
- ERROR_LOGON_TYPE_NOT_GRANTED
- ERROR_LOG_FILE_FULL
- ERROR_LUIDS_EXHAUSTED
- ERROR_MAPPED_ALIGNMENT
- ERROR_MAX_THRDS_REACHED
- ERROR_MEDIA_CHANGED
- ERROR_MEMBERS_PRIMARY_GROUP
- ERROR_MEMBER_IN_ALIAS
- ERROR_MEMBER_IN_GROUP
- ERROR_MEMBER_NOT_IN_ALIAS
- ERROR_MEMBER_NOT_IN_GROUP
- ERROR_METAFILE_NOT_SUPPORTED
- ERROR_META_EXPANSION_TOO_LONG
- ERROR_MOD_NOT_FOUND
- ERROR_MORE_DATA
- ERROR_MORE_WRITES
- ERROR_MR_MID_NOT_FOUND
- ERROR_NEGATIVE_SEEK
- ERROR_NESTING_NOT_ALLOWED
- ERROR_NETLOGON_NOT_STARTED
- ERROR_NETNAME_DELETED
- ERROR_NETWORK_ACCESS_DENIED
- ERROR_NETWORK_BUSY
- ERROR_NETWORK_UNREACHABLE
- ERROR_NET_WRITE_FAULT
- ERROR_NOACCESS
- ERROR_NOLOGON_INTERDOMAIN_TRUST_ACCOUNT
- ERROR_NOLOGON_SERVER_TRUST_ACCOUNT
- ERROR_NOLOGON_WORKSTATION_TRUST_ACCOUNT
- ERROR_NONE_MAPPED
- ERROR_NON_MDICHILD_WINDOW
- ERROR_NOTIFY_ENUM_DIR
- ERROR_NOT_ALL_ASSIGNED
- ERROR_NOT_CHILD_WINDOW
- ERROR_NOT_CONNECTED
- ERROR_NOT_CONTAINER
- ERROR_NOT_DOS_DISK
- ERROR_NOT_ENOUGH_MEMORY
- ERROR_NOT_ENOUGH_QUOTA
- ERROR_NOT_ENOUGH_SERVER_MEMORY
- ERROR_NOT_JOINED
- ERROR_NOT_LOCKED
- ERROR_NOT_LOGON_PROCESS
- ERROR_NOT_OWNER
- ERROR_NOT_READY
- ERROR_NOT_REGISTRY_FILE
- ERROR_NOT_SAME_DEVICE
- ERROR_NOT_SUBSTED
- ERROR_NOT_SUPPORTED
- ERROR_NO_BROWSER_SERVERS_FOUND
- ERROR_NO_DATA
- ERROR_NO_DATA_DETECTED
- ERROR_NO_IMPERSONATION_TOKEN
- ERROR_NO_INHERITANCE
- ERROR_NO_LOGON_SERVERS
- ERROR_NO_LOG_SPACE
- ERROR_NO_MEDIA_IN_DRIVE
- ERROR_NO_MORE_FILES
- ERROR_NO_MORE_ITEMS
- ERROR_NO_MORE_SEARCH_HANDLES
- ERROR_NO_NETWORK
- ERROR_NO_NET_OR_BAD_PATH
- ERROR_NO_PROC_SLOTS
- ERROR_NO_QUOTAS_FOR_ACCOUNT
- ERROR_NO_SCROLLBARS
- ERROR_NO_SECURITY_ON_OBJECT
- ERROR_NO_SHUTDOWN_IN_PROGRESS
- ERROR_NO_SIGNAL_SENT
- ERROR_NO_SPOOL_SPACE
- ERROR_NO_SUCH_ALIAS
- ERROR_NO_SUCH_DOMAIN
- ERROR_NO_SUCH_GROUP
- ERROR_NO_SUCH_LOGON_SESSION
- ERROR_NO_SUCH_MEMBER
- ERROR_NO_SUCH_PACKAGE
- ERROR_NO_SUCH_PRIVILEGE
- ERROR_NO_SUCH_USER
- ERROR_NO_SYSTEM_MENU
- ERROR_NO_TOKEN
- ERROR_NO_TRUST_LSA_SECRET
- ERROR_NO_TRUST_SAM_ACCOUNT
- ERROR_NO_UNICODE_TRANSLATION
- ERROR_NO_USER_SESSION_KEY
- ERROR_NO_VOLUME_LABEL
- ERROR_NO_WILDCARD_CHARACTERS
- ERROR_NT_CROSS_ENCRYPTION_REQUIRED
- ERROR_NULL_LM_PASSWORD
- ERROR_OPEN_FAILED
- ERROR_OPEN_FILES
- ERROR_OPERATION_ABORTED
- ERROR_OUTOFMEMORY
- ERROR_OUT_OF_PAPER
- ERROR_OUT_OF_STRUCTURES
- ERROR_PARTIAL_COPY
- ERROR_PARTITION_FAILURE
- ERROR_PASSWORD_EXPIRED
- ERROR_PASSWORD_MUST_CHANGE
- ERROR_PASSWORD_RESTRICTION
- ERROR_PATH_BUSY
- ERROR_PATH_NOT_FOUND
- ERROR_PIPE_BUSY
- ERROR_PIPE_CONNECTED
- ERROR_PIPE_LISTENING
- ERROR_PIPE_NOT_CONNECTED
- ERROR_POPUP_ALREADY_ACTIVE
- ERROR_PORT_UNREACHABLE
- ERROR_POSSIBLE_DEADLOCK
- ERROR_PRINTER_ALREADY_EXISTS
- ERROR_PRINTER_DELETED
- ERROR_PRINTER_DRIVER_ALREADY_INSTALLED
- ERROR_PRINTER_DRIVER_IN_USE
- ERROR_PRINTQ_FULL
- ERROR_PRINT_CANCELLED
- ERROR_PRINT_MONITOR_ALREADY_INSTALLED
- ERROR_PRINT_PROCESSOR_ALREADY_INSTALLED
- ERROR_PRIVATE_DIALOG_INDEX
- ERROR_PRIVILEGE_NOT_HELD
- ERROR_PROCESS_ABORTED
- ERROR_PROC_NOT_FOUND
- ERROR_PROTOCOL_UNREACHABLE
- ERROR_READ_FAULT
- ERROR_REC_NON_EXISTENT
- ERROR_REDIRECTOR_HAS_OPEN_HANDLES
- ERROR_REDIR_PAUSED
- ERROR_REGISTRY_CORRUPT
- ERROR_REGISTRY_IO_FAILED
- ERROR_REGISTRY_RECOVERED
- ERROR_RELOC_CHAIN_XEEDS_SEGLIM
- ERROR_REMOTE_SESSION_LIMIT_EXCEEDED
- ERROR_REM_NOT_LIST
- ERROR_REQUEST_ABORTED
- ERROR_REQ_NOT_ACCEP
- ERROR_RESOURCE_DATA_NOT_FOUND
- ERROR_RESOURCE_LANG_NOT_FOUND
- ERROR_RESOURCE_NAME_NOT_FOUND
- ERROR_RESOURCE_TYPE_NOT_FOUND
- ERROR_RETRY
- ERROR_REVISION_MISMATCH
- ERROR_RING2SEG_MUST_BE_MOVABLE
- ERROR_RING2_STACK_IN_USE
- ERROR_RPL_NOT_ALLOWED
- ERROR_RXACT_COMMIT_FAILURE
- ERROR_RXACT_INVALID_STATE
- ERROR_SAME_DRIVE
- ERROR_SCREEN_ALREADY_LOCKED
- ERROR_SECRET_TOO_LONG
- ERROR_SECTOR_NOT_FOUND
- ERROR_SEEK
- ERROR_SEEK_ON_DEVICE
- ERROR_SEM_IS_SET
- ERROR_SEM_NOT_FOUND
- ERROR_SEM_OWNER_DIED
- ERROR_SEM_TIMEOUT
- ERROR_SEM_USER_LIMIT
- ERROR_SERIAL_NO_DEVICE
- ERROR_SERVER_DISABLED
- ERROR_SERVER_HAS_OPEN_HANDLES
- ERROR_SERVER_NOT_DISABLED
- ERROR_SERVICE_ALREADY_RUNNING
- ERROR_SERVICE_CANNOT_ACCEPT_CTRL
- ERROR_SERVICE_DATABASE_LOCKED
- ERROR_SERVICE_DEPENDENCY_DELETED
- ERROR_SERVICE_DEPENDENCY_FAIL
- ERROR_SERVICE_DISABLED
- ERROR_SERVICE_DOES_NOT_EXIST
- ERROR_SERVICE_EXISTS
- ERROR_SERVICE_LOGON_FAILED
- ERROR_SERVICE_MARKED_FOR_DELETE
- ERROR_SERVICE_NEVER_STARTED
- ERROR_SERVICE_NOT_ACTIVE
- ERROR_SERVICE_NOT_FOUND
- ERROR_SERVICE_NO_THREAD
- ERROR_SERVICE_REQUEST_TIMEOUT
- ERROR_SERVICE_SPECIFIC_ERROR
- ERROR_SERVICE_START_HANG
- ERROR_SESSION_CREDENTIAL_CONFLICT
- ERROR_SETCOUNT_ON_BAD_LB
- ERROR_SETMARK_DETECTED
- ERROR_SHARING_BUFFER_EXCEEDED
- ERROR_SHARING_PAUSED
- ERROR_SHARING_VIOLATION
- ERROR_SHUTDOWN_IN_PROGRESS
- ERROR_SIGNAL_PENDING
- ERROR_SIGNAL_REFUSED
- ERROR_SOME_NOT_MAPPED
- ERROR_SPECIAL_ACCOUNT
- ERROR_SPECIAL_GROUP
- ERROR_SPECIAL_USER
- ERROR_SPL_NO_ADDJOB
- ERROR_SPL_NO_STARTDOC
- ERROR_SPOOL_FILE_NOT_FOUND
- ERROR_STACK_OVERFLOW
- ERROR_STATIC_INIT
- ERROR_SUBST_TO_JOIN
- ERROR_SUBST_TO_SUBST
- ERROR_SUCCESS
- ERROR_SWAPERROR
- ERROR_SYSTEM_TRACE
- ERROR_THREAD_1_INACTIVE
- ERROR_TLW_WITH_WSCHILD
- ERROR_TOKEN_ALREADY_IN_USE
- ERROR_TOO_MANY_CMDS
- ERROR_TOO_MANY_CONTEXT_IDS
- ERROR_TOO_MANY_LUIDS_REQUESTED
- ERROR_TOO_MANY_MODULES
- ERROR_TOO_MANY_MUXWAITERS
- ERROR_TOO_MANY_NAMES
- ERROR_TOO_MANY_OPEN_FILES
- ERROR_TOO_MANY_POSTS
- ERROR_TOO_MANY_SECRETS
- ERROR_TOO_MANY_SEMAPHORES
- ERROR_TOO_MANY_SEM_REQUESTS
- ERROR_TOO_MANY_SESS
- ERROR_TOO_MANY_SIDS
- ERROR_TOO_MANY_TCBS
- ERROR_TRANSFORM_NOT_SUPPORTED
- ERROR_TRUSTED_DOMAIN_FAILURE
- ERROR_TRUSTED_RELATIONSHIP_FAILURE
- ERROR_TRUST_FAILURE
- ERROR_UNABLE_TO_LOCK_MEDIA
- ERROR_UNABLE_TO_UNLOAD_MEDIA
- ERROR_UNEXP_NET_ERR
- ERROR_UNKNOWN_PORT
- ERROR_UNKNOWN_PRINTER_DRIVER
- ERROR_UNKNOWN_PRINTPROCESSOR
- ERROR_UNKNOWN_PRINT_MONITOR
- ERROR_UNKNOWN_REVISION
- ERROR_UNRECOGNIZED_MEDIA
- ERROR_UNRECOGNIZED_VOLUME
- ERROR_USER_EXISTS
- ERROR_USER_MAPPED_FILE
- ERROR_VC_DISCONNECTED
- ERROR_WAIT_NO_CHILDREN
- ERROR_WINDOW_NOT_COMBOBOX
- ERROR_WINDOW_NOT_DIALOG
- ERROR_WINDOW_OF_OTHER_THREAD
- ERROR_WINS_INTERNAL
- ERROR_WRITE_FAULT
- ERROR_WRITE_PROTECT
- ERROR_WRONG_DISK
- ERROR_WRONG_PASSWORD
- E_ABORT
- E_ACCESSDENIED
- E_FAIL
- E_HANDLE
- E_INVALIDARG
- E_NOINTERFACE
- E_NOTIMPL
- E_OUTOFMEMORY
- E_POINTER
- E_UNEXPECTED
- FACILITY_CONTROL
- FACILITY_DISPATCH
- FACILITY_ITF
- FACILITY_NT_BIT
- FACILITY_NULL
- FACILITY_RPC
- FACILITY_STORAGE
- FACILITY_WIN32
- FACILITY_WINDOWS
- INPLACE_E_FIRST
- INPLACE_E_LAST
- INPLACE_E_NOTOOLSPACE
- INPLACE_E_NOTUNDOABLE
- INPLACE_S_FIRST
- INPLACE_S_LAST
- INPLACE_S_TRUNCATED
- MARSHAL_E_FIRST
- MARSHAL_E_LAST
- MARSHAL_S_FIRST
- MARSHAL_S_LAST
- MEM_E_INVALID_LINK
- MEM_E_INVALID_ROOT
- MEM_E_INVALID_SIZE
- MK_E_CANTOPENFILE
- MK_E_CONNECTMANUALLY
- MK_E_ENUMERATION_FAILED
- MK_E_EXCEEDEDDEADLINE
- MK_E_FIRST
- MK_E_INTERMEDIATEINTERFACENOTSUPPORTED
- MK_E_INVALIDEXTENSION
- MK_E_LAST
- MK_E_MUSTBOTHERUSER
- MK_E_NEEDGENERIC
- MK_E_NOINVERSE
- MK_E_NOOBJECT
- MK_E_NOPREFIX
- MK_E_NOSTORAGE
- MK_E_NOTBINDABLE
- MK_E_NOTBOUND
- MK_E_NO_NORMALIZED
- MK_E_SYNTAX
- MK_E_UNAVAILABLE
- MK_S_FIRST
- MK_S_HIM
- MK_S_LAST
- MK_S_ME
- MK_S_MONIKERALREADYREGISTERED
- MK_S_REDUCED_TO_SELF
- MK_S_US
- NOERROR
- NO_ERROR
- OLEOBJ_E_FIRST
- OLEOBJ_E_INVALIDVERB
- OLEOBJ_E_LAST
- OLEOBJ_E_NOVERBS
- OLEOBJ_S_CANNOT_DOVERB_NOW
- OLEOBJ_S_FIRST
- OLEOBJ_S_INVALIDHWND
- OLEOBJ_S_INVALIDVERB
- OLEOBJ_S_LAST
- OLE_E_ADVF
- OLE_E_ADVISENOTSUPPORTED
- OLE_E_BLANK
- OLE_E_CANTCONVERT
- OLE_E_CANT_BINDTOSOURCE
- OLE_E_CANT_GETMONIKER
- OLE_E_CLASSDIFF
- OLE_E_ENUM_NOMORE
- OLE_E_FIRST
- OLE_E_INVALIDHWND
- OLE_E_INVALIDRECT
- OLE_E_LAST
- OLE_E_NOCACHE
- OLE_E_NOCONNECTION
- OLE_E_NOSTORAGE
- OLE_E_NOTRUNNING
- OLE_E_NOT_INPLACEACTIVE
- OLE_E_OLEVERB
- OLE_E_PROMPTSAVECANCELLED
- OLE_E_STATIC
- OLE_E_WRONGCOMPOBJ
- OLE_S_FIRST
- OLE_S_LAST
- OLE_S_MAC_CLIPFORMAT
- OLE_S_STATIC
- OLE_S_USEREG
- REGDB_E_CLASSNOTREG
- REGDB_E_FIRST
- REGDB_E_IIDNOTREG
- REGDB_E_INVALIDVALUE
- REGDB_E_KEYMISSING
- REGDB_E_LAST
- REGDB_E_READREGDB
- REGDB_E_WRITEREGDB
- REGDB_S_FIRST
- REGDB_S_LAST
- RPC_E_ATTEMPTED_MULTITHREAD
- RPC_E_CALL_CANCELED
- RPC_E_CALL_REJECTED
- RPC_E_CANTCALLOUT_AGAIN
- RPC_E_CANTCALLOUT_INASYNCCALL
- RPC_E_CANTCALLOUT_INEXTERNALCALL
- RPC_E_CANTCALLOUT_ININPUTSYNCCALL
- RPC_E_CANTPOST_INSENDCALL
- RPC_E_CANTTRANSMIT_CALL
- RPC_E_CHANGED_MODE
- RPC_E_CLIENT_CANTMARSHAL_DATA
- RPC_E_CLIENT_CANTUNMARSHAL_DATA
- RPC_E_CLIENT_DIED
- RPC_E_CONNECTION_TERMINATED
- RPC_E_DISCONNECTED
- RPC_E_FAULT
- RPC_E_INVALIDMETHOD
- RPC_E_INVALID_CALLDATA
- RPC_E_INVALID_DATA
- RPC_E_INVALID_DATAPACKET
- RPC_E_INVALID_PARAMETER
- RPC_E_NOT_REGISTERED
- RPC_E_OUT_OF_RESOURCES
- RPC_E_RETRY
- RPC_E_SERVERCALL_REJECTED
- RPC_E_SERVERCALL_RETRYLATER
- RPC_E_SERVERFAULT
- RPC_E_SERVER_CANTMARSHAL_DATA
- RPC_E_SERVER_CANTUNMARSHAL_DATA
- RPC_E_SERVER_DIED
- RPC_E_SERVER_DIED_DNE
- RPC_E_SYS_CALL_FAILED
- RPC_E_THREAD_NOT_INIT
- RPC_E_UNEXPECTED
- RPC_E_WRONG_THREAD
- RPC_S_ADDRESS_ERROR
- RPC_S_ALREADY_LISTENING
- RPC_S_ALREADY_REGISTERED
- RPC_S_BINDING_HAS_NO_AUTH
- RPC_S_BINDING_INCOMPLETE
- RPC_S_CALL_CANCELLED
- RPC_S_CALL_FAILED
- RPC_S_CALL_FAILED_DNE
- RPC_S_CALL_IN_PROGRESS
- RPC_S_CANNOT_SUPPORT
- RPC_S_CANT_CREATE_ENDPOINT
- RPC_S_COMM_FAILURE
- RPC_S_DUPLICATE_ENDPOINT
- RPC_S_ENTRY_ALREADY_EXISTS
- RPC_S_ENTRY_NOT_FOUND
- RPC_S_FP_DIV_ZERO
- RPC_S_FP_OVERFLOW
- RPC_S_FP_UNDERFLOW
- RPC_S_GROUP_MEMBER_NOT_FOUND
- RPC_S_INCOMPLETE_NAME
- RPC_S_INTERFACE_NOT_FOUND
- RPC_S_INTERNAL_ERROR
- RPC_S_INVALID_AUTH_IDENTITY
- RPC_S_INVALID_BINDING
- RPC_S_INVALID_BOUND
- RPC_S_INVALID_ENDPOINT_FORMAT
- RPC_S_INVALID_NAF_ID
- RPC_S_INVALID_NAME_SYNTAX
- RPC_S_INVALID_NETWORK_OPTIONS
- RPC_S_INVALID_NET_ADDR
- RPC_S_INVALID_OBJECT
- RPC_S_INVALID_RPC_PROTSEQ
- RPC_S_INVALID_STRING_BINDING
- RPC_S_INVALID_STRING_UUID
- RPC_S_INVALID_TAG
- RPC_S_INVALID_TIMEOUT
- RPC_S_INVALID_VERS_OPTION
- RPC_S_MAX_CALLS_TOO_SMALL
- RPC_S_NAME_SERVICE_UNAVAILABLE
- RPC_S_NOTHING_TO_EXPORT
- RPC_S_NOT_ALL_OBJS_UNEXPORTED
- RPC_S_NOT_CANCELLED
- RPC_S_NOT_LISTENING
- RPC_S_NOT_RPC_ERROR
- RPC_S_NO_BINDINGS
- RPC_S_NO_CALL_ACTIVE
- RPC_S_NO_CONTEXT_AVAILABLE
- RPC_S_NO_ENDPOINT_FOUND
- RPC_S_NO_ENTRY_NAME
- RPC_S_NO_INTERFACES
- RPC_S_NO_MORE_BINDINGS
- RPC_S_NO_MORE_MEMBERS
- RPC_S_NO_PRINC_NAME
- RPC_S_NO_PROTSEQS
- RPC_S_NO_PROTSEQS_REGISTERED
- RPC_S_OBJECT_NOT_FOUND
- RPC_S_OUT_OF_RESOURCES
- RPC_S_PROCNUM_OUT_OF_RANGE
- RPC_S_PROTOCOL_ERROR
- RPC_S_PROTSEQ_NOT_FOUND
- RPC_S_PROTSEQ_NOT_SUPPORTED
- RPC_S_SEC_PKG_ERROR
- RPC_S_SERVER_TOO_BUSY
- RPC_S_SERVER_UNAVAILABLE
- RPC_S_STRING_TOO_LONG
- RPC_S_TYPE_ALREADY_REGISTERED
- RPC_S_UNKNOWN_AUTHN_LEVEL
- RPC_S_UNKNOWN_AUTHN_SERVICE
- RPC_S_UNKNOWN_AUTHN_TYPE
- RPC_S_UNKNOWN_AUTHZ_SERVICE
- RPC_S_UNKNOWN_IF
- RPC_S_UNKNOWN_MGR_TYPE
- RPC_S_UNSUPPORTED_AUTHN_LEVEL
- RPC_S_UNSUPPORTED_NAME_SYNTAX
- RPC_S_UNSUPPORTED_TRANS_SYN
- RPC_S_UNSUPPORTED_TYPE
- RPC_S_UUID_LOCAL_ONLY
- RPC_S_UUID_NO_ADDRESS
- RPC_S_WRONG_KIND_OF_BINDING
- RPC_S_ZERO_DIVIDE
- RPC_X_BAD_STUB_DATA
- RPC_X_BYTE_COUNT_TOO_SMALL
- RPC_X_ENUM_VALUE_OUT_OF_RANGE
- RPC_X_INVALID_ES_ACTION
- RPC_X_NO_MORE_ENTRIES
- RPC_X_NULL_REF_POINTER
- RPC_X_SS_CANNOT_GET_CALL_HANDLE
- RPC_X_SS_CHAR_TRANS_OPEN_FAIL
- RPC_X_SS_CHAR_TRANS_SHORT_FILE
- RPC_X_SS_CONTEXT_DAMAGED
- RPC_X_SS_HANDLES_MISMATCH
- RPC_X_SS_IN_NULL_CONTEXT
- RPC_X_WRONG_ES_VERSION
- RPC_X_WRONG_STUB_VERSION
- SEVERITY_ERROR
- SEVERITY_SUCCESS
- STG_E_ABNORMALAPIEXIT
- STG_E_ACCESSDENIED
- STG_E_CANTSAVE
- STG_E_DISKISWRITEPROTECTED
- STG_E_EXTANTMARSHALLINGS
- STG_E_FILEALREADYEXISTS
- STG_E_FILENOTFOUND
- STG_E_INSUFFICIENTMEMORY
- STG_E_INUSE
- STG_E_INVALIDFLAG
- STG_E_INVALIDFUNCTION
- STG_E_INVALIDHANDLE
- STG_E_INVALIDHEADER
- STG_E_INVALIDNAME
- STG_E_INVALIDPARAMETER
- STG_E_INVALIDPOINTER
- STG_E_LOCKVIOLATION
- STG_E_MEDIUMFULL
- STG_E_NOMOREFILES
- STG_E_NOTCURRENT
- STG_E_NOTFILEBASEDSTORAGE
- STG_E_OLDDLL
- STG_E_OLDFORMAT
- STG_E_PATHNOTFOUND
- STG_E_READFAULT
- STG_E_REVERTED
- STG_E_SEEKERROR
- STG_E_SHAREREQUIRED
- STG_E_SHAREVIOLATION
- STG_E_TOOMANYOPENFILES
- STG_E_UNIMPLEMENTEDFUNCTION
- STG_E_UNKNOWN
- STG_E_WRITEFAULT
- STG_S_CONVERTED
- S_FALSE
- S_OK
- TYPE_E_AMBIGUOUSNAME
- TYPE_E_BADMODULEKIND
- TYPE_E_BUFFERTOOSMALL
- TYPE_E_CANTCREATETMPFILE
- TYPE_E_CANTLOADLIBRARY
- TYPE_E_CIRCULARTYPE
- TYPE_E_DLLFUNCTIONNOTFOUND
- TYPE_E_DUPLICATEID
- TYPE_E_ELEMENTNOTFOUND
- TYPE_E_INCONSISTENTPROPFUNCS
- TYPE_E_INVALIDID
- TYPE_E_INVALIDSTATE
- TYPE_E_INVDATAREAD
- TYPE_E_IOERROR
- TYPE_E_LIBNOTREGISTERED
- TYPE_E_NAMECONFLICT
- TYPE_E_OUTOFBOUNDS
- TYPE_E_QUALIFIEDNAMEDISALLOWED
- TYPE_E_REGISTRYACCESS
- TYPE_E_SIZETOOBIG
- TYPE_E_TYPEMISMATCH
- TYPE_E_UNDEFINEDTYPE
- TYPE_E_UNKNOWNLCID
- TYPE_E_UNSUPFORMAT
- TYPE_E_WRONGTYPEKIND
- VIEW_E_DRAW
- VIEW_E_FIRST
- VIEW_E_LAST
- VIEW_S_ALREADY_FROZEN
- VIEW_S_FIRST
- VIEW_S_LAST
-);
-
-sub AUTOLOAD {
- # This AUTOLOAD is used to 'autoload' constants from the constant()
- # XS function. If a constant is not found then control is passed
- # to the AUTOLOAD in AutoLoader.
-
- my($constname);
- ($constname = $AUTOLOAD) =~ s/.*:://;
- #reset $! to zero to reset any current errors.
- local $! = 0;
- local $^E = 0;
- my $val = constant($constname, @_ ? $_[0] : 0);
- if ($! != 0) {
- if ($! =~ /Invalid/) {
- $AutoLoader::AUTOLOAD = $AUTOLOAD;
- goto &AutoLoader::AUTOLOAD;
- }
- else {
- ($pack,$file,$line) = caller;
- die "Your vendor has not defined Win32::WinError macro $constname, used at $file line $line.";
- }
- }
- eval "sub $AUTOLOAD { $val }";
- goto &$AUTOLOAD;
-}
-
-bootstrap Win32::WinError;
-
-# Preloaded methods go here.
-
-# Autoload methods go after __END__, and are processed by the autosplit program.
-
-1;
-__END__