diff options
author | Siep Kroonenberg <siepo@cybercomm.nl> | 2020-03-08 17:43:21 +0000 |
---|---|---|
committer | Siep Kroonenberg <siepo@cybercomm.nl> | 2020-03-08 17:43:21 +0000 |
commit | a55bd3bddc4be09481fee6e37a7b4ff3e9394eda (patch) | |
tree | 2f99f1f92f08d51ef05ec6cdace102ae57d3e72d /Master/tlpkg/tlperl | |
parent | bb6e6d17ca709ed97c25fd192c1ea788e6e2c583 (diff) |
Temporarily re-add Win32::OLE module
git-svn-id: svn://tug.org/texlive/trunk@54174 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl')
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/OLE.pm | 177 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/Win32/OLE.pm | 968 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/Win32/OLE/Const.pm | 201 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/Win32/OLE/Enum.pm | 95 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/Win32/OLE/Lite.pm | 224 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/Win32/OLE/NEWS.pod | 380 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/Win32/OLE/NLS.pm | 968 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/Win32/OLE/TPJ.pod | 798 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/Win32/OLE/TypeInfo.pm | 389 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/Win32/OLE/Variant.pm | 577 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/auto/Win32/OLE/.packlist | 11 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/site/lib/auto/Win32/OLE/OLE.dll | bin | 0 -> 135168 bytes |
12 files changed, 4788 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/site/lib/OLE.pm b/Master/tlpkg/tlperl/site/lib/OLE.pm new file mode 100755 index 00000000000..234f6986ab3 --- /dev/null +++ b/Master/tlpkg/tlperl/site/lib/OLE.pm @@ -0,0 +1,177 @@ +# Compatibility layer for applications using the old toplevel OLE.pm. +# New code should use Win32::OLE + +# This file is based on ../lib/OLE.pm from ActiveState build 315. + +# Compatibility notes: +# - "GetObject" -> "GetActiveObject" +# - "keys %$collection" -> "Win32::OLE::Enum->All($collection)" +# or "in $Collection" +# - "unnamed" default method retries + +######################################################################## +# package Win32; +######################################################################## + +*Win32::OLELastError = sub { return OLE->LastError() }; + + +######################################################################## +package OLE::Variant; +######################################################################## + +use Win32::OLE qw(CP_ACP); +use Win32::OLE::Variant; + +use strict; +use vars qw($AUTOLOAD @ISA $LCID $CP $Warn $LastError $_NewEnum $_Unique); +@ISA = qw(Win32::OLE::Variant); + +$Warn = 0; +$LCID = 2 << 10; # LOCALE_SYSTEM_DEFAULT +$CP = CP_ACP; +$_NewEnum = 0; +$_Unique = 0; + +sub new { + my $self = shift; + my $variant = $self->SUPER::new(@_); + $OLE::LastError = $Win32::OLE->LastError unless defined $variant; + return $variant; +} + + +######################################################################## +package OLE::Tie; +######################################################################## +use strict; +use vars qw(@ISA); +@ISA = qw(Win32::OLE::Tie); + +# !!! It is VERY important that Win32::OLE::Tie::DESTROY gets called. !!! +# If you subclass DESTROY, don't forget to call $self->SUPER::DESTROY. +# Otherwise the OLE interfaces will not be released until process termination! + +# Retry default method if property doesn't exist +sub FETCH { + my ($self,$key) = @_; + return $self->SUPER::Fetch($key, 1); +} + +sub STORE { + my ($self,$key,$value) = @_; + $self->SUPER::Store($key, $value, 1); +} + +# Enumerate collection members, not object properties +*FIRSTKEY = *Win32::OLE::Tie::FIRSTENUM; +*NEXTKEY = *Win32::OLE::Tie::NEXTENUM; + + +######################################################################## +package OLE; +######################################################################## +use Win32::OLE qw(CP_ACP); + +# Use OleInitialize() instead of CoInitializeEx: +Win32::OLE->Initialize(Win32::OLE::COINIT_OLEINITIALIZE); + +use strict; + +# Disable overload; unfortunately "no overload" doesn't do it :-( +# Overloading is no longer enabled by default in Win32::OLE +#use overload '""' => sub {overload::StrVal($_[0])}, +# '0+' => sub {overload::StrVal($_[0])}; + +use vars qw($AUTOLOAD @ISA $LCID $CP $Warn $LastError $Tie); +@ISA = qw(Win32::OLE); + +$Warn = 0; +$LCID = 2 << 10; # LOCALE_SYSTEM_DEFAULT +$CP = CP_ACP; +$Tie = 'OLE::Tie'; + +sub new { + my $class = shift; + $class = shift if $class eq 'OLE'; + return OLE->SUPER::new($class); +} + +sub copy { + my $class = shift; + $class = shift if $class eq 'OLE'; + return OLE->SUPER::GetActiveObject($class); +} + +sub AUTOLOAD { + my $self = shift; + my $retval; + $AUTOLOAD =~ s/.*:://o; + + Carp::croak("Cannot autoload class method \"$AUTOLOAD\"") + unless ref($self) && UNIVERSAL::isa($self,'OLE'); + + local $^H = 0; # !hack alert! + unless (defined $self->Dispatch($AUTOLOAD, $retval, @_)) { + # Retry default method + $self->Dispatch(undef, $retval, $AUTOLOAD, @_); + } + return $retval; +} + +*CreateObject = \&new; +*GetObject = \© + +# Automation data types. + +sub VT_EMPTY {0;} +sub VT_NULL {1;} +sub VT_I2 {2;} +sub VT_I4 {3;} +sub VT_R4 {4;} +sub VT_R8 {5;} +sub VT_CY {6;} +sub VT_DATE {7;} +sub VT_BSTR {8;} +sub VT_DISPATCH {9;} +sub VT_ERROR {10;} +sub VT_BOOL {11;} +sub VT_VARIANT {12;} +sub VT_UNKNOWN {13;} +sub VT_I1 {16;} +sub VT_UI1 {17;} +sub VT_UI2 {18;} +sub VT_UI4 {19;} +sub VT_I8 {20;} +sub VT_UI8 {21;} +sub VT_INT {22;} +sub VT_UINT {23;} +sub VT_VOID {24;} +sub VT_HRESULT {25;} +sub VT_PTR {26;} +sub VT_SAFEARRAY {27;} +sub VT_CARRAY {28;} +sub VT_USERDEFINED {29;} +sub VT_LPSTR {30;} +sub VT_LPWSTR {31;} +sub VT_FILETIME {64;} +sub VT_BLOB {65;} +sub VT_STREAM {66;} +sub VT_STORAGE {67;} +sub VT_STREAMED_OBJECT {68;} +sub VT_STORED_OBJECT {69;} +sub VT_BLOB_OBJECT {70;} +sub VT_CF {71;} +sub VT_CLSID {72;} + +sub TKIND_ENUM {0;} +sub TKIND_RECORD {1;} +sub TKIND_MODULE {2;} +sub TKIND_INTERFACE {3;} +sub TKIND_DISPATCH {4;} +sub TKIND_COCLASS {5;} +sub TKIND_ALIAS {6;} +sub TKIND_UNION {7;} +sub TKIND_MAX {8;} + +1; diff --git a/Master/tlpkg/tlperl/site/lib/Win32/OLE.pm b/Master/tlpkg/tlperl/site/lib/Win32/OLE.pm new file mode 100755 index 00000000000..ece534b15fa --- /dev/null +++ b/Master/tlpkg/tlperl/site/lib/Win32/OLE.pm @@ -0,0 +1,968 @@ +# The documentation is at the __END__ + +package Win32::OLE; + +use strict; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK @EXPORT_FAIL $AUTOLOAD + $CP $LCID $Warn $LastError $_NewEnum $_Unique); + +$VERSION = '0.1712'; + +use Carp; +use Exporter; +use DynaLoader; +@ISA = qw(Exporter DynaLoader); + +@EXPORT = qw(); +@EXPORT_OK = qw(in valof with HRESULT EVENTS OVERLOAD + CP_ACP CP_OEMCP CP_MACCP CP_UTF7 CP_UTF8 + DISPATCH_METHOD DISPATCH_PROPERTYGET + DISPATCH_PROPERTYPUT DISPATCH_PROPERTYPUTREF); +@EXPORT_FAIL = qw(EVENTS OVERLOAD); + +sub export_fail { + shift; + my @unknown; + while (@_) { + my $symbol = shift; + if ($symbol eq 'OVERLOAD') { + eval <<'OVERLOAD'; + use overload '""' => \&valof, + '0+' => \&valof, + fallback => 1; +OVERLOAD + } + elsif ($symbol eq 'EVENTS') { + Win32::OLE->Initialize(Win32::OLE::COINIT_OLEINITIALIZE()); + } + else { + push @unknown, $symbol; + } + } + return @unknown; +} + +unless (defined &Dispatch) { + # Use regular DynaLoader if XS part is not yet initialized + bootstrap Win32::OLE; + require Win32::OLE::Lite; +} + +1; + +######################################################################## + +__END__ + +=head1 NAME + +Win32::OLE - OLE Automation extensions + +=head1 SYNOPSIS + + $ex = Win32::OLE->new('Excel.Application') or die "oops\n"; + $ex->Amethod("arg")->Bmethod->{'Property'} = "foo"; + $ex->Cmethod(undef,undef,$Arg3); + $ex->Dmethod($RequiredArg1, {NamedArg1 => $Value1, NamedArg2 => $Value2}); + + $wd = Win32::OLE->GetObject("D:\\Data\\Message.doc"); + $xl = Win32::OLE->GetActiveObject("Excel.Application"); + +=head1 DESCRIPTION + +This module provides an interface to OLE Automation from Perl. +OLE Automation brings VisualBasic like scripting capabilities and +offers powerful extensibility and the ability to control many Win32 +applications from Perl scripts. + +The Win32::OLE module uses the IDispatch interface exclusively. It is +not possible to access a custom OLE interface. OLE events and OCX's are +currently not supported. + +Actually, that's no longer strictly true. This module now contains +B<ALPHA> level support for OLE events. This is largely untested and the +specific interface might still change in the future. + +=head2 Methods + +=over 8 + +=item Win32::OLE->new(PROGID[, DESTRUCTOR]) + +The new() class method starts a new instance of an OLE Automation object. +It returns a reference to this object or C<undef> if the creation failed. + +The PROGID argument must be either the OLE I<program id> or the I<class id> +of the required application. The optional DESTRUCTOR specifies a DESTROY-like +method. This can be either a CODE reference or a string containing an OLE +method name. It can be used to cleanly terminate OLE applications in case the +Perl program dies. + +To create an object via DCOM on a remote server you can use an array +reference in place of PROGID. The referenced array must contain the +machine name and the I<program id> or I<class id>. For example: + + my $obj = Win32::OLE->new(['my.machine.com', 'Program.Id']); + +If the PROGID is a I<program id> then Win32::OLE will try to resolve the +corresponding I<class id> locally. If the I<program id> is not registered +locally then the remote registry is queried. This will only succeed if +the local process has read access to the remote registry. The safest +(and fastest) method is to specify the C<class id> directly. + +=item Win32::OLE->EnumAllObjects([CALLBACK]) + +This class method returns the number Win32::OLE objects currently in +existence. It will call the optional CALLBACK function for each of +these objects: + + $Count = Win32::OLE->EnumAllObjects(sub { + my $Object = shift; + my $Class = Win32::OLE->QueryObjectType($Object); + printf "# Object=%s Class=%s\n", $Object, $Class; + }); + +The EnumAllObjects() method is primarily a debugging tool. It can be +used e.g. in an END block to check if all external connections have +been properly destroyed. + +=item Win32::OLE->FreeUnusedLibraries() + +The FreeUnusedLibraries() class method unloads all unused OLE +resources. These are the libraries of those classes of which all +existing objects have been destroyed. The unloading of object +libraries is really only important for long running processes that +might instantiate a huge number of B<different> objects over time. + +Be aware that objects implemented in Visual Basic have a buggy +implementation of this functionality: They pretend to be unloadable +while they are actually still running their cleanup code. Unloading +the DLL at that moment typically produces an access violation. The +probability for this problem can be reduced by calling the +SpinMessageLoop() method and sleep()ing for a few seconds. + +=item Win32::OLE->GetActiveObject(CLASS[, DESTRUCTOR]) + +The GetActiveObject() class method returns an OLE reference to a +running instance of the specified OLE automation server. It returns +C<undef> if the server is not currently active. It will croak if +the class is not even registered. The optional DESTRUCTOR method takes +either a method name or a code reference. It is executed when the last +reference to this object goes away. It is generally considered rude +to stop applications that you did not start yourself. + +=item Win32::OLE->GetObject(MONIKER[, DESTRUCTOR]) + +The GetObject() class method returns an OLE reference to the specified +object. The object is specified by a pathname optionally followed by +additional item subcomponent separated by exclamation marks '!'. The +optional DESTRUCTOR argument has the same semantics as the DESTRUCTOR in +new() or GetActiveObject(). + +=item Win32::OLE->Initialize([COINIT]) + +The Initialize() class method can be used to specify an alternative +apartment model for the Perl thread. It must be called B<before> the +first OLE object is created. If the C<Win32::OLE::Const> module is +used then the call to the Initialize() method must be made from a BEGIN +block before the first C<use> statement for the C<Win32::OLE::Const> +module. + +Valid values for COINIT are: + + Win32::OLE::COINIT_APARTMENTTHREADED - single threaded + Win32::OLE::COINIT_MULTITHREADED - the default + Win32::OLE::COINIT_OLEINITIALIZE - single threaded, additional OLE stuff + +COINIT_OLEINITIALIZE is sometimes needed when an OLE object uses +additional OLE compound document technologies not available from the +normal COM subsystem (for example MAPI.Session seems to require it). +Both COINIT_OLEINITIALIZE and COINIT_APARTMENTTHREADED create a hidden +top level window and a message queue for the Perl process. This may +create problems with other application, because Perl normally doesn't +process its message queue. This means programs using synchronous +communication between applications (such as DDE initiation), may hang +until Perl makes another OLE method call/property access or terminates. +This applies to InstallShield setups and many things started to shell +associations. Please try to utilize the C<Win32::OLE-E<gt>SpinMessageLoop> +and C<Win32::OLE-E<gt>Uninitialize> methods if you can not use the default +COINIT_MULTITHREADED model. + +=item OBJECT->Invoke(METHOD[, ARGS]) + +The Invoke() object method is an alternate way to invoke OLE +methods. It is normally equivalent to C<$OBJECT-E<gt>METHOD(@ARGS)>. This +function must be used if the METHOD name contains characters not valid +in a Perl variable name (like foreign language characters). It can +also be used to invoke the default method of an object even if the +default method has not been given a name in the type library. In this +case use <undef> or C<''> as the method name. To invoke an OLE objects +native Invoke() method (if such a thing exists), please use: + + $Object->Invoke('Invoke', @Args); + +=item Win32::OLE->LastError() + +The LastError() class method returns the last recorded OLE +error. This is a dual value like the C<$!> variable: in a numeric +context it returns the error number and in a string context it returns +the error message. The error number is a signed HRESULT value. Please +use the L<HRESULT(ERROR)> function to convert an unsigned hexadecimal +constant to a signed HRESULT. + +The last OLE error is automatically reset by a successful OLE +call. The numeric value can also explicitly be set by a call (which will +discard the string value): + + Win32::OLE->LastError(0); + +=item OBJECT->LetProperty(NAME,ARGS,VALUE) + +In Win32::OLE property assignment using the hash syntax is equivalent +to the Visual Basic C<Set> syntax (I<by reference> assignment): + + $Object->{Property} = $OtherObject; + +corresponds to this Visual Basic statement: + + Set Object.Property = OtherObject + +To get the I<by value> treatment of the Visual Basic C<Let> statement + + Object.Property = OtherObject + +you have to use the LetProperty() object method in Perl: + + $Object->LetProperty($Property, $OtherObject); + +LetProperty() also supports optional arguments for the property assignment. +See L<OBJECT->SetProperty(NAME,ARGS,VALUE)> for details. + +=item Win32::OLE->MessageLoop() + +The MessageLoop() class method will run a standard Windows message +loop, dispatching messages until the QuitMessageLoop() class method is +called. It is used to wait for OLE events. + +=item Win32::OLE->Option(OPTION) + +The Option() class method can be used to inspect and modify +L<Module Options>. The single argument form retrieves the value of +an option: + + my $CP = Win32::OLE->Option('CP'); + +A single call can be used to set multiple options simultaneously: + + Win32::OLE->Option(CP => CP_ACP, Warn => 3); + +=item Win32::OLE->QueryObjectType(OBJECT) + +The QueryObjectType() class method returns a list of the type library +name and the objects class name. In a scalar context it returns the +class name only. It returns C<undef> when the type information is not +available. + +=item Win32::OLE->QuitMessageLoop() + +The QuitMessageLoop() class method posts a (user-level) "Quit" message +to the current threads message loop. QuitMessageLoop() is typically +called from an event handler. The MessageLoop() class method will +return when it receives this "Quit" method. + +=item OBJECT->SetProperty(NAME,ARGS,VALUE) + +The SetProperty() method allows to modify properties with arguments, +which is not supported by the hash syntax. The hash form + + $Object->{Property} = $Value; + +is equivalent to + + $Object->SetProperty('Property', $Value); + +Arguments must be specified between the property name and the new value: + + $Object->SetProperty('Property', @Args, $Value); + +It is not possible to use "named argument" syntax with this function +because the new value must be the last argument to SetProperty(). + +This method hides any native OLE object method called SetProperty(). +The native method will still be available through the Invoke() method: + + $Object->Invoke('SetProperty', @Args); + +=item Win32::OLE->SpinMessageLoop + +This class method retrieves all pending messages from the message queue +and dispatches them to their respective window procedures. Calling this +method is only necessary when not using the COINIT_MULTITHREADED model. +All OLE method calls and property accesses automatically process the +message queue. + +=item Win32::OLE->Uninitialize + +The Uninitialize() class method uninitializes the OLE subsystem. It +also destroys the hidden top level window created by OLE for single +threaded apartments. All OLE objects will become invalid after this call! +It is possible to call the Initialize() class method again with a different +apartment model after shutting down OLE with Uninitialize(). + +=item Win32::OLE->WithEvents(OBJECT[, HANDLER[, INTERFACE]]) + +This class method enables and disables the firing of events by the +specified OBJECT. If no HANDLER is specified, then events are +disconnected. For some objects Win32::OLE is not able to +automatically determine the correct event interface. In this case the +INTERFACE argument must contain either the COCLASS name of the OBJECT +or the name of the event DISPATCH interface. Please read the L<Events> +section below for detailed explanation of the Win32::OLE event +support. + +=back + +Whenever Perl does not find a method name in the Win32::OLE package it +is automatically used as the name of an OLE method and this method call +is dispatched to the OLE server. + +There is one special hack built into the module: If a method or property +name could not be resolved with the OLE object, then the default method +of the object is called with the method name as its first parameter. So + + my $Sheet = $Worksheets->Table1; +or + my $Sheet = $Worksheets->{Table1}; + +is resolved as + + my $Sheet = $Worksheet->Item('Table1'); + +provided that the $Worksheets object does not have a C<Table1> method +or property. This hack has been introduced to call the default method +of collections which did not name the method in their type library. The +recommended way to call the "unnamed" default method is: + + my $Sheet = $Worksheets->Invoke('', 'Table1'); + +This special hack is disabled under C<use strict 'subs';>. + +=head2 Object methods and properties + +The object returned by the new() method can be used to invoke +methods or retrieve properties in the same fashion as described +in the documentation for the particular OLE class (eg. Microsoft +Excel documentation describes the object hierarchy along with the +properties and methods exposed for OLE access). + +Optional parameters on method calls can be omitted by using C<undef> +as a placeholder. A better way is to use named arguments, as the +order of optional parameters may change in later versions of the OLE +server application. Named parameters can be specified in a reference +to a hash as the last parameter to a method call. + +Properties can be retrieved or set using hash syntax, while methods +can be invoked with the usual perl method call syntax. The C<keys> +and C<each> functions can be used to enumerate an object's properties. +Beware that a property is not always writable or even readable (sometimes +raising exceptions when read while being undefined). + +If a method or property returns an embedded OLE object, method +and property access can be chained as shown in the examples below. + +=head2 Functions + +The following functions are not exported by default. + +=over 8 + +=item HRESULT(ERROR) + +The HRESULT() function converts an unsigned number into a signed HRESULT +error value as used by OLE internally. This is necessary because Perl +treats all hexadecimal constants as unsigned. To check if the last OLE +function returned "Member not found" (0x80020003) you can write: + + if (Win32::OLE->LastError == HRESULT(0x80020003)) { + # your error recovery here + } + +=item in(COLLECTION) + +If COLLECTION is an OLE collection object then C<in $COLLECTION> +returns a list of all members of the collection. This is a shortcut +for C<Win32::OLE::Enum-E<gt>All($COLLECTION)>. It is most commonly used in +a C<foreach> loop: + + foreach my $value (in $collection) { + # do something with $value here + } + +=item valof(OBJECT) + +Normal assignment of Perl OLE objects creates just another reference +to the OLE object. The valof() function explictly dereferences the +object (through the default method) and returns the value of the object. + + my $RefOf = $Object; + my $ValOf = valof $Object; + $Object->{Value} = $NewValue; + +Now $ValOf still contains the old value whereas $RefOf would +resolve to the $NewValue because it is still a reference to +$Object. + +The valof() function can also be used to convert Win32::OLE::Variant +objects to Perl values. + +=item with(OBJECT, PROPERTYNAME => VALUE, ...) + +This function provides a concise way to set the values of multiple +properties of an object. It iterates over its arguments doing +C<$OBJECT-E<gt>{PROPERTYNAME} = $VALUE> on each trailing pair. + +=back + +=head2 Overloading + +The Win32::OLE objects can be overloaded to automatically convert to +their values whenever they are used in a bool, numeric or string +context. This is not enabled by default. You have to request it +through the OVERLOAD pseudoexport: + + use Win32::OLE qw(in valof with OVERLOAD); + +You can still get the original string representation of an object +(C<Win32::OLE=0xDEADBEEF>), e.g. for debugging, by using the +C<overload::StrVal()> method: + + print overload::StrVal($object), "\n"; + +Please note that C<OVERLOAD> is a global setting. If any module enables +Win32::OLE overloading then it's active everywhere. + +=head2 Events + +The Win32::OLE module now contains B<ALPHA> level event support. This +support is only available when Perl is running in a single threaded +apartment. This can most easily be assured by using the C<EVENTS> +pseudo-import: + + use Win32::OLE qw(EVENTS); + +which implicitly does something like: + + use Win32::OLE; + Win32::OLE->Initialize(Win32::OLE::COINIT_OLEINITIALIZE); + +The current interface to OLE events should be considered experimental +and is subject to change. It works as expected for normal OLE +applications, but OLE control events often don't seem to work yet. + +Events must be enabled explicitly for an OLE object through the +Win32::OLE->WithEvents() class method. The Win32::OLE module uses the +IProvideClassInfo2 interface to determine the default event source of +the object. If this interface is not supported, then the user must +specify the name of the event source explicitly in the WithEvents() +method call. It is also possible to specify the class name of the +object as the third parameter. In this case Win32::OLE will try to +look up the default source interface for this COCLASS. + +The HANDLER argument to Win32::OLE->WithEvents() can either be a CODE +reference or a package name. In the first case, all events will invoke +this particular function. The first two arguments to this function will +be the OBJECT itself and the name of the event. The remaining arguments +will be event specific. + + sub Event { + my ($Obj,$Event,@Args) = @_; + print "Event triggered: '$Event'\n"; + } + Win32::OLE->WithEvents($Obj, \&Event); + +Alternatively the HANDLER argument can specify a package name. When the +OBJECT fires an event, Win32::OLE will try to find a function of the same +name as the event in this package. This function will be called with the +OBJECT as the first argument followed again by the event specific parameters: + + package MyEvents; + sub EventName1 { + my ($Obj,@Args) = @_; + print "EventName1 event triggered\n"; + } + + package main; + Win32::OLE->WithEvents($Obj, 'MyEvents', 'IEventInterface'); + +If Win32::OLE doesn't find a function with the name of the event then nothing +happens. + +Event parameters passed I<by reference> are handled specially. They are not +converted to the corresponding Perl datatype but passed as Win32::OLE::Variant +objects. You can assign a new value to these objects with the help of the +Put() method. This value will be passed back to the object when the event +function returns: + + package MyEvents; + sub BeforeClose { + my ($self,$Cancel) = @_; + $Cancel->Put(1) unless $MayClose; + } + +Direct assignment to $Cancel would have no effect on the original value and +would therefore not command the object to abort the closing action. + +=head2 Module Options + +The following module options can be accessed and modified with the +C<Win32::OLE-E<gt>Option> class method. In earlier versions of the Win32::OLE +module these options were manipulated directly as class variables. This +practice is now deprecated. + +=over 8 + +=item CP + +This variable is used to determine the codepage used by all +translations between Perl strings and Unicode strings used by the OLE +interface. The default value is CP_ACP, which is the default ANSI +codepage. Other possible values are CP_OEMCP, CP_MACCP, CP_UTF7 and +CP_UTF8. These constants are not exported by default. + +=item LCID + +This variable controls the locale identifier used for all OLE calls. +It is set to LOCALE_NEUTRAL by default. Please check the +L<Win32::OLE::NLS> module for other locale related information. + +=item Variant + +This options controls how method calls and property accessors return +values of type VT_CY and VT_DECIMAL are being returned. By default +VT_CY values are turned into strings and VT_DECIMAL values into +floating point numbers. If the C<Variant> option is enabled, these +values are returned as Win32::OLE::Variant objects, just like VT_DATE +and VT_ERROR values. If the Win32::OLE::Variant module is also +loaded, then all values should still behave as before in string and in +numeric context. + +The only reason that the C<Variant> behavior is not the default is that +this is an incompatible change that might break existing programs. + +=item Warn + +This variable determines the behavior of the Win32::OLE module when +an error happens. Valid values are: + + 0 Ignore error, return undef + 1 Carp::carp if $^W is set (-w option) + 2 always Carp::carp + 3 Carp::croak + +The error number and message (without Carp line/module info) are +available through the C<Win32::OLE-E<gt>LastError> class method. + +Alternatively the Warn option can be set to a CODE reference. E.g. + + Win32::OLE->Option(Warn => 3); + +is equivalent to + + Win32::OLE->Option(Warn => \&Carp::croak); + +This can even be used to emulate the VisualBasic C<On Error Goto +Label> construct: + + Win32::OLE->Option(Warn => sub {goto CheckError}); + # ... your normal OLE code here ... + + CheckError: + # ... your error handling code here ... + +=item _NewEnum + +This option enables additional enumeration support for collection +objects. When the C<_NewEnum> option is set, all collections will +receive one additional property: C<_NewEnum>. The value of this +property will be a reference to an array containing all the elements +of the collection. This option can be useful when used in conjunction +with an automatic tree traversal program, like C<Data::Dumper> or an +object tree browser. The value of this option should be either 1 +(enabled) or 0 (disabled, default). + + Win32::OLE->Option(_NewEnum => 1); + # ... + my @sheets = @{$Excel->Worksheets->{_NewEnum}}; + +In normal application code, this would be better written as: + + use Win32::OLE qw(in); + # ... + my @sheets = in $Excel->Worksheets; + +=item _Unique + +The C<_Unique> options guarantees that Win32::OLE will maintain a +one-to-one mapping between Win32::OLE objects and the native COM/OLE +objects. Without this option, you can query the same property twice +and get two different Win32::OLE objects for the same underlying COM +object. + +Using a unique proxy makes life easier for tree traversal algorithms +to recognize they already visited a particular node. This option +comes at a price: Win32::OLE has to maintain a global hash of all +outstanding objects and their corresponding proxies. Identity checks +on COM objects can also be expensive if the objects reside +out-of-process or even on a different computer. Therefore this option +is off by default unless the program is being run in the debugger. + +Unfortunately, this option doesn't always help. Some programs will +return new COM objects for even the same property when asked for it +multiple times (especially for collections). In this case, there is +nothing Win32::OLE can do to detect that these objects are in fact +identical (because they aren't at the COM level). + +The C<_Unique> option can be set to either 1 (enabled) or 0 (disabled, +default). + +=back + +=head1 EXAMPLES + +Here is a simple Microsoft Excel application. + + use Win32::OLE; + + # use existing instance if Excel is already running + eval {$ex = Win32::OLE->GetActiveObject('Excel.Application')}; + die "Excel not installed" if $@; + unless (defined $ex) { + $ex = Win32::OLE->new('Excel.Application', sub {$_[0]->Quit;}) + or die "Oops, cannot start Excel"; + } + + # get a new workbook + $book = $ex->Workbooks->Add; + + # write to a particular cell + $sheet = $book->Worksheets(1); + $sheet->Cells(1,1)->{Value} = "foo"; + + # write a 2 rows by 3 columns range + $sheet->Range("A8:C9")->{Value} = [[ undef, 'Xyzzy', 'Plugh' ], + [ 42, 'Perl', 3.1415 ]]; + + # print "XyzzyPerl" + $array = $sheet->Range("A8:C9")->{Value}; + for (@$array) { + for (@$_) { + print defined($_) ? "$_|" : "<undef>|"; + } + print "\n"; + } + + # save and exit + $book->SaveAs( 'test.xls' ); + undef $book; + undef $ex; + +Please note the destructor specified on the Win32::OLE->new method. It ensures +that Excel will shutdown properly even if the Perl program dies. Otherwise +there could be a process leak if your application dies after having opened +an OLE instance of Excel. It is the responsibility of the module user to +make sure that all OLE objects are cleaned up properly! + +Here is an example of using Variant data types. + + use Win32::OLE; + use Win32::OLE::Variant; + $ex = Win32::OLE->new('Excel.Application', \&OleQuit) or die "oops\n"; + $ex->{Visible} = 1; + $ex->Workbooks->Add; + # should generate a warning under -w + $ovR8 = Variant(VT_R8, "3 is a good number"); + $ex->Range("A1")->{Value} = $ovR8; + $ex->Range("A2")->{Value} = Variant(VT_DATE, 'Jan 1,1970'); + + sub OleQuit { + my $self = shift; + $self->Quit; + } + +The above will put value "3" in cell A1 rather than the string +"3 is a good number". Cell A2 will contain the date. + +Similarly, to invoke a method with some binary data, you can +do the following: + + $obj->Method( Variant(VT_UI1, "foo\000b\001a\002r") ); + +Here is a wrapper class that basically delegates everything but +new() and DESTROY(). The wrapper class shown here is another way to +properly shut down connections if your application is liable to die +without proper cleanup. Your own wrappers will probably do something +more specific to the particular OLE object you may be dealing with, +like overriding the methods that you may wish to enhance with your +own. + + package Excel; + use Win32::OLE; + + sub new { + my $s = {}; + if ($s->{Ex} = Win32::OLE->new('Excel.Application')) { + return bless $s, shift; + } + return undef; + } + + sub DESTROY { + my $s = shift; + if (exists $s->{Ex}) { + print "# closing connection\n"; + $s->{Ex}->Quit; + return undef; + } + } + + sub AUTOLOAD { + my $s = shift; + $AUTOLOAD =~ s/^.*:://; + $s->{Ex}->$AUTOLOAD(@_); + } + + 1; + +The above module can be used just like Win32::OLE, except that +it takes care of closing connections in case of abnormal exits. +Note that the effect of this specific example can be easier accomplished +using the optional destructor argument of Win32::OLE::new: + + my $Excel = Win32::OLE->new('Excel.Application', sub {$_[0]->Quit;}); + +Note that the delegation shown in the earlier example is not the same as +true subclassing with respect to further inheritance of method calls in your +specialized object. See L<perlobj>, L<perltoot> and L<perlbot> for details. +True subclassing (available by setting C<@ISA>) is also feasible, +as the following example demonstrates: + + # + # Add error reporting to Win32::OLE + # + + package Win32::OLE::Strict; + use Carp; + use Win32::OLE; + + use strict qw(vars); + use vars qw($AUTOLOAD @ISA); + @ISA = qw(Win32::OLE); + + sub AUTOLOAD { + my $obj = shift; + $AUTOLOAD =~ s/^.*:://; + my $meth = $AUTOLOAD; + $AUTOLOAD = "SUPER::" . $AUTOLOAD; + my $retval = $obj->$AUTOLOAD(@_); + unless (defined($retval) || $AUTOLOAD eq 'DESTROY') { + my $err = Win32::OLE::LastError(); + croak(sprintf("$meth returned OLE error 0x%08x",$err)) + if $err; + } + return $retval; + } + + 1; + +This package inherits the constructor new() from the Win32::OLE +package. It is important to note that you cannot later rebless a +Win32::OLE object as some information about the package is cached by +the object. Always invoke the new() constructor through the right +package! + +Here's how the above class will be used: + + use Win32::OLE::Strict; + my $Excel = Win32::OLE::Strict->new('Excel.Application', 'Quit'); + my $Books = $Excel->Workbooks; + $Books->UnknownMethod(42); + +In the sample above the call to UnknownMethod() will be caught with + + UnknownMethod returned OLE error 0x80020009 at test.pl line 5 + +because the Workbooks object inherits the class C<Win32::OLE::Strict> from the +C<$Excel> object. + +=head1 NOTES + +=head2 Hints for Microsoft Office automation + +=over 8 + +=item Documentation + +The object model for the Office applications is defined in the Visual Basic +reference guides for the various applications. These are typically not +installed by default during the standard installation. They can be added +later by rerunning the setup program with the custom install option. + +=item Class, Method and Property names + +The names have been changed between different versions of Office. For +example C<Application> was a method in Office 95 and is a property in +Office97. Therefore it will not show up in the list of property names +C<keys %$object> when querying an Office 95 object. + +The class names are not always identical to the method/property names +producing the object. E.g. the C<Workbook> method returns an object of +type C<Workbook> in Office 95 and C<_Workbook> in Office 97. + +=item Moniker (GetObject support) + +Office applications seem to implement file monikers only. For example +it seems to be impossible to retrieve a specific worksheet object through +C<GetObject("File.XLS!Sheet")>. Furthermore, in Excel 95 the moniker starts +a Worksheet object and in Excel 97 it returns a Workbook object. You can use +either the Win32::OLE::QueryObjectType class method or the $object->{Version} +property to write portable code. + +=item Enumeration of collection objects + +Enumerations seem to be incompletely implemented. Office 95 application don't +seem to support neither the Reset() nor the Clone() methods. The Clone() +method is still unimplemented in Office 97. A single walk through the +collection similar to Visual Basics C<for each> construct does work however. + +=item Localization + +Starting with Office 97 Microsoft has changed the localized class, method and +property names back into English. Note that string, date and currency +arguments are still subject to locale specific interpretation. Perl uses the +system default locale for all OLE transaction whereas Visual Basic uses a +type library specific locale. A Visual Basic script would use "R1C1" in string +arguments to specify relative references. A Perl script running on a German +language Windows would have to use "Z1S1". Set the LCID module option +to an English locale to write portable scripts. This variable should +not be changed after creating the OLE objects; some methods seem to randomly +fail if the locale is changed on the fly. + +=item SaveAs method in Word 97 doesn't work + +This is an known bug in Word 97. Search the MS knowledge base for Word / +Foxpro incompatibility. That problem applies to the Perl OLE interface as +well. A workaround is to use the WordBasic compatibility object. It doesn't +support all the options of the native method though. + + $Word->WordBasic->FileSaveAs($file); + +The problem seems to be fixed by applying the Office 97 Service Release 1. + +=item Randomly failing method calls + +It seems like modifying objects that are not selected/activated is sometimes +fragile. Most of these problems go away if the chart/sheet/document is +selected or activated before being manipulated (just like an interactive +user would automatically do it). + +=back + +=head2 Incompatibilities + +There are some incompatibilities with the version distributed by Activeware +(as of build 306). + +=over 8 + +=item 1 + +The package name has changed from "OLE" to "Win32::OLE". + +=item 2 + +All functions of the form "Win32::OLEFoo" are now "Win32::OLE::Foo", +though the old names are temporarily accommodated. Win32::OLECreateObject() +was changed to Win32::OLE::CreateObject(), and is now called +Win32::OLE::new() bowing to established convention for naming constructors. +The old names should be considered deprecated, and will be removed in the +next version. + +=item 3 + +Package "OLE::Variant" is now "Win32::OLE::Variant". + +=item 4 + +The Variant function is new, and is exported by default. So are +all the VT_XXX type constants. + +=item 5 + +The support for collection objects has been moved into the package +Win32::OLE::Enum. The C<keys %$object> method is now used to enumerate +the properties of the object. + +=back + +=head2 Bugs and Limitations + +=over 8 + +=item * + +To invoke a native OLE method with the same name as one of the +Win32::OLE methods (C<Dispatch>, C<Invoke>, C<SetProperty>, C<DESTROY>, +etc.), you have to use the C<Invoke> method: + + $Object->Invoke('Dispatch', @AdditionalArgs); + +The same is true for names exported by the Exporter or the Dynaloader +modules, e.g.: C<export>, C<export_to_level>, C<import>, +C<_push_tags>, C<export_tags>, C<export_ok_tags>, C<export_fail>, +C<require_version>, C<dl_load_flags>, +C<croak>, C<bootstrap>, C<dl_findfile>, C<dl_expandspec>, +C<dl_find_symbol_anywhere>, C<dl_load_file>, C<dl_find_symbol>, +C<dl_undef_symbols>, C<dl_install_xsub> and C<dl_error>. + +=back + +=head1 SEE ALSO + +The documentation for L<Win32::OLE::Const>, L<Win32::OLE::Enum>, +L<Win32::OLE::NLS> and L<Win32::OLE::Variant> contains additional +information about OLE support for Perl on Win32. + +=head1 AUTHORS + +Originally put together by the kind people at Hip and Activeware. + +Gurusamy Sarathy <gsar@cpan.org> subsequently fixed several +major bugs, memory leaks, and reliability problems, along with some +redesign of the code. + +Jan Dubois <jand@activestate.com> pitched in with yet more massive redesign, +added support for named parameters, and other significant enhancements. +He's been hacking on it ever since. + +Please send questions about problems with this module to the +Perl-Win32-Users mailinglist at ActiveState.com. The mailinglist charter +requests that you put an [OLE] tag somewhere on the subject line (for OLE +related questions only, of course). + +=head1 COPYRIGHT + + (c) 1995 Microsoft Corporation. All rights reserved. + Developed by ActiveWare Internet Corp., now known as + ActiveState Tool Corp., http://www.ActiveState.com + + Other modifications Copyright (c) 1997-2006 by Gurusamy Sarathy + <gsar@cpan.org> and Jan Dubois <jand@activestate.com> + + You may distribute under the terms of either the GNU General Public + License or the Artistic License, as specified in the README file. + +=head1 VERSION + +Version 0.1712 14 May 2014 + +=cut diff --git a/Master/tlpkg/tlperl/site/lib/Win32/OLE/Const.pm b/Master/tlpkg/tlperl/site/lib/Win32/OLE/Const.pm new file mode 100755 index 00000000000..d0fe00b9ea7 --- /dev/null +++ b/Master/tlpkg/tlperl/site/lib/Win32/OLE/Const.pm @@ -0,0 +1,201 @@ +# The documentation is at the __END__ + +package Win32::OLE::Const; + +use strict; +use Carp; +use Win32::OLE; + +my $Typelibs; +sub _Typelib { + my ($clsid,$title,$version,$langid,$filename) = @_; + # Filenames might have a resource index appended to it. + $filename = $1 if $filename =~ /^(.*\.(?:dll|exe))(\\\d+)$/i; + # Ignore if it looks like a file but doesn't exist. + # We don't verify existence of monikers or filenames + # without a full pathname. + return if $filename =~ /^\w:\\.*\.(exe|dll)$/ && !-f $filename; + push @$Typelibs, \@_; +} +unless (__PACKAGE__->_Typelibs("TypeLib")) { + warn("Cannot access HKEY_CLASSES_ROOT\\Typelib"); +} +# Enumerate 32bit type libraries on Win64 +__PACKAGE__->_Typelibs("Wow6432Node\\TypeLib"); + +sub import { + my ($self,$name,$major,$minor,$language,$codepage) = @_; + return unless defined($name) && $name !~ /^\s*$/; + $self->Load($name,$major,$minor,$language,$codepage,scalar caller); +} + +sub EnumTypeLibs { + my ($self,$callback) = @_; + foreach (@$Typelibs) { &$callback(@$_) } + return; +} + +sub Load { + my ($self,$name,$major,$minor,$language,$codepage,$caller) = @_; + + if (UNIVERSAL::isa($name,'Win32::OLE')) { + my $typelib = $name->GetTypeInfo->GetContainingTypeLib; + return _Constants($typelib, undef); + } + + undef $minor unless defined $major; + my $typelib = $self->LoadRegTypeLib($name,$major,$minor, + $language,$codepage); + return _Constants($typelib, $caller); +} + +sub LoadRegTypeLib { + my ($self,$name,$major,$minor,$language,$codepage) = @_; + undef $minor unless defined $major; + + unless (defined($name) && $name !~ /^\s*$/) { + carp "Win32::OLE::Const->Load: No or invalid type library name"; + return; + } + + my @found; + foreach my $Typelib (@$Typelibs) { + my ($clsid,$title,$version,$langid,$filename) = @$Typelib; + next unless $title =~ /^$name/; + next unless $version =~ /^([0-9a-fA-F]+)\.([0-9a-fA-F]+)$/; + my ($maj,$min) = (hex($1), hex($2)); + next if defined($major) && $maj != $major; + next if defined($minor) && $min < $minor; + next if defined($language) && $language != $langid; + push @found, [$clsid,$maj,$min,$langid,$filename]; + } + + unless (@found) { + carp "No type library matching \"$name\" found"; + return; + } + + @found = sort { + # Prefer greater version number + my $res = $b->[1] <=> $a->[1]; + $res = $b->[2] <=> $a->[2] if $res == 0; + # Prefer default language for equal version numbers + $res = -1 if $res == 0 && $a->[3] == 0; + $res = 1 if $res == 0 && $b->[3] == 0; + $res; + } @found; + + #printf "Loading %s\n", join(' ', @{$found[0]}); + return _LoadRegTypeLib(@{$found[0]},$codepage); +} + +1; + +__END__ + +=head1 NAME + +Win32::OLE::Const - Extract constant definitions from TypeLib + +=head1 SYNOPSIS + + use Win32::OLE::Const 'Microsoft Excel'; + printf "xlMarkerStyleDot = %d\n", xlMarkerStyleDot; + + my $wd = Win32::OLE::Const->Load("Microsoft Word 8\\.0 Object Library"); + foreach my $key (keys %$wd) { + printf "$key = %s\n", $wd->{$key}; + } + +=head1 DESCRIPTION + +This modules makes all constants from a registered OLE type library +available to the Perl program. The constant definitions can be +imported as functions, providing compile time name checking. +Alternatively the constants can be returned in a hash reference +which avoids defining lots of functions of unknown names. + +=head2 Functions/Methods + +=over 4 + +=item use Win32::OLE::Const + +The C<use> statement can be used to directly import the constant names +and values into the users namespace. + + use Win32::OLE::Const (TYPELIB,MAJOR,MINOR,LANGUAGE); + +The TYPELIB argument specifies a regular expression for searching +through the registry for the type library. Note that this argument is +implicitly prefixed with C<^> to speed up matches in the most common +cases. Use a typelib name like ".*Excel" to match anywhere within the +description. TYPELIB is the only required argument. + +The MAJOR and MINOR arguments specify the requested version of +the type specification. If the MAJOR argument is used then only +typelibs with exactly this major version number will be matched. The +MINOR argument however specifies the minimum acceptable minor version. +MINOR is ignored if MAJOR is undefined. + +If the LANGUAGE argument is used then only typelibs with exactly this +language id will be matched. + +The module will select the typelib with the highest version number +satisfying the request. If no language id is specified then a the default +language (0) will be preferred over the others. + +Note that only constants with valid Perl variable names will be exported, +i.e. names matching this regexp: C</^[a-zA-Z_][a-zA-Z0-9_]*$/>. + +=item Win32::OLE::Const->Load + +The Win32::OLE::Const->Load method returns a reference to a hash of +constant definitions. + + my $const = Win32::OLE::Const->Load(TYPELIB,MAJOR,MINOR,LANGUAGE); + +The parameters are the same as for the C<use> case. + +This method is generally preferable when the typelib uses a non-english +language and the constant names contain locale specific characters not +allowed in Perl variable names. + +Another advantage is that all available constants can now be enumerated. + +The load method also accepts an OLE object as a parameter. In this case +the OLE object is queried about its containing type library and no registry +search is done at all. Interestingly this seems to be slower. + +=back + +=head1 EXAMPLES + +The first example imports all Excel constants names into the main namespace +and prints the value of xlMarkerStyleDot (-4118). + + use Win32::OLE::Const ('Microsoft Excel 8.0 Object Library'); + print "xlMarkerStyleDot = %d\n", xlMarkerStyleDot; + +The second example returns all Word constants in a hash ref. + + use Win32::OLE::Const; + my $wd = Win32::OLE::Const->Load("Microsoft Word 8.0 Object Library"); + foreach my $key (keys %$wd) { + printf "$key = %s\n", $wd->{$key}; + } + printf "wdGreen = %s\n", $wd->{wdGreen}; + +The last example uses an OLE object to specify the type library: + + use Win32::OLE; + use Win32::OLE::Const; + my $Excel = Win32::OLE->new('Excel.Application', 'Quit'); + my $xl = Win32::OLE::Const->Load($Excel); + + +=head1 AUTHORS/COPYRIGHT + +This module is part of the Win32::OLE distribution. + +=cut diff --git a/Master/tlpkg/tlperl/site/lib/Win32/OLE/Enum.pm b/Master/tlpkg/tlperl/site/lib/Win32/OLE/Enum.pm new file mode 100755 index 00000000000..6047d2c8274 --- /dev/null +++ b/Master/tlpkg/tlperl/site/lib/Win32/OLE/Enum.pm @@ -0,0 +1,95 @@ +# The documentation is at the __END__ + +package Win32::OLE::Enum; +1; + +# everything is pure XS in Win32::OLE::Enum +# - new +# - DESTROY +# +# - All +# - Clone +# - Next +# - Reset +# - Skip + +__END__ + +=head1 NAME + +Win32::OLE::Enum - OLE Automation Collection Objects + +=head1 SYNOPSIS + + my $Sheets = $Excel->Workbooks(1)->Worksheets; + my $Enum = Win32::OLE::Enum->new($Sheets); + my @Sheets = $Enum->All; + + while (defined(my $Sheet = $Enum->Next)) { ... } + +=head1 DESCRIPTION + +This module provides an interface to OLE collection objects from +Perl. It defines an enumerator object closely mirroring the +functionality of the IEnumVARIANT interface. + +Please note that the Reset() method is not available in all implementations +of OLE collections (like Excel 7). In that case the Enum object is good +only for a single walk through of the collection. + +=head2 Functions/Methods + +=over 8 + +=item Win32::OLE::Enum->new($object) + +Creates an enumerator for $object, which must be a valid OLE collection +object. Note that correctly implemented collection objects must support +the C<Count> and C<Item> methods, so creating an enumerator is not always +necessary. + +=item $Enum->All() + +Returns a list of all objects in the collection. You have to call +$Enum->Reset() before the enumerator can be used again. The previous +position in the collection is lost. + +This method can also be called as a class method: + + my @list = Win32::OLE::Enum->All($Collection); + +=item $Enum->Clone() + +Returns a clone of the enumerator maintaining the current position within +the collection (if possible). Note that the C<Clone> method is often not +implemented. Use $Enum->Clone() in an eval block to avoid dying if you +are not sure that Clone is supported. + +=item $Enum->Next( [$count] ) + +Returns the next element of the collection. In a list context the optional +$count argument specifies the number of objects to be returned. In a scalar +context only the last of at most $count retrieved objects is returned. The +default for $count is 1. + +=item $Enum->Reset() + +Resets the enumeration sequence to the beginning. There is no guarantee that +the exact same set of objects will be enumerated again (e.g. when enumerating +files in a directory). The methods return value indicates the success of the +operation. (Note that the Reset() method seems to be unimplemented in some +applications like Excel 7. Use it in an eval block to avoid dying.) + +=item $Enum->Skip( [$count] ) + +Skip the next $count elements of the enumeration. The default for $count is 1. +The functions returns TRUE if at least $count elements could be skipped. It +returns FALSE if not enough elements were left. + +=back + +=head1 AUTHORS/COPYRIGHT + +This module is part of the Win32::OLE distribution. + +=cut diff --git a/Master/tlpkg/tlperl/site/lib/Win32/OLE/Lite.pm b/Master/tlpkg/tlperl/site/lib/Win32/OLE/Lite.pm new file mode 100755 index 00000000000..66b5e50ac0e --- /dev/null +++ b/Master/tlpkg/tlperl/site/lib/Win32/OLE/Lite.pm @@ -0,0 +1,224 @@ +package Win32::OLE; + +sub _croak { require Carp; Carp::croak(@_) } + +unless (defined &Dispatch) { + DynaLoader::boot_DynaLoader('DynaLoader') + unless defined(&DynaLoader::dl_load_file); + my $file; + foreach my $dir (@INC) { + my $try = "$dir/auto/Win32/OLE/OLE.dll"; + last if $file = (-f $try && $try); + } + _croak("Can't locate loadable object for module Win32::OLE". + " in \@INC (\@INC contains: @INC)") + unless $file; # wording similar to error from 'require' + + my $libref = DynaLoader::dl_load_file($file, 0) or + _croak("Can't load '$file' for module Win32::OLE: ". + DynaLoader::dl_error()."\n"); + + my $boot_symbol_ref = DynaLoader::dl_find_symbol($libref, "boot_Win32__OLE") + or _croak("Can't find 'boot_Win32__OLE' symbol in $file\n"); + + my $xs = DynaLoader::dl_install_xsub("Win32::OLE::bootstrap", + $boot_symbol_ref, $file); + &$xs('Win32::OLE'); +} + +if (defined &DB::sub && !defined $_Unique) { + warn "Win32::OLE operating in debugging mode: _Unique => 1\n"; + $_Unique = 1; +} + +$Warn = 1; + +sub CP_ACP {0;} # ANSI codepage +sub CP_OEMCP {1;} # OEM codepage +sub CP_MACCP {2;} +sub CP_UTF7 {65000;} +sub CP_UTF8 {65001;} + +sub DISPATCH_METHOD {1;} +sub DISPATCH_PROPERTYGET {2;} +sub DISPATCH_PROPERTYPUT {4;} +sub DISPATCH_PROPERTYPUTREF {8;} + +sub COINIT_MULTITHREADED {0;} # Default +sub COINIT_APARTMENTTHREADED {2;} # Use single threaded apartment model + +# Bogus COINIT_* values to indicate special cases: +sub COINIT_OLEINITIALIZE {-1;} # Use OleInitialize instead of CoInitializeEx +sub COINIT_NO_INITIALIZE {-2;} # We are already initialized, just believe me + +sub HRESULT { + my $hr = shift; + $hr -= 2**32 if $hr & 0x80000000; + return $hr; +} + +# CreateObject is defined here only because it is documented in the +# "Learning Perl on Win32 Systems" Gecko book. Please use Win32::OLE->new(). +sub CreateObject { + if (ref($_[0]) && UNIVERSAL::isa($_[0],'Win32::OLE')) { + $AUTOLOAD = ref($_[0]) . '::CreateObject'; + goto &AUTOLOAD; + } + + # Hack to allow C<$obj = CreateObject Win32::OLE 'My.App';>. Although this + # is contrary to the Gecko, we just make it work since it doesn't hurt. + return Win32::OLE->new($_[1]) if $_[0] eq 'Win32::OLE'; + + # Gecko form: C<$success = Win32::OLE::CreateObject('My.App',$obj);> + $_[1] = Win32::OLE->new($_[0]); + return defined $_[1]; +} + +sub LastError { + unless (defined $_[0]) { + # Win32::OLE::LastError() will always return $Win32::OLE::LastError + return $LastError; + } + + if (ref($_[0]) && UNIVERSAL::isa($_[0],'Win32::OLE')) { + $AUTOLOAD = ref($_[0]) . '::LastError'; + goto &AUTOLOAD; + } + + #no strict 'refs'; + my $LastError = "$_[0]::LastError"; + $$LastError = $_[1] if defined $_[1]; + return $$LastError; +} + +my $Options = "^(?:CP|LCID|Warn|Variant|_NewEnum|_Unique)\$"; + +sub Option { + if (ref($_[0]) && UNIVERSAL::isa($_[0],'Win32::OLE')) { + $AUTOLOAD = ref($_[0]) . '::Option'; + goto &AUTOLOAD; + } + + my $class = shift; + + if (@_ == 1) { + my $option = shift; + return ${"${class}::$option"} if $option =~ /$Options/o; + _croak("Invalid $class option: $option"); + } + + while (@_) { + my ($option,$value) = splice @_, 0, 2; + _croak("Invalid $class option: $option") if $option !~ /$Options/o; + ${"${class}::$option"} = $value; + $class->_Unique() if $option eq "_Unique"; + } +} + +sub Invoke { + my ($self,$method,@args) = @_; + $self->Dispatch($method, my $retval, @args); + return $retval; +} + +sub LetProperty { + my ($self,$method,@args) = @_; + $self->Dispatch([DISPATCH_PROPERTYPUT, $method], my $retval, @args); + return $retval; +} + +sub SetProperty { + my ($self,$method,@args) = @_; + my $wFlags = DISPATCH_PROPERTYPUT; + if (@args) { + # If the value is an object then it will be set by reference! + my $value = $args[-1]; + if (UNIVERSAL::isa($value, 'Win32::OLE')) { + $wFlags = DISPATCH_PROPERTYPUTREF; + } + elsif (UNIVERSAL::isa($value,'Win32::OLE::Variant')) { + my $type = $value->Type & ~0xfff; # VT_TYPEMASK + # VT_DISPATCH and VT_UNKNOWN represent COM objects + $wFlags = DISPATCH_PROPERTYPUTREF if $type == 9 || $type == 13; + } + } + $self->Dispatch([$wFlags, $method], my $retval, @args); + return $retval; +} + +sub AUTOLOAD { + my $self = shift; + my $autoload = substr $AUTOLOAD, rindex($AUTOLOAD, ':')+1; + _croak("Cannot autoload class method \"$autoload\"") + unless ref($self) && UNIVERSAL::isa($self, 'Win32::OLE'); + my $success = $self->Dispatch($autoload, my $retval, @_); + unless (defined $success || ($^H & 0x200) != 0) { + # Retry default method if C<no strict 'subs';> + $self->Dispatch(undef, $retval, $autoload, @_); + } + return $retval; +} + +sub in { + my @res; + while (@_) { + my $this = shift; + if (UNIVERSAL::isa($this, 'Win32::OLE')) { + push @res, Win32::OLE::Enum->All($this); + } + elsif (ref($this) eq 'ARRAY') { + push @res, @$this; + } + else { + push @res, $this; + } + } + return @res; +} + +sub valof { + my $arg = shift; + if (UNIVERSAL::isa($arg, 'Win32::OLE')) { + require Win32::OLE::Variant; + my ($class) = overload::StrVal($arg) =~ /^([^=]+)=/; + #no strict 'refs'; + local $Win32::OLE::CP = ${"${class}::CP"}; + local $Win32::OLE::LCID = ${"${class}::LCID"}; + #use strict 'refs'; + # VT_EMPTY variant for return code + my $variant = Win32::OLE::Variant->new; + $arg->Dispatch(undef, $variant); + return $variant->Value; + } + $arg = $arg->Value if UNIVERSAL::can($arg, 'Value'); + return $arg; +} + +sub with { + my $object = shift; + while (@_) { + my $property = shift; + $object->{$property} = shift; + } +} + +######################################################################## + +package Win32::OLE::Tie; + +# Only retry default method under C<no strict 'subs';> +sub FETCH { + my ($self,$key) = @_; + if ($key eq "_NewEnum") { + (my $class = ref $self) =~ s/::Tie$//; + return [Win32::OLE::Enum->All($self)] if ${"${class}::_NewEnum"}; + } + $self->Fetch($key, !$Win32::OLE::Strict); +} + +sub STORE { + my ($self,$key,$value) = @_; + $self->Store($key, $value, !$Win32::OLE::Strict); +} + +1; diff --git a/Master/tlpkg/tlperl/site/lib/Win32/OLE/NEWS.pod b/Master/tlpkg/tlperl/site/lib/Win32/OLE/NEWS.pod new file mode 100755 index 00000000000..217fe4a6fcc --- /dev/null +++ b/Master/tlpkg/tlperl/site/lib/Win32/OLE/NEWS.pod @@ -0,0 +1,380 @@ +=pod + +=head1 NAME + +Win32::OLE::NEWS - What's new in Win32::OLE + +This file contains a history of user visible changes to the +Win32::OLE::* modules. Only new features and major bug fixes that +might affect backwards compatibility are included. + +=head1 Version 0.18 + +=head2 VT_CY and VT_DECIMAL return values handled differently + +The new C<Variant> option enables values of VT_CY or VT_DECIMAL type +to be returned as Win32::OLE::Variant objects instead of being +converted into strings and numbers respectively. This is similar to +the change in Win32::OLE version 0.12 to VT_DATE and VT_ERROR values. +The Win32::OLE::Variant module must be included to make sure that +VT_CY and VT_DECIMAL values behave as before in numeric or string +contexts. + +Because the new behavior is potentially incompatible, it must be +explicitly enabled: + + Win32::OLE->Option(Variant => 1); + + +=head1 Version 0.17 + +=head2 New nullstring() function in Win32::OLE::Variant + +The nullstring() function returns a VT_BSTR variant containing a NULL +string pointer. Note that this is not the same as a VT_BSTR variant +containing the empty string "". + +The nullstring() return value is equivalent to the Visual Basic +C<vbNullString> constant. + + +=head1 Version 0.16 + +=head2 Improved Unicode support + +Passing Unicode strings to methods and properties as well as returning +Unicode strings back to Perl works now with both Perl 5.6 and 5.8. +Note that the Unicode support in 5.8 is much more complete than in 5.6 +or 5.6.1. + +C<Unicode::String> objects can now be passed to methods or assigned to +properties. + +You must enable Unicode support by switching Win32::OLE to the UTF8 +codepage: + + Win32::OLE->Option(CP => Win32::OLE::CP_UTF8()); + + +=head1 Version 0.13 + +=head2 New nothing() function in Win32::OLE::Variant + +The nothing() function returns an empty VT_DISPATCH variant. It can be +used to clear an object reference stored in a property + + use Win32::OLE::Variant qw(:DEFAULT nothing); + # ... + $object->{Property} = nothing; + +This has the same effect as the Visual Basic statement + + Set object.Property = Nothing + +=head2 New _NewEnum and _Unique options + +There are two new options available for the Win32::OLE->Option class +method: C<_NewEnum> provides the elements of a collection object +directly as the value of a C<_NewEnum> property. The C<_Unique> +option guarantees that Win32::OLE will not create multiple proxy +objects for the same underlying COM/OLE object. + +Both options are only really useful to tree traversal programs or +during debugging. + + +=head1 Version 0.12 + +=head2 Additional error handling functionality + +The Warn option can now be set to a CODE reference too. For example, + + Win32::OLE->Option(Warn => 3); + +could now be written as + + Win32::OLE->Option(Warn => \&Carp::croak); + +This can even be used to emulate the VisualBasic C<On Error Goto +Label> construct: + + Win32::OLE->Option(Warn => sub {goto CheckError}); + # ... your normal OLE code here ... + + CheckError: + # ... your error handling code here ... + +=head2 Builtin event loop + +Processing OLE events required a polling loop before, e.g. + + my $Quit; + #... + until ($Quit) { + Win32::OLE->SpinMessageLoop; + Win32::Sleep(100); + } + package BrowserEvents; + sub OnQuit { $Quit = 1 } + +This is inefficient and a bit odd. This version of Win32::OLE now +supports a standard messageloop: + + Win32::OLE->MessageLoop(); + + package BrowserEvents; + sub OnQuit { Win32::OLE->QuitMessageLoop } + +=head2 Free unused OLE libraries + +Previous versions of Win32::OLE would call the CoFreeUnusedLibraries() +API whenever an OLE object was destroyed. This made sure that OLE +libraries would be unloaded as soon as they were no longer needed. +Unfortunately, objects implemented in Visual Basic tend to crash +during this call, as they pretend to be ready for unloading, when in +fact, they aren't. + +The unloading of object libraries is really only important for long +running processes that might instantiate a huge number of B<different> +objects over time. Therefore this API is no longer called +automatically. The functionality is now available explicitly to those +who want or need it by calling a Win32::OLE class method: + + Win32::OLE->FreeUnusedLibraries(); + +=head2 The "Win32::OLE" article from "The Perl Journal #10" + +The article is Copyright 1998 by I<The Perl +Journal>. http://www.tpj.com + +It originally appeared in I<The Perl Journal> # 10 and appears here +courtesy of Jon Orwant and I<The Perl Journal>. The sample code from +the article is in the F<eg/tpj.pl> file. + +=head2 VARIANT->Put() bug fixes + +The Put() method didn't work correctly for arrays of type VT_BSTR, +VT_DISPATH or VT_UNKNOWN. This has been fixed. + +=head2 Error message fixes + +Previous versions of Win32::OLE gave a wrong argument index for some +OLE error messages (the number was too large by 1). This should be +fixed now. + +=head2 VT_DATE and VT_ERROR return values handled differently + +Method calls and property accesses returning a VT_DATE or VT_ERROR +value would previously translate the value to string or integer +format. This has been changed to return a Win32::OLE::Variant object. +The return values will behave as before if the Win32::OLE::Variant +module is being used. This module overloads the conversion of +the objects to strings and numbers. + + +=head1 Version 0.11 (changes since 0.1008) + +=head2 new DHTML typelib browser + +The Win32::OLE distribution now contains a type library browser. It +is written in PerlScript, generating dynamic HTML. It requires +Internet Explorer 4.0 or later. You'll find it in +F<browser/Browser.html>. It should be available in the ActivePerl +HTML help under Win32::OLE::Browser. + +After selecting a library, type or member you can press F1 to call up +the corresponding help file at the appropriate location. + +=head2 VT_DECIMAL support + +The Win32::OLE::Variant module now supports VT_DECIMAL variants too. +They are not "officially" allowed in OLE Automation calls, but even +Microsoft's "ActiveX Data Objects" sometimes returns VT_DECIMAL +values. + +VT_DECIMAL variables are stored as 96-bit integers scaled by a +variable power of 10. The power of 10 scaling factor specifies the +number of digits to the right of the decimal point, and ranges from 0 +to 28. With a scale of 0 (no decimal places), the largest possible +value is +/-79,228,162,514,264,337,593,543,950,335. With a 28 decimal +places, the largest value is +/-7.9228162514264337593543950335 and the +smallest, non-zero value is +/-0.0000000000000000000000000001. + +=head1 Version 0.1008 + +=head2 new LetProperty() object method + +In Win32::OLE property assignment using the hash syntax is equivalent +to the Visual Basic C<Set> syntax (I<by reference> assignment): + + $Object->{Property} = $OtherObject; + +corresponds to this Visual Basic statement: + + Set Object.Property = OtherObject + +To get the I<by value> treatment of the Visual Basic C<Let> statement + + Object.Property = OtherObject + +you have to use the LetProperty() object method in Perl: + + $Object->LetProperty($Property, $OtherObject); + +=head2 new HRESULT() function + +The HRESULT() function converts an unsigned number into a signed HRESULT +error value as used by OLE internally. This is necessary because Perl +treats all hexadecimal constants as unsigned. To check if the last OLE +function returned "Member not found" (0x80020003) you can write: + + if (Win32::OLE->LastError == HRESULT(0x80020003)) { + # your error recovery here + } + +=head1 Version 0.1007 (changes since 0.1005) + +=head2 OLE Event support + +This version of Win32::OLE contains B<ALPHA> level support for OLE events. The +user interface is still subject to change. There are ActiveX objects / controls +that don't fire events under the current implementation. + +Events are enabled for a specific object with the Win32::OLE->WithEvents() +class method: + + Win32::OLE->WithEvents(OBJECT, HANDLER, INTERFACE) + +Please read further documentation in Win32::OLE. + +=head2 GetObject() and GetActiveObject() now support optional DESTRUCTOR argument + +It is now possible to specify a DESTRUCTOR argument to the GetObject() and +GetActiveObject() class methods. They work identical to the new() DESTRUCTOR +argument. + +=head2 Remote object instantiation via DCOM + +This has actually been in Win32::OLE since 0.0608, but somehow never got +documented. You can provide an array reference in place of the usual PROGID +parameter to Win32::OLE->new(): + + OBJ = Win32::OLE->new([MACHINE, PRODID]); + +The array must contain two elements: the name of the MACHINE and the PROGID. +This will try to create the object on the remote MACHINE. + +=head2 Enumerate all Win32::OLE objects + +This class method returns the number Win32::OLE objects currently in +existence. It will call the optional CALLBACK function for each of +these objects: + + $Count = Win32::OLE->EnumAllObjects(sub { + my $Object = shift; + my $Class = Win32::OLE->QueryObjectType($Object); + printf "# Object=%s Class=%s\n", $Object, $Class; + }); + +The EnumAllObjects() method is primarily a debugging tool. It can be +used e.g. in an END block to check if all external connections have +been properly destroyed. + +=head2 The VARIANT->Put() method now returns the VARIANT object itself + +This allows chaining of Put() method calls to set multiple values in an +array variant: + + $Array->Put(0,0,$First_value)->Put(0,1,$Another_value); + +=head2 The VARIANT->Put(ARRAYREF) form allows assignment to a complete SAFEARRAY + +This allows automatic conversion from a list of lists to a SAFEARRAY. +You can now write: + + my $Array = Variant(VT_ARRAY|VT_R8, [1,2], 2); + $Array->Put([[1,2], [3,4]]); + +instead of the tedious: + + $Array->Put(1,0,1); + $Array->Put(1,1,2); + $Array->Put(2,0,3); + $Array->Put(2,1,4); + +=head2 New Variant formatting methods + +There are four new methods for formatting variant values: Currency(), Date(), +Number() and Time(). For example: + + my $v = Variant(VT_DATE, "April 1 99"); + print $v->Date(DATE_LONGDATE), "\n"; + print $v->Date("ddd',' MMM dd yy"), "\n"; + +will print: + + Thursday, April 01, 1999 + Thu, Apr 01 99 + +=head2 new Win32::OLE::NLS methods: SendSettingChange() and SetLocaleInfo() + +SendSettingChange() sends a WM_SETTINGCHANGE message to all top level windows. + +SetLocaleInfo() allows changing elements in the user override section of the +locale database. Unfortunately these changes are not automatically available +to further Variant formatting; you have to call SendSettingChange() first. + +=head2 Win32::OLE::Const now correctly treats version numbers as hex + +The minor and major version numbers of type libraries have been treated as +decimal. This was wrong. They are now correctly decoded as hex. + +=head2 more robust global destruction of Win32::OLE objects + +The final destruction of Win32::OLE objects has always been somewhat fragile. +The reason for this is that Perl doesn't honour reference counts during global +destruction but destroys objects in seemingly random order. This can lead +to leaked database connections or unterminated external objects. The only +solution was to make all objects lexical and hope that no object would be +trapped in a closure. Alternatively all objects could be explicitly set to +C<undef>, which doesn't work very well with exception handling. + +With version 0.1007 of Win32::OLE this problem should be gone: The module +keeps a list of active Win32::OLE objects. It uses an END block to destroy +all objects at program termination I<before> the Perl's global destruction +starts. Objects still existing at program termination are now destroyed in +reverse order of creation. The effect is similar to explicitly calling +Win32::OLE->Uninitialize() just prior to termination. + +=head1 Version 0.1005 (changes since 0.1003) + +Win32::OLE 0.1005 has been release with ActivePerl build 509. It is also +included in the I<Perl Resource Kit for Win32> Update. + +=head2 optional DESTRUCTOR for GetActiveObject() GetObject() class methods + +The GetActiveObject() and GetObject() class method now also support an +optional DESTRUCTOR parameter just like Win32::OLE->new(). The DESTRUCTOR +is executed when the last reference to this object goes away. It is +generally considered C<impolite> to stop applications that you did not +start yourself. + +=head2 new Variant object method: $object->Copy() + +See L<Win32::OLE::Variant/Copy([DIM])>. + +=head2 new Win32::OLE->Option() class method + +The Option() class method can be used to inspect and modify +L<Win32::OLE/Module Options>. The single argument form retrieves +the value of an option: + + my $CP = Win32::OLE->Option('CP'); + +A single call can be used to set multiple options simultaneously: + + Win32::OLE->Option(CP => CP_ACP, Warn => 3); + +Currently the following options exist: CP, LCID and C<Warn>. + +=cut diff --git a/Master/tlpkg/tlperl/site/lib/Win32/OLE/NLS.pm b/Master/tlpkg/tlperl/site/lib/Win32/OLE/NLS.pm new file mode 100755 index 00000000000..84ea0c77241 --- /dev/null +++ b/Master/tlpkg/tlperl/site/lib/Win32/OLE/NLS.pm @@ -0,0 +1,968 @@ +# The documentation is at the __END__ + +package Win32::OLE::NLS; +require Win32::OLE; # Make sure the XS bootstrap has been called + +use strict; +use vars qw(@EXPORT @EXPORT_OK %EXPORT_TAGS @ISA); + +use Exporter; +@ISA = qw(Exporter); + +@EXPORT = qw( + CompareString + LCMapString + GetLocaleInfo + GetStringType + GetSystemDefaultLangID + GetSystemDefaultLCID + GetUserDefaultLangID + GetUserDefaultLCID + + MAKELANGID + PRIMARYLANGID + SUBLANGID + LANG_SYSTEM_DEFAULT + LANG_USER_DEFAULT + MAKELCID + LANGIDFROMLCID + LOCALE_SYSTEM_DEFAULT + LOCALE_USER_DEFAULT + ); + +@EXPORT_OK = qw(SetLocaleInfo SendSettingChange); + +%EXPORT_TAGS = +( + CT => [qw(CT_CTYPE1 CT_CTYPE2 CT_CTYPE3)], + C1 => [qw(C1_UPPER C1_LOWER C1_DIGIT C1_SPACE C1_PUNCT + C1_CNTRL C1_BLANK C1_XDIGIT C1_ALPHA)], + C2 => [qw(C2_LEFTTORIGHT C2_RIGHTTOLEFT C2_EUROPENUMBER + C2_EUROPESEPARATOR C2_EUROPETERMINATOR C2_ARABICNUMBER + C2_COMMONSEPARATOR C2_BLOCKSEPARATOR C2_SEGMENTSEPARATOR + C2_WHITESPACE C2_OTHERNEUTRAL C2_NOTAPPLICABLE)], + C3 => [qw(C3_NONSPACING C3_DIACRITIC C3_VOWELMARK C3_SYMBOL C3_KATAKANA + C3_HIRAGANA C3_HALFWIDTH C3_FULLWIDTH C3_IDEOGRAPH C3_KASHIDA + C3_ALPHA C3_NOTAPPLICABLE)], + NORM => [qw(NORM_IGNORECASE NORM_IGNORENONSPACE NORM_IGNORESYMBOLS + NORM_IGNOREWIDTH NORM_IGNOREKANATYPE NORM_IGNOREKASHIDA)], + LCMAP => [qw(LCMAP_LOWERCASE LCMAP_UPPERCASE LCMAP_SORTKEY LCMAP_HALFWIDTH + LCMAP_FULLWIDTH LCMAP_HIRAGANA LCMAP_KATAKANA)], + LANG => [qw(LANG_NEUTRAL LANG_ALBANIAN LANG_ARABIC LANG_BAHASA + LANG_BULGARIAN LANG_CATALAN LANG_CHINESE LANG_CZECH LANG_DANISH + LANG_DUTCH LANG_ENGLISH LANG_FINNISH LANG_FRENCH LANG_GERMAN + LANG_GREEK LANG_HEBREW LANG_HUNGARIAN LANG_ICELANDIC + LANG_ITALIAN LANG_JAPANESE LANG_KOREAN LANG_NORWEGIAN + LANG_POLISH LANG_PORTUGUESE LANG_RHAETO_ROMAN LANG_ROMANIAN + LANG_RUSSIAN LANG_SERBO_CROATIAN LANG_SLOVAK LANG_SPANISH + LANG_SWEDISH LANG_THAI LANG_TURKISH LANG_URDU)], + SUBLANG => [qw(SUBLANG_NEUTRAL SUBLANG_DEFAULT SUBLANG_SYS_DEFAULT + SUBLANG_CHINESE_SIMPLIFIED SUBLANG_CHINESE_TRADITIONAL + SUBLANG_DUTCH SUBLANG_DUTCH_BELGIAN SUBLANG_ENGLISH_US + SUBLANG_ENGLISH_UK SUBLANG_ENGLISH_AUS SUBLANG_ENGLISH_CAN + SUBLANG_ENGLISH_NZ SUBLANG_ENGLISH_EIRE SUBLANG_FRENCH + SUBLANG_FRENCH_BELGIAN SUBLANG_FRENCH_CANADIAN + SUBLANG_FRENCH_SWISS SUBLANG_GERMAN SUBLANG_GERMAN_SWISS + SUBLANG_GERMAN_AUSTRIAN SUBLANG_ITALIAN SUBLANG_ITALIAN_SWISS + SUBLANG_NORWEGIAN_BOKMAL SUBLANG_NORWEGIAN_NYNORSK + SUBLANG_PORTUGUESE SUBLANG_PORTUGUESE_BRAZILIAN + SUBLANG_SERBO_CROATIAN_CYRILLIC SUBLANG_SERBO_CROATIAN_LATIN + SUBLANG_SPANISH SUBLANG_SPANISH_MEXICAN + SUBLANG_SPANISH_MODERN)], + CTRY => [qw(CTRY_DEFAULT CTRY_AUSTRALIA CTRY_AUSTRIA CTRY_BELGIUM + CTRY_BRAZIL CTRY_CANADA CTRY_DENMARK CTRY_FINLAND CTRY_FRANCE + CTRY_GERMANY CTRY_ICELAND CTRY_IRELAND CTRY_ITALY CTRY_JAPAN + CTRY_MEXICO CTRY_NETHERLANDS CTRY_NEW_ZEALAND CTRY_NORWAY + CTRY_PORTUGAL CTRY_PRCHINA CTRY_SOUTH_KOREA CTRY_SPAIN + CTRY_SWEDEN CTRY_SWITZERLAND CTRY_TAIWAN CTRY_UNITED_KINGDOM + CTRY_UNITED_STATES)], + LOCALE => [qw(LOCALE_NOUSEROVERRIDE LOCALE_ILANGUAGE LOCALE_SLANGUAGE + LOCALE_SENGLANGUAGE LOCALE_SABBREVLANGNAME + LOCALE_SNATIVELANGNAME LOCALE_ICOUNTRY LOCALE_SCOUNTRY + LOCALE_SENGCOUNTRY LOCALE_SABBREVCTRYNAME LOCALE_SNATIVECTRYNAME + LOCALE_IDEFAULTLANGUAGE LOCALE_IDEFAULTCOUNTRY + LOCALE_IDEFAULTCODEPAGE LOCALE_IDEFAULTANSICODEPAGE LOCALE_SLIST + LOCALE_IMEASURE LOCALE_SDECIMAL LOCALE_STHOUSAND + LOCALE_SGROUPING LOCALE_IDIGITS LOCALE_ILZERO LOCALE_INEGNUMBER + LOCALE_SNATIVEDIGITS LOCALE_SCURRENCY LOCALE_SINTLSYMBOL + LOCALE_SMONDECIMALSEP LOCALE_SMONTHOUSANDSEP LOCALE_SMONGROUPING + LOCALE_ICURRDIGITS LOCALE_IINTLCURRDIGITS LOCALE_ICURRENCY + LOCALE_INEGCURR LOCALE_SDATE LOCALE_STIME LOCALE_SSHORTDATE + LOCALE_SLONGDATE LOCALE_STIMEFORMAT LOCALE_IDATE LOCALE_ILDATE + LOCALE_ITIME LOCALE_ITIMEMARKPOSN LOCALE_ICENTURY LOCALE_ITLZERO + LOCALE_IDAYLZERO LOCALE_IMONLZERO LOCALE_S1159 LOCALE_S2359 + LOCALE_ICALENDARTYPE LOCALE_IOPTIONALCALENDAR + LOCALE_IFIRSTDAYOFWEEK LOCALE_IFIRSTWEEKOFYEAR LOCALE_SDAYNAME1 + LOCALE_SDAYNAME2 LOCALE_SDAYNAME3 LOCALE_SDAYNAME4 + LOCALE_SDAYNAME5 LOCALE_SDAYNAME6 LOCALE_SDAYNAME7 + LOCALE_SABBREVDAYNAME1 LOCALE_SABBREVDAYNAME2 + LOCALE_SABBREVDAYNAME3 LOCALE_SABBREVDAYNAME4 + LOCALE_SABBREVDAYNAME5 LOCALE_SABBREVDAYNAME6 + LOCALE_SABBREVDAYNAME7 LOCALE_SMONTHNAME1 LOCALE_SMONTHNAME2 + LOCALE_SMONTHNAME3 LOCALE_SMONTHNAME4 LOCALE_SMONTHNAME5 + LOCALE_SMONTHNAME6 LOCALE_SMONTHNAME7 LOCALE_SMONTHNAME8 + LOCALE_SMONTHNAME9 LOCALE_SMONTHNAME10 LOCALE_SMONTHNAME11 + LOCALE_SMONTHNAME12 LOCALE_SMONTHNAME13 LOCALE_SABBREVMONTHNAME1 + LOCALE_SABBREVMONTHNAME2 LOCALE_SABBREVMONTHNAME3 + LOCALE_SABBREVMONTHNAME4 LOCALE_SABBREVMONTHNAME5 + LOCALE_SABBREVMONTHNAME6 LOCALE_SABBREVMONTHNAME7 + LOCALE_SABBREVMONTHNAME8 LOCALE_SABBREVMONTHNAME9 + LOCALE_SABBREVMONTHNAME10 LOCALE_SABBREVMONTHNAME11 + LOCALE_SABBREVMONTHNAME12 LOCALE_SABBREVMONTHNAME13 + LOCALE_SPOSITIVESIGN LOCALE_SNEGATIVESIGN LOCALE_IPOSSIGNPOSN + LOCALE_INEGSIGNPOSN LOCALE_IPOSSYMPRECEDES LOCALE_IPOSSEPBYSPACE + LOCALE_INEGSYMPRECEDES LOCALE_INEGSEPBYSPACE)], + TIME => [qw(TIME_NOMINUTESORSECONDS TIME_NOSECONDS TIME_NOTIMEMARKER + TIME_FORCE24HOURFORMAT)], + DATE => [qw(DATE_SHORTDATE DATE_LONGDATE DATE_USE_ALT_CALENDAR + DATE_YEARMONTH DATE_LTRREADING DATE_RTLREADING)], +); + +foreach my $tag (keys %EXPORT_TAGS) { + push @EXPORT_OK, @{$EXPORT_TAGS{$tag}}; +} + +# Character Type Flags +sub CT_CTYPE1 { 0x0001 } +sub CT_CTYPE2 { 0x0002 } +sub CT_CTYPE3 { 0x0004 } + +# Character Type 1 Bits +sub C1_UPPER { 0x0001 } +sub C1_LOWER { 0x0002 } +sub C1_DIGIT { 0x0004 } +sub C1_SPACE { 0x0008 } +sub C1_PUNCT { 0x0010 } +sub C1_CNTRL { 0x0020 } +sub C1_BLANK { 0x0040 } +sub C1_XDIGIT { 0x0080 } +sub C1_ALPHA { 0x0100 } + +# Character Type 2 Bits +sub C2_LEFTTORIGHT { 0x1 } +sub C2_RIGHTTOLEFT { 0x2 } +sub C2_EUROPENUMBER { 0x3 } +sub C2_EUROPESEPARATOR { 0x4 } +sub C2_EUROPETERMINATOR { 0x5 } +sub C2_ARABICNUMBER { 0x6 } +sub C2_COMMONSEPARATOR { 0x7 } +sub C2_BLOCKSEPARATOR { 0x8 } +sub C2_SEGMENTSEPARATOR { 0x9 } +sub C2_WHITESPACE { 0xA } +sub C2_OTHERNEUTRAL { 0xB } +sub C2_NOTAPPLICABLE { 0x0 } + +# Character Type 3 Bits +sub C3_NONSPACING { 0x0001 } +sub C3_DIACRITIC { 0x0002 } +sub C3_VOWELMARK { 0x0004 } +sub C3_SYMBOL { 0x0008 } +sub C3_KATAKANA { 0x0010 } +sub C3_HIRAGANA { 0x0020 } +sub C3_HALFWIDTH { 0x0040 } +sub C3_FULLWIDTH { 0x0080 } +sub C3_IDEOGRAPH { 0x0100 } +sub C3_KASHIDA { 0x0200 } +sub C3_ALPHA { 0x8000 } +sub C3_NOTAPPLICABLE { 0x0 } + +# String Flags +sub NORM_IGNORECASE { 0x0001 } +sub NORM_IGNORENONSPACE { 0x0002 } +sub NORM_IGNORESYMBOLS { 0x0004 } +sub NORM_IGNOREWIDTH { 0x0008 } +sub NORM_IGNOREKANATYPE { 0x0040 } +sub NORM_IGNOREKASHIDA { 0x40000} + +# Locale Dependent Mapping Flags +sub LCMAP_LOWERCASE { 0x0100 } +sub LCMAP_UPPERCASE { 0x0200 } +sub LCMAP_SORTKEY { 0x0400 } +sub LCMAP_HALFWIDTH { 0x0800 } +sub LCMAP_FULLWIDTH { 0x1000 } +sub LCMAP_HIRAGANA { 0x2000 } +sub LCMAP_KATAKANA { 0x4000 } + +# Primary Language Identifier +sub LANG_NEUTRAL { 0x00 } +sub LANG_ALBANIAN { 0x1c } +sub LANG_ARABIC { 0x01 } +sub LANG_BAHASA { 0x21 } +sub LANG_BULGARIAN { 0x02 } +sub LANG_CATALAN { 0x03 } +sub LANG_CHINESE { 0x04 } +sub LANG_CZECH { 0x05 } +sub LANG_DANISH { 0x06 } +sub LANG_DUTCH { 0x13 } +sub LANG_ENGLISH { 0x09 } +sub LANG_FINNISH { 0x0b } +sub LANG_FRENCH { 0x0c } +sub LANG_GERMAN { 0x07 } +sub LANG_GREEK { 0x08 } +sub LANG_HEBREW { 0x0d } +sub LANG_HUNGARIAN { 0x0e } +sub LANG_ICELANDIC { 0x0f } +sub LANG_ITALIAN { 0x10 } +sub LANG_JAPANESE { 0x11 } +sub LANG_KOREAN { 0x12 } +sub LANG_NORWEGIAN { 0x14 } +sub LANG_POLISH { 0x15 } +sub LANG_PORTUGUESE { 0x16 } +sub LANG_RHAETO_ROMAN { 0x17 } +sub LANG_ROMANIAN { 0x18 } +sub LANG_RUSSIAN { 0x19 } +sub LANG_SERBO_CROATIAN { 0x1a } +sub LANG_SLOVAK { 0x1b } +sub LANG_SPANISH { 0x0a } +sub LANG_SWEDISH { 0x1d } +sub LANG_THAI { 0x1e } +sub LANG_TURKISH { 0x1f } +sub LANG_URDU { 0x20 } + +# Sublanguage Identifier +sub SUBLANG_NEUTRAL { 0x00 } +sub SUBLANG_DEFAULT { 0x01 } +sub SUBLANG_SYS_DEFAULT { 0x02 } +sub SUBLANG_CHINESE_SIMPLIFIED { 0x02 } +sub SUBLANG_CHINESE_TRADITIONAL { 0x01 } +sub SUBLANG_DUTCH { 0x01 } +sub SUBLANG_DUTCH_BELGIAN { 0x02 } +sub SUBLANG_ENGLISH_US { 0x01 } +sub SUBLANG_ENGLISH_UK { 0x02 } +sub SUBLANG_ENGLISH_AUS { 0x03 } +sub SUBLANG_ENGLISH_CAN { 0x04 } +sub SUBLANG_ENGLISH_NZ { 0x05 } +sub SUBLANG_ENGLISH_EIRE { 0x06 } +sub SUBLANG_FRENCH { 0x01 } +sub SUBLANG_FRENCH_BELGIAN { 0x02 } +sub SUBLANG_FRENCH_CANADIAN { 0x03 } +sub SUBLANG_FRENCH_SWISS { 0x04 } +sub SUBLANG_GERMAN { 0x01 } +sub SUBLANG_GERMAN_SWISS { 0x02 } +sub SUBLANG_GERMAN_AUSTRIAN { 0x03 } +sub SUBLANG_ITALIAN { 0x01 } +sub SUBLANG_ITALIAN_SWISS { 0x02 } +sub SUBLANG_NORWEGIAN_BOKMAL { 0x01 } +sub SUBLANG_NORWEGIAN_NYNORSK { 0x02 } +sub SUBLANG_PORTUGUESE { 0x02 } +sub SUBLANG_PORTUGUESE_BRAZILIAN { 0x01 } +sub SUBLANG_SERBO_CROATIAN_CYRILLIC { 0x02 } +sub SUBLANG_SERBO_CROATIAN_LATIN { 0x01 } +sub SUBLANG_SPANISH { 0x01 } +sub SUBLANG_SPANISH_MEXICAN { 0x02 } +sub SUBLANG_SPANISH_MODERN { 0x03 } + +# Country codes +sub CTRY_DEFAULT { 0 } +sub CTRY_AUSTRALIA { 61 } +sub CTRY_AUSTRIA { 43 } +sub CTRY_BELGIUM { 32 } +sub CTRY_BRAZIL { 55 } +sub CTRY_CANADA { 2 } +sub CTRY_DENMARK { 45 } +sub CTRY_FINLAND { 358 } +sub CTRY_FRANCE { 33 } +sub CTRY_GERMANY { 49 } +sub CTRY_ICELAND { 354 } +sub CTRY_IRELAND { 353 } +sub CTRY_ITALY { 39 } +sub CTRY_JAPAN { 81 } +sub CTRY_MEXICO { 52 } +sub CTRY_NETHERLANDS { 31 } +sub CTRY_NEW_ZEALAND { 64 } +sub CTRY_NORWAY { 47 } +sub CTRY_PORTUGAL { 351 } +sub CTRY_PRCHINA { 86 } +sub CTRY_SOUTH_KOREA { 82 } +sub CTRY_SPAIN { 34 } +sub CTRY_SWEDEN { 46 } +sub CTRY_SWITZERLAND { 41 } +sub CTRY_TAIWAN { 886 } +sub CTRY_UNITED_KINGDOM { 44 } +sub CTRY_UNITED_STATES { 1 } + +# Locale Types +sub LOCALE_NOUSEROVERRIDE { 0x80000000 } +sub LOCALE_ILANGUAGE { 0x0001 } +sub LOCALE_SLANGUAGE { 0x0002 } +sub LOCALE_SENGLANGUAGE { 0x1001 } +sub LOCALE_SABBREVLANGNAME { 0x0003 } +sub LOCALE_SNATIVELANGNAME { 0x0004 } +sub LOCALE_ICOUNTRY { 0x0005 } +sub LOCALE_SCOUNTRY { 0x0006 } +sub LOCALE_SENGCOUNTRY { 0x1002 } +sub LOCALE_SABBREVCTRYNAME { 0x0007 } +sub LOCALE_SNATIVECTRYNAME { 0x0008 } +sub LOCALE_IDEFAULTLANGUAGE { 0x0009 } +sub LOCALE_IDEFAULTCOUNTRY { 0x000A } +sub LOCALE_IDEFAULTCODEPAGE { 0x000B } +sub LOCALE_IDEFAULTANSICODEPAGE { 0x1004 } +sub LOCALE_SLIST { 0x000C } +sub LOCALE_IMEASURE { 0x000D } +sub LOCALE_SDECIMAL { 0x000E } +sub LOCALE_STHOUSAND { 0x000F } +sub LOCALE_SGROUPING { 0x0010 } +sub LOCALE_IDIGITS { 0x0011 } +sub LOCALE_ILZERO { 0x0012 } +sub LOCALE_INEGNUMBER { 0x1010 } +sub LOCALE_SNATIVEDIGITS { 0x0013 } +sub LOCALE_SCURRENCY { 0x0014 } +sub LOCALE_SINTLSYMBOL { 0x0015 } +sub LOCALE_SMONDECIMALSEP { 0x0016 } +sub LOCALE_SMONTHOUSANDSEP { 0x0017 } +sub LOCALE_SMONGROUPING { 0x0018 } +sub LOCALE_ICURRDIGITS { 0x0019 } +sub LOCALE_IINTLCURRDIGITS { 0x001A } +sub LOCALE_ICURRENCY { 0x001B } +sub LOCALE_INEGCURR { 0x001C } +sub LOCALE_SDATE { 0x001D } +sub LOCALE_STIME { 0x001E } +sub LOCALE_SSHORTDATE { 0x001F } +sub LOCALE_SLONGDATE { 0x0020 } +sub LOCALE_STIMEFORMAT { 0x1003 } +sub LOCALE_IDATE { 0x0021 } +sub LOCALE_ILDATE { 0x0022 } +sub LOCALE_ITIME { 0x0023 } +sub LOCALE_ITIMEMARKPOSN { 0x1005 } +sub LOCALE_ICENTURY { 0x0024 } +sub LOCALE_ITLZERO { 0x0025 } +sub LOCALE_IDAYLZERO { 0x0026 } +sub LOCALE_IMONLZERO { 0x0027 } +sub LOCALE_S1159 { 0x0028 } +sub LOCALE_S2359 { 0x0029 } +sub LOCALE_ICALENDARTYPE { 0x1009 } +sub LOCALE_IOPTIONALCALENDAR { 0x100B } +sub LOCALE_IFIRSTDAYOFWEEK { 0x100C } +sub LOCALE_IFIRSTWEEKOFYEAR { 0x100D } +sub LOCALE_SDAYNAME1 { 0x002A } +sub LOCALE_SDAYNAME2 { 0x002B } +sub LOCALE_SDAYNAME3 { 0x002C } +sub LOCALE_SDAYNAME4 { 0x002D } +sub LOCALE_SDAYNAME5 { 0x002E } +sub LOCALE_SDAYNAME6 { 0x002F } +sub LOCALE_SDAYNAME7 { 0x0030 } +sub LOCALE_SABBREVDAYNAME1 { 0x0031 } +sub LOCALE_SABBREVDAYNAME2 { 0x0032 } +sub LOCALE_SABBREVDAYNAME3 { 0x0033 } +sub LOCALE_SABBREVDAYNAME4 { 0x0034 } +sub LOCALE_SABBREVDAYNAME5 { 0x0035 } +sub LOCALE_SABBREVDAYNAME6 { 0x0036 } +sub LOCALE_SABBREVDAYNAME7 { 0x0037 } +sub LOCALE_SMONTHNAME1 { 0x0038 } +sub LOCALE_SMONTHNAME2 { 0x0039 } +sub LOCALE_SMONTHNAME3 { 0x003A } +sub LOCALE_SMONTHNAME4 { 0x003B } +sub LOCALE_SMONTHNAME5 { 0x003C } +sub LOCALE_SMONTHNAME6 { 0x003D } +sub LOCALE_SMONTHNAME7 { 0x003E } +sub LOCALE_SMONTHNAME8 { 0x003F } +sub LOCALE_SMONTHNAME9 { 0x0040 } +sub LOCALE_SMONTHNAME10 { 0x0041 } +sub LOCALE_SMONTHNAME11 { 0x0042 } +sub LOCALE_SMONTHNAME12 { 0x0043 } +sub LOCALE_SMONTHNAME13 { 0x100E } +sub LOCALE_SABBREVMONTHNAME1 { 0x0044 } +sub LOCALE_SABBREVMONTHNAME2 { 0x0045 } +sub LOCALE_SABBREVMONTHNAME3 { 0x0046 } +sub LOCALE_SABBREVMONTHNAME4 { 0x0047 } +sub LOCALE_SABBREVMONTHNAME5 { 0x0048 } +sub LOCALE_SABBREVMONTHNAME6 { 0x0049 } +sub LOCALE_SABBREVMONTHNAME7 { 0x004A } +sub LOCALE_SABBREVMONTHNAME8 { 0x004B } +sub LOCALE_SABBREVMONTHNAME9 { 0x004C } +sub LOCALE_SABBREVMONTHNAME10 { 0x004D } +sub LOCALE_SABBREVMONTHNAME11 { 0x004E } +sub LOCALE_SABBREVMONTHNAME12 { 0x004F } +sub LOCALE_SABBREVMONTHNAME13 { 0x100F } +sub LOCALE_SPOSITIVESIGN { 0x0050 } +sub LOCALE_SNEGATIVESIGN { 0x0051 } +sub LOCALE_IPOSSIGNPOSN { 0x0052 } +sub LOCALE_INEGSIGNPOSN { 0x0053 } +sub LOCALE_IPOSSYMPRECEDES { 0x0054 } +sub LOCALE_IPOSSEPBYSPACE { 0x0055 } +sub LOCALE_INEGSYMPRECEDES { 0x0056 } +sub LOCALE_INEGSEPBYSPACE { 0x0057 } + +# GetTimeFormat Flags +sub TIME_NOMINUTESORSECONDS { 0x0001 } +sub TIME_NOSECONDS { 0x0002 } +sub TIME_NOTIMEMARKER { 0x0004 } +sub TIME_FORCE24HOURFORMAT { 0x0008 } + +# GetDateFormat Flags +sub DATE_SHORTDATE { 0x0001 } +sub DATE_LONGDATE { 0x0002 } +sub DATE_USE_ALT_CALENDAR { 0x0004 } +sub DATE_YEARMONTH { 0x0008 } +sub DATE_LTRREADING { 0x0010 } +sub DATE_RTLREADING { 0x0020 } + +# Language Identifier Functions +sub MAKELANGID { my ($p,$s) = @_; (($s & 0xffff) << 10) | ($p & 0xffff); } +sub PRIMARYLANGID { my $lgid = shift; $lgid & 0x3ff; } +sub SUBLANGID { my $lgid = shift; ($lgid >> 10) & 0x3f; } + +sub LANG_SYSTEM_DEFAULT { MAKELANGID(LANG_NEUTRAL, SUBLANG_SYS_DEFAULT); } +sub LANG_USER_DEFAULT { MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT); } + +# Locale Identifier Functions +sub MAKELCID { my $lgid = shift; $lgid & 0xffff; } +sub LANGIDFROMLCID { my $lcid = shift; $lcid & 0xffff; } + +sub LOCALE_SYSTEM_DEFAULT { MAKELCID(LANG_SYSTEM_DEFAULT); } +sub LOCALE_USER_DEFAULT { MAKELCID(LANG_USER_DEFAULT); } + +1; + +__END__ + +=head1 NAME + +Win32::OLE::NLS - OLE National Language Support + +=head1 SYNOPSIS + + missing + +=head1 DESCRIPTION + +This module provides access to the national language support features +in the F<OLENLS.DLL>. + +=head2 Functions + +=over 8 + +=item CompareString(LCID,FLAGS,STR1,STR2) + +Compare STR1 and STR2 in the LCID locale. FLAGS indicate the character +traits to be used or ignored when comparing the two strings. + + NORM_IGNORECASE Ignore case + NORM_IGNOREKANATYPE Ignore hiragana/katakana character differences + NORM_IGNORENONSPACE Ignore accents, diacritics, and vowel marks + NORM_IGNORESYMBOLS Ignore symbols + NORM_IGNOREWIDTH Ignore character width + +Possible return values are: + + 0 Function failed + 1 STR1 is less than STR2 + 2 STR1 is equal to STR2 + 3 STR1 is greater than STR2 + +Note that you can subtract 2 from the return code to get values +comparable to the C<cmp> operator. + +=item LCMapString(LCID,FLAGS,STR) + +LCMapString translates STR using LCID dependent translation. +Flags contains a combination of the following options: + + LCMAP_LOWERCASE Lowercase + LCMAP_UPPERCASE Uppercase + LCMAP_HALFWIDTH Narrow characters + LCMAP_FULLWIDTH Wide characters + LCMAP_HIRAGANA Hiragana + LCMAP_KATAKANA Katakana + LCMAP_SORTKEY Character sort key + +The following normalization options can be combined with C<LCMAP_SORTKEY>: + + NORM_IGNORECASE Ignore case + NORM_IGNOREKANATYPE Ignore hiragana/katakana character differences + NORM_IGNORENONSPACE Ignore accents, diacritics, and vowel marks + NORM_IGNORESYMBOLS Ignore symbols + NORM_IGNOREWIDTH Ignore character width + +The return value is the translated string. + +=item GetLocaleInfo(LCID,LCTYPE) + +Retrieve locale setting LCTYPE from the locale specified by LCID. Use +LOCALE_NOUSEROVERRIDE | LCTYPE to always query the locale database. +Otherwise user changes to C<win.ini> through the windows control panel +take precedence when retrieving values for the system default locale. +See the documentation below for a list of valid LCTYPE values. + +The return value is the contents of the requested locale setting. + +=item GetStringType(LCID,TYPE,STR) + +Retrieve type information from locale LCID about each character in STR. +The requested TYPE can be one of the following 3 levels: + + CT_CTYPE1 ANSI C and POSIX type information + CT_CTYPE2 Text layout type information + CT_CTYPE3 Text processing type information + +The return value is a list of values, each of wich is a bitwise OR of +the applicable type bits from the corresponding table below: + + @ct = GetStringType(LOCALE_SYSTEM_DEFAULT, CT_CTYPE1, "String"); + +ANSI C and POSIX character type information: + + C1_UPPER Uppercase + C1_LOWER Lowercase + C1_DIGIT Decimal digits + C1_SPACE Space characters + C1_PUNCT Punctuation + C1_CNTRL Control characters + C1_BLANK Blank characters + C1_XDIGIT Hexadecimal digits + C1_ALPHA Any letter + +Text layout type information: + + C2_LEFTTORIGHT Left to right + C2_RIGHTTOLEFT Right to left + C2_EUROPENUMBER European number, European digit + C2_EUROPESEPARATOR European numeric separator + C2_EUROPETERMINATOR European numeric terminator + C2_ARABICNUMBER Arabic number + C2_COMMONSEPARATOR Common numeric separator + C2_BLOCKSEPARATOR Block separator + C2_SEGMENTSEPARATOR Segment separator + C2_WHITESPACE White space + C2_OTHERNEUTRAL Other neutrals + C2_NOTAPPLICABLE No implicit direction (e.g. ctrl codes) + +Text precessing type information: + + C3_NONSPACING Nonspacing mark + C3_DIACRITIC Diacritic nonspacing mark + C3_VOWELMARK Vowel nonspacing mark + C3_SYMBOL Symbol + C3_KATAKANA Katakana character + C3_HIRAGANA Hiragana character + C3_HALFWIDTH Narrow character + C3_FULLWIDTH Wide character + C3_IDEOGRAPH Ideograph + C3_ALPHA Any letter + C3_NOTAPPLICABLE Not applicable + + +=item GetSystemDefaultLangID() + +Returns the system default language identifier. + +=item GetSystemDefaultLCID() + +Returns the system default locale identifier. + +=item GetUserDefaultLangID() + +Returns the user default language identifier. + +=item GetUserDefaultLCID() + +Returns the user default locale identifier. + +=item SendSettingChange() + +Sends a WM_SETTINGCHANGE message to all top level windows. + +=item SetLocaleInfo(LCID, LCTYPE, LCDATA) + +Changes an item in the user override part of the locale setting LCID. +It doesn't change the system default database. The following LCTYPEs are +changeable: + + LOCALE_ICALENDARTYPE LOCALE_SDATE + LOCALE_ICURRDIGITS LOCALE_SDECIMAL + LOCALE_ICURRENCY LOCALE_SGROUPING + LOCALE_IDIGITS LOCALE_SLIST + LOCALE_IFIRSTDAYOFWEEK LOCALE_SLONGDATE + LOCALE_IFIRSTWEEKOFYEAR LOCALE_SMONDECIMALSEP + LOCALE_ILZERO LOCALE_SMONGROUPING + LOCALE_IMEASURE LOCALE_SMONTHOUSANDSEP + LOCALE_INEGCURR LOCALE_SNEGATIVESIGN + LOCALE_INEGNUMBER LOCALE_SPOSITIVESIGN + LOCALE_IPAPERSIZE LOCALE_SSHORTDATE + LOCALE_ITIME LOCALE_STHOUSAND + LOCALE_S1159 LOCALE_STIME + LOCALE_S2359 LOCALE_STIMEFORMAT + LOCALE_SCURRENCY LOCALE_SYEARMONTH + +You have to call SendSettingChange() to activate these changes for +subsequent Win32::OLE::Variant object formatting because the OLE +subsystem seems to cache locale information. + +=item MAKELANGID(LANG,SUBLANG) + +Creates a language identifier from a primary language and a sublanguage. + +=item PRIMARYLANGID(LANGID) + +Retrieves the primary language from a language identifier. + +=item SUBLANGID(LANGID) + +Retrieves the sublanguage from a language identifier. + +=item MAKELCID(LANGID) + +Creates a locale identifies from a language identifier. + +=item LANGIDFROMLCID(LCID) + +Retrieves a language identifier from a locale identifier. + +=back + +=head2 Locale Types + +=over 8 + +=item LOCALE_ILANGUAGE + +The language identifier (in hex). + +=item LOCALE_SLANGUAGE + +The localized name of the language. + +=item LOCALE_SENGLANGUAGE + +The ISO Standard 639 English name of the language. + +=item LOCALE_SABBREVLANGNAME + +The three-letter abbreviated name of the language. The first two +letters are from the ISO Standard 639 language name abbreviation. The +third letter indicates the sublanguage type. + +=item LOCALE_SNATIVELANGNAME + +The native name of the language. + +=item LOCALE_ICOUNTRY + +The country code, which is based on international phone codes. + +=item LOCALE_SCOUNTRY + +The localized name of the country. + +=item LOCALE_SENGCOUNTRY + +The English name of the country. + +=item LOCALE_SABBREVCTRYNAME + +The ISO Standard 3166 abbreviated name of the country. + +=item LOCALE_SNATIVECTRYNAME + +The native name of the country. + +=item LOCALE_IDEFAULTLANGUAGE + +Language identifier for the principal language spoken in this +locale. + +=item LOCALE_IDEFAULTCOUNTRY + +Country code for the principal country in this locale. + +=item LOCALE_IDEFAULTANSICODEPAGE + +The ANSI code page associated with this locale. Format: 4 Unicode +decimal digits plus a Unicode null terminator. + +XXX This should be translated by GetLocaleInfo. XXX + +=item LOCALE_IDEFAULTCODEPAGE + +The OEM code page associated with the country. + +=item LOCALE_SLIST + +Characters used to separate list items (often a comma). + +=item LOCALE_IMEASURE + +Default measurement system: + + 0 metric system (S.I.) + 1 U.S. system + +=item LOCALE_SDECIMAL + +Characters used for the decimal separator (often a dot). + +=item LOCALE_STHOUSAND + +Characters used as the separator between groups of digits left of the decimal. + +=item LOCALE_SGROUPING + +Sizes for each group of digits to the left of the decimal. An explicit +size is required for each group. Sizes are separated by semicolons. If +the last value is 0, the preceding value is repeated. To group +thousands, specify 3;0. + +=item LOCALE_IDIGITS + +The number of fractional digits. + +=item LOCALE_ILZERO + +Whether to use leading zeros in decimal fields. A setting of 0 +means use no leading zeros; 1 means use leading zeros. + +=item LOCALE_SNATIVEDIGITS + +The ten characters that are the native equivalent of the ASCII 0-9. + +=item LOCALE_INEGNUMBER + +Negative number mode. + + 0 (1.1) + 1 -1.1 + 2 -1.1 + 3 1.1 + 4 1.1 + +=item LOCALE_SCURRENCY + +The string used as the local monetary symbol. + +=item LOCALE_SINTLSYMBOL + +Three characters of the International monetary symbol specified in ISO +4217, Codes for the Representation of Currencies and Funds, followed +by the character separating this string from the amount. + +=item LOCALE_SMONDECIMALSEP + +Characters used for the monetary decimal separators. + +=item LOCALE_SMONTHOUSANDSEP + +Characters used as monetary separator between groups of digits left of +the decimal. + +=item LOCALE_SMONGROUPING + +Sizes for each group of monetary digits to the left of the decimal. An +explicit size is needed for each group. Sizes are separated by +semicolons. If the last value is 0, the preceding value is +repeated. To group thousands, specify 3;0. + +=item LOCALE_ICURRDIGITS + +Number of fractional digits for the local monetary format. + +=item LOCALE_IINTLCURRDIGITS + +Number of fractional digits for the international monetary format. + +=item LOCALE_ICURRENCY + +Positive currency mode. + + 0 Prefix, no separation. + 1 Suffix, no separation. + 2 Prefix, 1-character separation. + 3 Suffix, 1-character separation. + +=item LOCALE_INEGCURR + +Negative currency mode. + + 0 ($1.1) + 1 -$1.1 + 2 $-1.1 + 3 $1.1- + 4 $(1.1$) + 5 -1.1$ + 6 1.1-$ + 7 1.1$- + 8 -1.1 $ (space before $) + 9 -$ 1.1 (space after $) + 10 1.1 $- (space before $) + +=item LOCALE_ICALENDARTYPE + +The type of calendar currently in use. + + 1 Gregorian (as in U.S.) + 2 Gregorian (always English strings) + 3 Era: Year of the Emperor (Japan) + 4 Era: Year of the Republic of China + 5 Tangun Era (Korea) + +=item LOCALE_IOPTIONALCALENDAR + +The additional calendar types available for this LCID. Can be a +null-separated list of all valid optional calendars. Value is +0 for "None available" or any of the LOCALE_ICALENDARTYPE settings. + +XXX null separated list should be translated by GetLocaleInfo XXX + +=item LOCALE_SDATE + +Characters used for the date separator. + +=item LOCALE_STIME + +Characters used for the time separator. + +=item LOCALE_STIMEFORMAT + +Time-formatting string. + +=item LOCALE_SSHORTDATE + +Short Date_Time formatting strings for this locale. + +=item LOCALE_SLONGDATE + +Long Date_Time formatting strings for this locale. + +=item LOCALE_IDATE + +Short Date format-ordering specifier. + + 0 Month - Day - Year + 1 Day - Month - Year + 2 Year - Month - Day + +=item LOCALE_ILDATE + +Long Date format ordering specifier. Value can be any of the valid +LOCALE_IDATE settings. + +=item LOCALE_ITIME + +Time format specifier. + + 0 AM/PM 12-hour format. + 1 24-hour format. + +=item LOCALE_ITIMEMARKPOSN + +Whether the time marker string (AM|PM) precedes or follows the time +string. + 0 Suffix (9:15 AM). + 1 Prefix (AM 9:15). + +=item LOCALE_ICENTURY + +Whether to use full 4-digit century. + + 0 Two digit. + 1 Full century. + +=item LOCALE_ITLZERO + +Whether to use leading zeros in time fields. + + 0 No leading zeros. + 1 Leading zeros for hours. + +=item LOCALE_IDAYLZERO + +Whether to use leading zeros in day fields. Values as for +LOCALE_ITLZERO. + +=item LOCALE_IMONLZERO + +Whether to use leading zeros in month fields. Values as for +LOCALE_ITLZERO. + +=item LOCALE_S1159 + +String for the AM designator. + +=item LOCALE_S2359 + +String for the PM designator. + +=item LOCALE_IFIRSTWEEKOFYEAR + +Specifies which week of the year is considered first. + + 0 Week containing 1/1 is the first week of the year. + 1 First full week following 1/1is the first week of the year. + 2 First week with at least 4 days is the first week of the year. + +=item LOCALE_IFIRSTDAYOFWEEK + +Specifies the day considered first in the week. Value "0" means +SDAYNAME1 and value "6" means SDAYNAME7. + +=item LOCALE_SDAYNAME1 .. LOCALE_SDAYNAME7 + +Long name for Monday .. Sunday. + +=item LOCALE_SABBREVDAYNAME1 .. LOCALE_SABBREVDAYNAME7 + +Abbreviated name for Monday .. Sunday. + +=item LOCALE_SMONTHNAME1 .. LOCALE_SMONTHNAME12 + +Long name for January .. December. + +=item LOCALE_SMONTHNAME13 + +Native name for 13th month, if it exists. + +=item LOCALE_SABBREVMONTHNAME1 .. LOCALE_SABBREVMONTHNAME12 + +Abbreviated name for January .. December. + +=item LOCALE_SABBREVMONTHNAME13 + +Native abbreviated name for 13th month, if it exists. + +=item LOCALE_SPOSITIVESIGN + +String value for the positive sign. + +=item LOCALE_SNEGATIVESIGN + +String value for the negative sign. + +=item LOCALE_IPOSSIGNPOSN + +Formatting index for positive values. + + 0 Parentheses surround the amount and the monetary symbol. + 1 The sign string precedes the amount and the monetary symbol. + 2 The sign string precedes the amount and the monetary symbol. + 3 The sign string precedes the amount and the monetary symbol. + 4 The sign string precedes the amount and the monetary symbol. + +=item LOCALE_INEGSIGNPOSN + +Formatting index for negative values. Values as for LOCALE_IPOSSIGNPOSN. + +=item LOCALE_IPOSSYMPRECEDES + +If the monetary symbol precedes, 1. If it succeeds a positive amount, 0. + +=item LOCALE_IPOSSEPBYSPACE + +If the monetary symbol is separated by a space from a positive amount, +1. Otherwise, 0. + +=item LOCALE_INEGSYMPRECEDES + +If the monetary symbol precedes, 1. If it succeeds a negative amount, 0. + +=item LOCALE_INEGSEPBYSPACE + +If the monetary symbol is separated by a space from a negative amount, +1. Otherwise, 0. + +=back + +=head1 AUTHORS/COPYRIGHT + +This module is part of the Win32::OLE distribution. + +=cut diff --git a/Master/tlpkg/tlperl/site/lib/Win32/OLE/TPJ.pod b/Master/tlpkg/tlperl/site/lib/Win32/OLE/TPJ.pod new file mode 100755 index 00000000000..e45770baa42 --- /dev/null +++ b/Master/tlpkg/tlperl/site/lib/Win32/OLE/TPJ.pod @@ -0,0 +1,798 @@ +=pod + +=head1 NAME + +The Perl Journal #10 - Win32::OLE by Jan Dubois + +=head1 INTRODUCTION + +Suppose you're composing a document with Microsoft Word. You want to +include an Excel spreadsheet. You could save the spreadsheet in some +image format that Word can understand, and import it into your +document. But if the spreadsheet changes, your document will be out of +date. + +Microsoft's OLE (Object Linking and Embedding, pronounced "olay") lets +one program use objects from another. In the above scenario, the +spreadsheet is the object. As long as Excel makes that spreadsheet +available as an OLE object, and Word knows to treat it like one, your +document will always be current. + +You can control OLE objects from Perl with the Win32::OLE module, and +that's what this article is about. First, I'll show you how to "think +OLE," which mostly involves a lot of jargon. Next, I'll show you the +mechanics involved in using Win32::OLE. Then we'll go through a Perl +program that uses OLE to manipulate Microsoft Excel, Microsoft Access, +and Lotus Notes. Finally, I'll talk about Variants, an internal OLE +data type. + + +=head1 THE OLE MINDSET + +When an application makes an OLE object available for other +applications to use, that's called OLE I<automation>. The program +using the object is called the I<controller>, and the application +providing the object is called the I<server>. OLE automation is guided +by the OLE Component Object Model (COM) which specifies how those +objects must behave if they are to be used by other processes and +machines. + +There are two different types of OLE automation servers. I<In-process> +servers are implemented as dynamic link libraries (DLLs) and run in +the same process space as the controller. I<Out-of-process> servers +are more interesting; they are standalone executables that exist as +separate processes - possibly on a different computer. + +The Win32::OLE module lets your Perl program act as an OLE +controller. It allows Perl to be used in place of other languages like +Visual Basic or Java to control OLE objects. This makes all OLE +automation servers immediately available as Perl modules. + +Don't confuse ActiveState OLE with Win32::OLE. ActiveState OLE is +completely different, although future builds of ActiveState Perl (500 +and up) will work with Win32::OLE. + +Objects can expose OLE methods, properties, and events to the outside +world. Methods are functions that the controller can call to make the +object do something; properties describe the state of the object; and +events let the controller know about external events affecting the +object, such as the user clicking on a button. Since events involve +asynchronous communication with their objects, they require either +threads or an event loop. They are not yet supported by the Win32::OLE +module, and for the same reason ActiveX controls (OCXs) are currently +unsupported as well. + +=head1 WORKING WITH WIN32::OLE + +The Win32::OLE module doesn't let your Perl program create OLE +objects. What it does do is let your Perl program act like a remote +control for other applications-it lets your program be an OLE +controller. You can take an OLE object from another application +(Access, Notes, Excel, or anything else that speaks OLE) and invoke +its methods or manipulate its properties. + +=head2 THE FIRST STEP: CREATING AN OLE SERVER OBJECT + +First, we need to create a Perl object to represent the OLE +server. This is a weird idea; what it amounts to is that if we want to +control OLE objects produced by, say, Excel, we have to create a Perl +object that represents Excel. So even though our program is an OLE +controller, it'll contain objects that represent OLE servers. + +You can create a new OLE I<server object> with C<< Win32::OLE->new >>. +This takes a program ID (a human readable string like +C<'Speech.VoiceText'>) and returns a server object: + + my $server = Win32::OLE->new('Excel.Application', 'Quit'); + +Some server objects (particularly those for Microsoft Office +applications) don't automatically terminate when your program no +longer needs them. They need some kind of Quit method, and that's just +what our second argument is. It can be either a code reference or a +method name to be invoked when the object is destroyed. This lets you +ensure that objects will be properly cleaned up even when the Perl +program dies abnormally. + +To access a server object on a different computer, replace the first +argument with a reference to a list of the server name and program ID: + + my $server = Win32::OLE->new(['foo.bar.com', + 'Excel.Application']); + +(To get the requisite permissions, you'll need to configure your +security settings with F<DCOMCNFG.EXE>.) + +You can also directly attach your program to an already running OLE +server: + + my $server = Win32::OLE->GetActiveObject('Excel.Application'); + +This fails (returning C<undef>) if no server exists, or if the server +refuses the connection for some reason. It is also possible to use a +persistent object moniker (usually a filename) to start the associated +server and load the object into memory: + + my $doc = Win32::OLE->GetObject("MyDocument.Doc"); + +=head2 METHOD CALLS + +Once you've created one of these server objects, you need to call its +methods to make the OLE objects sing and dance. OLE methods are +invoked just like normal Perl object methods: + + $server->Foo(@Arguments); + +This is a Perl method call - but it also triggers an OLE method call +in the object. After your program executes this statement, the +C<$server> object will execute its Foo() method. The available methods +are typically documented in the application's I<object model>. + +B<Parameters.> By default, all parameters are positional +(e.g. C<foo($first, $second, $third)>) rather than named (e.g. +C<< foo(-name => "Yogi", -title => "Coach") >>). The required parameters +come first, followed by the optional parameters; if you need to +provide a dummy value for an optional parameter, use undef. + +Positional parameters get cumbersome if a method takes a lot of +them. You can use named arguments instead if you go to a little extra +trouble - when the last argument is a reference to a hash, the +key/value pairs of the hash are treated as named parameters: + + $server->Foo($Pos1, $Pos2, {Name1 => $Value1, + Name2 => $Value2}); + +B<Foreign Languages and Default Methods.> Sometimes OLE servers use +method and property names that are specific to a non-English +locale. That means they might have non-ASCII characters, which aren't +allowed in Perl variable names. In German, you might see C<Öffnen> used +instead of C<Open>. In these cases, you can use the Invoke() method: + + $server->Invoke('Öffnen', @Arguments); + +This is necessary because C<< $Server->Öffnen(@Arguments) >> is a syntax +error in current versions of Perl. + +=head2 PROPERTIES + +As I said earlier, objects can expose three things to the outside +world: methods, properties, and events. We've covered methods, and +Win32::OLE can't handle events. That leaves properties. But as it +turns out, properties and events are largely interchangeable. Most +methods have corresponding properties, and vice versa. + +An object's properties can be accessed with a hash reference: + + $server->{Bar} = $value; + $value = $server->{Bar}; + +This example sets and queries the value of the property named +C<Bar>. You could also have called the object's Bar() method to +achieve the same effect: + + $value = $server->Bar; + +However, you can't write the first line as C<< $server->Bar = $value >>, +because you can't assign to the return value of a method call. In +Visual Basic, OLE automation distinguishes between assigning the name +of an object and assigning its value: + + Set Object = OtherObject + + Let Value = Object + +The C<Set> statement shown here makes C<Object> refer to the same object as +C<OtherObject>. The C<Let> statement copies the value instead. (The value of +an OLE object is what you get when you call the object's default +method. + +In Perl, saying C<< $server1 = $server2 >> always creates another reference, +just like the C<Set> in Visual Basic. If you want to assign the value +instead, use the valof() function: + + my $value = valof $server; + +This is equivalent to + + my $value = $server->Invoke(''); + +=head2 SAMPLE APPLICATION + +Let's look at how all of this might be used. In Listing: 1 you'll see +F<T-Bond.pl>, a program that uses Win32::OLE for an almost-real world +application. + +The developer of this application, Mary Lynch, is a financial futures +broker. Every afternoon, she connects to the Chicago Board of Trade +(CBoT) web site at http://www.cbot.com and collects the time and sales +information for U.S. T-bond futures. She wants her program to create a +chart that depicts the data in 15-minute intervals, and then she wants +to record the data in a database for later analysis. Then she wants +her program to send mail to her clients. + +Mary's program will use Microsoft Access as a database, Microsoft +Excel to produce the chart, and Lotus Notes to send the mail. It will +all be controlled from a single Perl program using OLE automation. In +this section, we'll go through T-Bond. pl step by step so you can see +how Win32::OLE lets you control these applications. + +=head2 DOWNLOADING A WEB PAGE WITH LWP + +However, Mary first needs to amass the raw T-bond data by having her +Perl program automatically download and parse a web page. That's the +perfect job for LWP, the libwww-perl bundle available on the CPAN. LWP +has nothing to do with OLE. But this is a real-world application, and +it's just what Mary needs to download her data from the Chicago Board +of Trade. + + use LWP::Simple; + my $URL = 'http://www.cbot.com/mplex/quotes/tsfut'; + my $text = get("$URL/tsf$Contract.htm"); + +She could also have used the Win32::Internet module: + + use Win32::Internet; + my $URL = 'http://www.cbot.com/mplex/quotes/tsfut'; + my $text = $Win32::Internet->new->FetchURL("$URL/tsf$Contract.htm"); + +Mary wants to condense the ticker data into 15 minute bars. She's +interested only in lines that look like this: + + 03/12/1998 US 98Mar 12116 15:28:34 Open + +A regular expression can be used to determine whether a line looks +like this. If it does, the regex can split it up into individual +fields. The price quoted above, C<12116>, really means 121 16/32, and +needs to be converted to 121.5. The data is then condensed into 15 +minute intervals and only the first, last, highest, and lowest price +during each interval are kept. The time series is stored in the array +C<@Bars>. Each entry in C<@Bars> is a reference to a list of 5 elements: +Time, Open, High, Low, and Close. + + foreach (split "\n", $text) { + # 03/12/1998 US 98Mar 12116 15:28:34 Open + my ($Date,$Price,$Hour,$Min,$Sec,$Ind) = + m|^\s*(\d+/\d+/\d+) # " 03/12/1998" + \s+US\s+\S+\s+(\d+) # " US 98Mar 12116" + \s+(\d+):(\d+):(\d+) # " 12:42:40" + \s*(.*)$|x; # " Ask" + next unless defined $Date; + $Day = $Date; + + # Convert from fractional to decimal format + $Price = int($Price/100) + ($Price%100)/32; + + # Round up time to next multiple of 15 minutes + my $NewTime = int(($Sec+$Min*60+$Hour*3600)/900+1)*900; + unless (defined $Time && $NewTime == $Time) { + push @Bars, [$hhmm, $Open, $High, $Low, $Close] + if defined $Time; + $Open = $High = $Low = $Close = undef; + $Time = $NewTime; + my $Hour = int($Time/3600); + $hhmm = sprintf "%02d:%02d", $Hour, $Time/60-$Hour*60; + } + + # Update 15 minute bar values + $Close = $Price; + $Open = $Price unless defined $Open; + $High = $Price unless defined $High && $High > $Price; + $Low = $Price unless defined $Low && $Low > $Price; + } + + die "No data found" unless defined $Time; + push @Bars, [$hhmm, $Open, $High, $Low, $Close]; + +=head2 MICROSOFT ACCESS + +Now that Mary has her T-bond quotes, she's ready to use Win32::OLE to +store them into a Microsoft Access database. This has the advantage +that she can copy the database to her lap-top and work with it on her +long New York commute. She's able to create an Access database as +follows: + + use Win32::ODBC; + use Win32::OLE; + + # Include the constants for the Microsoft Access + # "Data Access Object". + + use Win32::OLE::Const 'Microsoft DAO'; + + my $DSN = 'T-Bonds'; + my $Driver = 'Microsoft Access Driver (*.mdb)'; + my $Desc = 'US T-Bond Quotes'; + my $Dir = 'i:\tmp\tpj'; + my $File = 'T-Bonds.mdb'; + my $Fullname = "$Dir\\$File"; + + # Remove old database and dataset name + unlink $Fullname if -f $Fullname; + Win32::ODBC::ConfigDSN(ODBC_REMOVE_DSN, $Driver, "DSN=$DSN") + if Win32::ODBC::DataSources($DSN); + + # Create new database + my $Access = Win32::OLE->new('Access.Application', 'Quit'); + my $Workspace = $Access->DBEngine->CreateWorkspace('', 'Admin', ''); + my $Database = $Workspace->CreateDatabase($Fullname, dbLangGeneral); + + # Add new database name + Win32::ODBC::ConfigDSN(ODBC_ADD_DSN, $Driver, + "DSN=$DSN", "Description=$Desc", "DBQ=$Fullname", + "DEFAULTDIR=$Dir", "UID=", "PWD="); + +This uses Win32::ODBC (described in TPJ #9) to remove and create +F<T-Bonds.mdb>. This lets Mary use the same script on her workstation +and on her laptop even when the database is stored in different +locations on each. The program also uses Win32::OLE to make Microsoft +Access create an empty database. + +Every OLE server has some constants that your Perl program will need +to use, made accessible by the Win32::OLE::Const module. For instance, +to grab the Excel constants, say C<use Win32::OLE::Const 'Microsoft +Excel'>. + +In the above example, we imported the Data Access Object con-stants +just so we could use C<dbLangGeneral>. + +=head2 MICROSOFT EXCEL + +Now Mary uses Win32::OLE a second time, to have Microsoft Excel create +the chart shown below. + + Figure 1: T-Bond data generated by MicroSoft Excel via Win32::OLE + + # Start Excel and create new workbook with a single sheet + use Win32::OLE qw(in valof with); + use Win32::OLE::Const 'Microsoft Excel'; + use Win32::OLE::NLS qw(:DEFAULT :LANG :SUBLANG); + + my $lgid = MAKELANGID(LANG_ENGLISH, SUBLANG_DEFAULT); + $Win32::OLE::LCID = MAKELCID($lgid); + + $Win32::OLE::Warn = 3; + +Here, Mary sets the locale to American English, which lets her do +things like use American date formats (e.g. C<"12-30-98"> rather than +C<"30-12-98">) in her program. It will continue to work even when she's +visiting one of her international customers and has to run this +program on their computers. + +The value of C<$Win32::OLE::Warn> determines what happens when an OLE +error occurs. If it's 0, the error is ignored. If it's 2, or if it's 1 +and the script is running under C<-w>, the Win32::OLE module invokes +C<Carp::carp()>. If C<$Win32::OLE::Warn> is set to 3, C<Carp::croak()> +is invoked and the program dies immediately. + +Now the data can be put into an Excel spreadsheet to produce the +chart. The following section of the program launches Excel and creates +a new workbook with a single worksheet. It puts the column titles +('Time', 'Open', 'High', 'Low', and 'Close') in a bold font on the +first row of the sheet. The first column displays the timestamp in +I<hh:mm> format; the next four display prices. + + my $Excel = Win32::OLE->new('Excel.Application', 'Quit'); + $Excel->{SheetsInNewWorkbook} = 1; + my $Book = $Excel->Workbooks->Add; + my $Sheet = $Book->Worksheets(1); + $Sheet->{Name} = 'Candle'; + + # Insert column titles + my $Range = $Sheet->Range("A1:E1"); + $Range->{Value} = [qw(Time Open High Low Close)]; + $Range->Font->{Bold} = 1; + + $Sheet->Columns("A:A")->{NumberFormat} = "h:mm"; + # Open/High/Low/Close to be displayed in 32nds + $Sheet->Columns("B:E")->{NumberFormat} = "# ?/32"; + + # Add 15 minute data to spreadsheet + print "Add data\n"; + $Range = $Sheet->Range(sprintf "A2:E%d", 2+$#Bars); + $Range->{Value} = \@Bars; + +The last statement shows how to pass arrays to OLE objects. The +Win32::OLE module automatically translates each array reference to a +C<SAFEARRAY>, the internal OLE array data type. This translation first +determines the maximum nesting level used by the Perl array, and then +creates a C<SAFEARRAY> of the same dimension. The C<@Bars> array +already contains the data in the correct form for the spreadsheet: + + ([Time1, Open1, High1, Low1, Close1], + ... + [TimeN, OpenN, HighN, LowN, CloseN]) + +Now the table in the spreadsheet can be used to create a candle stick +chart from our bars. Excel automatically chooses the time axis labels +if they are selected before the chart is created: + + # Create candle stick chart as new object on worksheet + $Sheet->Range("A:E")->Select; + + my $Chart = $Book->Charts->Add; + $Chart->{ChartType} = xlStockOHLC; + $Chart->Location(xlLocationAsObject, $Sheet->{Name}); + # Excel bug: the old $Chart is now invalid! + $Chart = $Excel->ActiveChart; + +We can change the type of the chart from a separate sheet to a chart +object on the spreadsheet page with the C<< $Chart->Location >> +method. (This invalidates the chart object handle, which might be +considered a bug in Excel.) Fortunately, this new chart is still the +'active' chart, so an object handle to it can be reclaimed simply by +asking Excel. + +At this point, our chart still needs a title, the legend is +meaningless, and the axis has decimals instead of fractions. We can +fix those with the following code: + + # Add title, remove legend + with($Chart, HasLegend => 0, HasTitle => 1); + $Chart->ChartTitle->Characters->{Text} = "US T-Bond"; + + # Set up daily statistics + $Open = $Bars[0][1]; + $High = $Sheet->Evaluate("MAX(C:C)"); + $Low = $Sheet->Evaluate("MIN(D:D)"); + $Close = $Bars[$#Bars][4]; + +The with() function partially mimics the Visual Basic With statement, +but allows only property assignments. It's a convenient shortcut for +this: + + { # open new scope + my $Axis = $Chart->Axes(xlValue); + $Axis->{HasMajorGridlines} = 1; + $Axis->{HasMinorGridlines} = 1; + # etc ... + } + +The C<$High> and C<$Low> for the day are needed to determine the +minimum and maximum scaling levels. MIN and MAX are spreadsheet +functions, and aren't automatically available as methods. However, +Excel provides an Evaluate() method to calculate arbitrary spreadsheet +functions, so we can use that. + +We want the chart to show major gridlines at every fourth tick and +minor gridlines at every second tick. The minimum and maximum are +chosen to be whatever multiples of 1/16 we need to do that. + + # Change tickmark spacing from decimal to fractional + with($Chart->Axes(xlValue), + HasMajorGridlines => 1, + HasMinorGridlines => 1, + MajorUnit => 1/8, + MinorUnit => 1/16, + MinimumScale => int($Low*16)/16, + MaximumScale => int($High*16+1)/16 + ); + + # Fat candles with only 5% gaps + $Chart->ChartGroups(1)->{GapWidth} = 5; + + sub RGB { $_[0] | ($_[1] >> 8) | ($_[2] >> 16) } + + # White background with a solid border + + $Chart->PlotArea->Border->{LineStyle} = xlContinuous; + $Chart->PlotArea->Border->{Color} = RGB(0,0,0); + $Chart->PlotArea->Interior->{Color} = RGB(255,255,255); + + # Add 1 hour moving average of the Close series + my $MovAvg = $Chart->SeriesCollection(4)->Trendlines + ->Add({Type => xlMovingAvg, Period => 4}); + $MovAvg->Border->{Color} = RGB(255,0,0); + +Now the finished workbook can be saved to disk as +F<i:\tmp\tpj\data.xls>. That file most likely still exists from when the +program ran yesterday, so we'll remove it. (Otherwise, Excel would pop +up a dialog with a warning, because the SaveAs() method doesn't like +to overwrite files.) + + + # Save workbook to file my $Filename = 'i:\tmp\tpj\data.xls'; + unlink $Filename if -f $Filename; + $Book->SaveAs($Filename); + $Book->Close; + +=head2 ACTIVEX DATA OBJECTS + +Mary stores the daily prices in her T-bonds database, keeping the data +for the different contracts in separate tables. After creating an ADO +(ActiveX Data Object) connection to the database, she tries to connect +a record set to the table for the current contract. If this fails, she +assumes that the table doesn't exists yet and tries to create it: + + use Win32::OLE::Const 'Microsoft ActiveX Data Objects'; + + my $Connection = Win32::OLE->new('ADODB.Connection'); + my $Recordset = Win32::OLE->new('ADODB.Recordset'); + $Connection->Open('T-Bonds'); + + # Open a record set for the table of this contract + { + local $Win32::OLE::Warn = 0; + $Recordset->Open($Contract, $Connection, adOpenKeyset, + adLockOptimistic, adCmdTable); + } + + # Create table and index if it doesn't exist yet + if (Win32::OLE->LastError) { + $Connection->Execute(<<"SQL"); + CREATE TABLE $Contract + ( + Day DATETIME, + Open DOUBLE, High DOUBLE, Low DOUBLE, Close DOUBLE + ) + SQL + $Connection->Execute(<<"SQL"); + CREATE INDEX $Contract + ON $Contract (Day) WITH PRIMARY + SQL + $Recordset->Open($Contract, $Connection, adOpenKeyset, + adLockOptimistic, adCmdTable); + } + +C<$Win32::OLE::Warn> is temporarily set to zero, so that if +C<$Recordset->Open> fails, the failure will be recorded silently without +terminating the program. C<Win32::OLE->LastError> shows whether the Open +failed or not. C<LastError> returns the OLE error code in a numeric +context and the OLE error message in a string context, just like +Perl's C<$!> variable. + +Now Mary can add today's data: + + # Add new record to table + use Win32::OLE::Variant; + $Win32::OLE::Variant::LCID = $Win32::OLE::LCID; + + my $Fields = [qw(Day Open High Low Close)]; + my $Values = [Variant(VT_DATE, $Day), + $Open, $High, $Low, $Close]; + +Mary uses the Win32::OLE::Variant module to store C<$Day> as a date +instead of a mere string. She wants to make sure that it's stored as +an American-style date, so in the third line shown here she sets the +locale ID of the Win32::OLE::Variant module to match the Win32::OLE +module. (C<$Win32::OLE::LCID> had been set earlier to English, since +that's what the Chicago Board of Trade uses.) + + { + local $Win32::OLE::Warn = 0; + $Recordset->AddNew($Fields, $Values); + } + + # Replace existing record + if (Win32::OLE->LastError) { + $Recordset->CancelUpdate; + $Recordset->Close; + $Recordset->Open(<<"SQL", $Connection, adOpenDynamic); + SELECT * FROM $Contract + WHERE Day = #$Day# + SQL + $Recordset->Update($Fields, $Values); + } + + $Recordset->Close; + $Connection->Close; + +The program expects to be able to add a new record to the table. It +fails if a record for this date already exists, because the Day field +is the primary index and therefore must be unique. If an error occurs, +the update operation started by AddNew() must first be cancelled with +C<< $Recordset->CancelUpdate >>; otherwise the record set won't close. + +=head2 LOTUS NOTES + +Now Mary can use Lotus Notes to mail updates to all her customers +interested in the T-bond data. (Lotus Notes doesn't provide its +constants in the OLE type library, so Mary had to determine them by +playing around with LotusScript.) The actual task is quite simple: A +Notes session must be started, the mail database must be opened and +the mail message must be created. The body of the message is created +as a rich text field, which lets her mix formatted text with object +attachments. + +In her program, Mary extracts the email addresses from her customer +database and sends separate message to each. Here, we've simplified it +somewhat. + + sub EMBED_ATTACHMENT {1454;} # from LotusScript + + my $Notes = Win32::OLE->new('Notes.NotesSession'); + my $Database = $Notes->GetDatabase('', ''); + $Database->OpenMail; + my $Document = $Database->CreateDocument; + + $Document->{Form} = 'Memo'; + $Document->{SendTo} = ['Jon Orwant >orwant@tpj.com>', + 'Jan Dubois >jan.dubois@ibm.net>']; + $Document->{Subject} = "US T-Bonds Chart for $Day"; + + my $Body = $Document->CreateRichtextItem('Body'); + $Body->AppendText(<<"EOT"); + I\'ve attached the latest US T-Bond data and chart for $Day. + The daily statistics were: + + \tOpen\t$Open + \tHigh\t$High + \tLow\t$Low + \tClose\t$Close + + Kind regards, + + Mary + EOT + + $Body->EmbedObject(EMBED_ATTACHMENT, '', $Filename); + + $Document->Send(0); + +=head1 VARIANTS + +In this final section, I'll talk about Variants, which are the data +types that you use to talk to OLE objects. We talked about this line +earlier: + + my $Values = [Variant(VT_DATE, $Day), + $Open, $High, $Low, $Close]; + +Here, the Variant() function creates a Variant object, of type C<VT_DATE> +and with the value C<$Day>. Variants are similar in many ways to Perl +scalars. Arguments to OLE methods are transparently converted from +their internal Perl representation to Variants and back again by the +Win32::OLE module. + +OLE automation uses a generic C<VARIANT> data type to pass +parameters. This data type contains type information in addition to +the actual data value. Only the following data types are valid for OLE +automation: + + B<Data Type Meaning> + VT_EMPTY Not specified + VT_NULL Null + VT_I2 2 byte signed integer + VT_I4 4 byte signed integer + VT_R4 4 byte real + VT_R8 8 byte real + VT_CY Currency + VT_DATE Date + VT_BSTR Unicode string + VT_DISPATCH OLE automation interface + VT_ERROR Error + VT_BOOL Boolean + VT_VARIANT (only valid with VT_BYREF) + VT_UNKNOWN Generic COM interface + VT_UI1 Unsigned character + +The following two flags can also be used: + + VT_ARRAY Array of values + VT_BYREF Pass by reference (instead of by value) + +B<The Perl to Variant transformation.> The following conversions are +performed automatically whenever a Perl value must be translated into +a Variant: + + Perl value Variant + Integer values VT_I4 + Real values VT_R8 + Strings VT_BSTR + undef VT_ERROR (DISP_E_PARAMNOTFOUND) + Array reference VT_VARIANT | VT_ARRAY + Win32::OLE object VT_DISPATCH + Win32::OLE::Variant object Type of the Variant object + +What if your Perl value is a list of lists? Those can be irregularly +shaped in Perl; that is, the subsidiary lists needn't have the same +number of elements. In this case, the structure will be converted to a +"rectangular" C<SAFEARRAY> of Variants, with unused slots set to +C<VT_EMPTY>. Consider this Perl 2-D array: + + [ ["Perl" ], # one element + [1, 3.1215, undef] # three elements + ] + +This will be translated to a 2 by 3 C<SAFEARRAY> that looks like this: + + VT_BSTR("Perl") VT_EMPTY VT_EMPTY + VT_I4(1) VT_R8(3.1415) VT_ERROR(DISP_E_PARAMNOTFOUND) + +B<The Variant To Perl Transformation.> Automatic conversion from Variants +to Perl values happens as follows: + + Variant Perl value + VT_BOOL, VT_ERROR Integer + VT_UI1, VT_I2, VT_I4 Integer + VT_R4, VT_R8 Float value + VT_BSTR String + VT_DISPATCH Win32::OLE object + +B<The Win32::OLE::Variant module.> This module provides access to the +Variant data type, which gives you more control over how these +arguments to OLE methods are encoded. (This is rarely necessary if you +have a good grasp of the default conversion rules.) A Variant object +can be created with the C<< Win32::OLE::Variant->new >> method or the +equivalent Variant() function: + + use Win32::OLE::Variant; + my $var1 = Win32::OLE::Variant->new(VT_DATE, 'Jan 1,1970'); + my $var2 = Variant(VT_BSTR, 'This is an Unicode string'); + +Several methods let you inspect and manipulate Variant objects: The +Type() and Value() methods return the variant type and value; the As() +method returns the value after converting it to a different variant +type; ChangeType() coerces the Variant into a different type; and +Unicode() returns the value of a Variant object as an object of the +Unicode::String class. + +These conversions are more interesting if they can be applied directly +to the return value of an OLE method call without first mutilating the +value with default conversions. This is possible with the following +trick: + + my $RetVal = Variant(VT_EMPTY, undef); + $Object->Dispatch($Method, $RetVal, @Arguments); + +Normally, you wouldn't call Dispatch() directly; it's executed +implicitly by either AUTOLOAD() or Invoke(). If Dispatch() realizes +that the return value is already a Win32::OLE::Variant object, the +return value is not translated into a Perl representation but rather +copied verbatim into the Variant object. + +Whenever a Win32::OLE::Variant object is used in a numeric or string +context it is automatically converted into the corresponding format. + + printf "Number: %f and String: %s\n", + $Var, $Var; + +This is equivalent to: + + printf "Number: %f and String: %s\n", + $Var->As(VT_R8), $Var->As(VT_BSTR); + +For methods that modify their arguments, you need to use the C<VT_BYREF> +flag. This lets you create number and string Variants that can be +modified by OLE methods. Here, Corel's GetSize() method takes two +integers and stores the C<x> and C<y> dimensions in them: + + my $x = Variant( VT_I4 | VT_BYREF, 0); + my $y = Variant( VT_I4 | VT_BYREF, 0); + $Corel->GetSize($x, $y); + +C<VT_BYREF> support for other Variant types might appear in future +releases of Win32::OLE. + +=head1 FURTHER INFORMATION + +=head2 DOCUMENTATION AND EXAMPLE CODE + +More information about the OLE modules can be found in the +documentation bundled with Win32::OLE. The distribution also contains +other code samples. + +The object model for Microsoft Office applications can be found in the +Visual Basic Reference for Microsoft Access, Excel, Word, or +PowerPoint. These help files are not installed by default, but they +can be added later by rerunning F<setup.exe> and choosing I<custom +setup>. The object model for Microsoft Outlook can be found on the +Microsoft Office Developer Forum at: +http://www.microsoft.com/OutlookDev/. + +Information about the LotusScript object model can be found at: +http://www.lotus.com/products/lotusscript.nsf. + +=head2 OLE AUTOMATION ON OTHER PLATFORMS + +Microsoft also makes OLE technology available for the Mac. DCOM is +already included in Windows NT 4.0 and can be downloaded for Windows +95. MVS and some Unix systems can use EntireX to get OLE +functionality; see +http://www.softwareag.com/corporat/solutions/entirex/entirex.htm. + +=head1 COPYRIGHT + +Copyright 1998 I<The Perl Journal>. http://www.tpj.com + +This article originally appeared in I<The Perl Journal> #10. It +appears courtesy of Jon Orwant and I<The Perl Journal>. This document +may be distributed under the same terms as Perl itself. diff --git a/Master/tlpkg/tlperl/site/lib/Win32/OLE/TypeInfo.pm b/Master/tlpkg/tlperl/site/lib/Win32/OLE/TypeInfo.pm new file mode 100755 index 00000000000..d95399c1e29 --- /dev/null +++ b/Master/tlpkg/tlperl/site/lib/Win32/OLE/TypeInfo.pm @@ -0,0 +1,389 @@ +# This module is still experimental and intentionally undocumented. +# If you don't know why it is here, then you should probably not use it. + +package Win32::OLE::TypeInfo; + +use strict; +use vars qw(@ISA @EXPORT @EXPORT_OK); +use vars qw(@VT %TYPEFLAGS @TYPEKIND %IMPLTYPEFLAGS %PARAMFLAGS + %FUNCFLAGS @CALLCONV @FUNCKIND %INVOKEKIND %VARFLAGS + %LIBFLAGS @SYSKIND); + +use Exporter; +@ISA = qw(Exporter); + +@EXPORT = qw( + VT_EMPTY VT_NULL VT_I2 VT_I4 VT_R4 VT_R8 VT_CY VT_DATE + VT_BSTR VT_DISPATCH VT_ERROR VT_BOOL VT_VARIANT VT_UNKNOWN + VT_DECIMAL VT_I1 VT_UI1 VT_UI2 VT_UI4 VT_I8 VT_UI8 VT_INT + VT_UINT VT_VOID VT_HRESULT VT_PTR VT_SAFEARRAY VT_CARRAY + VT_USERDEFINED VT_LPSTR VT_LPWSTR VT_FILETIME VT_BLOB + VT_STREAM VT_STORAGE VT_STREAMED_OBJECT VT_STORED_OBJECT + VT_BLOB_OBJECT VT_CF VT_CLSID VT_VECTOR VT_ARRAY VT_BYREF + VT_RESERVED VT_ILLEGAL VT_ILLEGALMASKED VT_TYPEMASK + + TYPEFLAG_FAPPOBJECT TYPEFLAG_FCANCREATE TYPEFLAG_FLICENSED + TYPEFLAG_FPREDECLID TYPEFLAG_FHIDDEN TYPEFLAG_FCONTROL + TYPEFLAG_FDUAL TYPEFLAG_FNONEXTENSIBLE TYPEFLAG_FOLEAUTOMATION + TYPEFLAG_FRESTRICTED TYPEFLAG_FAGGREGATABLE TYPEFLAG_FREPLACEABLE + TYPEFLAG_FDISPATCHABLE TYPEFLAG_FREVERSEBIND + + TKIND_ENUM TKIND_RECORD TKIND_MODULE TKIND_INTERFACE TKIND_DISPATCH + TKIND_COCLASS TKIND_ALIAS TKIND_UNION TKIND_MAX + + IMPLTYPEFLAG_FDEFAULT IMPLTYPEFLAG_FSOURCE IMPLTYPEFLAG_FRESTRICTED + IMPLTYPEFLAG_FDEFAULTVTABLE + + PARAMFLAG_NONE PARAMFLAG_FIN PARAMFLAG_FOUT PARAMFLAG_FLCID + PARAMFLAG_FRETVAL PARAMFLAG_FOPT PARAMFLAG_FHASDEFAULT + + FUNCFLAG_FRESTRICTED FUNCFLAG_FSOURCE FUNCFLAG_FBINDABLE + FUNCFLAG_FREQUESTEDIT FUNCFLAG_FDISPLAYBIND FUNCFLAG_FDEFAULTBIND + FUNCFLAG_FHIDDEN FUNCFLAG_FUSESGETLASTERROR FUNCFLAG_FDEFAULTCOLLELEM + FUNCFLAG_FUIDEFAULT FUNCFLAG_FNONBROWSABLE FUNCFLAG_FREPLACEABLE + FUNCFLAG_FIMMEDIATEBIND + + CC_FASTCALL CC_CDECL CC_MSCPASCAL CC_PASCAL CC_MACPASCAL CC_STDCALL + CC_FPFASTCALL CC_SYSCALL CC_MPWCDECL CC_MPWPASCAL CC_MAX + + INVOKE_FUNC INVOKE_PROPERTYGET INVOKE_PROPERTYPUT INVOKE_PROPERTYPUTREF + + VARFLAG_FREADONLY VARFLAG_FSOURCE VARFLAG_FBINDABLE VARFLAG_FREQUESTEDIT + VARFLAG_FDISPLAYBIND VARFLAG_FDEFAULTBIND VARFLAG_FHIDDEN VARFLAG_FRESTRICTED + VARFLAG_FDEFAULTCOLLELEM VARFLAG_FUIDEFAULT VARFLAG_FNONBROWSABLE + VARFLAG_FREPLACEABLE VARFLAG_FIMMEDIATEBIND + + LIBFLAG_FRESTRICTED LIBFLAG_FCONTROL LIBFLAG_FHIDDEN + SYS_WIN16 SYS_WIN32 SYS_MAC + + FUNC_VIRTUAL FUNC_PUREVIRTUAL FUNC_NONVIRTUAL FUNC_STATIC FUNC_DISPATCH + + @VT %TYPEFLAGS @TYPEKIND %IMPLTYPEFLAGS %PARAMFLAGS + %FUNCFLAGS @CALLCONV @FUNCKIND %INVOKEKIND %VARFLAGS %LIBFLAGS @SYSKIND +); + +# Lib Flags +# --------- + +sub LIBFLAG_FRESTRICTED () { 0x01; } +sub LIBFLAG_FCONTROL () { 0x02; } +sub LIBFLAG_FHIDDEN () { 0x04; } + +$LIBFLAGS{LIBFLAG_FRESTRICTED()} = LIBFLAG_FRESTRICTED; +$LIBFLAGS{LIBFLAG_FCONTROL()} = LIBFLAG_FCONTROL; +$LIBFLAGS{LIBFLAG_FHIDDEN()} = LIBFLAG_FHIDDEN; + +# Sys Kind +# -------- + +sub SYS_WIN16 () { 0; } +sub SYS_WIN32 () { SYS_WIN16() + 1; } +sub SYS_MAC () { SYS_WIN32() + 1; } + +$SYSKIND[SYS_WIN16] = 'SYS_WIN16'; +$SYSKIND[SYS_WIN32] = 'SYS_WIN32'; +$SYSKIND[SYS_MAC] = 'SYS_MAC'; + +# Type Flags +# ---------- + +sub TYPEFLAG_FAPPOBJECT () { 0x1; } +sub TYPEFLAG_FCANCREATE () { 0x2; } +sub TYPEFLAG_FLICENSED () { 0x4; } +sub TYPEFLAG_FPREDECLID () { 0x8; } +sub TYPEFLAG_FHIDDEN () { 0x10; } +sub TYPEFLAG_FCONTROL () { 0x20; } +sub TYPEFLAG_FDUAL () { 0x40; } +sub TYPEFLAG_FNONEXTENSIBLE () { 0x80; } +sub TYPEFLAG_FOLEAUTOMATION () { 0x100; } +sub TYPEFLAG_FRESTRICTED () { 0x200; } +sub TYPEFLAG_FAGGREGATABLE () { 0x400; } +sub TYPEFLAG_FREPLACEABLE () { 0x800; } +sub TYPEFLAG_FDISPATCHABLE () { 0x1000; } +sub TYPEFLAG_FREVERSEBIND () { 0x2000; } + +$TYPEFLAGS{TYPEFLAG_FAPPOBJECT()} = TYPEFLAG_FAPPOBJECT; +$TYPEFLAGS{TYPEFLAG_FCANCREATE()} = TYPEFLAG_FCANCREATE; +$TYPEFLAGS{TYPEFLAG_FLICENSED()} = TYPEFLAG_FLICENSED; +$TYPEFLAGS{TYPEFLAG_FPREDECLID()} = TYPEFLAG_FPREDECLID; +$TYPEFLAGS{TYPEFLAG_FHIDDEN()} = TYPEFLAG_FHIDDEN; +$TYPEFLAGS{TYPEFLAG_FCONTROL()} = TYPEFLAG_FCONTROL; +$TYPEFLAGS{TYPEFLAG_FDUAL()} = TYPEFLAG_FDUAL; +$TYPEFLAGS{TYPEFLAG_FNONEXTENSIBLE()} = TYPEFLAG_FNONEXTENSIBLE; +$TYPEFLAGS{TYPEFLAG_FOLEAUTOMATION()} = TYPEFLAG_FOLEAUTOMATION; +$TYPEFLAGS{TYPEFLAG_FRESTRICTED()} = TYPEFLAG_FRESTRICTED; +$TYPEFLAGS{TYPEFLAG_FAGGREGATABLE()} = TYPEFLAG_FAGGREGATABLE; +$TYPEFLAGS{TYPEFLAG_FREPLACEABLE()} = TYPEFLAG_FREPLACEABLE; +$TYPEFLAGS{TYPEFLAG_FDISPATCHABLE()} = TYPEFLAG_FDISPATCHABLE; +$TYPEFLAGS{TYPEFLAG_FREVERSEBIND()} = TYPEFLAG_FREVERSEBIND; + +# Type Kind +# --------- + +sub TKIND_ENUM () { 0; } +sub TKIND_RECORD () { TKIND_ENUM() + 1; } +sub TKIND_MODULE () { TKIND_RECORD() + 1; } +sub TKIND_INTERFACE () { TKIND_MODULE() + 1; } +sub TKIND_DISPATCH () { TKIND_INTERFACE() + 1; } +sub TKIND_COCLASS () { TKIND_DISPATCH() + 1; } +sub TKIND_ALIAS () { TKIND_COCLASS() + 1; } +sub TKIND_UNION () { TKIND_ALIAS() + 1; } +sub TKIND_MAX () { TKIND_UNION() + 1; } + +$TYPEKIND[TKIND_ENUM] = 'TKIND_ENUM'; +$TYPEKIND[TKIND_RECORD] = 'TKIND_RECORD'; +$TYPEKIND[TKIND_MODULE] = 'TKIND_MODULE'; +$TYPEKIND[TKIND_INTERFACE] = 'TKIND_INTERFACE'; +$TYPEKIND[TKIND_DISPATCH] = 'TKIND_DISPATCH'; +$TYPEKIND[TKIND_COCLASS] = 'TKIND_COCLASS'; +$TYPEKIND[TKIND_ALIAS] = 'TKIND_ALIAS'; +$TYPEKIND[TKIND_UNION] = 'TKIND_UNION'; + +# Implemented Type Flags +# ---------------------- + +sub IMPLTYPEFLAG_FDEFAULT () { 0x1; } +sub IMPLTYPEFLAG_FSOURCE () { 0x2; } +sub IMPLTYPEFLAG_FRESTRICTED () { 0x4; } +sub IMPLTYPEFLAG_FDEFAULTVTABLE () { 0x800; } + +$IMPLTYPEFLAGS{IMPLTYPEFLAG_FDEFAULT()} = IMPLTYPEFLAG_FDEFAULT; +$IMPLTYPEFLAGS{IMPLTYPEFLAG_FSOURCE()} = IMPLTYPEFLAG_FSOURCE; +$IMPLTYPEFLAGS{IMPLTYPEFLAG_FRESTRICTED()} = IMPLTYPEFLAG_FRESTRICTED; +$IMPLTYPEFLAGS{IMPLTYPEFLAG_FDEFAULTVTABLE()} = IMPLTYPEFLAG_FDEFAULTVTABLE; + +# Parameter Flags +# --------------- + +sub PARAMFLAG_NONE () { 0; } +sub PARAMFLAG_FIN () { 0x1; } +sub PARAMFLAG_FOUT () { 0x2; } +sub PARAMFLAG_FLCID () { 0x4; } +sub PARAMFLAG_FRETVAL () { 0x8; } +sub PARAMFLAG_FOPT () { 0x10; } +sub PARAMFLAG_FHASDEFAULT () { 0x20; } + +$PARAMFLAGS{PARAMFLAG_NONE()} = PARAMFLAG_NONE; +$PARAMFLAGS{PARAMFLAG_FIN()} = PARAMFLAG_FIN; +$PARAMFLAGS{PARAMFLAG_FOUT()} = PARAMFLAG_FOUT; +$PARAMFLAGS{PARAMFLAG_FLCID()} = PARAMFLAG_FLCID; +$PARAMFLAGS{PARAMFLAG_FRETVAL()} = PARAMFLAG_FRETVAL; +$PARAMFLAGS{PARAMFLAG_FOPT()} = PARAMFLAG_FOPT; +$PARAMFLAGS{PARAMFLAG_FHASDEFAULT()} = PARAMFLAG_FHASDEFAULT; + +# Function Flags +# -------------- + +sub FUNCFLAG_FRESTRICTED () { 0x1; } +sub FUNCFLAG_FSOURCE () { 0x2; } +sub FUNCFLAG_FBINDABLE () { 0x4; } +sub FUNCFLAG_FREQUESTEDIT () { 0x8; } +sub FUNCFLAG_FDISPLAYBIND () { 0x10; } +sub FUNCFLAG_FDEFAULTBIND () { 0x20; } +sub FUNCFLAG_FHIDDEN () { 0x40; } +sub FUNCFLAG_FUSESGETLASTERROR () { 0x80; } +sub FUNCFLAG_FDEFAULTCOLLELEM () { 0x100; } +sub FUNCFLAG_FUIDEFAULT () { 0x200; } +sub FUNCFLAG_FNONBROWSABLE () { 0x400; } +sub FUNCFLAG_FREPLACEABLE () { 0x800; } +sub FUNCFLAG_FIMMEDIATEBIND () { 0x1000; } + +$FUNCFLAGS{FUNCFLAG_FRESTRICTED()} = FUNCFLAG_FRESTRICTED; +$FUNCFLAGS{FUNCFLAG_FSOURCE()} = FUNCFLAG_FSOURCE; +$FUNCFLAGS{FUNCFLAG_FBINDABLE()} = FUNCFLAG_FBINDABLE; +$FUNCFLAGS{FUNCFLAG_FREQUESTEDIT()} = FUNCFLAG_FREQUESTEDIT; +$FUNCFLAGS{FUNCFLAG_FDISPLAYBIND()} = FUNCFLAG_FDISPLAYBIND; +$FUNCFLAGS{FUNCFLAG_FDEFAULTBIND()} = FUNCFLAG_FDEFAULTBIND; +$FUNCFLAGS{FUNCFLAG_FHIDDEN()} = FUNCFLAG_FHIDDEN; +$FUNCFLAGS{FUNCFLAG_FUSESGETLASTERROR()} = FUNCFLAG_FUSESGETLASTERROR; +$FUNCFLAGS{FUNCFLAG_FDEFAULTCOLLELEM()} = FUNCFLAG_FDEFAULTCOLLELEM; +$FUNCFLAGS{FUNCFLAG_FUIDEFAULT()} = FUNCFLAG_FUIDEFAULT; +$FUNCFLAGS{FUNCFLAG_FNONBROWSABLE()} = FUNCFLAG_FNONBROWSABLE; +$FUNCFLAGS{FUNCFLAG_FREPLACEABLE()} = FUNCFLAG_FREPLACEABLE; +$FUNCFLAGS{FUNCFLAG_FIMMEDIATEBIND()} = FUNCFLAG_FIMMEDIATEBIND; + +# Calling conventions +# ------------------- + +sub CC_FASTCALL () { 0; } +sub CC_CDECL () { 1; } +sub CC_MSCPASCAL () { CC_CDECL() + 1; } +sub CC_PASCAL () { CC_MSCPASCAL; } +sub CC_MACPASCAL () { CC_PASCAL() + 1; } +sub CC_STDCALL () { CC_MACPASCAL() + 1; } +sub CC_FPFASTCALL () { CC_STDCALL() + 1; } +sub CC_SYSCALL () { CC_FPFASTCALL() + 1; } +sub CC_MPWCDECL () { CC_SYSCALL() + 1; } +sub CC_MPWPASCAL () { CC_MPWCDECL() + 1; } +sub CC_MAX () { CC_MPWPASCAL() + 1; } + +$CALLCONV[CC_FASTCALL] = 'CC_FASTCALL'; +$CALLCONV[CC_CDECL] = 'CC_CDECL'; +$CALLCONV[CC_PASCAL] = 'CC_PASCAL'; +$CALLCONV[CC_MACPASCAL] = 'CC_MACPASCAL'; +$CALLCONV[CC_STDCALL] = 'CC_STDCALL'; +$CALLCONV[CC_FPFASTCALL] = 'CC_FPFASTCALL'; +$CALLCONV[CC_SYSCALL] = 'CC_SYSCALL'; +$CALLCONV[CC_MPWCDECL] = 'CC_MPWCDECL'; +$CALLCONV[CC_MPWPASCAL] = 'CC_MPWPASCAL'; + +# Function Kind +# ------------- + +sub FUNC_VIRTUAL () { 0; } +sub FUNC_PUREVIRTUAL () { FUNC_VIRTUAL() + 1; } +sub FUNC_NONVIRTUAL () { FUNC_PUREVIRTUAL() + 1; } +sub FUNC_STATIC () { FUNC_NONVIRTUAL() + 1; } +sub FUNC_DISPATCH () { FUNC_STATIC() + 1; } + +$FUNCKIND[FUNC_VIRTUAL] = 'FUNC_VIRTUAL'; +$FUNCKIND[FUNC_PUREVIRTUAL] = 'FUNC_PUREVIRTUAL'; +$FUNCKIND[FUNC_NONVIRTUAL] = 'FUNC_NONVIRTUAL'; +$FUNCKIND[FUNC_STATIC] = 'FUNC_STATIC'; +$FUNCKIND[FUNC_DISPATCH] = 'FUNC_DISPATCH'; + +# Invoke Kind +# ----------- + +sub INVOKE_FUNC () { 1; } +sub INVOKE_PROPERTYGET () { 2; } +sub INVOKE_PROPERTYPUT () { 4; } +sub INVOKE_PROPERTYPUTREF () { 8; } + +$INVOKEKIND{INVOKE_FUNC()} = INVOKE_FUNC; +$INVOKEKIND{INVOKE_PROPERTYGET()} = INVOKE_PROPERTYGET; +$INVOKEKIND{INVOKE_PROPERTYPUT()} = INVOKE_PROPERTYPUT; +$INVOKEKIND{INVOKE_PROPERTYPUTREF()} = INVOKE_PROPERTYPUTREF; + +# Variable Flags +# -------------- + +sub VARFLAG_FREADONLY () { 0x1; } +sub VARFLAG_FSOURCE () { 0x2; } +sub VARFLAG_FBINDABLE () { 0x4; } +sub VARFLAG_FREQUESTEDIT () { 0x8; } +sub VARFLAG_FDISPLAYBIND () { 0x10; } +sub VARFLAG_FDEFAULTBIND () { 0x20; } +sub VARFLAG_FHIDDEN () { 0x40; } +sub VARFLAG_FRESTRICTED () { 0x80; } +sub VARFLAG_FDEFAULTCOLLELEM () { 0x100; } +sub VARFLAG_FUIDEFAULT () { 0x200; } +sub VARFLAG_FNONBROWSABLE () { 0x400; } +sub VARFLAG_FREPLACEABLE () { 0x800; } +sub VARFLAG_FIMMEDIATEBIND () { 0x1000; } + +$VARFLAGS{VARFLAG_FREADONLY()} = VARFLAG_FREADONLY; +$VARFLAGS{VARFLAG_FSOURCE()} = VARFLAG_FSOURCE; +$VARFLAGS{VARFLAG_FBINDABLE()} = VARFLAG_FBINDABLE; +$VARFLAGS{VARFLAG_FREQUESTEDIT()} = VARFLAG_FREQUESTEDIT; +$VARFLAGS{VARFLAG_FDISPLAYBIND()} = VARFLAG_FDISPLAYBIND; +$VARFLAGS{VARFLAG_FDEFAULTBIND()} = VARFLAG_FDEFAULTBIND; +$VARFLAGS{VARFLAG_FHIDDEN()} = VARFLAG_FHIDDEN; +$VARFLAGS{VARFLAG_FRESTRICTED()} = VARFLAG_FRESTRICTED; +$VARFLAGS{VARFLAG_FDEFAULTCOLLELEM()} = VARFLAG_FDEFAULTCOLLELEM; +$VARFLAGS{VARFLAG_FUIDEFAULT()} = VARFLAG_FUIDEFAULT; +$VARFLAGS{VARFLAG_FNONBROWSABLE()} = VARFLAG_FNONBROWSABLE; +$VARFLAGS{VARFLAG_FREPLACEABLE()} = VARFLAG_FREPLACEABLE; +$VARFLAGS{VARFLAG_FIMMEDIATEBIND()} = VARFLAG_FIMMEDIATEBIND; + + +# Variant Types +# ------------- + +sub VT_EMPTY () { 0; } +sub VT_NULL () { 1; } +sub VT_I2 () { 2; } +sub VT_I4 () { 3; } +sub VT_R4 () { 4; } +sub VT_R8 () { 5; } +sub VT_CY () { 6; } +sub VT_DATE () { 7; } +sub VT_BSTR () { 8; } +sub VT_DISPATCH () { 9; } +sub VT_ERROR () { 10; } +sub VT_BOOL () { 11; } +sub VT_VARIANT () { 12; } +sub VT_UNKNOWN () { 13; } +sub VT_DECIMAL () { 14; } +sub VT_I1 () { 16; } +sub VT_UI1 () { 17; } +sub VT_UI2 () { 18; } +sub VT_UI4 () { 19; } +sub VT_I8 () { 20; } +sub VT_UI8 () { 21; } +sub VT_INT () { 22; } +sub VT_UINT () { 23; } +sub VT_VOID () { 24; } +sub VT_HRESULT () { 25; } +sub VT_PTR () { 26; } +sub VT_SAFEARRAY () { 27; } +sub VT_CARRAY () { 28; } +sub VT_USERDEFINED () { 29; } +sub VT_LPSTR () { 30; } +sub VT_LPWSTR () { 31; } +sub VT_FILETIME () { 64; } +sub VT_BLOB () { 65; } +sub VT_STREAM () { 66; } +sub VT_STORAGE () { 67; } +sub VT_STREAMED_OBJECT () { 68; } +sub VT_STORED_OBJECT () { 69; } +sub VT_BLOB_OBJECT () { 70; } +sub VT_CF () { 71; } +sub VT_CLSID () { 72; } +sub VT_VECTOR () { 0x1000; } +sub VT_ARRAY () { 0x2000; } +sub VT_BYREF () { 0x4000; } +sub VT_RESERVED () { 0x8000; } +sub VT_ILLEGAL () { 0xffff; } +sub VT_ILLEGALMASKED () { 0xfff; } +sub VT_TYPEMASK () { 0xfff; } + +$VT[VT_EMPTY] = 'VT_EMPTY'; +$VT[VT_NULL] = 'VT_NULL'; +$VT[VT_I2] = 'VT_I2'; +$VT[VT_I4] = 'VT_I4'; +$VT[VT_R4] = 'VT_R4'; +$VT[VT_R8] = 'VT_R8'; +$VT[VT_CY] = 'VT_CY'; +$VT[VT_DATE] = 'VT_DATE'; +$VT[VT_BSTR] = 'VT_BSTR'; +$VT[VT_DISPATCH] = 'VT_DISPATCH'; +$VT[VT_ERROR] = 'VT_ERROR'; +$VT[VT_BOOL] = 'VT_BOOL'; +$VT[VT_VARIANT] = 'VT_VARIANT'; +$VT[VT_UNKNOWN] = 'VT_UNKNOWN'; +$VT[VT_DECIMAL] = 'VT_DECIMAL'; +$VT[VT_I1] = 'VT_I1'; +$VT[VT_UI1] = 'VT_UI1'; +$VT[VT_UI2] = 'VT_UI2'; +$VT[VT_UI4] = 'VT_UI4'; +$VT[VT_I8] = 'VT_I8'; +$VT[VT_UI8] = 'VT_UI8'; +$VT[VT_INT] = 'VT_INT'; +$VT[VT_UINT] = 'VT_UINT'; +$VT[VT_VOID] = 'VT_VOID'; +$VT[VT_HRESULT] = 'VT_HRESULT'; +$VT[VT_PTR] = 'VT_PTR'; +$VT[VT_SAFEARRAY] = 'VT_SAFEARRAY'; +$VT[VT_CARRAY] = 'VT_CARRAY'; +$VT[VT_USERDEFINED] = 'VT_USERDEFINED'; +$VT[VT_LPSTR] = 'VT_LPSTR'; +$VT[VT_LPWSTR] = 'VT_LPWSTR'; +$VT[VT_FILETIME] = 'VT_FILETIME'; +$VT[VT_BLOB] = 'VT_BLOB'; +$VT[VT_STREAM] = 'VT_STREAM'; +$VT[VT_STORAGE] = 'VT_STORAGE'; +$VT[VT_STREAMED_OBJECT] = 'VT_STREAMED_OBJECT'; +$VT[VT_STORED_OBJECT] = 'VT_STORED_OBJECT'; +$VT[VT_BLOB_OBJECT] = 'VT_BLOB_OBJECT'; +$VT[VT_CF] = 'VT_CF'; +$VT[VT_CLSID] = 'VT_CLSID'; +$VT[VT_VECTOR] = 'VT_VECTOR'; +$VT[VT_ARRAY] = 'VT_ARRAY'; +$VT[VT_BYREF] = 'VT_BYREF'; +$VT[VT_RESERVED] = 'VT_RESERVED'; +$VT[VT_ILLEGAL] = 'VT_ILLEGAL'; +$VT[VT_ILLEGALMASKED] = 'VT_ILLEGALMASKED'; +$VT[VT_TYPEMASK] = 'VT_TYPEMASK'; + +1; diff --git a/Master/tlpkg/tlperl/site/lib/Win32/OLE/Variant.pm b/Master/tlpkg/tlperl/site/lib/Win32/OLE/Variant.pm new file mode 100755 index 00000000000..38fc6048209 --- /dev/null +++ b/Master/tlpkg/tlperl/site/lib/Win32/OLE/Variant.pm @@ -0,0 +1,577 @@ +# The documentation is at the __END__ + +package Win32::OLE::Variant; +require Win32::OLE; # Make sure the XS bootstrap has been called + +use strict; +use vars qw(@ISA @EXPORT @EXPORT_OK); + +use Exporter; +@ISA = qw(Exporter); + +@EXPORT = qw( + Variant + VT_EMPTY VT_NULL VT_I2 VT_I4 VT_R4 VT_R8 VT_CY VT_DATE VT_BSTR + VT_DISPATCH VT_ERROR VT_BOOL VT_VARIANT VT_UNKNOWN VT_DECIMAL VT_UI1 + VT_ARRAY VT_BYREF + ); + +@EXPORT_OK = qw(CP_ACP CP_OEMCP nothing nullstring); + +# Automation data types. +sub VT_EMPTY {0;} +sub VT_NULL {1;} +sub VT_I2 {2;} +sub VT_I4 {3;} +sub VT_R4 {4;} +sub VT_R8 {5;} +sub VT_CY {6;} +sub VT_DATE {7;} +sub VT_BSTR {8;} +sub VT_DISPATCH {9;} +sub VT_ERROR {10;} +sub VT_BOOL {11;} +sub VT_VARIANT {12;} +sub VT_UNKNOWN {13;} +sub VT_DECIMAL {14;} # Officially not allowed in VARIANTARGs +sub VT_UI1 {17;} + +sub VT_ARRAY {0x2000;} +sub VT_BYREF {0x4000;} + + +# For backward compatibility +sub CP_ACP {0;} # ANSI codepage +sub CP_OEMCP {1;} # OEM codepage + +use overload + # '+' => 'Add', '-' => 'Sub', '*' => 'Mul', '/' => 'Div', + '""' => sub {$_[0]->As(VT_BSTR)}, + '0+' => sub {$_[0]->As(VT_R8)}, + fallback => 1; + +sub Variant { + return Win32::OLE::Variant->new(@_); +} + +sub nothing { + return Win32::OLE::Variant->new(VT_DISPATCH); +} + +sub nullstring { + return Win32::OLE::Variant->new(VT_BSTR); +} + +1; + +__END__ + +=head1 NAME + +Win32::OLE::Variant - Create and modify OLE VARIANT variables + +=head1 SYNOPSIS + + use Win32::OLE::Variant; + my $var = Variant(VT_DATE, 'Jan 1,1970'); + $OleObject->{value} = $var; + $OleObject->Method($var); + + +=head1 DESCRIPTION + +The IDispatch interface used by the Perl OLE module uses a universal +argument type called VARIANT. This is basically an object containing +a data type and the actual data value. The data type is specified by +the VT_xxx constants. + +=head2 Functions + +=over 8 + +=item nothing() + +The nothing() function returns an empty VT_DISPATCH variant. It can be +used to clear an object reference stored in a property + + use Win32::OLE::Variant qw(:DEFAULT nothing); + # ... + $object->{Property} = nothing; + +This has the same effect as the Visual Basic statement + + Set object.Property = Nothing + +The nothing() function is B<not> exported by default. + +=item nullstring() + +The nullstring() function returns a VT_BSTR variant with a NULL string +pointer. This is B<not> the same as a VT_BSTR variant with an empty +string "". The nullstring() value is the same as the vbNullString +constant in Visual Basic. + +The nullstring() function is B<not> exported by default. + +=item Variant(TYPE, DATA) + +This is just a function alias of the C<Win32::OLE::Variant->new()> +method (see below). This function is exported by default. + +=back + +=head2 Methods + +=over 8 + +=item new(TYPE, DATA) + +This method returns a Win32::OLE::Variant object of the specified +TYPE that contains the given DATA. The Win32::OLE::Variant object +can be used to specify data types other than IV, NV or PV (which are +supported transparently). See L<Variants> below for details. + +For VT_EMPTY and VT_NULL variants, the DATA argument may be omitted. +For all non-VT_ARRAY variants DATA specifies the initial value. + +To create a SAFEARRAY variant, you have to specify the VT_ARRAY flag in +addition to the variant base type of the array elements. In this cases +DATA must be a list specifying the dimensions of the array. Each element +can be either an element count (indices 0 to count-1) or an array +reference pointing to the lower and upper array bounds of this dimension: + + my $Array = Win32::OLE::Variant->new(VT_ARRAY|VT_R8, [1,2], 2); + +This creates a 2-dimensional SAFEARRAY of doubles with 4 elements: +(1,0), (1,1), (2,0) and (2,1). + +A special case is the creation of one-dimensional VT_UI1 arrays with +a string DATA argument: + + my $String = Variant(VT_ARRAY|VT_UI1, "String"); + +This creates a 6 element character array initialized to "String". For +backward compatibility VT_UI1 with a string initializer automatically +implies VT_ARRAY. The next line is equivalent to the previous example: + + my $String = Variant(VT_UI1, "String"); + +If you really need a single character VT_UI1 variant, you have to create +it using a numeric intializer: + + my $Char = Variant(VT_UI1, ord('A')); + +=item As(TYPE) + +C<As> converts the VARIANT to the new type before converting to a +Perl value. This take the current LCID setting into account. For +example a string might contain a ',' as the decimal point character. +Using C<$variant->As(VT_R8)> will correctly return the floating +point value. + +The underlying variant object is NOT changed by this method. + +=item ChangeType(TYPE) + +This method changes the type of the contained VARIANT in place. It +returns the object itself, not the converted value. + +=item Copy([DIM]) + +This method creates a copy of the object. If the original variant had +the VT_BYREF bit set then the new object will contain a copy of the +referenced data and not a reference to the same old data. The new +object will not have the VT_BYREF bit set. + + my $Var = Variant(VT_I4|VT_ARRAY|VT_BYREF, [1,5], 3); + my $Copy = $Var->Copy; + +The type of C<$Copy> is now VT_I4|VT_ARRAY and the value is a copy of +the other SAFEARRAY. Changes to elements of C<$Var> will not be reflected +in C<$Copy> and vice versa. + +The C<Copy> method can also be used to extract a single element of a +VT_ARRAY | VT_VARIANT object. In this case the array indices must be +specified as a list DIM: + + my $Int = $Var->Copy(1, 2); + +C<$Int> is now a VT_I4 Variant object containing the value of element (1,2). + +=item Currency([FORMAT[, LCID]]) + +This method converts the VARIANT value into a formatted currency string. The +FORMAT can be either an integer constant or a hash reference. Valid constants +are 0 and LOCALE_NOUSEROVERRIDE. You get the value of LOCALE_NOUSEROVERRIDE +from the Win32::OLE::NLS module: + + use Win32::OLE::NLS qw(:LOCALE); + +LOCALE_NOUSEROVERRIDE tells the method to use the system default currency +format for the specified locale, disregarding any changes that might have +been made through the control panel application. + +The hash reference could contain the following keys: + + NumDigits number of fractional digits + LeadingZero whether to use leading zeroes in decimal fields + Grouping size of each group of digits to the left of the decimal + DecimalSep decimal separator string + ThousandSep thousand separator string + NegativeOrder see L<Win32::OLE::NLS/LOCALE_ICURRENCY> + PositiveOrder see L<Win32::OLE::NLS/LOCALE_INEGCURR> + CurrencySymbol currency symbol string + +For example: + + use Win32::OLE::Variant; + use Win32::OLE::NLS qw(:DEFAULT :LANG :SUBLANG :DATE :TIME); + my $lcidGerman = MAKELCID(MAKELANGID(LANG_GERMAN, SUBLANG_NEUTRAL)); + my $v = Variant(VT_CY, "-922337203685477.5808"); + print $v->Currency({CurrencySymbol => "Tuits"}, $lcidGerman), "\n"; + +will print: + + -922.337.203.685.477,58 Tuits + +=item Date([FORMAT[, LCID]]) + +Converts the VARIANT into a formatted date string. FORMAT can be either +one of the following integer constants or a format string: + + LOCALE_NOUSEROVERRIDE system default date format for this locale + DATE_SHORTDATE use the short date format (default) + DATE_LONGDATE use the long date format + DATE_YEARMONTH use the year/month format + DATE_USE_ALT_CALENDAR use the alternate calendar, if one exists + DATE_LTRREADING left-to-right reading order layout + DATE_RTLREADING right-to left reading order layout + +The constants are available from the Win32::OLE::NLS module: + + use Win32::OLE::NLS qw(:LOCALE :DATE); + +The following elements can be used to construct a date format string. +Characters must be specified exactly as given below (e.g. "dd" B<not> "DD"). +Spaces can be inserted anywhere between formatting codes, other verbatim +text should be included in single quotes. + + d day of month + dd day of month with leading zero for single-digit days + ddd day of week: three-letter abbreviation (LOCALE_SABBREVDAYNAME) + dddd day of week: full name (LOCALE_SDAYNAME) + M month + MM month with leading zero for single-digit months + MMM month: three-letter abbreviation (LOCALE_SABBREVMONTHNAME) + MMMM month: full name (LOCALE_SMONTHNAME) + y year as last two digits + yy year as last two digits with leading zero for years less than 10 + yyyy year represented by full four digits + gg period/era string + +For example: + + my $v = Variant(VT_DATE, "April 1 99"); + print $v->Date(DATE_LONGDATE), "\n"; + print $v->Date("ddd',' MMM dd yy"), "\n"; + +will print: + + Thursday, April 01, 1999 + Thu, Apr 01 99 + +=item Dim() + +Returns a list of array bounds for a VT_ARRAY variant. The list contains +an array reference for each dimension of the variant's SAFEARRAY. This +reference points to an array containing the lower and upper bounds for +this dimension. For example: + + my @Dim = $Var->Dim; + +Now C<@Dim> contains the following list: C<([1,5], [0,2])>. + +=item Get(DIM) + +For normal variants C<Get> returns the value of the variant, just like the +C<Value> method. For VT_ARRAY variants C<Get> retrieves the value of a single +array element. In this case C<DIM> must be a list of array indices. E.g. + + my $Val = $Var->Get(2,0); + +As a special case for one dimensional VT_UI1|VT_ARRAY variants the C<Get> +method without arguments returns the character array as a Perl string. + + print $String->Get, "\n"; + +=item IsNothing() + +Tests if the object is an empty VT_DISPATCH variant. See also nothing(). + +=item IsNullString() + +Tests if the object is an empty VT_BSTR variant. See also nullstring(). + +=item LastError() + +The use of the C<Win32::OLE::Variant->LastError()> method is deprecated. +Please use the C<Win32::OLE->LastError()> class method instead. + +=item Number([FORMAT[, LCID]]) + +This method converts the VARIANT value into a formatted number string. The +FORMAT can be either an integer constant or a hash reference. Valid constants +are 0 and LOCALE_NOUSEROVERRIDE. You get the value of LOCALE_NOUSEROVERRIDE +from the Win32::OLE::NLS module: + + use Win32::OLE::NLS qw(:LOCALE); + +LOCALE_NOUSEROVERRIDE tells the method to use the system default number +format for the specified locale, disregarding any changes that might have +been made through the control panel application. + +The hash reference could contain the following keys: + + NumDigits number of fractional digits + LeadingZero whether to use leading zeroes in decimal fields + Grouping size of each group of digits to the left of the decimal + DecimalSep decimal separator string + ThousandSep thousand separator string + NegativeOrder see L<Win32::OLE::NLS/LOCALE_INEGNUMBER> + +=item Put(DIM, VALUE) + +The C<Put> method is used to assign a new value to a variant. The value will +be coerced into the current type of the variant. E.g.: + + my $Var = Variant(VT_I4, 42); + $Var->Put(3.1415); + +This changes the value of the variant to C<3> because the type is VT_I4. + +For VT_ARRAY type variants the indices for each dimension of the contained +SAFEARRAY must be specified in front of the new value: + + $Array->Put(1, 1, 2.7); + +It is also possible to assign values to *every* element of the SAFEARRAY at +once using a single Put() method call: + + $Array->Put([[1,2], [3,4]]); + +In this case the argument to Put() must be an array reference and the +dimensions of the Perl list-of-lists must match the dimensions of the +SAFEARRAY exactly. + +The are a few special cases for one-dimensional VT_UI1 arrays: The VALUE +can be specified as a string instead of a number. This will set the selected +character to the first character of the string or to '\0' if the string was +empty: + + my $String = Variant(VT_UI1|VT_ARRAY, "ABCDE"); + $String->Put(1, "123"); + $String->Put(3, ord('Z')); + $String->Put(4, ''); + +This will set the value of C<$String> to C<"A1CZ\0">. If the index is omitted +then the string is copied to the value completely. The string is truncated +if it is longer than the size of the VT_UI1 array. The result will be padded +with '\0's if the string is shorter: + + $String->Put("String"); + +Now C<$String> contains the value "Strin". + +C<Put> returns the Variant object itself so that multiple C<Put> calls can be +chained together: + + $Array->Put(0,0,$First_value)->Put(0,1,$Another_value); + +=item Time([FORMAT[, LCID]]) + +Converts the VARIANT into a formatted time string. FORMAT can be either +one of the following integer constants or a format string: + + LOCALE_NOUSEROVERRIDE system default time format for this locale + TIME_NOMINUTESORSECONDS don't use minutes or seconds + TIME_NOSECONDS don't use seconds + TIME_NOTIMEMARKER don't use a time marker + TIME_FORCE24HOURFORMAT always use a 24-hour time format + +The constants are available from the Win32::OLE::NLS module: + + use Win32::OLE::NLS qw(:LOCALE :TIME); + +The following elements can be used to construct a time format string. +Characters must be specified exactly as given below (e.g. "dd" B<not> "DD"). +Spaces can be inserted anywhere between formatting codes, other verbatim +text should be included in single quotes. + + h hours; 12-hour clock + hh hours with leading zero for single-digit hours; 12-hour clock + H hours; 24-hour clock + HH hours with leading zero for single-digit hours; 24-hour clock + m minutes + mm minutes with leading zero for single-digit minutes + s seconds + ss seconds with leading zero for single-digit seconds + t one character time marker string, such as A or P + tt multicharacter time marker string, such as AM or PM + +For example: + + my $v = Variant(VT_DATE, "April 1 99 2:23 pm"); + print $v->Time, "\n"; + print $v->Time(TIME_FORCE24HOURFORMAT|TIME_NOTIMEMARKER), "\n"; + print $v->Time("hh.mm.ss tt"), "\n"; + +will print: + + 2:23:00 PM + 14:23:00 + 02.23.00 PM + +=item Type() + +The C<Type> method returns the variant type of the contained VARIANT. + +=item Unicode() + +The C<Unicode> method returns a C<Unicode::String> object. This contains +the BSTR value of the variant in network byte order. If the variant is +not currently in VT_BSTR format then a VT_BSTR copy will be produced first. + +=item Value() + +The C<Value> method returns the value of the VARIANT as a Perl value. The +conversion is performed in the same manner as all return values of +Win32::OLE method calls are converted. + +=back + +=head2 Overloading + +The Win32::OLE::Variant package has overloaded the conversion to +string and number formats. Therefore variant objects can be used in +arithmetic and string operations without applying the C<Value> +method first. + +=head2 Class Variables + +The Win32::OLE::Variant class used to have its own set of class variables +like C<$CP>, C<$LCID> and C<$Warn>. In version 0.1003 and later of the +Win32::OLE module these variables have been eliminated. Now the settings +of Win32::OLE are used by the Win32::OLE::Variant module too. Please read +the documentation of the C<Win32::OLE->Option> class method. + + +=head2 Constants + +These constants are exported by default: + + VT_EMPTY + VT_NULL + VT_I2 + VT_I4 + VT_R4 + VT_R8 + VT_CY + VT_DATE + VT_BSTR + VT_DISPATCH + VT_ERROR + VT_BOOL + VT_VARIANT + VT_UNKNOWN + VT_DECIMAL + VT_UI1 + + VT_ARRAY + VT_BYREF + +VT_DECIMAL is not on the official list of allowable OLE Automation +datatypes. But even Microsoft ADO seems to sometimes return values +of Recordset fields in VT_DECIMAL format. + +=head2 Variants + +A Variant is a data type that is used to pass data between OLE +connections. + +The default behavior is to convert each perl scalar variable into +an OLE Variant according to the internal perl representation. +The following type correspondence holds: + + C type Perl type OLE type + ------ --------- -------- + int IV VT_I4 + double NV VT_R8 + char * PV VT_BSTR + void * ref to AV VT_ARRAY + ? undef VT_ERROR + ? Win32::OLE object VT_DISPATCH + +Note that VT_BSTR is a wide character or Unicode string. This presents a +problem if you want to pass in binary data as a parameter as 0x00 is +inserted between all the bytes in your data. The C<Variant()> method +provides a solution to this. With Variants the script writer can specify +the OLE variant type that the parameter should be converted to. Currently +supported types are: + + VT_UI1 unsigned char + VT_I2 signed int (2 bytes) + VT_I4 signed int (4 bytes) + VT_R4 float (4 bytes) + VT_R8 float (8 bytes) + VT_DATE OLE Date + VT_BSTR OLE String + VT_CY OLE Currency + VT_BOOL OLE Boolean + +When VT_DATE and VT_CY objects are created, the input parameter is treated +as a Perl string type, which is then converted to VT_BSTR, and finally to +VT_DATE of VT_CY using the C<VariantChangeType()> OLE API function. +See L<Win32::OLE/EXAMPLES> for how these types can be used. + +=head2 Variant arrays + +A variant can not only contain a single value but also a multi-dimensional +array of values (called a SAFEARRAY). In this case the VT_ARRAY flag must +be added to the base variant type, e.g. C<VT_I4 | VT_ARRAY> for an array of +integers. The VT_EMPTY and VT_NULL types are invalid for SAFEARRAYs. It +is possible to create an array of variants: C<VT_VARIANT | VT_ARRAY>. In this +case each element of the array can have a different type (including VT_EMPTY +and VT_NULL). The elements of a VT_VARIANT SAFEARRAY cannot have either of the +VT_ARRAY or VT_BYREF flags set. + +The lower and upper bounds for each dimension can be specified separately. +They do not have to have all the same lower bound (unlike Perl's arrays). + +=head2 Variants by reference + +Some OLE servers expect parameters passed by reference so that they +can be changed in the method call. This allows methods to easily +return multiple values. There is preliminary support for this in +the Win32::OLE::Variant module: + + my $x = Variant(VT_I4|VT_BYREF, 0); + my $y = Variant(VT_I4|VT_BYREF, 0); + $Corel->GetSize($x, $y); + print "Size is $x by $y\n"; + +After the C<GetSize> method call C<$x> and C<$y> will be set to +the respective sizes. They will still be variants. In the print +statement the overloading converts them to string representation +automatically. + +VT_BYREF is now supported for all variant types (including SAFEARRAYs). +It can also be used to pass an OLE object by reference: + + my $Results = $App->CreateResultsObject; + $Object->Method(Variant(VT_DISPATCH|VT_BYREF, $Results)); + +=head1 AUTHORS/COPYRIGHT + +This module is part of the Win32::OLE distribution. + +=cut diff --git a/Master/tlpkg/tlperl/site/lib/auto/Win32/OLE/.packlist b/Master/tlpkg/tlperl/site/lib/auto/Win32/OLE/.packlist new file mode 100755 index 00000000000..4799e901a6c --- /dev/null +++ b/Master/tlpkg/tlperl/site/lib/auto/Win32/OLE/.packlist @@ -0,0 +1,11 @@ +D:\tlperl\site\lib\OLE.pm
+D:\tlperl\site\lib\Win32\OLE.pm
+D:\tlperl\site\lib\Win32\OLE\Const.pm
+D:\tlperl\site\lib\Win32\OLE\Enum.pm
+D:\tlperl\site\lib\Win32\OLE\Lite.pm
+D:\tlperl\site\lib\Win32\OLE\NEWS.pod
+D:\tlperl\site\lib\Win32\OLE\NLS.pm
+D:\tlperl\site\lib\Win32\OLE\TPJ.pod
+D:\tlperl\site\lib\Win32\OLE\TypeInfo.pm
+D:\tlperl\site\lib\Win32\OLE\Variant.pm
+D:\tlperl\site\lib\auto\Win32\OLE\OLE.dll
diff --git a/Master/tlpkg/tlperl/site/lib/auto/Win32/OLE/OLE.dll b/Master/tlpkg/tlperl/site/lib/auto/Win32/OLE/OLE.dll Binary files differnew file mode 100755 index 00000000000..8ef92c143ed --- /dev/null +++ b/Master/tlpkg/tlperl/site/lib/auto/Win32/OLE/OLE.dll |