RegressionTests__Win32OLETests.st
author Claus Gittinger <cg@exept.de>
Tue, 09 Jul 2019 18:53:03 +0200
changeset 2327 bf482d49aeaf
parent 2233 73a9c0ab4b0a
child 2480 6ffb0b50d9cb
permissions -rw-r--r--
#QUALITY by exept class: RegressionTests::StringTests added: #test82c_expanding
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1707
76213a555906 #BUGFIX by sr
sr
parents: 1447
diff changeset
     1
"{ Encoding: utf8 }"
76213a555906 #BUGFIX by sr
sr
parents: 1447
diff changeset
     2
1447
2351db93aa5b package changes
Claus Gittinger <cg@exept.de>
parents: 1393
diff changeset
     3
"{ Package: 'stx:goodies/regression' }"
1353
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
"{ NameSpace: RegressionTests }"
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
TestCase subclass:#Win32OLETests
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
	instanceVariableNames:''
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
	classVariableNames:''
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
	poolDictionaries:''
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
	category:'tests-Regression-RuntimeSystem'
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
!
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
1355
8844ec16d47b #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1353
diff changeset
    15
!Win32OLETests class methodsFor:'queries'!
8844ec16d47b #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1353
diff changeset
    16
8844ec16d47b #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1353
diff changeset
    17
coveredPackageNames
8844ec16d47b #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1353
diff changeset
    18
    ^ #('exept:ole')
8844ec16d47b #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1353
diff changeset
    19
! !
8844ec16d47b #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1353
diff changeset
    20
1353
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
!Win32OLETests methodsFor:'tests'!
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
test00_loadOLE
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
    |iid_IEnum|
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
2233
73a9c0ab4b0a #BUGFIX by Stefan Reise
sr
parents: 1722
diff changeset
    26
    self 
73a9c0ab4b0a #BUGFIX by Stefan Reise
sr
parents: 1722
diff changeset
    27
        skipIf:[
73a9c0ab4b0a #BUGFIX by Stefan Reise
sr
parents: 1722
diff changeset
    28
            OperatingSystem isMSWINDOWSlike not 
73a9c0ab4b0a #BUGFIX by Stefan Reise
sr
parents: 1722
diff changeset
    29
            or:[ExternalAddress pointerSize = 8]] 
73a9c0ab4b0a #BUGFIX by Stefan Reise
sr
parents: 1722
diff changeset
    30
        description:'test skipped (OS is not WINDOWS 32bit)'.
1353
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
    Smalltalk at:#ExternalLibraryFunction:Verbose put:true.
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
    Smalltalk at:#ObjectFileLoader:Verbose put:true.
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
    "/
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
    "/ this will already perform a number of calls into OLE,
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
    "/ to get the CLSIDs of various wellknown interfaces
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
    "/ (see OLEInterfaceConstants initialize)
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
    Smalltalk loadPackage:'exept:ole'.
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
1447
2351db93aa5b package changes
Claus Gittinger <cg@exept.de>
parents: 1393
diff changeset
    40
    "/ so when we arrive here without error, some is already known to work..
1353
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
    self assert:(OLEInterfaceConstants notNil).
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
    iid_IEnum := OLEInterfaceConstants classVarAt:#'IID_IEnum'.
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
    self assert:(iid_IEnum notNil).
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
    self assert:(iid_IEnum class == GUID).
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
    self assert:(iid_IEnum printString = '{2AE64960-CDDD-101C-9029-040224007802}').
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
    "
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
     self new test00_loadOLE
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
    "
2233
73a9c0ab4b0a #BUGFIX by Stefan Reise
sr
parents: 1722
diff changeset
    51
73a9c0ab4b0a #BUGFIX by Stefan Reise
sr
parents: 1722
diff changeset
    52
    "Modified: / 21-05-2019 / 16:22:47 / Stefan Reise"
1356
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    53
!
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    54
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    55
test01_SysAllocString
2233
73a9c0ab4b0a #BUGFIX by Stefan Reise
sr
parents: 1722
diff changeset
    56
    |ole rslt|
1356
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    57
2233
73a9c0ab4b0a #BUGFIX by Stefan Reise
sr
parents: 1722
diff changeset
    58
    self 
73a9c0ab4b0a #BUGFIX by Stefan Reise
sr
parents: 1722
diff changeset
    59
        skipIf:[
73a9c0ab4b0a #BUGFIX by Stefan Reise
sr
parents: 1722
diff changeset
    60
            OperatingSystem isMSWINDOWSlike not 
73a9c0ab4b0a #BUGFIX by Stefan Reise
sr
parents: 1722
diff changeset
    61
            or:[ExternalAddress pointerSize = 8]] 
