1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
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;
|
