RegressionTests__Win32OLETests.st
author Claus Gittinger <cg@exept.de>
Tue, 25 Feb 2020 17:19:49 +0100
changeset 2586 7dc7be5a6f3d
parent 2480 6ffb0b50d9cb
permissions -rw-r--r--
#OTHER by cg s

"{ Encoding: utf8 }"

"
 COPYRIGHT (c) 2018 by eXept Software AG
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
"{ Package: 'stx:goodies/regression' }"

"{ NameSpace: RegressionTests }"

TestCase subclass:#Win32OLETests
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'tests-Regression-RuntimeSystem'
!

!Win32OLETests class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 2018 by eXept Software AG
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
! !

!Win32OLETests class methodsFor:'queries'!

coveredPackageNames
    ^ #('exept:ole')
! !

!Win32OLETests methodsFor:'tests'!

test00_loadOLE
    |iid_IEnum|

    self 
        skipIf:[
            OperatingSystem isMSWINDOWSlike not 
            or:[ExternalAddress pointerSize = 8]] 
        description:'test skipped (OS is not WINDOWS 32bit)'.

    Smalltalk at:#ExternalLibraryFunction:Verbose put:true.
    Smalltalk at:#ObjectFileLoader:Verbose put:true.
    "/
    "/ this will already perform a number of calls into OLE,
    "/ to get the CLSIDs of various wellknown interfaces
    "/ (see OLEInterfaceConstants initialize)
    Smalltalk loadPackage:'exept:ole'.

    "/ so when we arrive here without error, some is already known to work..
    self assert:(OLEInterfaceConstants notNil).

    iid_IEnum := OLEInterfaceConstants classVarAt:#'IID_IEnum'.
    self assert:(iid_IEnum notNil).
    self assert:(iid_IEnum class == GUID).
    self assert:(iid_IEnum printString = '{2AE64960-CDDD-101C-9029-040224007802}').

    "
     self new test00_loadOLE
    "

    "Modified: / 21-05-2019 / 16:22:47 / Stefan Reise"
!

test01_SysAllocString
    |ole rslt|

    self 
        skipIf:[
            OperatingSystem isMSWINDOWSlike not 
            or:[ExternalAddress pointerSize = 8]] 
        description:'test skipped (OS is not WINDOWS 32bit)'.

    ole := OLEAutomationDLL current.
    rslt := ole SysAllocString: 'hello World'.

    self assert:(rslt notNil).
    self assert:(rslt sizeInBytes == (4 + ('hello World' size * 2) "+ 2")).
    self assert:(rslt sizeInCharacters == 'hello World' size).
    self assert:(rslt characterAt:1) == $h.
    self assert:(rslt characterAt:2) == $e.

    "
     self new test01_SysAllocString
    "

    "Modified (format): / 21-05-2019 / 16:22:55 / Stefan Reise"
!

test02_GuidFromProgID
    |guid appToId|

    self 
        skipIf:[
            OperatingSystem isMSWINDOWSlike not 
            or:[ExternalAddress pointerSize = 8]] 
        description:'test skipped (OS is not WINDOWS 32bit)'.

    self
        should:[
            guid := GUID clsidFromProgID:'Foo.Bar'.
        ] 
        raise:OLEError.

    appToId := Dictionary new.
    appToId at:'AcroPDF.PDF'                        put:nil.
    appToId at:'InternetExplorer.Application'       put:'{0002DF01-0000-0000-C000-000000000046}'.
    appToId at:'Msxml2.DOMDocument.4.0'             put:'{88D969C0-F192-11D4-A65F-0040963251E5}'.
    appToId at:'Microsoft.JScript.Vsa.VsaEngine'    put:'{B71E484D-93ED-4B56-BFB9-CEED5134822B}'.
        
    appToId keysAndValuesDo:[:app :id |
        OLEError handle:[:ex |
            ex hresult = (OLEStatusCodeConstants at:#CO_E_CLASSSTRING) ifTrue:[
                "/ kind of expected - your machine has app not installed...
                Transcript showCR:'OLE: class not found: ', app
            ] ifFalse:[
                self assert:false description:'unexpected error code'.
            ]
        ] do:[
            guid := GUID clsidFromProgID:app.
            self assert:guid notNil.

            id notNil ifTrue:[
                self assert:guid printString = id.
            ].
        ].
    ].

    "
     self new test02_GuidFromProgID
    "

    "Modified: / 30-03-2016 / 02:28:15 / cg"
    "Modified: / 21-05-2019 / 16:23:00 / Stefan Reise"