73a9c0ab4b0a #BUGFIX by Stefan Reise
sr
parents: 1722
diff changeset
    62
        description:'test skipped (OS is not WINDOWS 32bit)'.
1707
76213a555906 #BUGFIX by sr
sr
parents: 1447
diff changeset
    63
1356
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    64
    ole := OLEAutomationDLL current.
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    65
    rslt := ole SysAllocString: 'hello World'.
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    66
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    67
    self assert:(rslt notNil).
1372
a990b4eb7030 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1356
diff changeset
    68
    self assert:(rslt sizeInBytes == (4 + ('hello World' size * 2) "+ 2")).
a990b4eb7030 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1356
diff changeset
    69
    self assert:(rslt sizeInCharacters == 'hello World' size).
a990b4eb7030 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1356
diff changeset
    70
    self assert:(rslt characterAt:1) == $h.
a990b4eb7030 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1356
diff changeset
    71
    self assert:(rslt characterAt:2) == $e.
1356
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    72
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    73
    "
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    74
     self new test01_SysAllocString
a8e8d673f22e #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1355
diff changeset
    75
    "
2233
73a9c0ab4b0a #BUGFIX by Stefan Reise
sr
parents: 1722
diff changeset
    76
73a9c0ab4b0a #BUGFIX by Stefan Reise
sr
parents: 1722
diff changeset
    77
    "Modified (format): / 21-05-2019 / 16:22:55 / Stefan Reise"
1374
caed36c1303d #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1372
diff changeset
    78
!
caed36c1303d #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1372
diff changeset
    79
caed36c1303d #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1372
diff changeset
    80
test02_GuidFromProgID
1722
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
    81
    |guid appToId|
1374
caed36c1303d #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1372
diff changeset
    82
1722
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
    83
    self 
2233
73a9c0ab4b0a #BUGFIX by Stefan Reise
sr
parents: 1722
diff changeset
    84
        skipIf:[
73a9c0ab4b0a #BUGFIX by Stefan Reise
sr
parents: 1722
diff changeset
    85
            OperatingSystem isMSWINDOWSlike not 
73a9c0ab4b0a #BUGFIX by Stefan Reise
sr
parents: 1722
diff changeset
    86
            or:[ExternalAddress pointerSize = 8]] 
73a9c0ab4b0a #BUGFIX by Stefan Reise
sr
parents: 1722
diff changeset
    87
        description:'test skipped (OS is not WINDOWS 32bit)'.
1707
76213a555906 #BUGFIX by sr
sr
parents: 1447
diff changeset
    88
1447
2351db93aa5b package changes
Claus Gittinger <cg@exept.de>
parents: 1393
diff changeset
    89
    self
1707
76213a555906 #BUGFIX by sr
sr
parents: 1447
diff changeset
    90
        should:[
1722
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
    91
            guid := GUID clsidFromProgID:'Foo.Bar'.
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
    92
        ] 
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
    93
        raise:OLEError.
1376
d2973f7acf8c #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1375
diff changeset
    94
1722
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
    95
    appToId := Dictionary new.
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
    96
    appToId at:'AcroPDF.PDF'                        put:nil.
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
    97
    appToId at:'InternetExplorer.Application'       put:'{0002DF01-0000-0000-C000-000000000046}'.
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
    98
    appToId at:'Msxml2.DOMDocument.4.0'             put:'{88D969C0-F192-11D4-A65F-0040963251E5}'.
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
    99
    appToId at:'Microsoft.JScript.Vsa.VsaEngine'    put:'{B71E484D-93ED-4B56-BFB9-CEED5134822B}'.
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
   100
        
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
   101
    appToId keysAndValuesDo:[:app :id |
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
   102
        OLEError handle:[:ex |
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
   103
            ex hresult = (OLEStatusCodeConstants at:#CO_E_CLASSSTRING) ifTrue:[
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
   104
                "/ kind of expected - your machine has app not installed...
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
   105
                Transcript showCR:'OLE: class not found: ', app
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
   106
            ] ifFalse:[
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
   107
                self assert:false description:'unexpected error code'.
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
   108
            ]
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
   109
        ] do:[
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
   110
            guid := GUID clsidFromProgID:app.
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
   111
            self assert:guid notNil.
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
   112
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
   113
            id notNil ifTrue:[
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
   114
                self assert:guid printString = id.
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
   115
            ].
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
   116
        ].
1375
7be5753688a8 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1374
diff changeset
   117
    ].
