Oxygen Basic

Information => Reference => Topic started by: JRS on August 09, 2018, 01:09:10 PM

Title: COM 64
Post by: JRS on August 09, 2018, 01:09:10 PM

I'm worried and curious where COM is going with 64 bit? Here is a way to access 32 bit COM objects from 64 bit languages.

Using a 32bit COM object in a 64bit environment (https://techtalk.gfi.com/32bit-object-64bit-environment/)

Title: Re: COM 64
Post by: Charles Pegge on August 09, 2018, 01:53:01 PM

I think that would be an unusual situation. All the Windows OS COM objects have dual access, as far as I know. Certainly SAPI (speech) runs in 32bit and 64bit.

Title: Re: COM 64
Post by: on August 09, 2018, 02:38:36 PM

Forget outdated COM servers. Even VB6 mscomct2.ocx no longer works with Windows 10 after the last "big update". I had an example that used the MonthView control, and it no longer works even if compiled with 32 bit.

Title: Re: COM 64
Post by: JRS on August 09, 2018, 02:50:16 PM

I don't seem to have any problems running COM/OLE/VB6 interfaces in Windows 10 using the Script BASIC COM extension module. Admittedly I'm not on the latest and greatest Win10 version and I'm running the 32 bit not 64 bit version of the OS.

I'm not using tbe standard mscomct2 with SB. All Windows controls per version of Windows along with current theming work.

Title: Re: COM 64
Post by: on August 09, 2018, 03:06:10 PM

> Admittedly I'm not on the latest and greatest Win10 version and I'm running the 32 bit not 64 bit version of the OS.
> I'm not using tbe standard mscomct2 with SB.

That says all. I had no problems with Windows 7 64 bit, but it no longer works with the version of Windows 10 that I'm using.

Title: Re: COM 64
Post by: JRS on August 09, 2018, 04:24:10 PM

I'll update my Windows 10 to 1803 and see if SB still runs. The update process is going to take a long time to complete based on how it's going now.

There is still a lot of VB6 code out there people depend on.

Title: Re: COM 64
Post by: JRS on August 10, 2018, 07:32:11 AM

All seems fine on Windows 10 1803 with the Script BASIC VB6 based IDE/Debugger.

Title: Re: COM 64
Post by: JRS on August 10, 2018, 12:31:44 PM

José,

You are correct with the MonthView OCX not running on Windows 10 Build 1803. It worked fine on my Windows 7 32 bit OS. (VirtualBox's on Linux)

Do you know where it is failing?

I wonder if you could use the Common Controls Replacement (https://www.allbasic.info/forum/index.php?topic=412.0) I'm using with VB6?

Title: Re: COM 64
Post by: JRS on August 10, 2018, 09:46:59 PM

The SAPI example worked in Windows 10 1803.

Code: Script BASIC

1. IMPORT com.sbi
2.  
3. voice = COM::CREATE(:SET, "SAPI.SpVoice")
4. FOR beers = 99 to 1 STEP -1
5.   IF beers = 1 THEN
6.     beers_str = "1 bottle of beer"
7.   ELSE
8.     beers_str = beers & " bottles of beer"
9.   END IF
10.   COM::CBN(voice, "speak", :CALL, beers_str & " on the wall. Take one down, pass it around.")
11. NEXT
12. COM::RELEASE(voice)
13.  

Note: On Windows 10, it's a male voice and sounds less like a computer.

Title: Re: COM 64
Post by: JRS on August 10, 2018, 10:33:42 PM

This is an example of Script BASIC calling a VB6 form saved as an OCX control and doing a callback from VB6 to SB functions.

Code: Script BASIC

1. import com.sbi
2.  
3. 'in the VB6 GUI
4. 'this one uses SBCallBackEx which supports multiple types and args
5. 'return values can be either string or long.
6. function Button1_Click(arg, arg1, arg2, arg3, arg4, arg5)
7.         print "Button1_Click arg=", arg, "\n"
8.         print "Button1_Click arg1=", arg1, "\n"
9.         print "Button1_Click arg2=", arg2, "\n"
10.         print "Button1_Click arg3=", arg3, "\n"
11.         print "Button1_Click arg4=", arg4, "\n"
12.         print "Button1_Click arg5=", arg5, "\n"
13.         Button1_Click = arg + 1
14. end function
15.  
16. 'in the VB6 GUI
17. 'this one uses SBCallBack it only takes one long arg. return value is long
18. function Button2_Click(arg)
19.         print "Back in script basic Button2_Click arg=", arg, "\n"
20.         Button2_Click = arg * 2
21. end function
22.  
23. obj = COM::CREATE(:SET, "VB6.Sample")
24.  
25. if obj = 0 then
26.     print "CreateObject failed!\n"
27. else
28.         print "obj = ", obj, "\n"
29.  
30.         oCollection = COM::CBN(obj, "CallBackHandlers", :GET)
31.     print "oCollection = ", oCollection, "\n"
32.  
33.     COM::CBN(oCollection, "Add", :CALL, ADDRESS(Button1_Click()), "frmCallBack.cmdOp1_Click" )
34.     COM::CBN(oCollection, "Add", :CALL, ADDRESS(Button2_Click()), "frmCallBack.cmdOp2_Click" )
35.  
36.     retVal = COM::CBN(obj, "LaunchCallBackForm", :CALL, 21)
37.     print "LaunchCallBackForm returned ", retVal, "\n"
38.  
39.     COM::RELEASE(obj)
40.     print "test complete!\n"
41. end if
42.  

C:\ScriptBASIC\com>scriba cb.sb
obj = 8216080
oCollection = 8273656
Button1_Click arg=21
Button1_Click arg1=two
Button1_Click arg2=3
Button1_Click arg3=four
Button1_Click arg4=5
Button1_Click arg5=8274128
Back in script basic Button2_Click arg=22
LaunchCallBackForm returned 44
test complete!

C:\ScriptBASIC\com>


This is the VB6 Callback OCX form code.

Code: Visual Basic

1. 'this is the simple callback it takes one long arg and returns a long
2. Private Declare Function ext_SBCallBack Lib "COM.dll" Alias "SBCallBack" (ByVal EntryPoint As Long, ByVal arg As Long) As Long
3. Private Declare Function eng_SBCallBack Lib "sb_engine.dll" Alias "SBCallBack" (ByVal EntryPoint As Long, ByVal arg As Long) As Long
4.  
5.  
6. 'this extended version will take a variant array as the argument and it will pass
7. 'them as arguments to the callback function. It supports Long,Byte,Integer,Object, and string inputs
8. 'The variant return result can be either a long or a string
9. 'the arg count of the script basic function actually does not have to line up to the array count.
10. 'extra args in the script declare will just be undef, or two few cause no problems either..
11. Private Declare Function ext_SBCallBackEx Lib "COM.dll" Alias "SBCallBackEx" (ByVal EntryPoint As Long, ByRef v As Variant) As Variant
12. Private Declare Function eng_SBCallBackEx Lib "sb_engine.dll" Alias "SBCallBackEx" (ByVal EntryPoint As Long, ByRef v As Variant) As Variant
13.  
14.  
15. Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
16.  
17. Private m_owner As Sample
18.  
19. Private Function TriggerCallBack(nodeID As Long, argValue As Long)
20.  
21.     'this little trick is so this works for both the standard COM extension,
22.    'as well as the embedded sb_engine.dll project i am working on..
23.    If GetModuleHandle("COM.dll") <> 0 Then
24.         TriggerCallBack = ext_SBCallBack(nodeID, argValue)
25.     ElseIf GetModuleHandle("sb_engine.dll") <> 0 Then
26.         TriggerCallBack = eng_SBCallBack(nodeID, argValue)
27.     Else
28.         MsgBox "Could not find the extension dll or the sb_engine.dll to get the sbcallback export from?", vbExclamation
29.     End If
30.    
31. End Function
32.  
33. Private Function TriggerCallBackEx(nodeID As Long, v() As Variant)
34.  
35.     'this little trick is so this works for both the standard COM extension,
36.    'as well as the embedded sb_engine.dll project i am working on..
37.    If GetModuleHandle("COM.dll") <> 0 Then
38.         TriggerCallBackEx = ext_SBCallBackEx(nodeID, v)
39.     ElseIf GetModuleHandle("sb_engine.dll") <> 0 Then
40.         TriggerCallBackEx = eng_SBCallBackEx(nodeID, v)
41.     Else
42.         MsgBox "Could not find the extension dll or the sb_engine.dll to get the sbcallback export from?", vbExclamation
43.     End If
44.    
45. End Function
46.  
47. Function ShowCallBackForm(defVal As Long, owner As Sample) As Long
48.     On Error Resume Next
49.     Set m_owner = owner
50.     txtValue = defVal
51.     Me.Show 1
52.     Set m_owner = Nothing
53.     ShowCallBackForm = CLng(txtValue)
54.     Unload Me
55. End Function
56.  
57. Private Sub cmdOp1_Click()
58.  
59.     Dim nodeID As Long
60.     Dim arg As Long
61.    
62.     On Error Resume Next
63.     nodeID = m_owner.CallBackHandlers("frmCallBack.cmdOp1_Click")
64.    
65.     If nodeID = 0 Then
66.         MsgBox "Script writer forgot to register a callback handler for me..", vbInformation
67.         Exit Sub
68.     End If
69.    
70.     Dim tmp(5)
71.     tmp(0) = CLng(txtValue)
72.     tmp(1) = "two"
73.     tmp(2) = 3
74.     tmp(3) = "four"
75.     tmp(4) = 5
76.     Set tmp(5) = Me
77.  
78. '    Dim tmp2(5) As Long
79. '    For i = 0 To UBound(tmp2)
80. '        tmp(2) = i
81. '    Next
82.    
83.     arg = CLng(txtValue)
84.     retval = TriggerCallBackEx(nodeID, tmp)
85.    
86.     If TypeName(retval) = "String" Then
87.         MsgBox "String return received: " & retval
88.     ElseIf TypeName(retval) = "Long" Then
89.         txtValue = retval
90.     Else
91.         'returns type Empty on failure..
92.        MsgBox "Typename(retVal) = " & TypeName(retval) & "  Value=" & retval
93.     End If
94.  

Title: Re: COM 64
Post by: JRS on August 11, 2018, 11:20:25 AM

Does your FB COM includes work on Windows 10 1803 with OCX controls other than the MonthView?

Here is the MonthView OCX running in VB6 under Windows 10 1803.

Title: Re: COM 64
Post by: José Roca on August 11, 2018, 12:16:32 PM

Don't know. I'm not interested in these old 32-bit only OCXs. I only wrote the example to test my OLE Container.

Title: Re: COM 64
Post by: JRS on August 11, 2018, 12:22:45 PM

Based on the first post in this thread, it looks like one can use 32 bit OCX controls from a 64 bit environment.

Does this mean there will be no traditional 32 bit OCX support in Paul's FB GUI designer?

Title: Re: COM 64
Post by: JRS on August 11, 2018, 03:31:54 PM

What do you think the merit is of keeping VB6 applications running under current OS standards?

My experience has been companies are more willing to retrofit existing code than start over on some other platform.

Title: Re: COM 64
Post by: José Roca on August 11, 2018, 04:23:59 PM

> Does this mean there will be no traditional 32 bit OCX support in Paul's FB GUI designer?

In the editor? Of course not. You can do it using the OLE Container and the Dispatch class of my framework. The only OCX that interests me is the WebBrowser control.

Title: Re: COM 64
Post by: JRS on August 11, 2018, 05:09:49 PM

I agree a web browser control is important in today's apps.

Title: Re: COM 64
Post by: José Roca on August 11, 2018, 05:32:21 PM

Hosting the WebBrowser control I can do a lot of things using HTML5.

Title: Re: COM 64
Post by: JRS on August 11, 2018, 05:57:37 PM

It's amazing what you can do in n a browser these days. JavaScript is a powerful DOM scripting engine that is tough to beat.

Title: Re: COM 64 - Web Browser Control
Post by: JRS on August 11, 2018, 11:32:55 PM

 I found an interesting VB6 web browser control replacement. It seems to work on Windows 10 build 1803.

Quote

vbMHWB, ActiveX control Replacement for VB's Webbrowser control

This activeX control (Source included) creates and hosts multiple
instances of the same webbrowser control which VB, C++, Delphi, ... use.
The difference is that with vbMHWB you have total control over GUI,
Context menus, Accelerator keys, Downloads, Security, ... using various
new events, properties, and methods. This is in addition to most of the
properties, methods, and events that VB's webbrowser control offers.

=================================================
Here is a list of main features
=================================================

Allows viewing of all request headers (html, images, css, ...) with the
option of adding additional headers (HTTP+HTTPS).

Allows viewing of all response headers (HTTP+HTTPS).

Allows GUI customization using DOC_HOST_UI_FLAGS per Webbrowser Control
instance or globally.

Allows behavior customization using DOC_DOWNLOAD_CONTROL_FLAGS per
Webbrowser Control instance or globally. DLIMAGES, DLVIDEOS, ...

Disallows context menus or raises OnContextMenu event for each context
menu activated.

Disallows accelerator keys or raises OnAcceletorKeys event for each
accelerator key activated.

That, by default, is configured to take over user downloads using
FileDownloadEx and OnFileDLxxxx events.

That can be used as a simple download manager using DownloadUrlAsync
method and OnFileDLxxx events.

Allows fine tuning of security per URL via
SecurityManagerProcessUrlAction event.

Allows interception and overriding of HTTP security problems
via OnHTTPSecurityProblem event.

Allows interception and overriding of basic authentication requests
via OnAuthentication event.

It is as easy to use as any other ActiveX control. Register, make a
reference to it in your project and use.

In addition adds a host of new properties, methods and events.
NewWindow3, cracking and creating URLs,...

===================================================
The source is in C++ and included in vbMHWB sub folder. For those who
can not compile the dll and due to the fact that PSC does not allow
compiled dlls, you will need to download the compiled version from
http://sourceforge.net/project/showfiles.php?group_id=137627&package_id=151143&release_id=326449

===================================================
To run the vbDemo project. After unzipping/building the package, copy
vbMHWB.dll from binaries/build folder to your system folder and
register the control. (assuming system dir path is 'C:\windows\system32\')
regsvr32.exe C:\windows\system32\vbMHWB.dll.

===================================================
HompePage:
http://vbmhwb.sourceforge.net/

Title: Re: COM 64
Post by: José Roca on August 12, 2018, 12:47:41 AM

It is not a replacement. It is wrapper that uses the WebBroser control and implements several classes and hooks to allow to customize or control some features. I also have written a "replacement" class with FreeBasic, although less complex because I'm only interested in hosting it, not in making my own internet browser.

Title: Re: COM 64
Post by: JRS on August 12, 2018, 01:06:44 AM

The term replacement is used to describe this custom web control verses the standard VB web control. I get your point it's a wrapper. I think the guy did a nice job with it.

My most favorite feature of this control. The next best feature is the multiple documents / windows using only one web control.

Quote

Sub LoadHTMLFromString(wbUID As Integer, sContent As String, sBaseUrl As String)
Loads sContent into a stream which is then loaded into the document. Unlike document.write, scripts are executed.
If content is greater than 256 characters then a base tag must be present to dispaly the entire content.
sBaseUrl sample: http://www.google.com.

Title: Re: COM 64
Post by: JRS on August 12, 2018, 10:02:39 AM

I have yet to find a development environment (IDE/Debugger/GUI Designer) for Windows that would make me switch from VB6. The icing is SB can seamlessly interface with VB as a high level Windows API based on COM/OLE automation.

Title: Re: COM 64
Post by: JRS on August 12, 2018, 08:38:34 PM

I was able to get VB6 and VS6 running under Windows 10 Build 1803.

You can have a peek HERE (https://www.allbasic.info/forum/index.php?topic=492.msg5233#msg5233).

Title: Re: COM 64
Post by: jack on August 13, 2018, 03:46:20 AM

Hi John
I am interested in the steps required to install VS6 on Windows 10, would you share with me the steps you followed?

Title: Re: COM 64
Post by: JRS on August 13, 2018, 08:22:52 AM

Jack,

Here is the procedure I used to install VB6 and VS6 on Windows 10 Build 1803. Pay special attention to the install custom options.

6 on 10 (https://www.codeproject.com/Articles/1191047/Install-Visual-Studio-on-Windows)

Title: Re: COM 64
Post by: jack on August 13, 2018, 08:33:29 AM

thanks John, but I already tried to follow the instructions on that site, the problem is that the instructions don't match for version VS6 professional, that is, there never was a custom options available

Title: Re: COM 64
Post by: JRS on August 13, 2018, 08:39:06 AM

I'm using Enterprise. Early in the install process Custom rather then default is an option. I would grab a copy of Enterprise off the web.

Title: Re: COM 64
Post by: jack on August 13, 2018, 02:32:57 PM

@John
I managed to install VB6 and VC6 but whenever I launch VB it gives the following error

Code: [Select]

Data View
Automation error
Error accessing the OLE registry
does that happen to you also?

Title: Re: COM 64
Post by: JRS on August 13, 2018, 02:50:51 PM

You have to run VB6 and VS6 as admin or turn off UAC.

Btw  I installed as XP SP3 but running as Win7 emulation.

Title: Re: COM 64
Post by: jack on August 13, 2018, 05:28:08 PM

thanks :)

Title: Re: COM 64
Post by: JRS on August 13, 2018, 06:03:52 PM

I have been using VB6 on Win7 to generate the SB IDE and COM examples. I used VS2008 to compile the C++ portions. It would be great if you could provide feedback on VS6 running on Win10.

Title: Re: COM 64
Post by: JRS on August 13, 2018, 10:18:06 PM

I noticed an interesting project by Marc Pons that creates a OCX in FreeBasic. It also has a lite ATL container. I wonder if this could be ported to O2?

PlanetSquires Forum Link (http://www.planetsquires.com/protect/forum/index.php?topic=3947.0)

Code: FreeBasic

1.  '      outgoing_test4.bas
2.  
3.  /'
4.  command line to compile exe test                       change according to your own paths
5.  "C:\Freebasic\fbc.exe" -x "C:\evolution_Outgoing5\Outgoing_test5.exe" -s console -v Outgoing_test5.bas > Outgoing_test5.log 2>&1
6.  
7.         that exe test can work with registered or not registered ocx ,
8.         because of the : Outgoing_test5.exe.Manifest
9.  
10.         wich do 2 actions , gives the xp behaviour for controls and makes the side by side "pseudo-registration" of ocx
11.  
12.         we could optionnaly put its content into rc
13.  
14.  
15.         note : the IOleWindow is not implemented here, because I do not yet know, how to use it to be able to getwindow  of container
16.  
17.  '/
18.  
19. '  CSED_FB specific : Name for RC module
20. #Define COMPIL_RC    Outgoing_test5.rc  ' with ou without double quotes !
21.  
22.  
23.  
24. #INCLUDE ONCE "windows.bi"
25.  
26. #Define Ax_NoAtl  'to use Ax_Lite5.bi without atl.dll functions , or when no visual control ( reduce size of exe)
27.                                                 ' here we decide to not use atl even visual control but using specific intern "container" usage
28.  
29. #INCLUDE ONCE "Ax_Lite5.bi"
30.  
31. #DEFINE RVB(a, b, c) bgr(a, b, c)
32.  
33. DIM SHARED g_hinstance as HINSTANCE
34. DIM SHARED Form1 AS HWND
35. DIM SHARED AS HWND         OcxHwnd      ' Ocx form handle
36. DIM SHARED AS HWND         OcxHwnd2     ' Ocx form handle
37.  
38.  
39. DECLARE SUB changeRVB(byval as integer)
40. Declare SUB Call_Sett()
41. DECLARE FUNCTION Form1_Proc(byval hWnd as HWND, byval Msg as UINT, byval wParam as WPARAM, byval lParam as LPARAM) as LRESULT
42. DECLARE SUB FormDefine()
43. Declare FUNCTION WINMAIN(BYVAL hInstance AS HINSTANCE, BYVAL hPrevInstance AS HINSTANCE, _
44.                                                                 BYVAL lpszCmdLine AS ZString PTR, BYVAL nCmdShow AS LONG) AS LONG
45.  
46.  
47.  
48. #INCLUDE ONCE "Comctrl5.bi"
49.  
50. AxInit(True) 'not really needed here
51.  
52. '**************************************************************
53. ' Other variables & constants used by the program go here
54. '**************************************************************
55. Dim Shared As IComCtrl Ptr              pVTI                    ,pVTI2
56. Dim Shared As Dword             obj_Event   , obj_Event2 ' cookie for object events
57.  
58.  
59.  
60. Sub Call_Init()                 ' be called from initialization of the control form
61.         OcxHwnd         = AxWinNoAtl(Form1, 50,50,200,150)      'create child window for "container"
62.         OcxHwnd2        = AxWinNoAtl(Form1,300,50,200,150)
63.         'print " OcxHwnd= " & str(OcxHwnd) & "       OcxHwnd2= " & str(OcxHwnd2)
64.  
65.         'pVTI   = AxCreate_Object ("ComCtrl.CD")                        'works but replaced by the : Ax_create_olecon doing more "natural" job
66.         'pVTI2  = AxCreate_Object ("ComCtrl.CD")
67.  
68.         pVTI    = Ax_create_olecon("ComCtrl.CD", OcxHwnd) 'using IOleWindow getwindow method throught pseudo-container
69.         pVTI2 = Ax_create_olecon("ComCtrl.CD", OcxHwnd2)
70.  
71.  
72.         'print  "pVTI  = " ;str(pVTI)
73.         'print  "pVTI2 = " ;str(pVTI2)
74.  
75.         if pVTI = NULL or pVTI2 = NULL THEN
76.                 MessageBox getactiveWindow(), "problem creating object, leaving...", "Error", 0
77.                 sendmessage(form1, WM_CLOSE, NULL, NULL)
78.                 exit sub
79.    END IF
80.  
81.         IOutGoing_Events_Connect (pVTI, Obj_Event  )
82.         IOutGoing_Events_Connect (pVTI2, Obj_Event2  ) ' do not understand why the second value is sometimes ok and sometimes 0
83.         Call_Sett() 'initial settings if you want some
84. End Sub
85.  
86.  
87. Sub Call_OnClose()                                                      ' normaly be called from close form command
88.         IOutGoing_Events_Disconnect (pVTI2, Obj_Event2)
89.         IOutGoing_Events_Disconnect (pVTI, Obj_Event)
90.         AxRelease_Object(pVTI2)
91.         AxRelease_Object(pVTI)                          'release object
92.  
93.         AxStop()  'not really needed it
94. End Sub
95.  
96.  
97. Sub Call_Sett()   'initial settings here
98.  
99. '       'ax_vt0 (pVTI, Initialize)                                                                                      'not needed because automatic initialisation
100. '       'ax_vt0 (pVTI2, Initialize)
101. '       'ax_vt (pVTI,CreateControl,cast(integer,OcxHwnd) )                      'not needed because automatic createcontrol
102. '       'ax_vt (pVTI2,CreateControl,cast(integer,OcxHwnd2) )
103.  
104.         ax_vt(pVTI, SetColor, RVB(0, 250, 250))
105.         ax_vt(pVTI2, SetColor, RVB(250, 250, 0))
106.  
107.         AxWinHide(OcxHwnd, form1)                                                                                       'to test only
108.         AxWinshow(OcxHwnd, form1)                                                                                       'to test only
109.  
110.         'print "   Obj_Event = " & str(Obj_Event) & "   Obj_Event2 = " & str(Obj_Event2)
111. End Sub
112.  
113.  
114.  
115. ' ========================================================================================
116. ' Main
117. ' ========================================================================================
118. End WinMain(GetModuleHandle(NULL), NULL, Command, SW_SHOW)
119.  
120. FUNCTION WINMAIN(BYVAL hInstance AS HINSTANCE, BYVAL hPrevInstance AS HINSTANCE, _
121.                                         BYVAL lpszCmdLine AS ZString PTR, BYVAL nCmdShow AS LONG) AS LONG
122.    DIM hwndMain AS HWND
123.    Dim hCtl AS HWND
124.    Dim hFont AS HFONT
125.    Dim wcex AS WNDCLASSEX
126.    Dim szClassName AS ZString * 80
127.  
128.    hFont = GetStockObject(ANSI_VAR_FONT)
129.  
130.    ' Register the window class
131.    szClassName = "Form1"
132.    g_hinstance = hInstance
133.    wcex.cbSize = SIZEOF(WNDCLASSEX)
134.    wcex.style = CS_HREDRAW OR CS_VREDRAW
135.    wcex.lpfnWndProc = @Form1_Proc
136.    wcex.cbClsExtra = 0
137.    wcex.cbWndExtra = 0
138.    wcex.hInstance = hInstance
139.    wcex.hCursor = LoadCursor(NULL, BYVAL IDC_ARROW)
140.    wcex.hbrBackground = cast(HBRUSH, COLOR_3DFACE + 1)
141.    wcex.lpszMenuName = NULL
142.    wcex.lpszClassName = STRPTR(szClassName)
143.    ' Sample, if resource icon: LoadIcon(hInst, "APPICON")
144.    wcex.hIcon = LoadIcon(NULL, BYVAL IDI_APPLICATION)
145.    ' Remember to set small icon too..
146.    wcex.hIconSm = LoadIcon(NULL, BYVAL IDI_APPLICATION)
147.    RegisterClassEx @wcex
148.  
149.    FormDefine()
150.  
151.    ' Message handler loop
152.    Dim uMsg AS MSG
153.    While GetMessage(@uMsg, NULL, 0, 0)
154.       'IF IsDialogMessage(hwndMain, @uMsg) = 0 THEN
155.          TranslateMessage @uMsg
156.          DispatchMessage @uMsg
157.       'END IF
158.    WEND
159.  
160.    FUNCTION = uMsg.wParam
161. END FUNCTION
162.  
163. '***************************************************************
164. ' Now let's create and load the form and all of its controls
165. '***************************************************************
166. SUB FormDefine()
167.    Form1 = CreateWindowEx(0, "Form1", "Test_5    for outgoing.ocx : registered or not !", _
168.          WS_MINIMIZEBOX or WS_SIZEBOX or WS_CAPTION or WS_MAXIMIZEBOX or WS_POPUP or WS_SYSMENU, _
169.          115, 180, 560, 300, HWND_DESKTOP, NULL, GetmoduleHandle(0), NULL)
170.         Call_Init()
171.    ShowWindow(Form1, SW_SHOW)
172. END SUB
173.  
174. '***************************************************************
175. ' Now that the form and its controls are loaded and on the
176. ' screen, we go into the event loop and wait for the user
177. ' to do something!
178. '***************************************************************
179.  
180. FUNCTION Form1_Proc(ByVal hWnd as HWND, byval Msg as UINT, byval wParam as WPARAM, byval lParam as LPARAM) as LRESULT
181.    SELECT Case Msg
182.                 CASE WM_CLOSE
183.                         Call_OnClose()
184.                         DestroyWindow(hWnd)
185.          EXIT FUNCTION
186.       CASE WM_DESTROY
187.          PostQuitMessage(0)
188.          EXIT FUNCTION
189.    END SELECT
190.    Return DefWindowProc(hWnd, Msg, wParam, lParam)
191. END FUNCTION
192.  

 

Title: Re: COM 64
Post by: Charles Pegge on August 14, 2018, 12:13:09 AM

Aurel created an ATL-based browser example:

projectsB\Scintilla\WebBrowserATL.o2bas

It's in the wrong place, but it also uses awinh.inc

Code: [Select]

'gui-skeleton app
$ Filename "ABrowser.exe"
'Include "RTL32.inc"
Include "awinh.inc"

#lookahead
INT win,win2
INT x,y,w,h,x2,y2,w2,h2
x=0:y=10:w=800:h=600
x2=410:y2=10:w2=400:h2=300
INT winstyle,wstyle2,wbstyle
winstyle = WS_MINMAXSIZE or WS_CLIPCHILDREN
wbstyle = WS_CHILD OR WS_VISIBLE OR WS_BORDER
INT btt0,btt1,btt2
INT b0ID = 100, b1ID=101, b2ID=102
INT bmpB0,bmpB1,bmpB2,bmpB3,bmpB4,bmpB5
bmpB0 = LoadImage(0,"btBack.bmp",0,28,28,16)
bmpB1 = LoadImage(0,"data/btOpen.bmp",0,30,30,16)
bmpB2 = LoadImage(0,"data/btSave.bmp",0,30,30,16)
'##### GLOBALS  ###############################################
% WM_FORWARDMSG = &H37F ' (895)

% IDB_BACK = 1001
% IDB_FWRD = 1002
% IDB_NAVG = 1003
% IDC_URL  = 1004
% IDC_WB   = 1005

DECLARE FUNCTION AtlAxWinInit LIB "ATL.DLL" ALIAS "AtlAxWinInit" () AS LONG
DECLARE FUNCTION AtlAxGetControl LIB "ATL.DLL" ALIAS "AtlAxGetControl" ( BYVAL hWnd AS sys,BYREF pp AS sys ) as INT
INT hWb
'##############################################################
'create window **************************************************
win = SetWindow("ATL:Browser",x,y,w,h,0,winstyle)
'****************************************************************
'create buttons
btt0 = SetButton(win,4,4,30,30,"<<",0x50000080,0x200,b0ID)
SendMessage btt0 , BM_SETIMAGE, 0, bmpB0
btt1 = SetButton(win,38,4,30,30,"<<",0x50000080,0x200,b1ID)
SendMessage btt1 , BM_SETIMAGE, 0, bmpB1
btt2 = SetButton(win,74,4,30,30,"<<",0x50000080,0x200,b2ID)
SendMessage btt2 , BM_SETIMAGE, 0, bmpB2


'Initializes ATL
AtlAxWinInit   
'create browser window
hWb = CreateWindowEx(0, "AtlAxWin", "www.google.com",wbstyle , 4, 40, w-16,(h-56)-64, win, IDC_WB, 0, 0)
'****************************************************************

'/////////
Wait()
'\\\\\\\\\

Function WndProc (sys hwnd,wmsg,wparam,lparam) as sys callback

SELECT hwnd
'----------------------------------------
CASE win
'----------------------------------------
Select wmsg

CASE WM_CLOSE
DestroyWindow win
PostQuitMessage 0

CASE WM_SIZE
GetSize(win,0,0,w,h)
MoveWindow(hWb,4,40,w-6,(h-56)-32 ,1)
',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
',,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    CASE WM_COMMAND
controlID = LoWord(wParam) 'get control ID
notifyCode = HiWord(wParam) 'get notification message

Select controlID
   CASE b0ID
If notifycode=0         
          print "< GO BACK >"
End If
     
       CASE b1ID
         If notifycode=0         
         print "< GO FOR >"
         End If

       CASE b2ID
         If notifycode=0         
         print "TESTING....1...2....3"
         End If

    End Select
End select


END SELECT

RETURN Default

END FUNCTION


Title: Re: COM 64
Post by: JRS on August 14, 2018, 12:44:13 AM

That's a great start for container support in O2, The work you did with DLLC and COM should also come in handy.

Title: Re: COM 64
Post by: jack on August 14, 2018, 03:59:14 AM

Quote from: John on August 13, 2018, 06:03:52 PM

It would be great if you could provide feedback on VS6 running on Win10.

hello John
I just ran a project that I had made for a friend, in the project I use the SendKeys function to send a tab key when enter is pressed, when run from the IDE, as long as I don't press enter, all is well, but as soon as I press enter I get a Runtime error 70, permission denied.
if I make the exe and run that exe from outside the IDE all is well.
so using VB6 in windows 10 is hindered by the fact that you can't test your program in progress unless you make the executable and run that from outside the IDE.

example sub using the SendKeys function

Code: [Select]

Private Sub Text14_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then                ' Enter = Tab
        SendKeys "{tab}"
        KeyAscii = 0
    End If
End Sub
[edit] I run the IDE as administrator.

Title: Re: COM 64
Post by: jack on August 14, 2018, 05:50:20 AM

I found out that I am not the only one with the problem, here's a replacement SendKeys that works OK in Windows 10 http://www.vbforums.com/showthread.php?613838-sendkeys-error-permission-denied-70-in-vb&s=3cd7c5011274d5abb3fb124da67b7041&p=4531911&viewfull=1#post4531911

Code: [Select]

Public Sub Sendkeys(text$, Optional wait As Boolean = False)
   Dim WshShell As Object
   Set WshShell = CreateObject("wscript.shell")
   WshShell.Sendkeys text, wait
   Set WshShell = Nothing
End Sub


Title: Re: COM 64
Post by: jack on August 14, 2018, 06:16:05 AM

with the VB6 IDE closed, if I double-click on a project then the VB6 IDE launches and opens the project as expected, but there's no "Error accessing the OLE registry"

Title: Re: COM 64
Post by: JRS on August 14, 2018, 07:13:51 AM

Can you turn off UAC and see if your permission problem goes away?

Title: Re: COM 64
Post by: jack on August 14, 2018, 07:31:09 AM

@John
turning off UAC does allow launching the VB6 IDE without problems, however the SendKeys problem remains unless I use the SendKeys substitute.
but I am not comfortable with having UAC off, if only one could selectively mark an application as safe without turning UAC off and without having to run as administrator.

Title: Re: COM 64
Post by: JRS on August 14, 2018, 08:15:06 AM

It's amazing that Microsoft sees their own software as a security risk.

Title: Re: COM 64
Post by: José Roca on August 14, 2018, 09:11:17 AM

You should already have learned that Microsoft doesn't give a shit about VB6.

Title: Re: COM 64
Post by: jack on August 14, 2018, 10:08:07 AM

in my case, I needed a way to make a GUI application that would run on Windows 98 and VB6 fit the need very well, it was easy to learn by doing with the occasional web search for a particular solution to a problem.

Title: Re: COM 64
Post by: JRS on August 14, 2018, 10:25:52 AM

Quote from: José Roca on August 14, 2018, 09:11:17 AM

You should already have learned that Microsoft doesn't give a shit about VB6.

VB classic was one of Microsoft's most successful product offerings. It is still a critical tool for SMBs.

Microsoft is supporting VB6 runtime until 2025. By that time everyone will be running Linux.

Title: Re: COM 64
Post by: José Roca on August 14, 2018, 10:28:06 AM

"Was" is the key word.

Title: Re: COM 64
Post by: JRS on August 14, 2018, 10:34:27 AM

If Microsoft open sources VB6, it's a new ball game.

Title: Re: COM 64
Post by: JRS on August 14, 2018, 11:14:18 AM

For me, VB6 on Windows 10 is experimental. I'm going to keep my VB IDE and VS2008 going on Win7 until Microsoft pulls the plug.

What I develop on Win7 runs and themes well on Win10.

Title: Re: COM 64
Post by: JRS on August 14, 2018, 06:32:02 PM

Quote from: Charles

Aurel created an ATL-based browser example:

Works (running in the IDE) on Win7. I will have to give it a try on Win10.

@Charles - I'm unable to create a .exe of this program. (dependent or independent) Runs fine from the IDE.

Title: Re: COM 64
Post by: Charles Pegge on August 14, 2018, 11:33:35 PM

Hi John,

I've tested successfully with RTL32 and RTL64.

Here is a cleaned up version

Code: [Select]

'gui-skeleton app
$ Filename "t.exe"
uses RTL32
'uses RTL64
uses awinh

#lookahead
INT win,win2
INT x,y,w,h,x2,y2,w2,h2
x=0:y=10:w=800:h=600
x2=410:y2=10:w2=400:h2=300
INT winstyle,wstyle2,wbstyle
winstyle = WS_MINMAXSIZE or WS_CLIPCHILDREN
wbstyle = WS_CHILD OR WS_VISIBLE OR WS_BORDER
INT btt0,btt1,btt2
INT b0ID = 100, b1ID=101, b2ID=102
INT bmpB0,bmpB1,bmpB2,bmpB3,bmpB4,bmpB5
bmpB0 = LoadImage(0,"btBack.bmp",0,28,28,16)
bmpB1 = LoadImage(0,"data/btOpen.bmp",0,30,30,16)
bmpB2 = LoadImage(0,"data/btSave.bmp",0,30,30,16)


% WM_FORWARDMSG = &H37F ' (895)

% IDB_BACK = 1001
% IDB_FWRD = 1002
% IDB_NAVG = 1003
% IDC_URL  = 1004
% IDC_WB   = 1005

extern lib "ATL.dll"
! AtlAxWinInit () as sys
! AtlAxGetControl  ( sys hWnd, **pp ) as int
end extern

int hWb

'create window
'
win = SetWindow("ATL:Browser",x,y,w,h,0,winstyle)

'create buttons
'
btt0 = SetButton(win,4,4,30,30,"<<",0x50000080,0x200,b0ID)
SendMessage btt0 , BM_SETIMAGE, 0, bmpB0
btt1 = SetButton(win,38,4,30,30,"<<",0x50000080,0x200,b1ID)
SendMessage btt1 , BM_SETIMAGE, 0, bmpB1
btt2 = SetButton(win,74,4,30,30,"<<",0x50000080,0x200,b2ID)
SendMessage btt2 , BM_SETIMAGE, 0, bmpB2


'Initializes ATL
AtlAxWinInit

'create browser window
hWb = CreateWindowEx(0, "AtlAxWin", "www.google.com",wbstyle , 4, 40, w-16,(h-56)-64, win, IDC_WB, 0, 0)
'
Wait()
'
function WndProc (sys hwnd,wmsg,wparam,lparam) as sys callback
==============================================================
select hwnd

case win

  select wmsg
  '
  case WM_CLOSE
    DestroyWindow win
    PostQuitMessage 0
  case WM_SIZE
    GetSize(win,0,0,w,h)
    MoveWindow(hWb,4,40,w-6,(h-56)-32 ,1)
  case WM_COMMAND
    controlID = LoWord(wParam) 'get control ID
    notifyCode = HiWord(wParam) 'get notification message
    '
    select controlID
    '
    case b0ID
      if notifycode=0         
        print "< GO BACK >"
      end if     
    case b1ID
      if notifycode=0         
        print "< GO FOR >"
      end if
    case b2ID
       If notifycode=0         
         print "TESTING....1...2....3"
       End If
    end select
  end select
end select

return default

end function


Title: Re: COM 64
Post by: JRS on August 16, 2018, 04:57:16 AM

This version doesn't compile or run from the IDE any longer.  It does create a t.exe version that seems to run. I'm going to give it a try on Win10.

I'm using the latest build on Win7.

Update

It seems to run on Windows 10 Build 1803 but no button graphics.

Title: Re: COM 64
Post by: Charles Pegge on August 16, 2018, 05:59:33 AM

Hi John,

It loads its button graphics from the data subfolder.

Title: Re: COM 64
Post by: JRS on August 16, 2018, 06:38:54 AM

Quote

It loads its button graphics from the data subfolder.

Thanks!

I still feel that if O2 could generate OCX controls / forms, it would be a big plus and generate interest in the compiler.

Title: Re: COM 64
Post by: Aurel on August 17, 2018, 05:17:51 AM

Hi Charles ,,John
I almost forget for this example .
I don't know from where is this few constant:

% IDB_BACK = 1001
% IDB_FWRD = 1002
% IDB_NAVG = 1003
% IDC_URL  = 1004
% IDC_WB   = 1005

and how to use them in this program .
Probably can be executed trough SendMessage ?

Title: Re: COM 64
Post by: JRS on August 17, 2018, 09:16:50 AM

Thanks Aurel for creating this example. It shows COM is a viable option in O2.

Title: Re: COM 64
Post by: José Roca on August 17, 2018, 09:45:12 AM

The only requirements for a language to work with COM is being able to create structures of pointers (for example, an array of pointers to the methods/procedures, know as virtual table) and, either explicitly or implicitly, call functions through pointers.

Title: Re: COM 64
Post by: José Roca on August 17, 2018, 09:53:45 AM

Quote from: John on August 17, 2018, 09:16:50 AM

Thanks Aurel for creating this example. It shows COM is a viable option in O2.

Sorry, but that example only shows how to use ATL.DLL to host the WebBrowser Control. The program itself doesn't use COM in any way.

Title: Re: COM 64
Post by: Aurel on August 17, 2018, 11:30:29 AM

Yes Jose  have a right that just show how attach atl control in window
and don't have any other functions...
I found it some time ago on Jose forum.

But i found something interesting on code project
https://www.codeproject.com/Articles/3365/Embed-an-HTML-control-in-your-own-window-using-plain-C
it is web browser control written in pure C and WOW looks very complex.
There is a source code for webcontrol dll ...so probably require compiling with C compiler
because translate whole code to oxgen should be huge task ...ufff
anyone know with what compile this C code?

Title: Re: COM 64
Post by: Aurel on August 17, 2018, 11:38:49 AM

Hmm crap..
It looks that this dll is full of bugs and strange problems
according to comments on code project.  >:(

Title: Re: COM 64
Post by: Charles Pegge on August 17, 2018, 12:06:30 PM

o2 can use the header classes directly. You just need to know what you want. Here are the ones I used for Text to speech (in SAPI5), with a slight cleanup:

Code: [Select]

  extern virtual

  '-------------
  class IUnknown
  '=============

    HRESULT QueryInterface(refiid id, pvObject* ppv)
    ULONG   AddRef()
    ULONG   Release()

  end class

  'from sapi.h


  'MIDL_INTERFACE("5EFF4AEF-8487-11D2-961C-00C04F8EE628")
  'ISpNotifySource : public IUnknown
  '
  extern virtual
  '
  '--------------------
  class ISpNotifySource
  '====================

    public

    extends IUnknown

        HRESULT SetNotifySink(
            /* [in] */ __RPC__in_opt ISpNotifySink *pNotifySink)
       
        HRESULT SetNotifyWindowMessage(
            /* [in] */ HWND hWnd,
            /* [in] */ UINT Msg,
            /* [in] */ WPARAM wParam,
            /* [in] */ LPARAM lParam)
       
        HRESULT SetNotifyCallbackFunction(
            /* [in] */ SPNOTIFYCALLBACK *pfnCallback,
            /* [in] */ WPARAM wParam,
            /* [in] */ LPARAM lParam)
       
        HRESULT SetNotifyCallbackInterface(
            /* [in] */ ISpNotifyCallback *pSpCallback,
            /* [in] */ WPARAM wParam,
            /* [in] */ LPARAM lParam)
       
        HRESULT SetNotifyWin32Event( void)
       
        HRESULT WaitForNotifyEvent(
            /* [in] */ DWORD dwMilliseconds)
       
        HANDLE GetNotifyEventHandle( void)

  end class



  'MIDL_INTERFACE("BE7A9CCE-5F9E-11D2-960F-00C04F8EE628")
  'ISpEventSource : public ISpNotifySource
  '

  '-------------------
  class ISpEventSource
  '===================

    public

    extends ISpNotifySource

        HRESULT SetInterest(
            /* [in] */ ULONGLONG ullEventInterest,
            /* [in] */ ULONGLONG ullQueuedInterest)
       
        HRESULT GetEvents(
            /* [in] */ ULONG ulCount,
            /* [size_is][out] */ SPEVENT *pEventArray,
            /* [out] */ ULONG *pulFetched)
       
        HRESULT GetInfo(
            /* [out] */ SPEVENTSOURCEINFO *pInfo)
       
  end class



    'MIDL_INTERFACE("6C44DF74-72B9-4992-A1EC-EF996E0422D4")
    'ISpVoice : public ISpEventSource
    '

    '-------------
    class ISpVoice
    '=============
    '
    public

    extends ISpEventSource

        HRESULT SetOutput(
            /* [in] */ IUnknown *pUnkOutput,
            /* [in] */ BOOL fAllowFormatChanges)
       
        HRESULT GetOutputObjectToken(
            /* [out] */ ISpObjectToken **ppObjectToken)
       
        HRESULT GetOutputStream(
            /* [out] */ ISpStreamFormat **ppStream)
       
        HRESULT Pause( void)
       
        HRESULT Resume( void)
       
        HRESULT SetVoice(
            /* [in] */ ISpObjectToken *pToken)
       
        HRESULT GetVoice(
            /* [out] */ ISpObjectToken **ppToken)
       
        HRESULT Speak(
            /* [string][in] */
            __in_opt  LPCWSTR pwcs,
            /* [in] */ DWORD dwFlags,
            /* [out] */
            __out_opt  ULONG *pulStreamNumber)

        HRESULT SpeakStream(
            /* [in] */ IStream *pStream,
            /* [in] */ DWORD dwFlags,
            /* [out] */
            __out_opt  ULONG *pulStreamNumber)
       
        HRESULT GetStatus(
            /* [out] */ SPVOICESTATUS *pStatus,
            /* [out] */ LPWSTR *ppszLastBookmark)
       
        HRESULT Skip(
            /* [string][in] */ LPCWSTR pItemType,
            /* [in] */ long lNumItems,
            /* [out] */ ULONG *pulNumSkipped)
       
        HRESULT SetPriority(
            /* [in] */ SPVPRIORITY ePriority)
       
        HRESULT GetPriority(
            /* [out] */ SPVPRIORITY *pePriority)
       
        HRESULT SetAlertBoundary(
            /* [in] */ SPEVENTENUM eBoundary)
       
        HRESULT GetAlertBoundary(
            /* [out] */ SPEVENTENUM *peBoundary)
       
        HRESULT SetRate(
            /* [in] */ long RateAdjust)
       
        HRESULT GetRate(
            /* [out] */ long *pRateAdjust)
        HRESULT SetVolume(
            /* [in] */ USHORT usVolume)
       
        HRESULT GetVolume(
            /* [out] */ USHORT *pusVolume)
       
        HRESULT WaitUntilDone(
            /* [in] */ ULONG msTimeout)
       
        HRESULT SetSyncSpeakTimeout(
            /* [in] */ ULONG msTimeout)
       
        HRESULT GetSyncSpeakTimeout(
            /* [out] */ ULONG *pmsTimeout)
       
        /* [local] */ HANDLE SpeakCompleteEvent( void)
       
        /* [local] */ HRESULT IsUISupported(
            /* [in] */ LPCWSTR pszTypeOfUI,
            /* [in] */ void *pvExtraData,
            /* [in] */ ULONG cbExtraData,
            /* [out] */ BOOL *pfSupported)
       
        /* [local] */ HRESULT DisplayUI(
            /* [in] */ HWND hwndParent,
            /* [in] */ LPCWSTR pszTitle,
            /* [in] */ LPCWSTR pszTypeOfUI,
            /* [in] */ void *pvExtraData,
            /* [in] */ ULONG cbExtraData)
       
    end class

    end extern

The full code can be found in inc\com  and examples\com. We could produce something that looks a bit simpler - (C baggage!)

Title: Re: COM 64
Post by: Aurel on August 17, 2018, 12:38:08 PM

well i am not sure that cwebcontrol looks like a very complex beast
 ???

Title: Re: COM 64
Post by: JRS on August 17, 2018, 01:58:27 PM

Quote

o2 can use the header classes directly. You just need to know what you want.

That is what makes O2 one of the friendliest C BASIC compilers around. Even FreeBasic (basic to C translator) can't read C header files.

I agree with Charles, COM is just around the corner with O2. It would be great if José Roca would mentor in this effort.

@Charles - How is O2 going to handle variants?

Title: Re: COM 64
Post by: JRS on September 05, 2018, 07:48:04 AM

I was able to get the VB6 OCX version of the Online Dictionary example running.

Check it out on the AllBASIC.info forum.

Title: Re: COM 64
Post by: JRS on September 07, 2018, 08:42:37 PM

Quote from: José Roca @ PlanetSquires Forums

It also seems that there is no interest to work with COM, other that automating Office with disphelper (https://sourceforge.net/projects/disphelper/).

Disphelper looks a lot like the CallByName COM interface.

It could be a quick way for for Charles to add COM / OLE automation support to O2.

Title: Re: COM 64
Post by: JRS on September 08, 2018, 06:37:56 PM

Charles,

It doesn't look like Chris Boss is going to make his EZGUI available to Oxygen Basic. Would it be possible to cobble together a CallByName COM/OLE automation interface? I could then reuse my efforts with VB6 OCX forms in O2.

Here is José Roca's CallByName in PowerBASIC.

CallByName.INC

Code: QBasic/QuickBASIC

1. %DISPATCH_METHOD         = 1
2. %DISPATCH_PROPERTYGET    = 2
3. %DISPATCH_PROPERTYPUT    = 4
4. %DISPATCH_PROPERTYPUTREF = 8
5.  
6. ' ********************************************************************************************
7. ' EXCEPINFO structure
8. ' ********************************************************************************************
9. TYPE EXCEPINFO
10.    wCode AS WORD               ' An error code describing the error.
11.    wReserved AS WORD           ' Reserved
12.    bstrSource AS DWORD         ' Source of the exception.
13.    bstrDescription AS DWORD    ' Textual description of the error.
14.    bstrHelpFile AS DWORD       ' Help file path.
15.    dwHelpContext AS DWORD      ' Help context ID.
16.    pvReserved AS DWORD         ' Reserved.
17.    pfnDeferredFillIn AS DWORD  ' Pointer to function that fills in Help and description info.
18.    scode AS DWORD              ' An error code describing the error.
19. END TYPE
20. ' ********************************************************************************************
21.  
22. ' ********************************************************************************************
23. ' Helper function to calculate the VTable address.
24. ' ********************************************************************************************
25. FUNCTION TB_VTableAddress (BYVAL pthis AS DWORD, BYVAL dwOffset AS DWORD) AS DWORD
26.    LOCAL ppthis AS DWORD PTR
27.    LOCAL pvtbl AS DWORD PTR
28.    LOCAL ppmethod AS DWORD PTR
29.    ppthis = pthis
30.    pvtbl = @ppthis
31.    ppmethod = pvtbl + dwOffset
32.    FUNCTION = @ppmethod
33. END FUNCTION
34. ' ********************************************************************************************
35.  
36. ' ********************************************************************************************
37. ' Maps a single member to a corresponding DispID, which can be used on subsequent calls to
38. ' IDispatch_Invoke.
39. ' Parameters:
40. ' riid
41. '   Reserved for future use. Must be IID_NULL.
42. ' strName
43. '   Name to be mapped.
44. ' rgDispId
45. '   Retrieved DispID value.
46. ' Return Value:
47. '   The return value obtained from the returned HRESULT is one of the following:
48. '   %S_OK                Success
49. '   %E_OUTOFMEMORY       Out of memory
50. '   %DISP_E_UNKNOWNNAME  One or more of the names were not known. The returned array of DISPIDs
51. '                        contains DISPID_UNKNOWN for each entry that corresponds to an unknown name.
52. '   %DISP_E_UNKNOWNLCID  The locale identifier (LCID) was not recognized.
53. ' ********************************************************************************************
54. DECLARE FUNCTION Proto_IDispatch_GetIDOfName (BYVAL pthis AS DWORD, BYREF riid AS GUID, BYref rgszNames AS STRING, BYVAL cNames AS DWORD, BYVAL lcid AS DWORD, BYref rgdispid AS LONG) AS DWORD
55. FUNCTION IDispatch_GetIDOfName (BYVAL pthis AS DWORD, BYref strName AS STRING, BYref rgdispid AS LONG) AS DWORD
56.    LOCAL HRESULT AS DWORD
57.    LOCAL pmethod AS DWORD
58.    LOCAL riid AS guid
59.    IF pthis = 0 THEN EXIT FUNCTION
60.    pmethod = TB_VTableAddress (pthis, 20)
61.    CALL DWORD pmethod USING Proto_IDispatch_GetIDOfName (pthis, riid, strName, 1, 0, rgdispid) TO HRESULT
62.    FUNCTION = HRESULT
63. END FUNCTION
64. ' ********************************************************************************************
65.  
66. ' ********************************************************************************************
67. ' Provides access to properties and methods exposed by an object. The dispatch function DispInvoke
68. ' provides a standard implementation of IDispatch_Invoke.
69. ' Parameters:
70. ' dispIdMember
71. '   Identifies the member. Use GetIDsOfNames or the object's documentation to obtain the dispatch identifier.
72. ' riid
73. '    Reserved for future use. Must be IID_NULL.
74. ' lcid
75. '   The locale context in which to interpret arguments. The lcid is used by the GetIDsOfNames
76. '   function, and is also passed to IDispatch_Invoke to allow the object to interpret its
77. '   arguments specific to a locale.
78. '   Applications that do not support multiple national languages can ignore this parameter.
79. ' wFlags
80. '   Flags describing the context of the Invoke call, include:
81. '     %DISPATCH_METHOD
82. '       The member is invoked as a method. If a property has the same name, both this and the
83. '       %DISPATCH_PROPERTYGET flag may be set.
84. '     %DISPATCH_PROPERTYGET
85. '       The member is retrieved as a property or data member.
86. '     %DISPATCH_PROPERTYPUT
87. '       The member is changed as a property or data member.
88. '     %DISPATCH_PROPERTYPUTREF
89. '       The member is changed by a reference assignment, rather than a value assignment. This
90. '       flag is valid only when the property accepts a reference to an object.
91. ' pDispParams
92. '   Pointer to a structure containing an array of arguments, an array of argument DISPIDs for
93. '   named arguments, and counts for the number of elements in the arrays.
94. ' pVarResult
95. '   Pointer to the location where the result is to be stored, or NULL if the caller expects no
96. '   result. This argument is ignored if DISPATCH_PROPERTYPUT or DISPATCH_PROPERTYPUTREF is specified.
97. ' pExcepInfo
98. '   Pointer to a structure that contains exception information. This structure should be filled
99. '   in if DISP_E_EXCEPTION is returned. Can be NULL.
100. ' puArgErr
101. '   The index within rgvarg of the first argument that has an error. Arguments are stored in
102. '   pDispParams->rgvarg in reverse order, so the first argument is the one with the highest index
103. '   in the array. This parameter is returned only when the resulting return value is
104. '   %DISP_E_TYPEMISMATCH or %DISP_E_PARAMNOTFOUND. This argument can be set to null.
105. ' Return Value:
106. '   The return value obtained from the returned HRESULT is one of the following:
107. '   %S_OK                     Success
108. '   %DISP_E_BADPARAMCOUNT     The number of elements provided to DISPPARAMS is different from the
109. '                             number of arguments accepted by the method or property.
110. '   %DISP_E_BADVARTYPE        One of the arguments in rgvarg is not a valid variant type.
111. '   %DISP_E_EXCEPTION         The application needs to raise an exception. In this case, the
112. '                             structure passed in pExcepInfo should be filled in.
113. '   %DISP_E_MEMBERNOTFOUND    The requested member does not exist, or the call to Invoke tried to
114. '                             set the value of a read-only property.
115. '   %DISP_E_NONAMEDARGS       This implementation of IDispatch does not support named arguments.
116. '   %DISP_E_OVERFLOW          One of the arguments in rgvarg could not be coerced to the specified type.
117. '   %DISP_E_PARAMNOTFOUND     One of the parameter DISPIDs does not correspond to a parameter on
118. '                             the method. In this case, puArgErr should be set to the first
119. '                             argument that contains the error.
120. '   %DISP_E_TYPEMISMATCH      One or more of the arguments could not be coerced. The index within
121. '                             rgvarg of the first parameter with the incorrect type is returned
122. '                             in the puArgErr parameter.
123. '   %DISP_E_UNKNOWNINTERFACE  The interface identifier passed in riid is not IID_NULL.
124. '   %DISP_E_UNKNOWNLCID       The member being invoked interprets string arguments according to
125. '                             the LCID, and the LCID is not recognized. If the LCID is not needed
126. '                             to interpret arguments, this error should not be returned.
127. '   %DISP_E_PARAMNOTOPTIONAL  A required parameter was omitted.
128. ' ********************************************************************************************
129. FUNCTION IDispatch_Invoke (BYVAL pthis AS DWORD, BYVAL dispidMember AS LONG, BYREF riid AS GUID, _
130. BYVAL lcid AS DWORD, BYVAL wFlags AS WORD, BYREF pdispparams AS DISPPARAMS, BYREF pvarResult AS VARIANT, _
131. BYREF pexcepinfo AS EXCEPINFO, BYREF puArgErr AS DWORD) AS DWORD
132.    LOCAL HRESULT AS DWORD
133.    LOCAL pmethod AS DWORD
134.    IF pthis = 0 THEN EXIT FUNCTION
135.    pmethod = TB_VTableAddress (pthis, 24)
136.    CALL DWORD pmethod USING IDispatch_Invoke (pthis, dispidMember, riid, lcid, wFlags, pdispparams, pvarResult, pexcepinfo, puArgErr) TO HRESULT
137.    FUNCTION = HRESULT
138. END FUNCTION
139. ' ********************************************************************************************
140.  
141. ' ********************************************************************************************
142. ' CallByName
143. ' ********************************************************************************************
144. FUNCTION TB_CallByName ( _
145.     BYVAL pthis AS DWORD, _                                    ' *IDispatch
146.     BYVAL vNameOrId AS VARIANT, _                              ' Name or identifier
147.     BYVAL callType AS LONG, _                                  ' Call type
148.     byref vParams() AS VARIANT, _                              ' Array of variants
149.     byref vResult AS variant, _                                ' Variant result
150.     byref pex AS EXCEPINFO _                                   ' EXCEPINFO
151.     ) EXPORT AS LONG                                           ' Error code
152.  
153.     DIM dw_puArgErr AS DWORD, DISPID_PROPERTYPUT AS LONG, IID_NULL AS GUID
154.     DIM vArgs(0) AS VARIANT, udt_DispParams AS DISPPARAMS
155.     DIM strName AS STRING, DispID AS LONG, nParams AS LONG, i AS LONG, idx AS LONG
156.  
157.     ' Check for null pointer
158.     IF pthis = 0 THEN FUNCTION = -1 : EXIT FUNCTION
159.  
160.     ' Get the DispID
161.     IF variantvt(vNameOrId) = %VT_BSTR THEN
162.        strName = ucode$(variant$(vNameOrId))
163.        IDispatch_GetIDOfName pthis, strName, DispID
164.     ELSE
165.        DispID = variant#(vNameOrId)
166.     END IF
167.  
168.     ' Copy the array in reversed order
169.     IF VARPTR(vParams()) THEN
170.        nParams = UBOUND(vParams) - LBOUND (vParams) + 1
171.        IF nParams > 0 THEN
172.           REDIM vArgs(nParams - 1)
173.           idx = nParams - 1
174.           FOR i = LBOUND(vParams) TO UBOUND(vParams)
175.              IF variantvt(vParams(i)) = %VT_EMPTY THEN
176.                 vArgs(idx) = ERROR %DISP_E_PARAMNOTFOUND
177.              ELSE
178.                 vArgs(idx) = vParams(i)
179.              END IF
180.              DECR idx
181.              IF idx < 0 THEN EXIT FOR
182.           NEXT
183.        END IF
184.    END IF
185.  
186.    IF CallType = 4 OR CallType = 8 THEN  ' %DISPATCH_PROPERTYPUT and %DISPATCH_PROPERTYPUTREF
187.       DISPID_PROPERTYPUT = -3
188.       udt_DispParams.CountNamed = 1
189.       udt_DispParams.NamedDispId = VARPTR(DISPID_PROPERTYPUT)
190.    END IF
191.  
192.    udt_DispParams.CountArgs = nParams
193.    IF nParams > 0 THEN udt_DispParams.VariantArgs = VARPTR(vArgs(0))
194.  
195.    FUNCTION = IDispatch_Invoke(pthis, DispID, IID_NULL, 0, CallType, udt_DispParams, vResult, pex, dw_puArgErr)
196.  
197. END FUNCTION
198. ' ********************************************************************************************
199.  

Example Use

Code: QBasic/QuickBASIC

1. #COMPILE EXE
2. #DIM ALL
3. #DEBUG ERROR ON
4. #INCLUDE "WIN32API.INC"
5. #INCLUDE "CallByName.INC"
6.  
7. %adOpenKeyset     = &H00000001
8. %adLockOptimistic = &H00000003
9. %adCmdText        = &H00000001
10.  
11. ' ********************************************************************************************
12. ' Main
13. ' ********************************************************************************************
14. FUNCTION pbmain
15.  
16.    LOCAL oCon AS dispatch
17.    LOCAL oRec AS dispatch
18.    LOCAL hr AS dword
19.    LOCAL pex AS EXCEPINFO
20.    LOCAL vResult AS VARIANT
21.    LOCAL bstrlen AS LONG
22.    DIM vParams(0) AS variant
23.    
24.    ' Creates a connection instance
25.    set oCon = new dispatch in "ADODB.Connection"
26.    IF isfalse isobject(oCon) THEN GOTO Terminate
27.    
28.    REDIM vParams(3)  ' Four parameters (0:3) - Empty variants are considered as optional parameters
29.    vParams(0) = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=f:\ffado\biblio.mdb"  ' <-- change as needed
30.    hr = TB_CallByName(objptr(oCon), "Open", %DISPATCH_METHOD, vParams(), BYVAL %NULL, BYVAL %NULL)
31.  
32.    ' Creates a recordset instance
33.    set oRec = new dispatch in "ADODB.Recordset"
34.    IF isfalse isobject(oRec) THEN GOTO Terminate
35.    
36.    ' Opens the recordset
37.    REDIM vParams(4)  ' Five parameters (0:4)
38.    vParams(0) = "SELECT TOP 20 * FROM Authors ORDER BY Author"
39.    set vParams(1) = oCon  ' This is a dispatch variable, so we have to assign it using SET
40.    vParams(2) = %adOpenKeyset
41.    vParams(3) = %adLockOptimistic
42.    vParams(4) = %adCmdText
43.    hr = TB_CallByName(objptr(oRec), "Open", %DISPATCH_METHOD, vParams(), BYVAL %NULL, BYVAL %NULL)
44.  
45.    DO
46.       hr = TB_CallByName(objptr(oRec), "Eof", %DISPATCH_PROPERTYGET, BYVAL %NULL, vResult, BYVAL %NULL)
47.       IF variant#(vResult) THEN EXIT DO
48.       REDIM vParams(0)  ' One parameter
49.       vParams(0) = "Author"
50.       hr = TB_CallByName(objptr(oRec), "Collect", %DISPATCH_PROPERTYGET, vParams(), vResult, BYVAL %NULL)
51.       PRINT variant$(vResult)
52.       ' Fetch the next row
53.       hr = TB_CallByName(objptr(oRec), "MoveNext", %DISPATCH_METHOD, BYVAL %NULL, BYVAL %NULL, BYVAL %NULL)
54.    LOOP
55.    
56.    
57. Terminate:
58.  
59.    ' Close the reordset
60.    hr = TB_CallByName(objptr(oRec), "Close", %DISPATCH_METHOD, BYVAL %NULL, BYVAL %NULL, BYVAL %NULL)
61.    ' Close the connection
62.    hr = TB_CallByName(objptr(oCon), "Close", %DISPATCH_METHOD, BYVAL %NULL, BYVAL %NULL, BYVAL %NULL)
63.  
64.    ' Cleanup
65.    set oRec = nothing
66.    set oCon = nothing
67.  
68.    waitkey$
69.  
70. END FUNCTION
71. ' ********************************************************************************************
72.  

Here is the Script BASIC CallByName function for the COM extension module.

Code: C

1. besFUNCTION(CallByName)
2.  
3.   int i;
4.   int slen;
5.   char *s;
6.   int com_args = 0;
7.   char* myCopy = NULL;
8.   LPWSTR wMethodName = NULL;
9.   vbCallType CallType = VbMethod;
10.   std::list<BSTR> bstrs;
11.   VARIANTARG* pvarg = NULL;
12.  
13.   VARIABLE arg_obj;
14.   VARIABLE arg_procName;
15.   VARIABLE arg_CallType;
16.  
17.   besRETURNVALUE = besNEWMORTALLONG;
18.   LONGVALUE(besRETURNVALUE) = 0;
19.  
20.   g_pSt = pSt;
21.  
22.   if(com_dbg) color_printf(colors::myellow,"CallByName %ld args\n",besARGNR);
23.  
24.   if(besARGNR < 2) RETURN0("CallByName requires at least 2 args..")
25.  
26.   arg_obj = besARGUMENT(1);
27.   besDEREFERENCE(arg_obj);
28.  
29.   if( TYPE(arg_obj) != VTYPE_LONG) RETURN0("CallByName first argument must be a long")
30.  
31.   arg_procName = besARGUMENT(2);
32.   besDEREFERENCE(arg_procName);
33.  
34.   if( TYPE(arg_procName) != VTYPE_STRING) RETURN0("CallByName second argument must be a string")
35.  
36.   if( besARGNR >= 3 ){
37.     arg_CallType = besARGUMENT(3);
38.     besDEREFERENCE(arg_CallType);
39.         CallType = (vbCallType)LONGVALUE(arg_CallType);
40.   }
41.  
42.   myCopy = GetCString(arg_procName);
43.   if(myCopy==0) RETURN0("malloc failed low mem")
44.  
45.   wMethodName = __C2W(myCopy);
46.   if(wMethodName==0) RETURN0("unicode conversion failed")
47.  
48.   if( LONGVALUE(arg_obj) == 0) RETURN0("CallByName(NULL) called")
49.   IDispatch* IDisp = (IDispatch*)LONGVALUE(arg_obj);
50.   DISPID  dispid; // long integer containing the dispatch ID
51.   HRESULT hr;
52.  
53.   // Get the Dispatch ID for the method name,
54.   // try block is in case client passed in an invalid pointer
55.   try{
56.           hr = IDisp->GetIDsOfNames(IID_NULL, &wMethodName, 1, LOCALE_USER_DEFAULT, &dispid);
57.           if( FAILED(hr) ) RETURN0("GetIDsOfNames failed")
58.   }
59.   catch(...){
60.           RETURN0("Invalid IDisp pointer?")
61.   }
62.          
63.   VARIANT    retVal;
64.   DISPPARAMS dispparams;
65.   memset(&dispparams, 0, sizeof(dispparams));
66.  
67.   com_args = besARGNR - 3;
68.   if(com_args < 0) com_args = 0;
69.    
70.   if(com_dbg) color_printf(colors::myellow,"CallByName(obj=%x, method='%s', calltype=%d , comArgs=%d)\n", LONGVALUE(arg_obj), myCopy, CallType, com_args);
71.  
72.   // Allocate memory for all VARIANTARG parameters.
73.   if(com_args > 0){
74.          pvarg = new VARIANTARG[com_args];
75.          if(pvarg == NULL) RETURN0("failed to alloc VARIANTARGs")
76.   }
77.  
78.   dispparams.rgvarg = pvarg;
79.   if(com_args > 0) memset(pvarg, 0, sizeof(VARIANTARG) * com_args);
80.          
81.   dispparams.cArgs = com_args;  // num of args function takes
82.   dispparams.cNamedArgs = 0;
83.  
84.   /* map in argument values and types    ->[ IN REVERSE ORDER ]<-    */
85.   for(int i=0; i < com_args; i++){
86.           VARIABLE arg_x;              
87.           arg_x = besARGUMENT(3 + com_args - i);
88.           besDEREFERENCE(arg_x);
89.  
90.                 switch( TYPE(arg_x) ){ //script basic type to COM variant type
91.  
92.                           case VTYPE_DOUBLE:
93.                           case VTYPE_ARRAY:
94.                           case VTYPE_REF:
95.                                 RETURN0("Arguments of script basic types [double, ref, array] not supported")
96.                                 break;
97.  
98.                           case VTYPE_LONG:
99.                                 pvarg[i].vt = VT_I4;
100.                                 pvarg[i].lVal = LONGVALUE(arg_x);
101.                                 break;
102.                          
103.                           case VTYPE_STRING:
104.                                 char* myStr = GetCString(arg_x);
105.                                
106.                                 //peek at data and see if an explicit VT_ type was specified.. scriptbasic only supports a few types
107.                                 if( !HandleSpecial(&pvarg[i], myStr) ){
108.                                         //nope its just a standard string type
109.                                         LPWSTR wStr = __C2W(myStr);
110.                                         BSTR bstr = SysAllocString(wStr);
111.                                         bstrs.push_back(bstr); //track these to free after call to prevent leak
112.                                         pvarg[i].vt = VT_BSTR;
113.                                         pvarg[i].bstrVal = bstr;
114.                                         free(myStr);
115.                                         free(wStr);
116.                                 }
117.  
118.                                 break;                   
119.                                
120.           }
121.  
122.   }
123.    
124.   //invoke should not need a try catch block because IDisp is already known to be ok and COM should only return a hr result?
125.  
126.   //property put gets special handling..
127.   if(CallType == VbLet){
128.             DISPID mydispid = DISPID_PROPERTYPUT;
129.         dispparams.rgdispidNamedArgs = &mydispid;
130.                 dispparams.cNamedArgs = 1;
131.                 hr=IDisp->Invoke( dispid, IID_NULL, LOCALE_USER_DEFAULT, CallType, &dispparams, NULL, NULL, NULL); //no return value arg
132.                 if( FAILED(hr) ) RETURN0("Invoke failed")
133.                 goto cleanup;
134.   }
135.  
136.   hr=IDisp->Invoke( dispid, IID_NULL, LOCALE_USER_DEFAULT, CallType, &dispparams, &retVal, NULL, NULL);
137.   if( FAILED(hr) ) RETURN0("Invoke failed")
138.  
139.   char* cstr = 0;
140.   //map in return value to scriptbasic return val
141.   switch(retVal.vt)
142.   {
143.         case VT_EMPTY: break;
144.  
145.         case VT_BSTR:
146.  
147.             cstr = __B2C(retVal.bstrVal);
148.                 slen = strlen(cstr);
149.                 if(com_dbg) color_printf(colors::myellow,"return value from COM function was string: %s\n", cstr);
150.                 besALLOC_RETURN_STRING(slen);
151.                 memcpy(STRINGVALUE(besRETURNVALUE),cstr,slen);
152.                 free(cstr);
153.                 break;
154.  
155.         case VT_I4:  /* this might be being really lazy but at least with VB6 it works ok.. */
156.         case VT_I2:
157.         case VT_I1:
158.     case VT_BOOL:
159.         case VT_UI1:
160.         case VT_UI2:
161.         case VT_UI4:
162.         case VT_I8:
163.         case VT_UI8:
164.         case VT_INT:
165.         case VT_UINT:
166.         case VT_DISPATCH:
167.  
168.                 if(com_dbg) color_printf(colors::myellow,"return value from COM function was numeric: %d\n", retVal.lVal);
169.         LONGVALUE(besRETURNVALUE) = retVal.lVal;
170.                 break;
171.  
172.         default:
173.                 color_printf(colors::mred,"currently unsupported VT return type: %x\n", retVal.vt);
174.                 break;
175.   }
176.  
177.  
178. cleanup:
179.  
180.   for (std::list<BSTR>::iterator it=bstrs.begin(); it != bstrs.end(); ++it) SysFreeString(*it);
181.   if(pvarg)       delete pvarg;
182.   if(wMethodName) free(wMethodName); //return0 maybe should goto cleanup cause these would leak
183.   if(myCopy)      free(myCopy);
184.   return 0;
185.  
186. besEND
187.  

Title: Re: COM 64 - Variant
Post by: JRS on September 09, 2018, 11:38:59 AM

This might help with getting variants incorporated in Oxygen Basic. If we can get the common use types that convert with other languages, this would solve a huge missing piece in O2. Charles has low level COM working in the Script BASIC DLLC extension module. It would be great if that effort could be reused in the CallByName interface.

VARIANT and VARIANTARG (https://msdn.microsoft.com/en-us//library/ms931135.aspx)

Mingw32 oaidl.h

Code: C

1. #ifndef _OAIDL_H
2. #define _OAIDL_H
3. #ifdef __cplusplus
4. extern "C" {
5. #endif
6. #ifdef NONAMELESSUNION
7. #define __VARIANT_NAME_1 n1
8. #define __VARIANT_NAME_2 n2
9. #define __VARIANT_NAME_3 n3
10. #define __VARIANT_NAME_4 n4
11. #else
12. #define __tagVARIANT
13. #define __VARIANT_NAME_1
14. #define __VARIANT_NAME_2
15. #define __VARIANT_NAME_3
16. #define __VARIANT_NAME_4
17. #endif
18. #define DISPID_UNKNOWN (-1)
19. #define DISPID_VALUE (0)
20. #define DISPID_PROPERTYPUT (-3)
21. #define DISPID_NEWENUM (-4)
22. #define DISPID_EVALUATE (-5)
23. #define DISPID_CONSTRUCTOR (-6)
24. #define DISPID_DESTRUCTOR (-7)
25. #define DISPID_COLLECT (-8)
26. #define FADF_AUTO (1)
27. #define FADF_STATIC (2)
28. #define FADF_EMBEDDED (4)
29. #define FADF_FIXEDSIZE (16)
30. #define FADF_BSTR (256)
31. #define FADF_UNKNOWN (512)
32. #define FADF_DISPATCH (1024)
33. #define FADF_VARIANT (2048)
34. #define FADF_RESERVED (0xf0e8)
35. #define PARAMFLAG_NONE (0)
36. #define PARAMFLAG_FIN (1)
37. #define PARAMFLAG_FOUT (2)
38. #define PARAMFLAG_FLCID (4)
39. #define PARAMFLAG_FRETVAL (8)
40. #define PARAMFLAG_FOPT (16)
41. #define PARAMFLAG_FHASDEFAULT (32)
42. #define IDLFLAG_NONE PARAMFLAG_NONE
43. #define IDLFLAG_FIN PARAMFLAG_FIN
44. #define IDLFLAG_FOUT PARAMFLAG_FOUT
45. #define IDLFLAG_FLCID PARAMFLAG_FLCID
46. #define IDLFLAG_FRETVAL PARAMFLAG_FRETVAL
47. #define IMPLTYPEFLAG_FDEFAULT 1
48. #define IMPLTYPEFLAG_FSOURCE 2
49. #define IMPLTYPEFLAG_FRESTRICTED 4
50. #define IMPLTYPEFLAG_FDEFAULTVTABLE 8
51.  
52. typedef interface ITypeLib *LPTYPELIB;
53. typedef interface ICreateTypeInfo *LPCREATETYPEINFO;
54. typedef interface ICreateTypeInfo2 *LPCREATETYPEINFO2;
55. typedef interface ICreateTypeLib *LPCREATETYPELIB;
56. typedef interface ICreateTypeLib2 *LPCREATETYPELIB2;
57. typedef interface ITypeComp *LPTYPECOMP;
58. typedef interface ITypeInfo *LPTYPEINFO;
59. typedef interface IErrorInfo *LPERRORINFO;
60. typedef interface IDispatch *LPDISPATCH;
61. typedef interface IEnumVARIANT *LPENUMVARIANT;
62. typedef interface ICreateErrorInfo *LPCREATEERRORINFO;
63. typedef interface ISupportErrorInfo *LPSUPPORTERRORINFO;
64. typedef interface IRecordInfo *LPRECORDINFO;
65.  
66. extern const IID IID_ITypeLib;
67. extern const IID IID_ICreateTypeInfo;
68. extern const IID IID_ICreateTypeInfo2;
69. extern const IID IID_ICreateTypeLib;
70. extern const IID IID_ICreateTypeLib2;
71. extern const IID IID_ITypeInfo;
72. extern const IID IID_IErrorInfo;
73. extern const IID IID_IDispatch;
74. extern const IID IID_IEnumVARIANT;
75. extern const IID IID_ICreateErrorInfo;
76. extern const IID IID_ISupportErrorInfo;
77. extern const IID IID_IRecordInfo;
78.  
79. typedef enum tagSYSKIND {
80.         SYS_WIN16,SYS_WIN32,SYS_MAC
81. } SYSKIND;
82. typedef enum tagLIBFLAGS {
83.         LIBFLAG_FRESTRICTED=1,LIBFLAG_FCONTROL=2,LIBFLAG_FHIDDEN=4,
84.         LIBFLAG_FHASDISKIMAGE=8
85. } LIBFLAGS;
86. typedef struct tagTLIBATTR {
87.         GUID guid;
88.         LCID lcid;
89.         SYSKIND syskind;
90.         WORD wMajorVerNum;
91.         WORD wMinorVerNum;
92.         WORD wLibFlags;
93. } TLIBATTR,*LPTLIBATTR;
94. typedef CY CURRENCY;
95. typedef struct tagSAFEARRAYBOUND {
96.         ULONG cElements;
97.         LONG lLbound;
98. }SAFEARRAYBOUND,*LPSAFEARRAYBOUND;
99. typedef struct _wireSAFEARR_BSTR
100. {
101.         ULONG Size;
102.         wireBSTR *aBstr;
103. }SAFEARR_BSTR;
104. typedef struct _wireSAFEARR_UNKNOWN {
105.         ULONG Size;
106.         IUnknown **apUnknown;
107. }SAFEARR_UNKNOWN;
108. typedef struct _wireSAFEARR_DISPATCH {
109.         ULONG Size;
110.         LPDISPATCH *apDispatch;
111. }SAFEARR_DISPATCH;
112. typedef struct _wireSAFEARR_VARIANT {
113.         ULONG Size;
114.         struct _wireVARIANT *aVariant;
115. }SAFEARR_VARIANT;
116. typedef enum tagSF_TYPE {
117.         SF_ERROR=VT_ERROR,
118.         SF_I1=VT_I1,
119.         SF_I2=VT_I2,
120.         SF_I4=VT_I4,
121.         SF_I8=VT_I8,
122.         SF_BSTR=VT_BSTR,
123.         SF_UNKNOWN=VT_UNKNOWN,
124.         SF_DISPATCH=VT_DISPATCH,
125.         SF_VARIANT=VT_VARIANT
126. }SF_TYPE;
127. typedef struct _wireBRECORD  {
128.         ULONG fFlags;
129.         ULONG clSize;
130.         LPRECORDINFO* pRecInfo;
131.         byte* pRecord;
132. } *wireBRECORD;
133. typedef struct _wireSAFEARR_BRECORD {
134.     ULONG Size;
135.     wireBRECORD* aRecord;
136.     } SAFEARR_BRECORD;
137. typedef struct _wireSAFEARR_HAVEIID {
138.         ULONG Size;
139.         IUnknown** apUnknown;
140.         IID iid;
141.         } SAFEARR_HAVEIID;
142. typedef struct _wireSAFEARRAY_UNION {
143.         ULONG sfType;
144.         union {
145.                 SAFEARR_BSTR BstrStr;
146.                 SAFEARR_UNKNOWN UnknownStr;
147.                 SAFEARR_DISPATCH DispatchStr;
148.                 SAFEARR_VARIANT VariantStr;
149.                 SAFEARR_BRECORD RecordStr;
150.                 SAFEARR_HAVEIID HaveIidStr;
151.                 BYTE_SIZEDARR ByteStr;
152.                 WORD_SIZEDARR WordStr;
153.                 DWORD_SIZEDARR LongStr;
154.                 HYPER_SIZEDARR HyperStr;
155.         }u;
156. }SAFEARRAYUNION;
157. typedef struct _wireSAFEARRAY {
158.         USHORT cDims;
159.         USHORT fFeatures;
160.         ULONG cbElements;
161.         ULONG cLocks;
162.         SAFEARRAYUNION uArrayStructs;
163.         SAFEARRAYBOUND rgsabound[1];
164. }*wireSAFEARRAY;
165. typedef wireSAFEARRAY *wirePSAFEARRAY;
166. typedef struct tagSAFEARRAY {
167.         USHORT cDims;
168.         USHORT fFeatures;
169.         ULONG cbElements;
170.         ULONG cLocks;
171.         PVOID pvData;
172.         SAFEARRAYBOUND rgsabound[1];
173. }SAFEARRAY,*LPSAFEARRAY;
174. typedef struct tagVARIANT {
175.   _ANONYMOUS_UNION union {
176.         struct __tagVARIANT {
177.         VARTYPE vt;
178.         WORD wReserved1;
179.         WORD wReserved2;
180.         WORD wReserved3;
181.         _ANONYMOUS_UNION union {
182.                 long lVal;
183.                 unsigned char bVal;
184.                 short iVal;
185.                 float fltVal;
186.                 double dblVal;
187.                 VARIANT_BOOL  boolVal;
188.                 SCODE scode;
189.                 CY cyVal;
190.                 DATE date;
191.                 BSTR bstrVal;
192.                 IUnknown *punkVal;
193.                 LPDISPATCH pdispVal;
194.                 SAFEARRAY *parray;
195.                 unsigned char *pbVal;
196.                 short *piVal;
197.                 long *plVal;
198.                 float *pfltVal;
199.                 double *pdblVal;
200.                 VARIANT_BOOL *pboolVal;
201.                 _VARIANT_BOOL  *pbool;
202.                 SCODE *pscode;
203.                 CY *pcyVal;
204.                 DATE *pdate;
205.                 BSTR *pbstrVal;
206.                 IUnknown **ppunkVal;
207.                 LPDISPATCH *ppdispVal;
208.                 SAFEARRAY **pparray;
209.                 struct tagVARIANT *pvarVal;
210.                 void *byref;
211.                 CHAR cVal;
212.                 USHORT uiVal;
213.                 ULONG ulVal;
214.                 INT intVal;
215.                 UINT uintVal;
216.                 DECIMAL *pdecVal;
217.                 CHAR  *pcVal;
218.                 USHORT  *puiVal;
219.                 ULONG  *pulVal;
220.                 INT  *pintVal;
221.                 UINT  *puintVal;
222.                 _ANONYMOUS_STRUCT struct {
223.                         PVOID pvRecord;
224.                         struct IRecordInfo *pRecInfo;
225.                 } __VARIANT_NAME_4;
226.         } __VARIANT_NAME_3;
227.     } __VARIANT_NAME_2;
228.     DECIMAL decVal;
229.   } __VARIANT_NAME_1;
230. } VARIANT,*LPVARIANT;
231. typedef VARIANT VARIANTARG;
232. typedef VARIANT *LPVARIANTARG;
233. typedef struct _wireVARIANT {
234.         DWORD clSize;
235.         DWORD rpcReserved;
236.         USHORT vt;
237.         USHORT wReserved1;
238.         USHORT wReserved2;
239.         USHORT wReserved3;
240.         _ANONYMOUS_UNION union {
241.                 LONG lVal;
242.                 BYTE bVal;
243.                 SHORT iVal;
244.                 FLOAT fltVal;
245.                 DOUBLE dblVal;
246.                 VARIANT_BOOL boolVal;
247.                 SCODE scode;
248.                 CY cyVal;
249.                 DATE date;
250.                 wireBSTR bstrVal;
251.                 IUnknown *punkVal;
252.                 LPDISPATCH pdispVal;
253.                 wirePSAFEARRAY parray;
254.                 wireBRECORD brecVal;
255.                 BYTE *pbVal;
256.                 SHORT *piVal;
257.                 LONG *plVal;
258.                 FLOAT *pfltVal;
259.                 DOUBLE *pdblVal;
260.                 VARIANT_BOOL *pboolVal;
261.                 SCODE *pscode;
262.                 CY *pcyVal;
263.                 DATE *pdate;
264.                 wireBSTR *pbstrVal;
265.                 IUnknown **ppunkVal;
266.                 LPDISPATCH *ppdispVal;
267.                 wirePSAFEARRAY *pparray;
268.                 struct _wireVARIANT *pvarVal;
269.                 CHAR cVal;
270.                 USHORT uiVal;
271.                 ULONG ulVal;
272.                 INT intVal;
273.                 UINT uintVal;
274.                 DECIMAL decVal;
275.                 DECIMAL *pdecVal;
276.                 CHAR *pcVal;
277.                 USHORT *puiVal;
278.                 ULONG *pulVal;
279.                 INT *pintVal;
280.                 UINT *puintVal;
281.         } DUMMYUNIONNAME;
282. } *wireVARIANT;  
283. typedef LONG DISPID;
284. typedef DISPID MEMBERID;
285. typedef DWORD HREFTYPE;
286. typedef enum tagTYPEKIND {
287.         TKIND_ENUM,TKIND_RECORD,TKIND_MODULE,TKIND_INTERFACE,TKIND_DISPATCH,
288.         TKIND_COCLASS,TKIND_ALIAS,TKIND_UNION,TKIND_MAX
289. }TYPEKIND;
290. typedef struct tagTYPEDESC {
291.         _ANONYMOUS_UNION union {
292.                 struct tagTYPEDESC *lptdesc;
293.                 struct tagARRAYDESC *lpadesc;
294.                 HREFTYPE hreftype;
295.         } DUMMYUNIONNAME;
296.         VARTYPE vt;
297. }TYPEDESC;
298. typedef struct tagARRAYDESC {
299.         TYPEDESC tdescElem;
300.         USHORT cDims;
301.         SAFEARRAYBOUND rgbounds[1];
302. }ARRAYDESC;
303. typedef struct tagPARAMDESCEX {
304.         ULONG cBytes;
305.         VARIANTARG varDefaultValue;
306. }PARAMDESCEX,*LPPARAMDESCEX;
307. typedef struct tagPARAMDESC {
308.         LPPARAMDESCEX pparamdescex;
309.         USHORT wParamFlags;
310. }PARAMDESC,*LPPARAMDESC;
311. typedef struct tagIDLDESC {
312.         ULONG dwReserved;
313.         USHORT wIDLFlags;
314. }IDLDESC,*LPIDLDESC;
315. typedef struct tagELEMDESC {
316.         TYPEDESC tdesc;
317.         _ANONYMOUS_UNION union {
318.                 IDLDESC idldesc;
319.                 PARAMDESC paramdesc;
320.         } DUMMYUNIONNAME;
321. } ELEMDESC,*LPELEMDESC;
322. typedef struct tagTYPEATTR {
323.         GUID guid;
324.         LCID lcid;
325.         DWORD dwReserved;
326.         MEMBERID memidConstructor;
327.         MEMBERID memidDestructor;
328.         LPOLESTR lpstrSchema;
329.         ULONG cbSizeInstance;
330.         TYPEKIND typekind;
331.         WORD cFuncs;
332.         WORD cVars;
333.         WORD cImplTypes;
334.         WORD cbSizeVft;
335.         WORD cbAlignment;
336.         WORD wTypeFlags;
337.         WORD wMajorVerNum;
338.         WORD wMinorVerNum;
339.         TYPEDESC tdescAlias;
340.         IDLDESC idldescType;
341. }TYPEATTR,*LPTYPEATTR;
342. typedef struct tagDISPPARAMS {
343.         VARIANTARG *rgvarg;
344.         DISPID *rgdispidNamedArgs;
345.         UINT cArgs;
346.         UINT cNamedArgs;
347. }DISPPARAMS;
348. typedef struct tagEXCEPINFO {
349.         WORD wCode;
350.         WORD wReserved;
351.         BSTR bstrSource;
352.         BSTR bstrDescription;
353.         BSTR bstrHelpFile;
354.         DWORD dwHelpContext;
355.         PVOID pvReserved;
356.         HRESULT(__stdcall * pfnDeferredFillIn)(struct tagEXCEPINFO*);
357.         SCODE scode;
358. } EXCEPINFO,*LPEXCEPINFO;
359. typedef enum tagCALLCONV {
360.         CC_FASTCALL,CC_CDECL,CC_MSCPASCAL,CC_PASCAL=CC_MSCPASCAL,
361.         CC_MACPASCAL,CC_STDCALL,CC_FPFASTCALL,CC_SYSCALL,CC_MPWCDECL,
362.         CC_MPWPASCAL,CC_MAX=CC_MPWPASCAL
363. }CALLCONV;
364. typedef enum tagFUNCKIND {
365.         FUNC_VIRTUAL,FUNC_PUREVIRTUAL,FUNC_NONVIRTUAL,
366.         FUNC_STATIC,FUNC_DISPATCH
367. }FUNCKIND;
368. typedef enum tagINVOKEKIND {
369.         INVOKE_FUNC=1,INVOKE_PROPERTYGET,INVOKE_PROPERTYPUT=4,
370.         INVOKE_PROPERTYPUTREF=8
371. }INVOKEKIND;
372. typedef struct tagFUNCDESC {
373.         MEMBERID memid;
374.         SCODE *lprgscode;
375.         ELEMDESC *lprgelemdescParam;
376.         FUNCKIND funckind;
377.         INVOKEKIND invkind;
378.         CALLCONV callconv;
379.         SHORT cParams;
380.         SHORT cParamsOpt;
381.         SHORT oVft;
382.         SHORT cScodes;
383.         ELEMDESC elemdescFunc;
384.         WORD wFuncFlags;
385. }FUNCDESC,*LPFUNCDESC;
386. typedef enum tagVARKIND {
387.         VAR_PERINSTANCE,VAR_STATIC,VAR_CONST,VAR_DISPATCH
388. } VARKIND;
389. typedef struct tagVARDESC {
390.         MEMBERID memid;
391.         LPOLESTR lpstrSchema;
392.         _ANONYMOUS_UNION union {
393.                 ULONG oInst;
394.                 VARIANT *lpvarValue;
395.         } DUMMYUNIONNAME;
396.         ELEMDESC elemdescVar;
397.         WORD wVarFlags;
398.         VARKIND varkind;
399. } VARDESC,*LPVARDESC;
400. typedef enum tagTYPEFLAGS {
401.         TYPEFLAG_FAPPOBJECT=1,TYPEFLAG_FCANCREATE=2,TYPEFLAG_FLICENSED=4,
402.         TYPEFLAG_FPREDECLID=8,TYPEFLAG_FHIDDEN=16,TYPEFLAG_FCONTROL=32,
403.         TYPEFLAG_FDUAL=64,TYPEFLAG_FNONEXTENSIBLE=128,
404.         TYPEFLAG_FOLEAUTOMATION=256,TYPEFLAG_FRESTRICTED=512,
405.         TYPEFLAG_FAGGREGATABLE=1024,TYPEFLAG_FREPLACEABLE=2048,
406.         TYPEFLAG_FDISPATCHABLE=4096,TYPEFLAG_FREVERSEBIND=8192
407. } TYPEFLAGS;
408. typedef enum tagFUNCFLAGS {
409.         FUNCFLAG_FRESTRICTED=1,FUNCFLAG_FSOURCE=2,FUNCFLAG_FBINDABLE=4,
410.         FUNCFLAG_FREQUESTEDIT=8,FUNCFLAG_FDISPLAYBIND=16,FUNCFLAG_FDEFAULTBIND=32,
411.         FUNCFLAG_FHIDDEN=64,FUNCFLAG_FUSESGETLASTERROR=128,FUNCFLAG_FDEFAULTCOLLELEM=256,
412.         FUNCFLAG_FUIDEFAULT=512,FUNCFLAG_FNONBROWSABLE=1024,FUNCFLAG_FREPLACEABLE=2048,
413.         FUNCFLAG_FIMMEDIATEBIND=4096
414. } FUNCFLAGS;
415. typedef enum tagVARFLAGS {
416.         VARFLAG_FREADONLY=1,VARFLAG_FSOURCE=2,VARFLAG_FBINDABLE=4,VARFLAG_FREQUESTEDIT=8,
417.         VARFLAG_FDISPLAYBIND=16,VARFLAG_FDEFAULTBIND=32,VARFLAG_FHIDDEN=64,VARFLAG_FRESTRICTED=128,
418.         VARFLAG_FDEFAULTCOLLELEM=256,VARFLAG_FUIDEFAULT=512,VARFLAG_FNONBROWSABLE=1024,
419.         VARFLAG_FREPLACEABLE=2048,VARFLAG_FIMMEDIATEBIND=4096
420. } VARFLAGS;
421. typedef struct tagCLEANLOCALSTORAGE {
422.         IUnknown *pInterface;
423.         PVOID pStorage;
424.         DWORD flags;
425. } CLEANLOCALSTORAGE;
426. typedef struct tagCUSTDATAITEM {
427.         GUID guid;
428.         VARIANTARG varValue;
429. } CUSTDATAITEM,*LPCUSTDATAITEM;
430. typedef struct tagCUSTDATA {
431.         DWORD cCustData;
432.         LPCUSTDATAITEM prgCustData;
433. } CUSTDATA,*LPCUSTDATA;
434.  
435. typedef enum tagDESCKIND {
436.         DESCKIND_NONE=0,DESCKIND_FUNCDESC=DESCKIND_NONE+1,
437.         DESCKIND_VARDESC=DESCKIND_FUNCDESC+1,DESCKIND_TYPECOMP=DESCKIND_VARDESC+1,
438.         DESCKIND_IMPLICITAPPOBJ=DESCKIND_TYPECOMP+1,
439.         DESCKIND_MAX=DESCKIND_IMPLICITAPPOBJ+1
440. } DESCKIND;
441.  
442. typedef union tagBINDPTR {
443.         LPFUNCDESC lpfuncdesc;
444.         LPVARDESC lpvardesc;
445.         LPTYPECOMP lptcomp;
446. } BINDPTR,*LPBINDPTR;
447.  
448. #undef INTERFACE
449. #define INTERFACE IDispatch
450. DECLARE_INTERFACE_(IDispatch,IUnknown)
451. {
452.         STDMETHOD(QueryInterface)(THIS_ REFIID,PVOID*) PURE;
453.         STDMETHOD_(ULONG,AddRef)(THIS) PURE;
454.         STDMETHOD_(ULONG,Release)(THIS) PURE;
455.         STDMETHOD(GetTypeInfoCount)(THIS_ UINT*) PURE;
456.         STDMETHOD(GetTypeInfo)(THIS_ UINT,LCID,LPTYPEINFO*) PURE;
457.         STDMETHOD(GetIDsOfNames)(THIS_ REFIID,LPOLESTR*,UINT,LCID,DISPID*) PURE;
458.         STDMETHOD(Invoke)(THIS_ DISPID,REFIID,LCID,WORD,DISPPARAMS*,VARIANT*,EXCEPINFO*,UINT*) PURE;
459. };
460.  
461. #undef INTERFACE
462. #define INTERFACE IEnumVARIANT
463. DECLARE_INTERFACE_(IEnumVARIANT,IUnknown)
464. {
465.         STDMETHOD(QueryInterface)(THIS_ REFIID,PVOID*) PURE;
466.         STDMETHOD_(ULONG,AddRef)(THIS) PURE;
467.         STDMETHOD_(ULONG,Release)(THIS) PURE;
468.         STDMETHOD(Next)(THIS_ ULONG,VARIANT*,ULONG*) PURE;
469.         STDMETHOD(Skip)(THIS_ ULONG) PURE;
470.         STDMETHOD(Reset)(THIS) PURE;
471.         STDMETHOD(Clone)(THIS_ IEnumVARIANT**) PURE;
472. };
473.  
474. #undef INTERFACE
475. #define INTERFACE ITypeComp
476. DECLARE_INTERFACE_(ITypeComp,IUnknown)
477. {
478.         STDMETHOD(QueryInterface)(THIS_ REFIID,PVOID*) PURE;
479.         STDMETHOD_(ULONG,AddRef)(THIS) PURE;
480.         STDMETHOD_(ULONG,Release)(THIS) PURE;
481.         STDMETHOD(Bind)(THIS_ LPOLESTR,ULONG,WORD,LPTYPEINFO*,DESCKIND*,LPBINDPTR) PURE;
482.         STDMETHOD(BindType)(THIS_ LPOLESTR,ULONG,LPTYPEINFO*,LPTYPECOMP*) PURE;
483. };
484.  
485. #undef INTERFACE
486. #define INTERFACE ITypeInfo
487. DECLARE_INTERFACE_(ITypeInfo,IUnknown)
488. {
489.         STDMETHOD(QueryInterface)(THIS_ REFIID,PVOID*) PURE;
490.         STDMETHOD_(ULONG,AddRef)(THIS) PURE;
491.         STDMETHOD_(ULONG,Release)(THIS) PURE;
492.         STDMETHOD(GetTypeAttr)(THIS_ LPTYPEATTR*) PURE;
493.         STDMETHOD(GetTypeComp)(THIS_ LPTYPECOMP*) PURE;
494.         STDMETHOD(GetFuncDesc)(THIS_ UINT,LPFUNCDESC*) PURE;
495.         STDMETHOD(GetVarDesc)(THIS_ UINT,LPVARDESC*) PURE;
496.         STDMETHOD(GetNames)(THIS_ MEMBERID,BSTR*,UINT,UINT*) PURE;
497.         STDMETHOD(GetRefTypeOfImplType)(THIS_ UINT,HREFTYPE*) PURE;
498.         STDMETHOD(GetImplTypeFlags)(THIS_ UINT,INT*) PURE;
499.         STDMETHOD(GetIDsOfNames)(THIS_ LPOLESTR*,UINT,MEMBERID*) PURE;
500.         STDMETHOD(Invoke)(THIS_ PVOID,MEMBERID,WORD,DISPPARAMS*,VARIANT*,EXCEPINFO*,UINT*) PURE;
501.         STDMETHOD(GetDocumentation)(THIS_ MEMBERID,BSTR*,BSTR*,DWORD*,BSTR*) PURE;
502.         STDMETHOD(GetDllEntry)(THIS_ MEMBERID,INVOKEKIND,BSTR*,BSTR*,WORD*) PURE;
503.         STDMETHOD(GetRefTypeInfo)(THIS_ HREFTYPE,LPTYPEINFO*) PURE;
504.         STDMETHOD(AddressOfMember)(THIS_ MEMBERID,INVOKEKIND,PVOID*) PURE;
505.         STDMETHOD(CreateInstance)(THIS_ LPUNKNOWN,REFIID,PVOID*) PURE;
506.         STDMETHOD(GetMops)(THIS_ MEMBERID,BSTR*) PURE;
507.         STDMETHOD(GetContainingTypeLib)(THIS_ LPTYPELIB*,UINT*) PURE;
508.         STDMETHOD_(void,ReleaseTypeAttr)(THIS_ LPTYPEATTR) PURE;
509.         STDMETHOD_(void,ReleaseFuncDesc)(THIS_ LPFUNCDESC) PURE;
510.         STDMETHOD_(void,ReleaseVarDesc)(THIS_ LPVARDESC) PURE;
511. };
512.  
513. #undef INTERFACE
514. #define INTERFACE ITypeLib
515. DECLARE_INTERFACE_(ITypeLib,IUnknown)
516. {
517.         STDMETHOD(QueryInterface)(THIS_ REFIID,PVOID*) PURE;
518.         STDMETHOD_(ULONG,AddRef)(THIS) PURE;
519.         STDMETHOD_(ULONG,Release)(THIS) PURE;
520.         STDMETHOD_(UINT,GetTypeInfoCount)(THIS) PURE;
521.         STDMETHOD(GetTypeInfo)(THIS_ UINT,ITypeInfo**) PURE;
522.         STDMETHOD(GetTypeInfoType)(THIS_ UINT,TYPEKIND*) PURE;
523.         STDMETHOD(GetTypeInfoOfGuid)(THIS_ REFGUID,ITypeInfo**) PURE;
524.         STDMETHOD(GetLibAttr)(THIS_ TLIBATTR**) PURE;
525.         STDMETHOD(GetTypeComp)(THIS_ ITypeComp*) PURE;
526.         STDMETHOD(GetDocumentation)(THIS_ INT,BSTR*,BSTR*,DWORD*,BSTR*) PURE;
527.         STDMETHOD(IsName)(THIS_ LPOLESTR,ULONG,BOOL*) PURE;
528.         STDMETHOD(FindName)(THIS_ LPOLESTR,ULONG,ITypeInfo**,MEMBERID*,USHORT*) PURE;
529.         STDMETHOD_(void,ReleaseTLibAttr)(THIS_ TLIBATTR*) PURE;
530. };
531.  
532. EXTERN_C const IID IID_IErrorInfo;
533. #undef INTERFACE
534. #define INTERFACE IErrorInfo
535. DECLARE_INTERFACE_(IErrorInfo, IUnknown)
536. {
537.         STDMETHOD(QueryInterface)(THIS_ REFIID,PVOID*) PURE;
538.         STDMETHOD_(ULONG,AddRef)(THIS) PURE;
539.         STDMETHOD_(ULONG,Release)(THIS) PURE;
540.         STDMETHOD(GetGUID)(THIS_ GUID*) PURE;
541.         STDMETHOD(GetSource)(THIS_ BSTR*) PURE;
542.         STDMETHOD(GetDescription)(THIS_ BSTR*) PURE;
543.         STDMETHOD(GetHelpFile)(THIS_ BSTR*) PURE;
544.         STDMETHOD(GetHelpContext)(THIS_ DWORD*) PURE;
545. };
546.  
547. EXTERN_C const IID IID_ICreateErrorInfo;
548. #undef INTERFACE
549. #define INTERFACE ICreateErrorInfo
550. DECLARE_INTERFACE_(ICreateErrorInfo, IUnknown)
551. {
552.         STDMETHOD(QueryInterface)(THIS_ REFIID,PVOID*)PURE;
553.         STDMETHOD_(ULONG,AddRef)(THIS) PURE;
554.         STDMETHOD_(ULONG,Release)(THIS) PURE;
555.         STDMETHOD(SetGUID)(THIS_ REFGUID) PURE;
556.         STDMETHOD(SetSource)(THIS_ LPOLESTR) PURE;
557.         STDMETHOD(SetDescription)(THIS_ LPOLESTR) PURE;
558.         STDMETHOD(SetHelpFile)(THIS_ LPOLESTR) PURE;
559.         STDMETHOD(SetHelpContext)(THIS_ DWORD) PURE;
560. };
561.  
562. EXTERN_C const IID IID_ISupportErrorInfo;
563. #undef INTERFACE
564. #define INTERFACE ISupportErrorInfo
565. DECLARE_INTERFACE_(ISupportErrorInfo, IUnknown)
566. {
567.         STDMETHOD(QueryInterface)(THIS_ REFIID,PVOID*) PURE;
568.         STDMETHOD_(ULONG,AddRef)(THIS) PURE;
569.         STDMETHOD_(ULONG,Release)(THIS) PURE;
570.         STDMETHOD(InterfaceSupportsErrorInfo)(THIS_ REFIID) PURE;
571. };
572.  
573. EXTERN_C const IID IID_IRecordInfo;
574. #undef INTERFACE
575. #define INTERFACE IRecordInfo
576. DECLARE_INTERFACE_(IRecordInfo, IUnknown)
577. {
578.         STDMETHOD(QueryInterface)(THIS_ REFIID,PVOID*) PURE;
579.         STDMETHOD_(ULONG,AddRef)(THIS) PURE;
580.         STDMETHOD_(ULONG,Release)(THIS) PURE;
581.         STDMETHOD(RecordInit)(THIS_ PVOID) PURE;
582.         STDMETHOD(RecordClear)(THIS_ PVOID) PURE;
583.         STDMETHOD(RecordCopy)(THIS_ PVOID, PVOID) PURE;
584.         STDMETHOD(GetGuid)(THIS_ GUID*) PURE;
585.         STDMETHOD(GetName)(THIS_ BSTR*) PURE;
586.         STDMETHOD(GetSize)(THIS_ ULONG*) PURE;
587.         STDMETHOD(GetTypeInfo)(THIS_ ITypeInfo**) PURE;
588.         STDMETHOD(GetField)(THIS_ PVOID,LPCOLESTR,VARIANT*) PURE;
589.         STDMETHOD(GetFieldNoCopy)(THIS_ PVOID,LPCOLESTR,VARIANT*,PVOID*) PURE;
590.         STDMETHOD(PutField )(THIS_ ULONG,PVOID,LPCOLESTR, VARIANT*) PURE;
591.         STDMETHOD(PutFieldNoCopy)(THIS_ ULONG,PVOID,LPCOLESTR,VARIANT*) PURE;
592.         STDMETHOD(GetFieldNames)(THIS_ ULONG*,BSTR*) PURE;
593.         STDMETHOD_(BOOL,IsMatchingType)(THIS_ THIS) PURE;
594.         STDMETHOD_(PVOID,RecordCreate)(THIS) PURE;
595.         STDMETHOD(RecordCreateCopy)(THIS_ PVOID,PVOID*) PURE;
596.         STDMETHOD(RecordDestroy )(THIS_ PVOID) PURE;
597. };
598.  
599. #ifdef __cplusplus
600. }
601. #endif
602. #endif
603.  

Title: Re: COM 64
Post by: JRS on September 09, 2018, 10:00:18 PM

Creating COM Objects with Visual Basic. NET (https://docs.microsoft.com/en-us/dotnet/visual-basic/programming-guide/com-interop/walkthrough-creating-com-objects)

Title: Re: COM 64
Post by: JRS on September 11, 2018, 08:53:44 PM

I thought I would give DLLC COM support a try and see if I could get my VB6 OCX form to show.

Note: the GUID used is the VB6 OCX object I created.

Code: Script BASIC

1. ' Test VB6 OCX Form
2.  
3. DECLARE SUB dllfile ALIAS "dllfile" LIB "DLLC"
4. DECLARE SUB dllguid ALIAS "dllguid" LIB "DLLC"
5. DECLARE SUB dllcall ALIAS "dllcall" LIB "DLLC"
6. DECLARE SUB dllcobj ALIAS "dllcobj" LIB "DLLC"
7. DECLARE SUB dllproc ALIAS "dllproc" LIB "DLLC"
8. DECLARE SUB dllmeth ALIAS "dllmeth" LIB "DLLC"
9.  
10. ole32 = dllfile("ole32.dll")
11.  
12. formobjguid = dllguid("E3F6D544-E159-4B15-99C6-ED7F5A1393BF")
13.  
14. CoInitialize     = dllproc(ole32,"CoInitialize (i)")
15. CoUninitialize   = dllproc(ole32,"CoUninitialize (i)")
16. CoCreateInstance = dllproc(ole32,"CoCreateInstance i=(t*ObjGuid ,i pUnkOuter,i context, t*IspGuid, i*Iface)" )
17.  
18. Context      = 7
19. pUnkOuter    = 0
20. old          = 0
21. Release      = dllmeth( 2,"Release i=()")
22.  
23. hr = 0
24. dllcall(CoInitialize, 0)
25. hr=dllcall(CoCreateInstance, formobjguid, pUnkouter, Context, 0, old)
26.  
27. PRINT "Create Return: ", hr,"\n"
28. PRINT "OLD Form Obj: ", old
29.  
30. dllcobj(old, Release)
31. dllcall(CoUninitialize)
32.  

C:\ScriptBASIC\sbvb\old>scriba o2vb.sb
Create Return: -2147221164
OLD Form Obj: 0
C:\ScriptBASIC\sbvb\old>


Any hints or ideas why I can't create an instance for the OCX with the above code?

Title: Re: COM 64
Post by: Charles Pegge on September 14, 2018, 07:38:11 AM

Hi John,

I have been looking for contemporary references to OCX. This one is from 2002

http://www.thevbzone.com/l_ocx.htm

I think it is long dead.

Title: Re: COM 64
Post by: JRS on September 14, 2018, 10:19:44 AM

I need the CallByName COM/OLE automation interface in O2. VB6 will create the OCX forms I need.

I'm going to try to prototype a CallByName interface with DLLC. My hope is others will chip in and give guidance.

Can O2 use the oaidl.h header file directly or do I need to define parts of it via DLLC?

Dual-Interface Support for OLE Automation Servers (https://msdn.microsoft.com/en-us/library/4h56szat.aspx)

Quote

ActiveX Controls that implement a Dual Interface do not use early binding when
placed on a Visual Basic form. Even if the Dual Interface is marked as the
default interface in the ActiveX Control's .odl file, Visual Basic still uses
the standard IDispatch interface for all automation calls.

STATUS
======

This behavior is by design.

MORE INFORMATION
================

Dual Interface provides an alternative to using the standard IDispatch interface
when making Automation calls. This technique is also referred to as Early
Binding because type checking is performed at compile time. Dual Interfaces are
rapidly becoming popular because they provide increased performance over the
standard IDispatch interface.

It is possible to add Dual Interface support to automation servers as well as
ActiveX Controls. The ACDUAL sample provided with Visual C++ 4.1 demonstrates
the addition of a Dual Interface to the AutoClick automation server. Tech Note
65, referenced in the References section below, outlines the changes you must
make to an automation server to support a Dual Interface. Although ACDUAL and
Tech Note 65 refer to automation servers, the information they provide is also
applicable to ActiveX Controls.

Visual Basic does support early binding for automation servers that support a
Dual Interface, but currently does not support Dual Interface ActiveX Controls.
If you attempt to use the Dual Interface on an ActiveX Control in Visual Basic,
the standard IDispatch interface is used instead. Future versions of Visual
Basic may take advantage of Dual Interface ActiveX Controls, but Visual Basic
4.0 does not.

Would this allow me to use the COM interface calls that exist in DLLC? (direct , non-iDispatch)

Title: Re: COM 64
Post by: Charles Pegge on September 15, 2018, 08:19:47 AM

John,

I don't want to go anywhere near this rabbit-hole. Gaining even the slightest competence in this area would be a dangerous distraction. o2 needs everything I've got.

Title: Re: COM 64
Post by: JRS on September 15, 2018, 08:27:24 AM

Okay.

Too bad José Roca hates O2.  :(

Title: Re: COM 64
Post by: José Roca on September 15, 2018, 09:09:34 AM

I don't hate O2. It is a chemical element that I need to live.

I can't do serius work with O2 without good documentation. I don't know how many times I have to repeat it.

If a CallByName function is so important to you (I don't have any need for it), why you don't write it youself? You already have sample code. Since I think that O2 can call functions thorugh pointers, you won't need the wrapper functions that calls them using CALL DWORD. This will simplify the code somewhat. The only problem is to build the array of variants. Maybe Charles has a macro for it.

Title: Re: COM 64
Post by: JRS on September 15, 2018, 11:57:34 AM

Would you know how to enable an ActiveX control to support dual interfaces? The docs I've read talk about a checkbox for it but I can't find it.

If I can get the OCX defined with a dual interface, the DLLC COM functions should be enough to get it working. The SAPI example Charles did uses the direct approach.

Quote

OLE Automation enables an object to expose a set of methods in two ways: via the IDispatch interface, and through direct OLE VTable binding. IDispatch is used by most tools available today, and offers support for late binding to properties and methods.

VTable binding offers much higher performance because this method is called directly instead of through IDispatch::Invoke. IDispatch offers late bound support, where direct VTable binding offers a significant performance gain; both techniques are valuable and important in different scenarios. By labeling an interface as [dual] in the type library, an OLE Automation interface can be used either via IDispatch, or it can be bound to directly. Containers can thus choose the most appropriate technique. Support for dual interfaces is strongly recommended for both controls and containers.

Title: Re: COM 64
Post by: JRS on September 15, 2018, 10:11:55 PM

Quote

Dual interfaces are very common. The default in an ATL wizard generated COM component is dual interface. Visual Basic 6.0 also creates COM components with dual interfaces.

Can I assume that VB6 creates a dual interface when creating an OCX DLL?

If that is the case, I'm confused why the DLLC code I posted (post #65) failed to create an instance for the Online Dictionary form OCX that works fine with the CallByName method of access.

Quote

To use early binding on an object, you need to know what its v-table looks like. In Visual Basic, you can do this by adding a reference to a type library that describes the object, its interface (v-table), and all the functions that can be called on the object. Once that is done, you can declare an object as being a certain type, then set and use that object using the v-table.

Quote

Early Bound Access to COM
In order for the compiler to have the type information at compile time, the runtime callable wrapper must first be generated by using the type library import utility, "tlbimp." This utility converts a type library to an assembly. The objects and interfaces from the type library are placed into a namespace corresponding to the name specified in the "library" clause (the name of the type library) with "Lib" appended by default. Thus, the default namespace for my type library is PETSLib. The command line parameter /out allows you to override this default. This utility can be used on any DLL, OCX or EXE that has a type library. Following is the execution of tlbimp on Pets.dll:


D:\projects>tlbimp Pets.dll
TlbImp - TypeLib to COM+ Assembly Converter Version 2000.14.1812.10
Copyright (C) Microsoft Corp. 2000.
All rights reserved.

Typelib imported successfully to PETSLib.dll

Title: Re: COM 64
Post by: JRS on September 16, 2018, 05:33:37 PM

An advantage DLLC brings to the table is that it can create O2 virtual exportable functions. This will satisfy the callback needs to O2 from the VB6 created OCX/ActivbeX DLL forms.Calling back to Script BASIC subs/functions is also doable. The only thing I see missing is VARIANT support in the limited form we need to pass standard variables around. DLLC does allow creating/accessing C structures dynamically which may be a way to pass VARIANT arrays to COM.

Title: Re: COM 64
Post by: José Roca on September 16, 2018, 11:44:01 PM

Write a class like I did. You won't need to do much work if you only want it in a limited form.

This one is very extensive:
https://github.com/JoseRoca/WinFBX/blob/master/docs/COM/CVAR%20Class.md

Title: Re: COM 64
Post by: JRS on September 17, 2018, 06:05:38 AM

Thanks José  for the tips.

My first goal is to get the Online Dictionary ActiveX DLL to be viewed as dual interface. Once I can instantiate the forms control using v-table access via DLLC, VARIANT support is next on the list.

Title: Re: COM 64
Post by: JRS on October 31, 2018, 10:37:51 PM

Quote from: Charles@JRS

It's a composite WinApi for VisualBasic 6.0 - the last version of VB. It might be useful for reference, but cumbersome to use as an include file.

What have you been hiding?  ;)

Title: Re: COM 64
Post by: Charles Pegge on November 01, 2018, 12:18:40 AM

I think it's one of yours, John. :)  (2013)

Title: Re: COM 64
Post by: JRS on November 01, 2018, 12:46:12 AM

Where can this file be found? It doesn't seem to be part of the O2 distribution ZIP.

Title: Re: COM 64
Post by: Charles Pegge on November 01, 2018, 01:35:47 AM

I'm posting it here:

https://github.com/Charles-Pegge/OxygenBasic/blob/master/WinApi2004.zip

Title: Re: COM 64
Post by: JRS on November 01, 2018, 02:14:08 AM

Thanks!

I think that was one of my attempts to get VB6 working with DLLC before Dave Zimmer wrote the SB COM extension.