!

test03_verbsEnumerator
    |clsID enumerator nextVerb|

    self skipIf:[OperatingSystem isMSWINDOWSlike not] description:'test skipped (OS is not WINDOWS)'.
    self skipIf:true description:'tests unfinished code'.

    clsID := GUID clsidFromProgID:'InternetExplorer.Application'.
    self assert:clsID notNil.
    self assert:(clsID printString = '{0002DF01-0000-0000-C000-000000000046}').

    enumerator := OLERegistryInterface verbsEnumerator:clsID.
    self assert:(enumerator notNil).

    nextVerb := enumerator next.
    self assert:nextVerb notNil.
    enumerator release.

    "
     self new test03_verbsEnumerator
    "

    "Created: / 30-03-2016 / 11:29:03 / cg"
!

test20_CreateInstance
    |guid iDispatch iWebBrowser iWebBrowserApp iWebBrowser2
     ids visibleID params result specTable|

    self skipIf:[OperatingSystem isMSWINDOWSlike not] description:'test skipped (OS is not WINDOWS)'.
    self skipIf:true description:'tests unfinished code'.

    guid := (GUID clsidFromProgID:'InternetExplorer.Application').
    self assert:(guid notNil).
    self assert:(guid printString = '{0002DF01-0000-0000-C000-000000000046}').

    iDispatch := IClassFactory
                createInstance:guid
                iid: (OLEInterface oleConstantAt:'IID_IDispatch')
                controllingUnknown:nil
                context:(OLEInterface oleConstantAt:'CLSCTX_ALL').
    self assert:(iDispatch notNil).

    self assert:(iDispatch hasTypeInfo).
    iWebBrowser := iDispatch queryInterface: IWebBrowser iid.
    self assert:(iWebBrowser notNil).
    specTable := OLEDispatchSpecificationTable constructSpecificationTable: iDispatch getTypeInfo.
    iDispatch release.

    iWebBrowserApp := iWebBrowser queryInterface: IWebBrowserApp iid.
    self assert:(iWebBrowserApp notNil).
    iWebBrowser release.

    iWebBrowser2 := iWebBrowserApp queryInterface: IWebBrowser2 iid.
    self assert:(iWebBrowser2 notNil).
    iWebBrowserApp release.

    "/ iWebBrowser2 setProperty:'Visible' value:true.
    ids := iWebBrowser2 getIDsOfNames:(Array with:'Visible').
    visibleID := ids first.

    params := OLE_DISPPARAMS new.
    params cArgs: 0.
    result := iWebBrowser2 invokePropertyGet: visibleID with:params.
    self assert:(result == false).

"/    params := OLEDispatchValueAdaptor new
"/                parametersForPropertySet: aIDispatchSpecification arguments: valueArray
"/                parameters parametersForPropertySet: aDispatchSpecification arguments: valueArray

    params := OLE_DISPPARAMS new.
    params cArgs: 1.
    params arguments:(Array with:true asOLEVariant).
    result := iWebBrowser2 invokePropertyPut: visibleID with:params.
    self assert:(result == false).

    iWebBrowser2 release.


    "
     self new test20_CreateInstance
    "

    "Created: / 30-03-2016 / 11:26:36 / cg"
    "Modified: / 30-03-2016 / 20:08:04 / cg"
! !

!Win32OLETests class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
! !