1374
caed36c1303d #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1372
diff changeset
   118
caed36c1303d #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1372
diff changeset
   119
    "
caed36c1303d #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1372
diff changeset
   120
     self new test02_GuidFromProgID
caed36c1303d #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1372
diff changeset
   121
    "
1377
c68053a15d26 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1376
diff changeset
   122
c68053a15d26 #REFACTORING
Claus Gittinger <cg@exept.de>
parents: 1376
diff changeset
   123
    "Modified: / 30-03-2016 / 02:28:15 / cg"
2233
73a9c0ab4b0a #BUGFIX by Stefan Reise
sr
parents: 1722
diff changeset
   124
    "Modified: / 21-05-2019 / 16:23:00 / Stefan Reise"
1378
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   125
!
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   126
1381
7fae9f959864 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1380
diff changeset
   127
test03_verbsEnumerator
7fae9f959864 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1380
diff changeset
   128
    |clsID enumerator nextVerb|
7fae9f959864 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1380
diff changeset
   129
1707
76213a555906 #BUGFIX by sr
sr
parents: 1447
diff changeset
   130
    self skipIf:[OperatingSystem isMSWINDOWSlike not] description:'test skipped (OS is not WINDOWS)'.
1722
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
   131
    self skipIf:true description:'tests unfinished code'.
1707
76213a555906 #BUGFIX by sr
sr
parents: 1447
diff changeset
   132
1381
7fae9f959864 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1380
diff changeset
   133
    clsID := GUID clsidFromProgID:'InternetExplorer.Application'.
7fae9f959864 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1380
diff changeset
   134
    self assert:clsID notNil.
7fae9f959864 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1380
diff changeset
   135
    self assert:(clsID printString = '{0002DF01-0000-0000-C000-000000000046}').
7fae9f959864 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1380
diff changeset
   136
7fae9f959864 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1380
diff changeset
   137
    enumerator := OLERegistryInterface verbsEnumerator:clsID.
7fae9f959864 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1380
diff changeset
   138
    self assert:(enumerator notNil).
7fae9f959864 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1380
diff changeset
   139
7fae9f959864 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1380
diff changeset
   140
    nextVerb := enumerator next.
7fae9f959864 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1380
diff changeset
   141
    self assert:nextVerb notNil.
7fae9f959864 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1380
diff changeset
   142
    enumerator release.
7fae9f959864 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1380
diff changeset
   143
7fae9f959864 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1380
diff changeset
   144
    "
7fae9f959864 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1380
diff changeset
   145
     self new test03_verbsEnumerator
7fae9f959864 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1380
diff changeset
   146
    "
7fae9f959864 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1380
diff changeset
   147
7fae9f959864 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1380
diff changeset
   148
    "Created: / 30-03-2016 / 11:29:03 / cg"
7fae9f959864 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1380
diff changeset
   149
!
7fae9f959864 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1380
diff changeset
   150
7fae9f959864 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1380
diff changeset
   151
test20_CreateInstance
1380
6b362a19ffd2 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 1379
diff changeset
   152
    |guid iDispatch iWebBrowser iWebBrowserApp iWebBrowser2
1382
82953a8ea3e4 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1381
diff changeset
   153
     ids visibleID params result specTable|
1378
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   154
1707
76213a555906 #BUGFIX by sr
sr
parents: 1447
diff changeset
   155
    self skipIf:[OperatingSystem isMSWINDOWSlike not] description:'test skipped (OS is not WINDOWS)'.
1722
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
   156
    self skipIf:true description:'tests unfinished code'.
1707
76213a555906 #BUGFIX by sr
sr
parents: 1447
diff changeset
   157
1447
2351db93aa5b package changes
Claus Gittinger <cg@exept.de>
parents: 1393
diff changeset
   158
    guid := (GUID clsidFromProgID:'InternetExplorer.Application').
1378
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   159
    self assert:(guid notNil).
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   160
    self assert:(guid printString = '{0002DF01-0000-0000-C000-000000000046}').
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   161
1447
2351db93aa5b package changes
Claus Gittinger <cg@exept.de>
parents: 1393
diff changeset
   162
    iDispatch := IClassFactory
1707
76213a555906 #BUGFIX by sr
sr
parents: 1447
diff changeset
   163
                createInstance:guid
76213a555906 #BUGFIX by sr
sr
parents: 1447
diff changeset
   164
                iid: (OLEInterface oleConstantAt:'IID_IDispatch')
76213a555906 #BUGFIX by sr
sr
parents: 1447
diff changeset
   165
                controllingUnknown:nil
76213a555906 #BUGFIX by sr
sr
parents: 1447
diff changeset
   166
                context:(OLEInterface oleConstantAt:'CLSCTX_ALL').
1378
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   167
    self assert:(iDispatch notNil).
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   168
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   169
    self assert:(iDispatch hasTypeInfo).
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   170
    iWebBrowser := iDispatch queryInterface: IWebBrowser iid.
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   171
    self assert:(iWebBrowser notNil).
1382
82953a8ea3e4 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1381
diff changeset
   172
    specTable := OLEDispatchSpecificationTable constructSpecificationTable: iDispatch getTypeInfo.
1378
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   173
    iDispatch release.
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   174
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   175
    iWebBrowserApp := iWebBrowser queryInterface: IWebBrowserApp iid.
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   176
    self assert:(iWebBrowserApp notNil).
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   177
    iWebBrowser release.
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   178
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   179
    iWebBrowser2 := iWebBrowserApp queryInterface: IWebBrowser2 iid.
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   180
    self assert:(iWebBrowser2 notNil).
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   181
    iWebBrowserApp release.
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   182
1380
6b362a19ffd2 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 1379
diff changeset
   183
    "/ iWebBrowser2 setProperty:'Visible' value:true.
6b362a19ffd2 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 1379
diff changeset
   184
    ids := iWebBrowser2 getIDsOfNames:(Array with:'Visible').
6b362a19ffd2 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 1379
diff changeset
   185
    visibleID := ids first.
6b362a19ffd2 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 1379
diff changeset
   186
6b362a19ffd2 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 1379
diff changeset
   187
    params := OLE_DISPPARAMS new.
6b362a19ffd2 #BUGFIX
Claus Gittinger <cg@exept.de>
parents: 1379
diff changeset
   188
    params cArgs: 0.
1382
82953a8ea3e4 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1381
diff changeset
   189
    result := iWebBrowser2 invokePropertyGet: visibleID with:params.
82953a8ea3e4 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1381
diff changeset
   190
    self assert:(result == false).
82953a8ea3e4 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1381
diff changeset
   191
82953a8ea3e4 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1381
diff changeset
   192
"/    params := OLEDispatchValueAdaptor new
82953a8ea3e4 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1381
diff changeset
   193
"/                parametersForPropertySet: aIDispatchSpecification arguments: valueArray
82953a8ea3e4 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1381
diff changeset
   194
"/                parameters parametersForPropertySet: aDispatchSpecification arguments: valueArray
82953a8ea3e4 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1381
diff changeset
   195
82953a8ea3e4 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1381
diff changeset
   196
    params := OLE_DISPPARAMS new.
82953a8ea3e4 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1381
diff changeset
   197
    params cArgs: 1.
1722
54ee95429abb #BUGFIX by sr
sr
parents: 1707
diff changeset
   198
    params arguments:(Array with:true asOLEVariant).
1382
82953a8ea3e4 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1381
diff changeset
   199
    result := iWebBrowser2 invokePropertyPut: visibleID with:params.
82953a8ea3e4 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1381
diff changeset
   200
    self assert:(result == false).
1379
b287b40bb60f #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1378
diff changeset
   201
1378
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   202
    iWebBrowser2 release.
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   203
1447
2351db93aa5b package changes
Claus Gittinger <cg@exept.de>
parents: 1393
diff changeset
   204
1378
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   205
    "
1381
7fae9f959864 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1380
diff changeset
   206
     self new test20_CreateInstance
1378
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   207
    "
9f3b1678697b #FEATURE
Claus Gittinger <cg@exept.de>
parents: 1377
diff changeset
   208
1381
7fae9f959864 #DOCUMENTATION
Claus Gittinger <cg@exept.de>
parents: 1380
diff changeset
   209
    "Created: / 30-03-2016 / 11:26:36 / cg"
1382
82953a8ea3e4 #UI_ENHANCEMENT
Claus Gittinger <cg@exept.de>
parents: 1381
diff changeset
   210
    "Modified: / 30-03-2016 / 20:08:04 / cg"
1353
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   211
! !
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   212
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   213
!Win32OLETests class methodsFor:'documentation'!
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   214
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   215
version
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   216
    ^ '$Header$'
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   217
!
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   218
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   219
version_CVS
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   220
    ^ '$Header$'
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   221
! !
f4b960546cfe initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   222