#if 0
Here is an example of how to use low level code with PB Win90 to create an out of process COM server which
can be run as a simple stand alone exe by simply executing it, or it can be connected to through the COM system
in the manner of Excel or Word. The program creates an object named class "CC", and the object exposes two
interfaces, e.g., an IX interface and an IY interface. These interfaces contain the worthless functionality
of allowing an integer and a dynamic string to be 'Get/Set'. While useless in a practical sense, it does show
how to create functionality in an out of process COM server object using low level PowerBASIC code.
If started as a stand alone exe by a user, it presents a visual interface where the IX and IY interfaces of
class CC can be exercised to store/retrieve integers and strings. If started by COM's Service Control Manager
(after being registered by using the /r switch on the program's command line when started from a command prompt),
it won't provide any visual interface, but its COM interfaces will be available in the normal programatic manner (while
it won't provide a GUI if started by COM, it will pop up a console window to show what's going on inside it).
My previous two COM examples ( CA and CB ) didn't have much in the way of instance variables, but this one CC -
does, i.e., the integer and string member variables. The string is especially interesting in that it shows
how PowerBASIC strings must be dealt with low level, i.e., at the level of BSTRs, which are OLE COM length
prefixed null terminated strings. To give you an idea of what I'm speaking of, if it hasn't already dawned on
you, if any of the interface functions must get/set a string, that string must be retained in a member variable
of the class CC - which in low level COM is created through a PowerBASIC Type. And Types can't contain dynamic
variable length strings - only fixed length null terminated asciiz strings. So, to store a BSTR (PowerBASIC
Dynamic String) in a Type one must revert to a more primitive form which would be some form of pointer variable
(I used Dword Ptrs here, but any kind of pointer would work, or even just a Dword. Note that if you needed to
dereference the pointer and get at the actual characters, you would need something that incr/decr in 16 bit
steps as its pointing to a unicode character)....
Type CC 'This is an example of what a class looks like in 'low level' COM
lpIX As IXVtbl Ptr 'pointer to IX VTable
lpIY As IYVtbl Ptr 'pointer to IY VTable
m_iXInt As Long 'member (instance) variable of integral type in IX interface
m_iYInt As Long 'member (instance) variable of integral type in IY interface
m_XText As Dword Ptr 'BSTRs are allocated with the OLE String Engine using functions such as
m_YText As Dword Ptr 'SysReAllocString() or SysAllocStringLen() and a pointer is returned.
m_cRef As Long 'reference counting variables for outstanding interfaces of class
End Type
Check out the GetXText() / SetXText() and GetYText() / SetYText() interface functions and you'll see how that's
done. Setting it up like this creates Strings that act exactly like BASIC Dynamic Strings to clients be they
Visual Basic or PowerBASIC. This nastiness becomes an invisible and hidden implementation detail to clients.
To clients that use dynamic strings - they just look like bona fide strings (that's because they are bona fide
strings).
Another issue I want to touch on is 'marshalling'. Marshalling in COM means the arrangement and movement of
interface function parameters and return values between processes. There are three types of marshalling; custom
marshalling, standard marshalling, and type library or universal marshalling. This program uses the easiest
which is universal or type library marshalling.
When this program, i.e., CC.Exe, is registered by starting it with the /r command line argument, the COM function
LoadTypeLibEx() is called in ExeRegisterServer(), and that function reads the TypeLib embedded in the Exe and
creates Interface keys for the IX and IY interfaces, and a typelib key under HKEY_CLASSES_ROOT. Specifically, it
creates all of the following keys in the registry under HKEY_CLASSES_ROOT:
1) Creates HKEY_CLASSES_ROOT\TypeLib\{20000000-0000-0000-0000-000000000023}\1.0
2) Creates HKEY_CLASSES_ROOT\TypeLib\{20000000-0000-0000-0000-000000000023}\1.0\0\win32=C:\Code\PwrBasic\PBWin90\CC\CC.exe '<Yours will be different!
3) Creates HKEY_CLASSES_ROOT\TypeLib\{20000000-0000-0000-0000-000000000023}\Flags
4) Creates HKEY_CLASSES_ROOT\TypeLib\{20000000-0000-0000-0000-000000000023}\1.0\HelpDir
5) Creates HKEY_CLASSES_ROOT\Interface\$IID_IX
6) Creates HKEY_CLASSES_ROOT\Interface\{20000000-0000-0000-0000-000000000021}\ProxyStubClsid={00020424-0000-0000-C000-000000000046}
7) Creates HKEY_CLASSES_ROOT\Interface\{20000000-0000-0000-0000-000000000021}\ProxyStubClsid32={00020424-0000-0000-C000-000000000046}
8) Creates HKEY_CLASSES_ROOT\Interface\{20000000-0000-0000-0000-000000000021}\TypeLib={20000000-0000-0000-0000-000000000023}
9) Creates HKEY_CLASSES_ROOT\Interface\$IID_IY
10) Creates HKEY_CLASSES_ROOT\Interface\{20000000-0000-0000-0000-000000000022}\ProxyStubClsid={00020424-0000-0000-C000-000000000046}
11) Creates HKEY_CLASSES_ROOT\Interface\{20000000-0000-0000-0000-000000000022}\ProxyStubClsid32={00020424-0000-0000-C000-000000000046}
12) Creates HKEY_CLASSES_ROOT\Interface\{20000000-0000-0000-0000-000000000022}\TypeLib={20000000-0000-0000-0000-000000000023}
This is a good bit of stuff, to be sure. None of this is necessary with in process dll servers, but due to the needs
of inter-process marshalling, it becomes necessary for out of process servers. These keys will be created if the
oleautomation attribute is attached to the interface definitions in the interface definition file ( CC.idl ). Here is
what the CC.idl file looks like...
//CC.idl
import "oaidl.idl";
[object, uuid(20000000-0000-0000-0000-000000000021), oleautomation, helpstring("The IX Interface Functions")] //IX
interface IX : IUnknown
{
HRESULT SetXInt([in] int iXVal);
HRESULT GetXInt([out, retval] int* pInt);
HRESULT SetXText([in] BSTR strText);
HRESULT GetXText([out, retval] BSTR* strText);
};
[object, uuid(20000000-0000-0000-0000-000000000022), oleautomation, helpstring("The IY Interface Functions")] //IY
interface IY : IUnknown
{
HRESULT SetYInt([in] int iYVal);
HRESULT GetYInt([out, retval] int* pInt);
HRESULT SetYText([in] BSTR strText);
HRESULT GetYText([out, retval] BSTR* strText);
};
[uuid(20000000-0000-0000-0000-000000000023), version(1.0), helpstring("Class CC With TypeLib")] //LibId
library CCLibrary
{
importlib("stdole32.tlb");
[uuid(20000000-0000-0000-0000-000000000020)]
coclass CC
{
[default] interface IX;
interface IY;
};
};
//End CC.idl
Note that due to the oleautomation attribute being attached to the interface definitions, the oleaut32.dll or universal
marshaller will be used to marshall method parameters. If you locate...
HKEY_CLASSES_ROOT\{00020424-0000-0000-C000-000000000046}\InProcServer32
in your registry, you'll find its value set to oleaut32.dll, which is where the universal marshaller is located. In practical
terms to use the universal marshaller or Type Library Marshalling in your out of process servers you need to use only variant
compliant data types. This includes the usual assembledge of various types of integers, floating point numbers, and BSTRs
(dynamic basic strings), so its not to hard to live with.
I'll just say a word about standard marshalling. When you use the Microsoft Interface Definition Language Compiler ( MIDL )
to compile a *.idl file into a Type Library, there are a number of additional *.c and *.h files produced as output besides the
*.tlb file containing the Type Library. Some of those other files can be compiled into proxy and stub code to be packaged with
a project, but how to do that is beyond the scope of what I wanted to cover here. To do all that you would need to run a C/C++
compiler, and produce alternate data in the registry than listed above.
I'll try to include the CC.tlb file created by using the MIDL compiler on the above CC.idl file. That way, if you are
interested in compiling and running this example, but don't want to fool around with getting the MIDL compiler installed on
your system, you'll be able to do so. The MIDL compiler is installed by many Microsoft products, including Visual Studio,
most or all of the Express versions of the same, as well as the Windows SDK. So I'll try to provide the exact steps you need
to take to create an out of process server using low level PowerBASIC code. In the command line examples of mine below the
path to my project is...
C:\Code\PwrBasic\PBWin90\CC
So, yours may be different and just use yours instead of mine when you see see the above string.
First, compile the CC.rc file just below into a CC.pbr file using the PowerBASIC Windows compiler...
//CC.rc
1 typelib CC.TLB
//End CC.rc
Next, compile the CC.bas project in your PowerBASIC Windows compiler which includes the CC.inc, Main.inc, and Registry.inc
files. Note that you need to use Jose's includes! After you compile the CC.bas file you'll end up with CC.exe, and you can
run that if you like and see the functionality of the program through the user interface elements. However, at this point
it is running as a stand alone exe and the COM subsystem of Windows knows nothing about it and won't be able to connect
to it as an out of process server. For Windows to know about it it must be registered, and to register it we need/want
to embed the type library for the COM Class CC in the exe file.
Take the CC.idl file listed above or the one included in the zip file and compile it with MIDL like so...
C:\Code\PwrBasic\PBWin90\CC>midl cc.idl
After successfully compiling that there should be a CC.tlb file in your working directory. Next use the PowerBASIC TypeLib
Embedder program PBTyp.exe to embed the type library in the CC.exe file just produced by PowerBASIC Windows...
C:\Code\PwrBasic\PBCC50\CC>PBTyp CC.Exe CC.rc
Here is the output from that on my machine from the PBTyp.exe program in your PowerBASIC installation...
PowerBASIC PBTYP TypeLib Embedder - Rev 1.0
Copyright (c) 2007 PowerBASIC Inc.
Module: CC
Target: CC.EXE
TypeLib: CC.TLB
Resource: CC.RC
That should be it and you are ready to register everything with Windows! At the command prompt window where you have
the CC.exe file execute this at the command line...
C:\Code\PwrBasic\PBWin90\CC>CC.exe /r
On my XP or Win2000 systems I get output like the following (cleaned up a bit) after that step in an AllocConsole()
window...
Entering WinMain()
lpCmdLine = /r
Entering Initialize()
IClassFactory_Vtbl.QueryInterface = 4219397
IClassFactory_Vtbl.AddRef = 4219677
IClassFactory_Vtbl.Release = 4219816
IClassFactory_Vtbl.CreateInstance = 4219963
IClassFactory_Vtbl.LockServer = 4221600
Varptr(CCClassFactory) = 4257784
Varptr(CCClassFactory.lpVtbl) = 4257784
Varptr(IClassFactory_Vtbl) = 4257788
CCClassFactory.lpVtbl = 4257788
Called CCClassFactory_QueryInterface()
Called CCClassFactory_AddRef()!
Leaving CCClassFactory_QueryInterface()
pClsFac = 4257784
Leaving Initialize()
Entering blnCmdLineProcessing()
Calling ExeRegisterServer()
Entering ExeRegisterServer()
szPath = C:\Code\PwrBasic\PBWin90\CC\CC.EXE
LoadTypeLib() Succeeded!
Entering RegisterServer()
szExeName = C:\Code\PwrBasic\PBWin90\CC\CC.EXE
szClsid = {20000000-0000-0000-0000-000000000020}
szLibid = {20000000-0000-0000-0000-000000000023}
szKey = CLSID\{20000000-0000-0000-0000-000000000020}
Leaving ExeRegisterServer()
ExeRegisterServer() Apparently Succeeded!
Leaving blnCmdLineProcessing()
At this point you'll probably want to examine your registry under HKEY_CLASSES_ROOT in terms of CLSID, Program ID,
Interface, and TypeLib keys to see everything I've been discussing to this point. After this post I'll try to
provide various example clients in C, C++, VB6, VB.NET, and PowerBASIC to exercise the local exe server. Finally,
you may find additional information about this project from when I first developed it several months ago at this
link including Console Compiler versions...
http://www.jose.it-berater.org/smfforum/index.php?topic=3666.0
#endif
'Tested With PowerBASIC Windows Compiler 9.04 And Jose Roca's Includes v116
#Compile Exe "CC.Exe" 'C:\Code\PwrBasic\PBWin90\CC\CC.Exe
#Dim All 'This program requires Jose Roca's includes. Jose's includes must
#Register None 'not be intermixed with the PowerBASIC includes obtained with
#Include "Win32Api.inc" 'purchase of the PowerBASIC compiler and installed in the WinApi
#Include "ObjBase.inc" 'directory under the PowerBASIC installation path. Jose's includes
#Include "OAIdl.inc" 'should be saved to an addition empty directory such as WinApiEx or
#Include "Main.inc" 'something like that. Under the Options menu of PowerBASIC you can
#Include "Registry.inc" 'then Set the Include Path to Jose's Includes.
#Include "CC.inc"
#Resource "CC.pbr"
Function fnWndProc_OnCreate(wea As WndEventArgs) As Long 'This function will execute whether this program is
Local pCreateStruct As CREATESTRUCT Ptr 'started by a user in the manner of a standard exe,
Local lpCmdLine As Asciiz Ptr 'or whether it was started by the COM Service Control
Local hCtl,pUnk As Dword 'Manager (SCM). If this program was started by SCM
Local Vtbl As Dword Ptr 'it won't create any visible window (it will create
Local hr As Long 'a non-visible window though).
Prnt " Entering fnWndProc_OnCreate()", 1 'Here we want to check if we were loaded by COM's
pCreateStruct=wea.lParam 'Service Control Manager (SCM). If we were there
wea.hInst=@pCreateStruct.hInstance 'would be a "/Embedding" or "-Embedding" in the
lpCmdLine=@pCreateStruct.lpCreateParams 'lpCmdLine parameter, i.e., its length wouldn't be
Prnt " lpCmdLine = " & Str$(lpCmdLine), 1 'zero. The logic just left and below checks this
Prnt " @lpCmdLine = " & @lpCmdLine, 1 'and if the length of this string is zero then this
Prnt " Len(@lpCmdLine) = " & Str$(Len(@lpCmdLine)), 1 'program is to run as a stand alone Exe and present
If Len(@lpCmdLine)=0 Then
hr=CCClassFactory_CreateInstance(Varptr(CCClassFactory), pUnk, $IID_IX, Varptr(pIX))
Prnt " pIX = " & Str$(pIX), 1
Prnt " @pIX = " & Str$(@pIX), 1 'a user interface to the user. Therefore it creates
Vtbl=@pIX 'buttons, labels, and text boxes, and executes a
Prnt " Vtbl = " & Str$(Vtbl), 1 'ShowWindow() call at bottom within the enclosing If.
If FAILED(hr) Then 'If the program was started by COM, then no
Function=-1 : Exit Function 'ShowWindow() is executed, but the window is non-
End If 'theless created not visible.
Call Dword @Vtbl[0] Using ptrQueryInterface(pIX, $IID_IY, pIY) To hr
If SUCCEEDED(hr) Then
Prnt " pIX->QueryInterface(pIY) Succeeded!", 1 'All these CreateWindowEx() calls below are important if this
Else 'program was started as a stand alone exe by a client (not by
Prnt " pIX->QueryInterface(pIY) Failed!", 1 'COM's SCM), as they will provide user interface elements
End If 'with which the user can interact on the visible main program
Prnt " pIY = " & Str$(pIY), 1 'window.
Prnt " @pIY = " & Str$(@pIY), 1
hCtl=CreateWindowEx(0,"static","The IX Interface",%WS_CHILD Or %WS_VISIBLE,215,5,120,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Set X Int",%WS_CHILD Or %WS_VISIBLE,10,35,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,35,40,22,Wea.hWnd,%EDIT_SET_X_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Set X Int",%WS_CHILD Or %WS_VISIBLE,160,35,75,22,Wea.hWnd,%BTN_SET_X_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Get X Int",%WS_CHILD Or %WS_VISIBLE,280,35,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,380,35,40,22,Wea.hWnd,%EDIT_GET_X_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Get X Int",%WS_CHILD Or %WS_VISIBLE,440,35,75,22,Wea.hWnd,%BTN_GET_X_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Set X Text",%WS_CHILD Or %WS_VISIBLE,10,75,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,75,320,22,Wea.hWnd,%EDIT_SET_X_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Set X Text",%WS_CHILD Or %WS_VISIBLE,440,75,75,22,Wea.hWnd,%BTN_SET_X_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Get X Text",%WS_CHILD Or %WS_VISIBLE,10,115,110,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,115,320,22,Wea.hWnd,%EDIT_GET_X_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Get X Text",%WS_CHILD Or %WS_VISIBLE,440,115,75,22,Wea.hWnd,%BTN_GET_X_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","The IY Interface",%WS_CHILD Or %WS_VISIBLE,215,170,120,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Set Y Int",%WS_CHILD Or %WS_VISIBLE,10,195,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,195,40,22,Wea.hWnd,%EDIT_SET_Y_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Set Y Int",%WS_CHILD Or %WS_VISIBLE,160,195,75,22,Wea.hWnd,%BTN_SET_Y_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Get Y Int",%WS_CHILD Or %WS_VISIBLE,280,195,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,380,195,40,22,Wea.hWnd,%EDIT_GET_Y_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Get Y Int",%WS_CHILD Or %WS_VISIBLE,440,195,75,22,Wea.hWnd,%BTN_GET_Y_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Set Y Text",%WS_CHILD Or %WS_VISIBLE,10,235,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,235,320,22,Wea.hWnd,%EDIT_SET_Y_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Set Y Text",%WS_CHILD Or %WS_VISIBLE,440,235,75,22,Wea.hWnd,%BTN_SET_Y_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Get Y Text",%WS_CHILD Or %WS_VISIBLE,10,265,110,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,265,320,22,Wea.hWnd,%EDIT_GET_Y_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Get Y Text",%WS_CHILD Or %WS_VISIBLE,440,265,75,22,Wea.hWnd,%BTN_GET_Y_TEXT,Wea.hInst,Byval 0)
Call ShowWindow(Wea.hWnd, %SW_SHOWNORMAL)
End If
Prnt " Leaving fnWndProc_OnCreate()", 1
fnWndProc_OnCreate=0
End Function
Function fnWndProc_OnCommand(Wea As WndEventArgs) As Long
Local szBuffer As Asciiz*128
Local strBuffer As String
Local Vtbl As Dword Ptr
Local x,y As Long
Vtbl=@pIX
Select Case As Long Lowrd(Wea.wParam)
Case %BTN_SET_X_INT
Call GetWindowText(GetDlgItem(Wea.hWnd,%EDIT_SET_X_INT),szBuffer,16)
x=Val(szBuffer)
Call Dword @Vtbl[3] Using ptrSetInt(pIX,x)
Case %BTN_GET_X_INT
Call Dword @Vtbl[4] Using ptrGetInt(pIX,x)
szBuffer=Str$(x)
Call SetWindowText(GetDlgItem(Wea.hWnd,%EDIT_GET_X_INT),szBuffer)
Case %BTN_SET_X_TEXT
Call GetWindowText(GetDlgItem(Wea.hWnd,%EDIT_SET_X_TEXT),szBuffer,128)
strBuffer=szBuffer
strBuffer=UCode$(strBuffer)
Call Dword @Vtbl[5] Using ptrSetText(pIX, Byval strBuffer)
Case %BTN_GET_X_TEXT
Call Dword @Vtbl[6] Using ptrGetText(pIX, Byref strBuffer)
strBuffer=ACode$(strBuffer)
Call SetWindowText(GetDlgItem(Wea.hWnd,%EDIT_GET_X_TEXT),Byval Strptr(strBuffer))
Case %BTN_SET_Y_INT
Call GetWindowText(GetDlgItem(Wea.hWnd,%EDIT_SET_Y_INT),szBuffer,16)
y=Val(szBuffer)
Call Dword @Vtbl[3] Using ptrSetInt(pIY,y)
Case %BTN_GET_Y_INT
Call Dword @Vtbl[4] Using ptrGetInt(pIY,y)
szBuffer=Str$(y)
Call SetWindowText(GetDlgItem(Wea.hWnd,%EDIT_GET_Y_INT),szBuffer)
Case %BTN_SET_Y_TEXT
Call GetWindowText(GetDlgItem(Wea.hWnd,%EDIT_SET_Y_TEXT),szBuffer,128)
strBuffer=szBuffer
strBuffer=UCode$(strBuffer)
Call Dword @Vtbl[5] Using ptrSetText(pIY, Byval strBuffer)
Case %BTN_GET_Y_TEXT
Call Dword @Vtbl[6] Using ptrGetText(pIY, Byref strBuffer)
strBuffer=ACode$(strBuffer)
Call SetWindowText(GetDlgItem(Wea.hWnd,%EDIT_GET_Y_TEXT),Byval Strptr(strBuffer))
End Select
fnWndProc_OnCommand=0
End Function
Function fnWndProc_OnPaint(Wea As WndEventArgs) As Long
Local ps As PAINTSTRUCT
Local hDC As Dword
hDC=BeginPaint(Wea.hWnd, ps)
MoveToEx(hDC, 20, 155, Byval 0)
LineTo(hDC, 510, 155)
EndPaint(Wea.hWnd, ps)
fnWndProc_OnPaint=0
End Function
Function fnWndProc_OnClose(Wea As WndEventArgs) As Long
Local Vtbl As Dword Ptr
Local hr As Long
'Control flow can reach this procedure in either
Prnt " Entering fnWndProc_OnClose()", 1 'of two ways. If the program is running as a
Call DestroyWindow(Wea.hWnd) 'stand alone executable execution will occur here
Prnt " pIX = " & Str$(pIX), 1 'when the user clicks the 'x' button in the Window's
Prnt " @pIX = " & Str$(@pIY), 1 'title bar. Alternately, if the program was loaded
Vtbl=@pIX 'by COM, when the client releases its interface
Call DWord @VTbl[2] Using ptrRelease(pIX) To hr 'pointers the reference count held in the g_lLocks
Prnt " pIY = " & Str$(pIY), 1 'global will reach zero in UnLock(), and a WM_CLOSE
Prnt " @pIY = " & Str$(@pIY), 1 'message will be sent to this window, as well as a
Vtbl=@pIY 'PostQuitMessage() to terminate the message queene.
Call DWord @VTbl[2] Using ptrRelease(pIY) To hr
Prnt " Leaving fnWndProc_OnClose()", 1
fnWndProc_OnClose=0
End Function
Function fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
Static wea As WndEventArgs
Register iReturn As Long
Register i As Long
For i=0 To 3
If wMsg=MsgHdlr(i).wMessage Then
wea.hWnd=hWnd: wea.wParam=wParam: wea.lParam=lParam
Call Dword MsgHdlr(i).dwFnPtr Using FnPtr(wea) To iReturn
fnWndProc=iReturn
Exit Function
End If
Next i
fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
End Function
Sub AttachMessageHandlers()
ReDim MsgHdlr(3) As MessageHandler 'Associate Windows Message With Message Handlers
MsgHdlr(0).wMessage=%WM_CREATE : MsgHdlr(0).dwFnPtr=CodePtr(fnWndProc_OnCreate)
MsgHdlr(1).wMessage=%WM_COMMAND : MsgHdlr(1).dwFnPtr=CodePtr(fnWndProc_OnCommand)
MsgHdlr(2).wMessage=%WM_PAINT : MsgHdlr(2).dwFnPtr=CodePtr(fnWndProc_OnPaint)
MsgHdlr(3).wMessage=%WM_CLOSE : MsgHdlr(3).dwFnPtr=CodePtr(fnWndProc_OnClose)
End Sub
Sub Terminate(Byval lpCmdLine As Asciiz Ptr, Byref regID As Dword)
If InStr(@lpCmdLine,"/Embedding") Or InStr(@lpCmdLine,"-Embedding") Then
Call CoRevokeClassObject(regID)
End If
End Sub
Function WinMain(ByVal hInstance As Long, ByVal hPrev As Long, ByVal lpCmdLine As Asciiz Ptr, ByVal iShow As Long) As Long
Local szAppName As Asciiz*8
Local blnFailure As Long
Local wc As WndClassEx
Local regID As Dword
Local Msg As tagMsg
Call AllocConsole() 'Create console for debug output. If this program was started by COM as a result,
Prnt "Entering WinMain()", 1 'for example, of a CoCreateInstance() call or high level call in PowerBASIC such as
Prnt " lpCmdLine = " & @lpCmdLine, 1 'Let pIX = AnyCom "ComObject.CC", then lpCmdLine will point to a string containing
Call Initialize() '-Embedding or /Embedding. In any case, subs Initialize() and AttachEventHandlers()
Call AttachMessageHandlers() 'have to be called. Initialize() creates an IClassFactory1 object which is an imple-
If CmdLineProcessing(hInstance, lpCmdLine, regID, blnFailure) Then
Waitkey() 'mentation of an important COM concept know as a Class Factory. Class Factories are
Function=0 : Exit Function 'something like the 'new' operator in C++ in that they create a specific kind of
End If 'object. See CCClassFactory_CreateInstance() in CC.inc. That is where a CC object
If blnFailure Then 'is created with low level COM code.
MessageBox(%NULL,"CoRegisterClassObject() Failed! This Is Decidedly Bad!","Error Report!",%MB_ICONERROR)
Function=-1 : Exit Function
End If
szAppName="CC.Exe"
wc.cbSize=SizeOf(wc) : wc.style=%CS_HREDRAW Or %CS_VREDRAW
wc.lpfnWndProc=CodePtr(fnWndProc) : wc.cbClsExtra=0
wc.cbWndExtra=0 : wc.hInstance=hInstance
wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION) : wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)
wc.hbrBackground=%COLOR_BTNFACE+1 : wc.lpszMenuName=%NULL
wc.lpszClassName=VarPtr(szAppName)
Call RegisterClassEx(wc)
hMainWnd=CreateWindowEx(0, szAppName, szAppName, %WS_OVERLAPPEDWINDOW, 400, 200, 545, 350, 0, 0, hInstance, ByVal lpCmdLine)
While GetMessage(Msg,%NULL,0,0)
TranslateMessage Msg
DispatchMessage Msg
Wend
Call Terminate(lpCmdLine, regID)
Prnt "Leaving WinMain()", 1
Waitkey()
WinMain=0
End Function
In the way of providing some miscellaneous details, here are a few quick notes.
You only need to register the program one time with the /r switch at the command line. To unregister the component do a /u.
I've only tested the program on Win2000/XP. I don't have Vista or Win 7 yet. Not sure what would be involved there.
Every time you compile the Exe with the PowerBASIC compiler, you need to run PBTyp on it to embed the Type Library, at least if you've unregistered the program and want to re-register it. I've had a lot of problems with forgetting to do that while debugging/experimenting with the registry code. Finally, I put a message box in it that will likely catch those scenerios. If you don't unregister it, its not necessary to keep embedding the type library, as it is only being accessed in the exe that one time when LoadTypeLibEx() is called.
If when you run the program you get an error from Windows stating that it can't locate a function in a dll, its probably because you are using one of the older versions of Jose's includes (pre 116). There was a capitalization issue with LoadTypeLibEx() that Jose fixed in his latest release. You can either fix the capitalazation in the include and recompile, or use Jose's latest includes.
Also, you might note if you look close at my WM_CREATE handler that if the program is started just as a stand alone exe, that is, not through SCM, I didn't bother going through COM to create an instance of CC for internal use within the program, but I just called CCClassFactory_CreateInstance() directly. After all, why go through COM when the functions/objects you need are right within the same program? However, with only a very minor change to the code (2 lines) we can create the object through COM. Here is an alternate fnWndProc_OnCreate() function showing this where I just called CoCreateInstance() for an IX pointer instead of using my class factory directly...
Function fnWndProc_OnCreate(wea As WndEventArgs) As Long 'This function will execute whether this program is
Local pCreateStruct As CREATESTRUCT Ptr 'started by a user in the manner of a standard exe,
Local lpCmdLine As Asciiz Ptr 'or whether it was started by the COM Service Control
Local Vtbl As Dword Ptr 'Manager (SCM). If this program was started by SCM
Local pUnk As IUnknown 'it won't create any visible window (it will create
Local hCtl As Dword 'a non-visible window though).
Local hr As Long
Prnt " Entering fnWndProc_OnCreate()", 1 'Here we want to check if we were loaded by COM's
pCreateStruct=wea.lParam 'Service Control Manager (SCM). If we were there
wea.hInst=@pCreateStruct.hInstance 'would be a "/Embedding" or "-Embedding" in the
lpCmdLine=@pCreateStruct.lpCreateParams 'lpCmdLine parameter, i.e., its length wouldn't be
Prnt " lpCmdLine = " & Str$(lpCmdLine), 1 'zero. The logic just left and below checks this
Prnt " @lpCmdLine = " & @lpCmdLine, 1 'and if the length of this string is zero then this
Prnt " Len(@lpCmdLine) = " & Str$(Len(@lpCmdLine)), 1 'program is to run as a stand alone Exe and present
If Len(@lpCmdLine)=0 Then 'a user interface to the user. Therefore it creates
hr=CoCreateInstance($CLSID_CC,pUnk,%CLSCTX_ALL,$IID_IX,pIX) 'buttons, labels, and text boxes, and executes a
If FAILED(hr) Then 'ShowWindow() call at bottom within the enclosing If.
Function=-1 : Exit Function 'If the program was started by COM, then no
End If 'ShowWindow() is executed, but the window is non-
Vtbl=@pIX 'theless created not visible.
Prnt " Vtbl = " & Str$(Vtbl), 1
Prnt " pIX = " & Str$(pIX), 1
Prnt " @pIX = " & Str$(@pIX), 1
Call Dword @Vtbl[0] Using ptrQueryInterface(pIX, $IID_IY, pIY) To hr
If SUCCEEDED(hr) Then
Prnt " pIX->QueryInterface(pIY) Succeeded!", 1 'All these CreateWindowEx() calls below are important if this
Else 'program was started as a stand alone exe by a client (not by
Prnt " pIX->QueryInterface(pIY) Failed!", 1 'COM's SCM), as they will provide user interface elements
End If 'with which the user can interact on the visible main program
Prnt " pIY = " & Str$(pIY), 1 'window.
Prnt " @pIY = " & Str$(@pIY), 1
hCtl=CreateWindowEx(0,"static","The IX Interface",%WS_CHILD Or %WS_VISIBLE,215,5,120,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Set X Int",%WS_CHILD Or %WS_VISIBLE,10,35,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,35,40,22,Wea.hWnd,%EDIT_SET_X_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Set X Int",%WS_CHILD Or %WS_VISIBLE,160,35,75,22,Wea.hWnd,%BTN_SET_X_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Get X Int",%WS_CHILD Or %WS_VISIBLE,280,35,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,380,35,40,22,Wea.hWnd,%EDIT_GET_X_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Get X Int",%WS_CHILD Or %WS_VISIBLE,440,35,75,22,Wea.hWnd,%BTN_GET_X_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Set X Text",%WS_CHILD Or %WS_VISIBLE,10,75,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,75,320,22,Wea.hWnd,%EDIT_SET_X_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Set X Text",%WS_CHILD Or %WS_VISIBLE,440,75,75,22,Wea.hWnd,%BTN_SET_X_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Get X Text",%WS_CHILD Or %WS_VISIBLE,10,115,110,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,115,320,22,Wea.hWnd,%EDIT_GET_X_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Get X Text",%WS_CHILD Or %WS_VISIBLE,440,115,75,22,Wea.hWnd,%BTN_GET_X_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","The IY Interface",%WS_CHILD Or %WS_VISIBLE,215,170,120,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Set Y Int",%WS_CHILD Or %WS_VISIBLE,10,195,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,195,40,22,Wea.hWnd,%EDIT_SET_Y_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Set Y Int",%WS_CHILD Or %WS_VISIBLE,160,195,75,22,Wea.hWnd,%BTN_SET_Y_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Get Y Int",%WS_CHILD Or %WS_VISIBLE,280,195,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,380,195,40,22,Wea.hWnd,%EDIT_GET_Y_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Get Y Int",%WS_CHILD Or %WS_VISIBLE,440,195,75,22,Wea.hWnd,%BTN_GET_Y_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Set Y Text",%WS_CHILD Or %WS_VISIBLE,10,235,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,235,320,22,Wea.hWnd,%EDIT_SET_Y_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Set Y Text",%WS_CHILD Or %WS_VISIBLE,440,235,75,22,Wea.hWnd,%BTN_SET_Y_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Get Y Text",%WS_CHILD Or %WS_VISIBLE,10,265,110,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,265,320,22,Wea.hWnd,%EDIT_GET_Y_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Get Y Text",%WS_CHILD Or %WS_VISIBLE,440,265,75,22,Wea.hWnd,%BTN_GET_Y_TEXT,Wea.hInst,Byval 0)
Call ShowWindow(Wea.hWnd, %SW_SHOWNORMAL)
End If
Prnt " Leaving fnWndProc_OnCreate()", 1
fnWndProc_OnCreate=0
End Function
Attached is a Visual Basic 6 project that provides a visual interface to the functionality of CC.exe and connects to it. It creates a form very similiar to the one the CC.exe program creates when executed without any command line parameters. It may not work on your system without some tweaking because the project will contain paths to the CC.exe file that won't likely be valid on your system, so the references will have to be changed. Here is another way you could create the project if you are having difficulties. You could just overwrite the frmCC.frm file with the one in my attachment after you have created the VB project prjCC, and that way you wouldn't have to spend an hour and a half creating buttons, textboxes, etc., to work with the object. If you want to try that, follow these steps...
1) Start Visual Basic 6;
2) Choose 'New Standard Exe Project';
3) From the main menu go to...
Project >> References...
...and locate 'Class CC With TypeLib'
in the References dialog box. Check the check box that you want to
include this reference in the project;
4) Name the form that Visual Basic included in the project as frmCC and
name the project prjCC;
5) Close the project and close Visual Basic 6;
6) Overwrite frmCC.frm created and named above with the attached (in zip)
frmCC.frm file. It has buttons, labels, and text boxes already set up
for you on the form.
7) Re-open Visual Basic 6 and the project and you should be able to fill
in text boxes, click buttons, etc, and use the functionality of the
PowerBASIC created local server. When the VB project runs the PowerBASIC
created AllocConsole() window from the server should open up and give you
debug output from calls being made by VB into the CC.exe server.
Here is a PowerBASIC Console Compiler 5.04 Program that connects to CC.exe...
#Compile Exe
#Dim All
$CLSID_CC = GUID$("{20000000-0000-0000-0000-000000000020}")
$IID_IX = GUID$("{20000000-0000-0000-0000-000000000021}")
$IID_IY = GUID$("{20000000-0000-0000-0000-000000000022}")
Interface IX $IID_IX : Inherit IAutomation
Method SetXInt(Byval iXVal As Long)
Method GetXInt() As Long
Method SetXText(Byval strText As String)
Method GetXText() As String
End Interface
Interface IY $IID_IY : Inherit IAutomation
Method SetYInt(Byval iYVal As Long)
Method GetYInt() As Long
Method SetYText(Byval strText As String)
Method GetYText() As String
End Interface
Function PBMain() As Long
Local strXText, strYText As String
Local hr,iXInt,iYInt As Long
Local pIX As IX
Local pIY As IY
pIX=AnyCom("ComObject.CC")
pIX.SetXInt(5)
pIX.SetXText("Here Is A New IX Interface BSTR!")
iXInt=pIX.GetXInt()
strXText=pIX.GetXText()
Print "iXInt = " iXInt
Print "strXText = " strXText
pIY=pIX
Set pIX = Nothing
pIY.SetYInt(10)
pIY.SetYText("Here Is A New IY Interface BSTR!")
iYInt=pIY.GetYInt()
strYText=pIY.GetYText()
Print "iYInt = " iYInt
Print "strYText = " strYText
Set pIY = Nothing
Waitkey$
PBMain=0
End Function
Oh! I forgot to post the other parts to the CC.exe program - includes and such! They are in the zip, but for lurkers, here they are...
'CC.inc - Contains Class CC
Declare Function CoRegisterClassObjectPtr Lib "OLE32.DLL" Alias "CoRegisterClassObject" _
( _
Byref rclsid As Guid, _ 'This is an alternate form of CoRegisterClassObject()
Byval pUnknown As Dword, _ 'as the one in Jose's includes doesn't seem to work
Byval dwClsContext As Dword, _ 'with low level do it yourself COM code such as this
Byval flags As Dword, _ '(at least not with mine!).
ByRef lpdwRegister As Dword _
) As Long
'IClassFactory1 Interface Function Pointers
Declare Function ptrCreateInstance (Byval this As Dword, Byval pUnk As Dword, Byref iid As Guid, Byref ppv As Dword) As Long
Declare Function ptrLockServer (Byval this As Dword, Byval blnLock As Long ) As Long
'IX, IY Interface Function Pointer Prototypes
Declare Function ptrQueryInterface (Byval this As Dword, Byref iid As Guid, Byref pUnknown As Dword ) As Long
Declare Function ptrAddRef (Byval this As Dword ) As Dword
Declare Function ptrRelease (Byval this As Dword ) As Dword
Declare Function ptrSetInt (Byval this As Dword, Byval iVal As Long ) As Long
Declare Function ptrGetInt (Byval this As Dword, Byref pVal As Long ) As Long
Declare Function ptrSetText (Byval this As Dword, Byval strText As String ) As Long
Declare Function ptrGetText (Byval this As Dword, Byref ptrText As String ) As Long
$IID_IClassFactory = Guid$("{00000001-0000-0000-C000-000000000046}")
$IID_IUnknown = Guid$("{00000000-0000-0000-C000-000000000046}")
$CLSID_CC = Guid$("{20000000-0000-0000-0000-000000000020}")
$IID_IX = Guid$("{20000000-0000-0000-0000-000000000021}")
$IID_IY = Guid$("{20000000-0000-0000-0000-000000000022}")
$LIBID_CCLibrary = Guid$("{20000000-0000-0000-0000-000000000023}")
Type IXVtbl 'I've covered the creation of COM objects in my first two tutorials in some detail, so I'll
QueryInterface As Dword Ptr 'just give a quick review here. A COM class contains state data, i.e., instance variables,
AddRef As Dword Ptr 'and VTable pointers, i.e., pointers to interfaces. If you look at Type CC below, that is
Release As Dword Ptr 'a COM class, and it contains two VTable (interface) pointers, and five member variables. Its
SetXInt As Dword Ptr 'size is therefore 28 bytes. The 1st two members are, respectively, pointers to the IX and
GetXInt As Dword Ptr 'IY interfaces, which are contiguous blocks of memory containing pointers to the interface
SetXText As Dword Ptr 'functions. Bytes 8 through 24 in Type CC are the four instance variables on which the IX
GetXText As Dword Ptr 'and IY interface functions work. They simply Get/Set these variables. The last four bytes
End Type 'of CC are a reference counting variable that keeps track of how many outstanding references
Type I_X 'there are on Class CC and its interfaces. Type IXVtbl and Type IYVtbl are UDTs which upon
lpIX As IXVtbl Ptr 'creation provide memory space where pointers to the interface functions will be stored. For
End Type 'example, if you look down in this code file around line 180 you'll see the function SetXInt().
Type IYVtbl 'The address of this function retrieved at runtime by the PowerBASIC CodePtr() function will
QueryInterface As Dword Ptr 'be stored in the SetXInt member of IXVtbl. Likewise for the other IXVtbl functions. Note
AddRef As Dword Ptr 'that every interface has QueryInterface, AddRef, and Release pointers stored as the 1st three
Release As Dword Ptr 'function pointers of the interface. This adds reference counting and interface navigation
SetYInt As Dword Ptr 'functionality to the interfaces. These three members are a part of something termed
GetYInt As Dword Ptr 'IUnknown, and if we were using C++ terminology one would say all COM interfaces inherit from
SetYText As Dword Ptr 'IUnknown, which is just another way of aying that every interface has QueryInterface, AddRef,
GetYText As Dword Ptr 'and Release as its 1st three members.
End Type
Type I_Y
lpIY As IYVtbl Ptr 'For this program to be started by COM it has to be registered 1st. You don't use RegSvr32
End Type 'for that. You must open a command prompt window to whatever directory CC.exe is in. Then
Type CC 'you must execute the program with a /r command line parameter...
lpIX As IXVtbl Ptr
lpIY As IYVtbl Ptr ' C:\Code\PwrBasic\PBWin90\CC>CC.exe /r
m_iXInt As Long '
m_iYInt As Long 'Having done that if the registration was successful you should be able to use the program
m_XText As Dword Ptr 'like any other local exe server from C/C++, vb.net, PowerBASIC, etc.
m_YText As Dword Ptr
m_cRef As Long
End Type
Type IClassFactoryVtbl 'When this program starts up in WinMain(), irregardless of whether it was started with
QueryInterface As Dword Ptr 'a command line argument by COM, a Class Factory will be created in Initialize(). If
AddRef As Dword Ptr '/r or /u was passed in for registration/unregistration, the program will simply perform
Release As Dword Ptr 'an early exit from WinMain() and terminate. If however, a /Embedding or -Embedding
CreateInstance As Dword Ptr 'String was passed in to WinMain(), then the program was started by COM's Service Control
LockServer As Dword Ptr 'Manager, and CoRegisterClassObject() needs to be called to register the Class Factory with
End Type 'COM so that it can create an instance of CC for a client. The critical variable passed...
Type IClassFactory1
lpVtbl As IClassFactoryVtbl Ptr
End Type
Global g_szFriendlyName As Asciiz*64 '...into CoRegisterClassObject() is the address of the CCClassFactory variable of type
Global g_szVerIndProgID As Asciiz*64 'IClassFactory1 just defined above. Note in this app CCClassFactory is just a global
Global g_szProgID As Asciiz*64 'variable.
Global CCClassFactory As IClassFactory1 'sizeof() = 4
Global IClassFactory_Vtbl As IClassFactoryVtbl 'sizeof() = 20
Global IX_Vtbl As IXVtbl 'sizeof() = 28
Global IY_Vtbl As IYVtbl 'sizeof() = 28
Global g_hModule As Dword
Global g_lLocks As Long
Global pIX As Dword Ptr 'When COM gets the address of the class factory object, it can then call the all important
Global pIY As Dword Ptr 'CCClassFactory_CreateInstance() function which will create a CC object, that is, a COM object
Global hMainWnd As Dword 'of class ComObject.CC. Note that the above function allocates memory for a CC object with...
Sub CCLock() '...CoTaskMemAlloc(), attaches the VTbl pointers to the object, and
Prnt " Entering CCLock()", 1 'initializes the state (instance) variables of the object to default values.
Prnt " g_lLocks = " & Str$(g_lLocks), 1
Call InterlockedIncrement(g_lLocks)
Prnt " g_lLocks = " & Str$(g_lLocks), 1
Prnt " Leaving CCLock()", 1
End Sub
Sub CCUnLock() 'Its important to realize what keeps this program running if an early exit
If g_lLocks > 0 Then 'doesn't occur due to the registration/unregistration scenerio. If execution
Prnt "Entering CCUnLock()", 1 'reaches the CreateWindow() call in WinMain(), a main program window will be
Prnt " g_lLocks = " & Str$(g_lLocks), 1 'created and the program will enter a message retrieval loop. If the main
Call InterlockedDecrement(g_lLocks) 'program window receives a click on the [x] to terminate it, Release() calls
Prnt " g_lLocks = " & Str$(g_lLocks), 1 'will be made on the globally allocated IX and IY interface variables, and
If g_lLocks=0 Then 'a DestroyWindow() call and PostQuitMessage() call made on the main window
If hMainWnd Then 'and WinMain()'s message pump. If the program was started by COM and the
Call PostQuitMessage(0) 'main window is invisible, a WM_CLOSE message and PostQuitMessage() will be
Call SendMessage(hMainWnd, %WM_CLOSE, 0, 0) 'SendMessag()'ed from CCUnlock() when g_lLocks reaches 0.
End If
End If
Prnt "Leaving CCUnLock()", 1
End If
End Sub
Function IX_QueryInterface(ByVal this As I_X Ptr, ByRef iid As Guid, ByVal ppv As Dword Ptr) As Long
@ppv=%NULL
Select Case iid
Case $IID_IUnknown
Prnt " Called IX_QueryInterface() For IID_IUnknown And this=" & Str$(this), 1
@ppv=this
Call IX_AddRef(this)
Function=%S_OK
Exit Function
Case $IID_IX
Prnt " Called IX_QueryInterface() For IID_IX And this=" & Str$(this), 1
@ppv=this
Call IX_AddRef(this)
Function=%S_OK
Exit Function
Case $IID_IY
Prnt " Called IX_QueryInterface() For IID_IY And this=" & Str$(this), 1
Incr this
@ppv=this
Call IY_AddRef(this)
Function=%S_OK
Exit Function
Case Else
Prnt "Called IX_QueryInterface()", 1
End Select
Function=%E_NoInterface
End Function
Function IX_AddRef(ByVal this As I_X Ptr) As Long
Local pCC As CC Ptr
Prnt "Called IX_AddRef()", 1
pCC=this
Incr @pCC.m_cRef
IX_AddRef=@pCC.m_cRef
End Function
Function IX_Release(ByVal this As I_X Ptr) As Long
Local pCC As CC Ptr
pCC=this
Decr @pCC.m_cRef
If @pCC.m_cRef=0 Then
Call CoTaskMemFree(this)
Prnt "Called IX_Release() And CC Was Deleted!", 1
Call CCUnLock()
Else
Prnt "Called IX_Release()", 1
End If
Function=@pCC.m_cRef
End Function
Function SetXInt(ByVal this As I_X Ptr, Byval iXVal As Long) As Long
Local pCC As CC Ptr
Prnt "Called SetXInt(" & Trim$(Str$(iXVal)) & ")", 1
pCC=this
@pCC.m_iXInt=iXVal
Function=%S_OK
End Function
Function GetXInt(ByVal this As I_X Ptr, Byref pXVal As Long) As Long
Local pCC As CC Ptr
pCC=this
pXVal=@pCC.m_iXInt
Prnt "Called GetXInt(" & Trim$(Str$(pXVal)) & ")", 1
Function=%S_OK
End Function
Function SetXText(ByVal this As I_X Ptr, Byval strXText As String) As Long
Local pCC As CC Ptr
Prnt "Setting IXText To " & strXText, 1
pCC=this
If SysReAllocString(@pCC.m_XText, Byval Strptr(strXText)) Then
Function=%S_OK
Else
Function=%S_FALSE
End If
End Function
Function GetXText(ByVal this As I_X Ptr, Byref strXText As String) As Long
Local pCC As CC Ptr
pCC=this
If SysReAllocString(strXText, Byval @pCC.m_XText) Then
Function=%S_OK
Else
Function=%S_FALSE
End If
Prnt "IX Text: " & strXText, 1
End Function
Function IY_QueryInterface(ByVal this As I_Y Ptr, ByRef iid As Guid, ByVal ppv As Dword Ptr) As Long
@ppv=%NULL
Select Case iid
Case $IID_IUnknown
Prnt "Called IY_QueryInterface() For IID_IUnknown", 1
Decr this
@ppv=this
Call IX_AddRef(this)
Function=%S_OK
Exit Function
Case $IID_IX
Prnt "Called IY_QueryInterface() For IID_IX", 1
Decr this
@ppv=this
Call IX_AddRef(this)
Function=%S_OK
Exit Function
Case $IID_IY
Prnt "Called IY_QueryInterface() For IID_IY", 1
@ppv=this
Call IY_AddRef(this)
Function=%S_OK
Exit Function
Case Else
Prnt "Called IY_QueryInterface()", 1
End Select
Function=%E_NoInterface
End Function
Function IY_AddRef(ByVal this As I_Y Ptr) As Long
Local pCC As CC Ptr
Prnt "Called IY_AddRef() - this = " & Str$(this), 1
Decr this
pCC=this
Incr @pCC.m_cRef
IY_AddRef=@pCC.m_cRef
End Function
Function IY_Release(ByVal this As I_Y Ptr) As Long
Local pCC As CC Ptr
Decr this
pCC=this
Decr @pCC.m_cRef
If @pCC.m_cRef=0 Then
Call CoTaskMemFree(this)
Prnt "Called IY_Release() And CC Was Deleted!", 1
Call CCUnLock()
Else
Prnt "Called IY_Release()", 1
End If
Function=@pCC.m_cRef
End Function
Function SetYInt(ByVal this As I_Y Ptr, Byval iYVal As Long) As Long
Local pCC As CC Ptr
Prnt "Called SetYInt(" & Trim$(Str$(iYVal)) & ")", 1
Decr this
pCC=this
@pCC.m_iYInt=iYVal
Function=%S_OK
End Function
Function GetYInt(ByVal this As I_Y Ptr, Byref pYVal As Long) As Long
Local pCC As CC Ptr
Decr this
pCC=this
pYVal=@pCC.m_iYInt
Prnt "Called GetXInt(" & Trim$(Str$(pYVal)) & ")", 1
Function=%S_OK
End Function
Function SetYText(ByVal this As I_Y Ptr, Byval strYText As String) Export As Long
Local pCC As CC Ptr
Prnt "Setting IYText To " & strYText, 1
Decr this
pCC=this
If SysReAllocString(@pCC.m_YText, Byval Strptr(strYText)) Then
Function=%S_OK
Else
Function=%S_FALSE
End If
End Function
Function GetYText(ByVal this As I_Y Ptr, Byref strYText As String) Export As Long
Local pCC As CC Ptr
Decr this
pCC=this
If SysReAllocString(strYText, Byval @pCC.m_YText) Then
Function=%S_OK
Else
Function=%S_FALSE
End If
Prnt "IY Text: " & strYText, 1
End Function
Function CCClassFactory_QueryInterface(ByVal this As IClassFactory1 Ptr, ByRef RefIID As Guid, ByVal pCF As Dword Ptr) As Long
Prnt "Called CCClassFactory_QueryInterface()", 1
If RefIID=$IID_IUnknown Or RefIID=$IID_IClassFactory Then
Call CCClassFactory_AddRef(this)
@pCF=this
Prnt " Leaving CCClassFactory_QueryInterface()", 1
Function=%NOERROR
Exit Function
End If
Function=%E_NoInterface
End Function
Function CCClassFactory_AddRef(ByVal this As IClassFactory1 Ptr) As Long
Prnt "Called CCClassFactory_AddRef()!", 1
'Print " Leaving CCClassFactory_AddRef()!"
CCClassFactory_AddRef=10
End Function
Function CCClassFactory_Release(ByVal this As IClassFactory1 Ptr) As Long
Prnt "Called CCClassFactory_Release()!", 1
'Print " this=" this
'Print " Leaving CCClassFactory_Release()!"
CCClassFactory_Release=20
End Function
Function CCClassFactory_CreateInstance(ByVal this As IClassFactory1 Ptr, ByVal pUnknown As Dword, ByRef RefIID As Guid, ByVal ppv As Dword Ptr) As Long
Local strIXStr, strIYStr As String
Local pIX As I_X Ptr
Local pCC As CC Ptr
Local hr As Long
Prnt "Called CCClassFactory_CreateInstance()", 1
@ppv=%NULL
If pUnknown Then
hr=%CLASS_E_NOAGGREGATION
Exit Function
Else
If RefIID=$IID_IUnknown Or RefIID=$IID_IX Or RefIID=$IID_IY Then
pCC=CoTaskMemAlloc(SizeOf(CC))
If pCC Then
Prnt " pCC =" & Str$(pCC), 1
@pCC.lpIX=VarPtr(IX_Vtbl)
@pCC.lpIY=VarPtr(IY_Vtbl)
Prnt " @pCC.lpIX=" & Str$(@pCC.lpIX), 1
Prnt " @pCC.lpIY=" & Str$(@pCC.lpIY), 1
Prnt "", 1
Prnt " " & Str$(Varptr(@pCC.lpIX)) & " ", 0 : Prnt Str$(@pCC.lpIX), 1
Prnt " " & Str$(Varptr(@pCC.lpIY)) & " ", 0 : Prnt Str$(@pCC.lpIY), 1
Prnt "",1
strIXStr="Default IX Interface String"
strIYStr="Default IY Interface String"
strIXStr=UCode$(strIXStr)
strIYStr=UCode$(strIYStr)
@pCC.m_XText=SysAllocStringLen(Byval Strptr(strIXStr),Len(strIXStr)+1)
@pCC.m_YText=SysAllocStringLen(Byval Strptr(strIYStr),Len(strIYStr)+1)
@pCC.m_iXInt=0 : @pCC.m_iYInt=0 : @pCC.m_cRef=0
pIX=pCC
hr= IX_QueryInterface(pIX,RefIID,ppv)
Prnt " pCC = " & Str$(pCC), 1
Prnt " pIX = " & Str$(pIX), 1
Prnt " @ppv = " & Str$(@ppv), 1
If SUCCEEDED(hr) Then
Call CCClassFactory_AddRef(this)
Call CCLock()
Else
Call CoTaskMemFree(pCC)
CCClassFactory_CreateInstance=%E_FAIL
Prnt "", 1 : Prnt "CreateInstance Failed!", 1
Exit Function
End If
Else
hr=%E_OutOfMemory
Exit Function
End If
Else
hr=%E_FAIL
Exit Function
End If
End If
Prnt "Leaving CBClassFactory_CreateInstance()", 1
CCClassFactory_CreateInstance=%S_Ok
End Function
Function CCClassFactory_LockServer(ByVal this As IClassFactory1 Ptr, Byval flock As Long) As Long
Prnt "Called CCClassFactory_LockServer()", 1
If flock Then
Call CCLock()
Else
Call CCUnLock()
End If
CCClassFactory_LockServer=%NOERROR
End Function
Function ExeRegisterServer(hInstance As Long) As Long
Local strAsciPath,strWideCharPath As String
Local hr,iBytesReturned As Long
Local szPath As Asciiz*256
Local pTypeLib As ITypeLib
Local strPath As String
Prnt " Entering ExeRegisterServer()", 1
If GetModuleFileName(hInstance, szPath, 256) Then
strPath=szPath
Prnt " szPath = " & strPath, 1
strAsciPath=szPath
strWideCharPath=UCode$(strAsciPath & $Nul)
hr=LoadTypeLibEx(Strptr(strWideCharPath), %REGKIND_REGISTER, pTypeLib)
If SUCCEEDED(hr) Then
Prnt " LoadTypeLib() Succeeded!", 1
Set pTypeLib = Nothing
hr=RegisterServer(szPath, $CLSID_CC, $LIBID_CCLibrary, g_szFriendlyName, g_szVerIndProgID, g_szProgID)
Else
Local dwFlags As Dword
Local szError As Asciiz*256
Local strError As String
Prnt " LoadTypeLib() Failed!", 1
iBytesReturned= _
FormatMessage _
( _
dwFlags, _
Byval 0, _
hr, _
MAKELANGID(%LANG_NEUTRAL, %SUBLANG_DEFAULT), _
Byval Varptr(szError), _
256, _
Byval %NULL _
)
If iBytesReturned=0 Then
iBytesReturned=MsgBox("...And That Is To Use PBTyp.exe To Embed The Type Library In The Exe!", %MB_ICONWARNING, "I Know What You Forgot...")
End If
strError=szError
Prnt " iBytesReturned = " & Str$(iBytesReturned), 1
Prnt "szBuffer = " & strError, 1
End If
End If
Prnt " Leaving ExeRegisterServer()", 1
Function=hr
End Function
Function ExeUnRegisterServer(hInstance As Long) As Long
Local hr As Long
Prnt " Entering ExeUnregisterServer()", 1
hr=UnRegisterTypeLib($LIBID_CCLibrary, 1, 0, %LANG_NEUTRAL, %SYS_WIN32)
If SUCCEEDED(hr) Then
Prnt " UnRegisterTypeLib() Succeeded!", 1
hr=UnregisterServer($CLSID_CC, g_szVerIndProgID, g_szProgID)
Else
Prnt " UnRegisterTypeLib() Failed!", 1
End If
Prnt " Leaving ExeUnregisterServer()", 1
Function=hr
End Function
Function CmdLineProcessing _
( _
Byval hInstance As Long, _
Byval lpCmdLine As Asciiz Ptr, _
Byref regID As Dword, _
Byref blnFailure As Long _
) As Long
Local hr As Long
Prnt "Entering blnCmdLineProcessing()", 1
If InStr(@lpCmdLine,"/r") Then
Prnt " Calling ExeRegisterServer()", 1
hr=ExeRegisterServer(hInstance)
If SUCCEEDED(hr) Then
Prnt " ExeRegisterServer() Apparently Succeeded!", 1
Else
Prnt " ExeRegisterServer() Apparently Failed!", 1
End If
Prnt "Leaving blnCmdLineProcessing()", 1
Prnt "", 1
Function=%TRUE
Exit Function
End If
If InStr(@lpCmdLine,"/u") Then
Prnt " Calling ExeUnregisterServer()", 1
hr=ExeUnregisterServer(hInstance)
If SUCCEEDED(hr) Then
Prnt " ExeUnregisterServer Apparently Succeeded!", 1
Else
Prnt " ExeUnregisterServer Apparently Failed!", 1
End If
Prnt "Leaving blnCmdLineProcessing()", 1
Prnt "", 1
Function=%TRUE
Exit Function
End If
If InStr(@lpCmdLine,"/Embedding") Or InStr(@lpCmdLine,"-Embedding") Then
Prnt " Was Loaded By COM!", 1
hr=CoRegisterClassObjectPtr($CLSID_CC, Varptr(CCClassFactory), %CLSCTX_LOCAL_SERVER, %REGCLS_MULTIPLEUSE, regID)
If SUCCEEDED(hr) Then
Prnt " CoRegisterClassObject() Succeeded!", 1
Else
Prnt "CoRegisterClassObject() Failed!", 1
blnFailure=%TRUE
Local dwFlags As Dword
Local szError As Asciiz*256
Local strError As String
dwFlags=%FORMAT_MESSAGE_FROM_SYSTEM
FormatMessage(dwFlags, Byval 0, hr, MAKELANGID(%LANG_NEUTRAL, %SUBLANG_DEFAULT), Byval Varptr(szError), 256, Byval %NULL)
strError=szError
Prnt "strBuffer = " & strError, 1
End If
End If
Prnt "Leaving blnCmdLineProcessing()", 1
Prnt "", 1
Function=%FALSE
End Function
Function Initialize() As Long
Local pClsFac As Dword Ptr
Local hr As Long
Prnt "Entering Initialize()", 1
g_szFriendlyName = "Com Object CC"
g_szProgID = "ComObject.CC.1"
g_szVerIndProgID = "ComObject.CC"
IClassFactory_Vtbl.QueryInterface = CodePtr(CCClassFactory_QueryInterface)
IClassFactory_Vtbl.AddRef = CodePtr(CCClassFactory_AddRef)
IClassFactory_Vtbl.Release = CodePtr(CCClassFactory_Release)
IClassFactory_Vtbl.CreateInstance = CodePtr(CCClassFactory_CreateInstance)
IClassFactory_Vtbl.LockServer = CodePtr(CCClassFactory_LockServer)
CCClassFactory.lpVtbl = VarPtr(IClassFactory_Vtbl)
Prnt " IClassFactory_Vtbl.QueryInterface = " & Str$(IClassFactory_Vtbl.QueryInterface), 1
Prnt " IClassFactory_Vtbl.AddRef = " & Str$(IClassFactory_Vtbl.AddRef), 1
Prnt " IClassFactory_Vtbl.Release = " & Str$(IClassFactory_Vtbl.Release), 1
Prnt " IClassFactory_Vtbl.CreateInstance = " & Str$(IClassFactory_Vtbl.CreateInstance), 1
Prnt " IClassFactory_Vtbl.LockServer = " & Str$(IClassFactory_Vtbl.LockServer), 1
Prnt "", 1
Prnt " Varptr(CCClassFactory) = " & Str$(Varptr(CCClassFactory)), 1
Prnt " Varptr(CCClassFactory.lpVtbl) = " & Str$(Varptr(CCClassFactory.lpVtbl)), 1
Prnt " Varptr(IClassFactory_Vtbl) = " & Str$(Varptr(IClassFactory_Vtbl)), 1
Prnt " CCClassFactory.lpVtbl = " & Str$(CCClassFactory.lpVtbl), 1
IX_Vtbl.QueryInterface = CodePtr(IX_QueryInterface)
IX_Vtbl.AddRef = CodePtr(IX_AddRef)
IX_Vtbl.Release = CodePtr(IX_Release)
IX_Vtbl.SetXInt = CodePtr(SetXInt)
IX_Vtbl.GetXInt = CodePtr(GetXInt)
IX_Vtbl.SetXText = CodePtr(SetXText)
IX_Vtbl.GetXText = CodePtr(GetXText)
IY_Vtbl.QueryInterface = CodePtr(IY_QueryInterface)
IY_Vtbl.AddRef = CodePtr(IY_AddRef)
IY_Vtbl.Release = CodePtr(IY_Release)
IY_Vtbl.SetYInt = CodePtr(SetYInt)
IY_Vtbl.GetYInt = CodePtr(GetYInt)
IY_Vtbl.SetYText = CodePtr(SetYText)
IY_Vtbl.GetYText = CodePtr(GetYText)
hr=CCClassFactory_QueryInterface(VarPtr(CCClassFactory), $IID_IClassFactory, Varptr(pClsFac))
If FAILED(hr) Then
CCClassFactory.lpVTbl=0
hr=%CLASS_E_CLASSNOTAVAILABLE
Exit Function
Else
Prnt " pClsFac = " & Str$(pClsFac), 1
End If
Prnt "Leaving Initialize()", 1 : Prnt "", 1
Function=hr
End Function
Here are Main.inc, Registry.inc, CC.idl, and CC.rc
'Main.inc
%EDIT_SET_X_INT = 1500
%BTN_SET_X_INT = 1505
%EDIT_GET_X_INT = 1510
%BTN_GET_X_INT = 1515
%EDIT_SET_X_TEXT = 1520
%BTN_SET_X_TEXT = 1525
%EDIT_GET_X_TEXT = 1530
%BTN_GET_X_TEXT = 1535
%EDIT_SET_Y_INT = 1540
%BTN_SET_Y_INT = 1545
%EDIT_GET_Y_INT = 1550
%BTN_GET_Y_INT = 1555
%EDIT_SET_Y_TEXT = 1560
%BTN_SET_Y_TEXT = 1565
%EDIT_GET_Y_TEXT = 1570
%BTN_GET_Y_TEXT = 1575
Type WndEventArgs
wParam As Long
lParam As Long
hWnd As Dword
hInst As Dword
End Type
Type MessageHandler
wMessage As Long
dwFnPtr As Dword
End Type
Declare Function FnPtr(wea As WndEventArgs) As Long
Global MsgHdlr() As MessageHandler
Sub Cls(hStdOut As Dword)
Local csbi As CONSOLE_SCREEN_BUFFER_INFO
Local dwConsoleSize As Dword
Local dwWritten As Dword
Local cdXY As COORD
Call GetConsoleScreenBufferInfo(hStdOut,csbi)
dwConsoleSize=csbi.dwSize.X * csbi.dwSize.Y
Call FillConsoleOutputCharacter(hStdOut,32,dwConsoleSize,cdXY,dwWritten)
Call GetConsoleScreenBufferInfo(hStdOut,csbi)
Call FillConsoleOutputAttribute(hStdOut,csbi.wAttributes,dwConsoleSize,cdXY,dwWritten)
Call SetConsoleCursorPosition(hStdOut,cdXY)
End Sub
Sub Locate(hStdOutput As Dword, x As Integer, y As Integer)
Local cdXY As COORD
cdXY.x=x : cdXY.y=y
Call SetConsoleCursorPosition(hStdOutput,cdXY)
End Sub
Sub Waitkey()
Local dwInputEvents As Dword
Local blnContinue As Long
Local hStdInput As Dword
Local ir As INPUT_RECORD
hStdInput=GetStdHandle(%STD_INPUT_HANDLE)
FlushConsoleInputBuffer(hStdInput)
blnContinue=%TRUE
Do While blnContinue=%TRUE
Call ReadConsoleInput(hStdInput,ir,1,dwInputEvents)
If ir.EventType=%KEY_EVENT Then
blnContinue=%FALSE
End If
Loop
End Sub
Sub Prnt(strLn As String, blnCrLf As Long)
Local iLen, iWritten As Long
Local hStdOutput As Dword
Local strNew As String
hStdOutput=GetStdHandle(%STD_OUTPUT_HANDLE)
If blnCrLf Then
strNew=strLn + $CrLf
End If
iLen = Len(strNew)
WriteConsole(hStdOutput, Byval Strptr(strNew), iLen, iWritten, Byval 0)
End Sub
'Registry.inc
Function SetKeyAndValue(Byref szKey As Asciiz, Byref szSubKey As Asciiz, Byref szValue As Asciiz) As Long
Local szKeyBuf As Asciiz*1024
Local lResult As Long
Local hKey As Dword
If szKey<>"" Then
szKeyBuf=szKey
If szSubKey<>"" Then
szKeyBuf=szKeyBuf+"\"+szSubKey
End If
lResult=RegCreateKeyEx(%HKEY_CLASSES_ROOT,szKeyBuf,0,Byval %NULL,%REG_OPTION_NON_VOLATILE,%KEY_ALL_ACCESS,Byval %NULL,hKey,%NULL)
If lResult<>%ERROR_SUCCESS Then
Function=%FALSE
Exit Function
End If
If szValue<>"" Then
Call RegSetValueEx(hKey,Byval %NULL, Byval 0, %REG_SZ, szValue, Len(szValue)+1)
End If
Call RegCloseKey(hKey)
Else
Function=%FALSE
Exit Function
End If
Function=%TRUE
End Function
Function RecursiveDeleteKey(Byval hKeyParent As Dword, Byref lpszKeyChild As Asciiz) As Long
Local dwSize,hKeyChild As Dword
Local szBuffer As Asciiz*256
Local time As FILETIME
Local lRes As Long
dwSize=256
lRes=RegOpenKeyEx(hKeyParent,lpszKeyChild,0,%KEY_ALL_ACCESS,hKeyChild)
If lRes<>%ERROR_SUCCESS Then
Function=lRes
Exit Function
End If
While(RegEnumKeyEx(hKeyChild,0,szBuffer,dwSize,0,Byval 0,Byval 0,time)=%S_OK)
lRes=RecursiveDeleteKey(hKeyChild,szBuffer) 'Delete the decendents of this child.
If lRes<>%ERROR_SUCCESS Then
Call RegCloseKey(hKeyChild)
Function=lRes
Exit Function
End If
dwSize=256
Loop
Call RegCloseKey(hKeyChild)
Function=RegDeleteKey(hKeyParent,lpszKeyChild) 'Delete this child.
End Function
Function RegisterServer(Byref szExeName As Asciiz, Byref ClassId As Guid, Byref LibId As Guid, Byref szFriendlyName As Asciiz, Byref szVerIndProgID As Asciiz, Byref szProgID As Asciiz) As Long
Local szClsid As Asciiz*48, szLibid As Asciiz*48, szKey As Asciiz*64
Local hStdOut As Dword
Local iReturn As Long
hStdOut=GetStdHandle(%STD_OUTPUT_HANDLE)
Prnt " Entering RegisterServer()", 1
Prnt " szExeName = " & szExeName, 1
szClsid=GuidTxt$(ClassId)
szLibid=GuidTxt$(LibId)
If szClsid <> "" And szLibid <> "" Then
Prnt " szClsid = " & szClsid, 1
Prnt " szLibid = " & szLibid, 1
szKey="CLSID\" & szClsid
Prnt " szKey = " & szKey, 1
If IsFalse(SetKeyAndValue(szKey, Byval %NULL, szFriendlyName)) Then
Function=%E_FAIL : Exit Function
End If
If IsFalse(SetKeyAndValue(szKey, "LocalServer32", szExeName)) Then
Function=%E_FAIL : Exit Function
End If
If IsFalse(SetKeyAndValue(szKey, "ProgID", szProgID)) Then
Function=%E_FAIL : Exit Function
End If
If IsFalse(SetKeyAndValue(szKey, "VersionIndependentProgID", szVerIndProgID)) Then
Function=%E_FAIL : Exit Function
End If
If IsFalse(SetKeyAndValue(szKey, "TypeLib", szLibid)) Then
Function=%E_FAIL : Exit Function
End If
If IsFalse(SetKeyAndValue(szVerIndProgID,Byval %NULL, szFriendlyName)) Then
Function=%E_FAIL : Exit Function
End If
If IsFalse(SetKeyAndValue(szVerIndProgID, "CLSID", szClsid)) Then
Function=%E_FAIL : Exit Function
End If
If IsFalse(SetKeyAndValue(szVerIndProgID, "CurVer", szProgID)) Then
Function=%E_FAIL : Exit Function
End If
If IsFalse(SetKeyAndValue(szProgID, Byval %NULL, "A COM Object Of Class C")) Then
Function=%E_FAIL : Exit Function
End If
If IsFalse(SetKeyAndValue(szProgID, "CLSID", szClsid)) Then
Function=%E_FAIL : Exit Function
End If
Function=%S_OK
Exit Function
Else
Function=%E_FAIL
Exit Function
End If
Prnt " Leaving RegisterServer()", 1
End Function
Function UnregisterServer(Byref ClassId As Guid, Byref szVerIndProgID As Asciiz, Byref szProgID As Asciiz) As Long
Local szClsid As Asciiz*48, szKey As Asciiz*64
Local lResult As Long
szClsid=GuidTxt$(ClassId)
If szClsid<>"" Then
szKey="CLSID\"+szClsid
lResult=RecursiveDeleteKey(%HKEY_CLASSES_ROOT,szKey)
If lResult<>%ERROR_SUCCESS Then
Function=%E_FAIL
Exit Function
End If
lResult=RecursiveDeleteKey(%HKEY_CLASSES_ROOT, szVerIndProgID) 'Delete the version-independent ProgID Key.
If lResult<>%ERROR_SUCCESS Then
Function=%E_FAIL
Exit Function
End If
lResult=recursiveDeleteKey(%HKEY_CLASSES_ROOT, szProgID) 'Delete the ProgID key.
If lResult<>%ERROR_SUCCESS Then
Function=%E_FAIL
Exit Function
End If
Else
Function=%E_FAIL
Exit Function
End If
Function=%S_OK
End Function
'CC.idl
import "oaidl.idl";
[object, uuid(20000000-0000-0000-0000-000000000021), oleautomation, helpstring("The IX Interface Functions")] //IX
interface IX : IUnknown
{
HRESULT SetXInt([in] int iXVal);
HRESULT GetXInt([out, retval] int* pInt);
HRESULT SetXText([in] BSTR strText);
HRESULT GetXText([out, retval] BSTR* strText);
};
[object, uuid(20000000-0000-0000-0000-000000000022), oleautomation, helpstring("The IY Interface Functions")] //IY
interface IY : IUnknown
{
HRESULT SetYInt([in] int iYVal);
HRESULT GetYInt([out, retval] int* pInt);
HRESULT SetYText([in] BSTR strText);
HRESULT GetYText([out, retval] BSTR* strText);
};
[uuid(20000000-0000-0000-0000-000000000023), version(1.0), helpstring("Class CC With TypeLib")]
library CCLibrary
{
importlib("stdole32.tlb");
[uuid(20000000-0000-0000-0000-000000000020)]
coclass CC
{
[default] interface IX;
interface IY;
};
};
//CC.rc
1 typelib CC.TLB
//end cc.rc
I'll post a VB.NET, C, and C++ client later when I have time.
This would be a C client...
#include <Windows.h>
#include <stdio.h>
const CLSID CLSID_CC = {0x20000000,0x0000,0x0000,{0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x20}};
const IID IID_IX = {0x20000000,0x0000,0x0000,{0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x21}};
const IID IID_IY = {0x20000000,0x0000,0x0000,{0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x22}};
typedef struct IXVtbl IXVtbl;
typedef struct IYVtbl IYVtbl;
typedef interface IX
{
const IXVtbl* lpVtbl;
}IX;
typedef interface IY
{
const IYVtbl* lpVtbl;
}IY;
struct IXVtbl
{
HRESULT (__stdcall* QueryInterface) (IX*, const IID*, void**);
ULONG (__stdcall* AddRef) (IX* );
ULONG (__stdcall* Release) (IX* );
HRESULT (__stdcall* SetXInt) (IX*, int );
HRESULT (__stdcall* GetXInt) (IX*, int* );
HRESULT (__stdcall* SetXText) (IX*, BSTR );
HRESULT (__stdcall* GetXText) (IX*, BSTR* );
};
struct IYVtbl
{
HRESULT (__stdcall* QueryInterface) (IY*, const IID*, void**);
ULONG (__stdcall* AddRef) (IY* );
ULONG (__stdcall* Release) (IY* );
HRESULT (__stdcall* SetYInt) (IY*, int );
HRESULT (__stdcall* GetYInt) (IY*, int* );
HRESULT (__stdcall* SetYText) (IY*, BSTR );
HRESULT (__stdcall* GetYText) (IY*, BSTR* );
};
int main(void)
{
BSTR strData;
IX* pIX=NULL;
IY* pIY=NULL;
int x=0,y=0;
HRESULT hr;
hr=CoInitialize(NULL);
if(SUCCEEDED(hr))
{
puts("CoInitialize() Succeeded!");
hr=CoCreateInstance(&CLSID_CC,NULL,CLSCTX_LOCAL_SERVER,&IID_IX,&pIX);
if(SUCCEEDED(hr))
{
//Working With IX Interface
pIX->lpVtbl->SetXInt(pIX,25);
pIX->lpVtbl->GetXInt(pIX,&x);
printf("x=%d\n",x);
strData=SysAllocString(L"");
pIX->lpVtbl->GetXText(pIX,&strData);
wprintf(L"strData = %s\n",strData);
SysReAllocString(&strData,L"New IX Interface BSTR");
pIX->lpVtbl->SetXText(pIX,strData);
pIX->lpVtbl->GetXText(pIX,&strData);
wprintf(L"strData = %s\n",strData);
//Now IY Interface
hr=pIX->lpVtbl->QueryInterface(pIX,&IID_IY,&pIY);
if(SUCCEEDED(hr))
{
pIY->lpVtbl->SetYInt(pIY,50);
pIY->lpVtbl->GetYInt(pIY,&y);
printf("y=%d\n",y);
pIY->lpVtbl->GetYText(pIY,&strData);
wprintf(L"strData = %s\n",strData);
SysReAllocString(&strData,L"New IY Interface BSTR");
pIY->lpVtbl->SetYText(pIY,strData);
pIY->lpVtbl->GetYText(pIY,&strData);
wprintf(L"strData = %s\n",strData);
pIY->lpVtbl->Release(pIY);
}
SysFreeString(strData);
pIX->lpVtbl->Release(pIX);
}
CoUninitialize();
}
getchar();
return 0;
}
...and a C++ version that's about the same...
#include <Windows.h>
#include <stdio.h>
const CLSID CLSID_CC = {0x20000000,0x0000,0x0000,{0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x20}};
const IID IID_IX = {0x20000000,0x0000,0x0000,{0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x21}};
const IID IID_IY = {0x20000000,0x0000,0x0000,{0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x22}};
interface IX : IUnknown
{
virtual HRESULT __stdcall SetXInt ( int iXInt ) = 0;
virtual HRESULT __stdcall GetXInt ( int* pInt ) = 0;
virtual HRESULT __stdcall SetXText ( BSTR strText ) = 0;
virtual HRESULT __stdcall GetXText ( BSTR* pText ) = 0;
};
interface IY : IUnknown
{
virtual HRESULT __stdcall SetYInt ( int iYInt ) = 0;
virtual HRESULT __stdcall GetYInt ( int* pInt ) = 0;
virtual HRESULT __stdcall SetYText ( BSTR strText ) = 0;
virtual HRESULT __stdcall GetYText ( BSTR* pText ) = 0;
};
int main(void)
{
IUnknown* pUnk=NULL;
BSTR strData;
IX* pIX=NULL;
IY* pIY=NULL;
HRESULT hr;
int x=0;
int y=0;
CoInitialize(NULL);
hr=CoCreateInstance(CLSID_CC,NULL,CLSCTX_LOCAL_SERVER,IID_IUnknown,(void**)&pUnk);
if(SUCCEEDED(hr))
{
printf("CoCreateInstance() For CLSID_CC Succeeded!\n");
hr=pUnk->QueryInterface(IID_IX,(void**)&pIX);
if(SUCCEEDED(hr))
{
printf("QueryInterface() For pIX Succeeded!\n");
hr=pIX->SetXInt(25);
if(SUCCEEDED(hr))
{
printf("pIX->SetXInt(25) Succeeded!\n");
pIX->GetXInt(&x);
printf("x = %d\n",x);
strData=SysAllocString(L"");
pIX->GetXText(&strData);
wprintf(L"strData = %s\n",strData);
SysReAllocString(&strData,L"New IX Interface BSTR");
pIX->SetXText(strData);
pIX->GetXText(&strData);
wprintf(L"strData = %s\n",strData);
}
//Now Do IY
hr=pIX->QueryInterface(IID_IY,(void**)&pIY);
if(SUCCEEDED(hr))
{
printf("QueryInterface() For pIY Succeeded!\n");
hr=pIY->SetYInt(50);
if(SUCCEEDED(hr))
{
printf("pIY->SetYInt(50) Succeeded!\n");
pIY->GetYInt(&y);
printf("y = %d\n",y);
pIY->GetYText(&strData);
wprintf(L"strData = %s\n",strData);
SysReAllocString(&strData,L"Now Re-Setting The IY Interface String!");
pIY->SetYText(strData);
SysReAllocString(&strData,L"New IY Interface BSTR");
pIY->GetYText(&strData);
wprintf(L"strData = %s\n",strData);
SysFreeString(strData);
}
pIY->Release();
}
pIX->Release();
}
pUnk->Release();
}
else
printf("CoCreateInstance() For CLSID_CC Succeeded!\n");
CoUninitialize();
getchar();
return 0;
}
...well, about the same output, but some of the coding is just a wee bit different.
And attached here are the form files for a VB9 (Visual Basic.NET from Visual Studio 2008) project that uses the COM Class. I didn't want to attach the entire set of files and directories that VB.NET creates when you set up a project because there are too many files and too many directories nested like four levels deep. Microsoft has no shame! So here are the directions for setting up a VB.NET project, and you can just include the attached vb.NET form files in the project as per the directions below...
1) Start Visual Basic.NET;
2) Create A New Windows Forms Application;
3) Go To...
Project >>> Add Reference...
4) Select The COM tab on the Add Reference Dialog Box;
5) Scroll down the list until you come to "Class CC With TypeLib".
Select that;
6) At this point VB.NET has likely included a default Form1 in your project.
You can right click on that in Solution Explorer and exclude it from the
project. Then copy frmCC.vb, frmCC.resx, and frmCC.Designer.vb to your
project directory (they are in the zip attached to this post). Right
click on the project in Solution Explorer and execute...
Add >>> Existing item
7) Select frmCC.vb ( in zip );
8) Go to project properties and set frmCC as the 'Start Up Form";
9) Run the project.
I'd like to provide a little information here for anyone who is interested in this code but who may not be familiar with my programming style and/or some of the coding idioms I commonly use. I'll also discuss some of the really tricky issues involved in this program and believe me there are some real tricky issues.
If you do a Compile/Run on CC.bas and all goes well (using Jose's latest includes, etc.) you'll see a form/window/dialog with text boxes, labels and buttons on it where you can, for example, enter a number in the 'SetXInt' text box, then click the 'SetXInt' button to call the corresponding IX interface member to store an integer in a 'Set' method of the IX interface. That whole GUI has nothing to do with COM, Exe Local Servers, or anything like that. It is produced by CC.bas as a more or less standard SDK style program. Here is CC.bas reversed engineered, so to speak, with everything but the visual interface removed. It is called Gui.bas and produces Gui.exe. Please compile and run it...
#Compile Exe "Gui.exe"
#Dim All
#Register None
#Include "Win32Api.inc"
%EDIT_SET_X_INT = 1500 'from Main.inc
%BTN_SET_X_INT = 1505
%EDIT_GET_X_INT = 1510
%BTN_GET_X_INT = 1515
%EDIT_SET_X_TEXT = 1520
%BTN_SET_X_TEXT = 1525
%EDIT_GET_X_TEXT = 1530
%BTN_GET_X_TEXT = 1535
%EDIT_SET_Y_INT = 1540
%BTN_SET_Y_INT = 1545
%EDIT_GET_Y_INT = 1550
%BTN_GET_Y_INT = 1555
%EDIT_SET_Y_TEXT = 1560
%BTN_SET_Y_TEXT = 1565
%EDIT_GET_Y_TEXT = 1570
%BTN_GET_Y_TEXT = 1575
Type WndEventArgs
wParam As Long
lParam As Long
hWnd As Dword
hInst As Dword
End Type
Type MessageHandler
wMessage As Long
dwFnPtr As Dword
End Type 'end of what's in Main.inc
Declare Function FnPtr(wea As WndEventArgs) As Long 'I believe this stuff is in CC.inc
Global MsgHdlr() As MessageHandler ''''''''''''''''''''''''''''''''''
Global hMainWnd As Dword ''''''''''''''''''''''''''''''''''
Function fnWndProc_OnCreate(wea As WndEventArgs) As Long
Local pCreateStruct As CREATESTRUCT Ptr
Local lpCmdLine As Asciiz Ptr
Local hCtl As Dword
pCreateStruct=wea.lParam
wea.hInst=@pCreateStruct.hInstance
lpCmdLine=@pCreateStruct.lpCreateParams
If @lpCmdLine="" Then
MsgBox("This Program Was Started With No Command Line Arguments")
Else
MsgBox("This Program Was Started With This Command Line Argument: " & @lpCmdLine)
End If
hCtl=CreateWindowEx(0,"static","The IX Interface",%WS_CHILD Or %WS_VISIBLE,215,5,120,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Set X Int",%WS_CHILD Or %WS_VISIBLE,10,35,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,35,40,22,Wea.hWnd,%EDIT_SET_X_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Set X Int",%WS_CHILD Or %WS_VISIBLE,160,35,75,22,Wea.hWnd,%BTN_SET_X_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Get X Int",%WS_CHILD Or %WS_VISIBLE,280,35,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,380,35,40,22,Wea.hWnd,%EDIT_GET_X_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Get X Int",%WS_CHILD Or %WS_VISIBLE,440,35,75,22,Wea.hWnd,%BTN_GET_X_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Set X Text",%WS_CHILD Or %WS_VISIBLE,10,75,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,75,320,22,Wea.hWnd,%EDIT_SET_X_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Set X Text",%WS_CHILD Or %WS_VISIBLE,440,75,75,22,Wea.hWnd,%BTN_SET_X_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Get X Text",%WS_CHILD Or %WS_VISIBLE,10,115,110,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,115,320,22,Wea.hWnd,%EDIT_GET_X_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Get X Text",%WS_CHILD Or %WS_VISIBLE,440,115,75,22,Wea.hWnd,%BTN_GET_X_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","The IY Interface",%WS_CHILD Or %WS_VISIBLE,215,170,120,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Set Y Int",%WS_CHILD Or %WS_VISIBLE,10,195,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,195,40,22,Wea.hWnd,%EDIT_SET_Y_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Set Y Int",%WS_CHILD Or %WS_VISIBLE,160,195,75,22,Wea.hWnd,%BTN_SET_Y_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Get Y Int",%WS_CHILD Or %WS_VISIBLE,280,195,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,380,195,40,22,Wea.hWnd,%EDIT_GET_Y_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Get Y Int",%WS_CHILD Or %WS_VISIBLE,440,195,75,22,Wea.hWnd,%BTN_GET_Y_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Set Y Text",%WS_CHILD Or %WS_VISIBLE,10,235,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,235,320,22,Wea.hWnd,%EDIT_SET_Y_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Set Y Text",%WS_CHILD Or %WS_VISIBLE,440,235,75,22,Wea.hWnd,%BTN_SET_Y_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Get Y Text",%WS_CHILD Or %WS_VISIBLE,10,265,110,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,265,320,22,Wea.hWnd,%EDIT_GET_Y_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Get Y Text",%WS_CHILD Or %WS_VISIBLE,440,265,75,22,Wea.hWnd,%BTN_GET_Y_TEXT,Wea.hInst,Byval 0)
Call ShowWindow(Wea.hWnd, %SW_SHOWNORMAL) '<<<<<<<<this is really, really unusual!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
fnWndProc_OnCreate=0
End Function
Function fnWndProc_OnCommand(Wea As WndEventArgs) As Long
Select Case As Long Lowrd(Wea.wParam)
Case %BTN_SET_X_INT
MsgBox("You Clicked The SetXInt Button")
Case %BTN_GET_X_INT
MsgBox("You Clicked The GetXInt Button")
Case %BTN_SET_X_TEXT
MsgBox("You Clicked The SetXText Button")
Case %BTN_GET_X_TEXT
MsgBox("You Clicked The GetXText Button")
Case %BTN_SET_Y_INT
MsgBox("You Clicked The SetYInt Button")
Case %BTN_GET_Y_INT
MsgBox("You Clicked The GetYInt Button")
Case %BTN_SET_Y_TEXT
MsgBox("You Clicked The SetYText Button")
Case %BTN_GET_Y_TEXT
MsgBox("You Clicked The GetYText Button")
End Select
fnWndProc_OnCommand=0
End Function
Function fnWndProc_OnPaint(Wea As WndEventArgs) As Long
Local ps As PAINTSTRUCT
Local hDC As Dword
hDC=BeginPaint(Wea.hWnd, ps)
MoveToEx(hDC, 20, 155, Byval 0)
LineTo(hDC, 510, 155)
EndPaint(Wea.hWnd, ps)
fnWndProc_OnPaint=0
End Function
Function fnWndProc_OnClose(Wea As WndEventArgs) As Long
Call DestroyWindow(Wea.hWnd)
PostQuitMessage(0)
fnWndProc_OnClose=0
End Function
Function fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
Static wea As WndEventArgs
Register iReturn As Long
Register i As Long
For i=0 To 3
If wMsg=MsgHdlr(i).wMessage Then
wea.hWnd=hWnd: wea.wParam=wParam: wea.lParam=lParam
Call Dword MsgHdlr(i).dwFnPtr Using FnPtr(wea) To iReturn
fnWndProc=iReturn
Exit Function
End If
Next i
fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
End Function
Sub AttachMessageHandlers()
ReDim MsgHdlr(3) As MessageHandler 'Associate Windows Message With Message Handlers
MsgHdlr(0).wMessage=%WM_CREATE : MsgHdlr(0).dwFnPtr=CodePtr(fnWndProc_OnCreate)
MsgHdlr(1).wMessage=%WM_COMMAND : MsgHdlr(1).dwFnPtr=CodePtr(fnWndProc_OnCommand)
MsgHdlr(2).wMessage=%WM_PAINT : MsgHdlr(2).dwFnPtr=CodePtr(fnWndProc_OnPaint)
MsgHdlr(3).wMessage=%WM_CLOSE : MsgHdlr(3).dwFnPtr=CodePtr(fnWndProc_OnClose)
End Sub
Function WinMain(ByVal hInstance As Long, ByVal hPrev As Long, ByVal lpCmdLine As Asciiz Ptr, ByVal iShow As Long) As Long
Local szAppName As Asciiz*8
Local wc As WndClassEx
Local Msg As tagMsg
Call AttachMessageHandlers()
szAppName="Gui.exe"
wc.cbSize=SizeOf(wc) : wc.style=%CS_HREDRAW Or %CS_VREDRAW
wc.lpfnWndProc=CodePtr(fnWndProc) : wc.cbClsExtra=0
wc.cbWndExtra=0 : wc.hInstance=hInstance
wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION) : wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)
wc.hbrBackground=%COLOR_BTNFACE+1 : wc.lpszMenuName=%NULL
wc.lpszClassName=VarPtr(szAppName)
Call RegisterClassEx(wc)
hMainWnd=CreateWindowEx(0,szAppName,szAppName,%WS_OVERLAPPEDWINDOW,400,200,545,350,0,0,hInstance,ByVal lpCmdLine)
While GetMessage(Msg,%NULL,0,0)
TranslateMessage Msg
DispatchMessage Msg
Wend
WinMain=0
End Function
You should first see a message box notifying you that the program was started without any command line parameters. Now open a command prompt window to whatever directory you have Gui.exe in or use the 'Run' command on the Start menu and start it something like this...
C:\.......>Gui.exe /Embedding
When you do, before you see the form you'll get a message box telling you the string "/Embedding" was in the command line.
Some of the weird science going on here is just pure vintage Fred where I do obscure things that could make my programs difficult to follow. In WinMain the command line parameter is brought in through the lpCmdLine variable. It's a pointer to a null terminated string - in other words, the address of the 1st byte of a string. The form/window/dialog is created by the CreateWindowEx() call near the bottom of WinMain(). I pass that lpCmdLine pointer in the last parameter of that call; see ByVal lpCmdLine there. Now concentrate real close on this as some 'weird science' is coming up; when a CreateWindowEx() call is made and before it returns Windows sends a WM_CREATE message to the Window Procedure fnWndProc_OnCreate() . The lParam associated with the WM_CREATE message is a pointer to a CREATESTRUCT...
typedef struct tagCREATESTRUCT
{ // cs
LPVOID lpCreateParams;
HINSTANCE hInstance;
HMENU hMenu;
HWND hwndParent;
int cy;
int cx;
int y;
int x;
LONG style;
LPCTSTR lpszName;
LPCTSTR lpszClass;
DWORD dwExStyle;
} CREATESTRUCT;
This CREATESTRUCT Type/struct has as its 1st member 'lpCreateParams'. That member holds the last parameter of the CreateWindowEx() call and all the other members in descending order popped off the stack are the other parameters of that CreateWindowEx() call back in WinMain(). I dereference the pointer lParam member of my WndEventArgs UDT In fnWndProc_OnCreate() like so to get at the command line argument lpCmdLine...
pCreateStruct=wea.lParam
wea.hInst=@pCreateStruct.hInstance
lpCmdLine=@pCreateStruct.lpCreateParams
So that's how my code in fnWndProc_OnCreate() gets ahold of the command line argument from WinMain(). Not using global variables to get at data makes my life real hard and toilsome, and this is probably also true for those unfortunates whose sorry lot is is to understand my code. I might add that at this link is one of my tutorials about the CREATESTRUCT thing....
http://www.jose.it-berater.org/smfforum/index.php?topic=1292.0
This business of the command line argument is important because when COM starts an exe local server as a result of a client making a COM call on a CLSID or ProgID, it passes the –Embedding or /Embedding string into the exe and logic there must be prepared to act on it.
I needed to get the command line argument into my WM_CREATE handler (here fnWndProc_OnCreate()) because it is there where I prefer to create child window controls to adorn my main program windows. Child window controls can be created in WinMain() after the CreateWindow() call that creates the parent window, but just as a matter of style I prefer not to create my child window controls there.
The thing that is extremely unusual about my GUI code above (other than my bizarre function pointer message cracker setup – more about that later) is that the ShowWindow() call that makes the controls on the form visible is located in fnWndProc_OnCreate(). That Api call is always or traditionally right after the CreateWindow() call down in WinMain(). The reason I put it where it is is that in the WM_CREATE handler fnWndProc_OnCreate() I wanted to only make the form visible if the program was NOT started by COM, i.e., the lpCmdLine string was null "".
For you see, if the program was started by COM and that –Embedding string comes in, then I need some mechanism to keep the program running and open while interface requests are coming in from COM, and external clients are holding object pointers. And that mechanism is the GetMessage() message pump in WinMain() servicing an invisible window!!!!!!!
Another very, very subtle but very, very important difference between Gui.bas and the real CC.bas COM server is that in Gui.bas there is a PostQuitMessage(0) in fnWndProc_OnClose() and there is no PostQuitMessage() in CC.Bas's fnWndProc_OnClose() message handler. fnWndProc_OnClose() will execute if the main form is visible (not started by COM) and the user clicks the 'x' button in the title bar. But let me ask what would happen if the main program window was open and some external client also made a request for some service of the COM object CC which caused its reference count to increment to 2, i.e., one for the visible form using IX and IY and another for some external client also holding interface pointers? If the user with the visible instance of the server closed the program out while another holder of interface pointers was still using it there would be a certain hard crash. Therefore, the PostQuitMessage() that causes the program to fall out of the message processing loop and WinMain() to exit must be contingent upon some other condition than a user unaware of other clients clicking an 'x' button. And that other condition is the reference count held in the g_lLocks global object counting variable. This is where AddRef() and Release() calls become so important. Take a look at CCUnLock()...
Sub CCUnLock() 'Its important to realize what keeps this program running if an early exit
If g_lLocks > 0 Then 'doesn't occur due to the registration/unregistration scenerio. If execution
Prnt "Entering CCUnLock()", 1 'reaches the CreateWindow() call in WinMain(), a main program window will be
Prnt " g_lLocks = " & Str$(g_lLocks), 1 'created and the program will enter a message retrieval loop. If the main
Call InterlockedDecrement(g_lLocks) 'program window receives a click on the [x] to terminate it, Release() calls
Prnt " g_lLocks = " & Str$(g_lLocks), 1 'will be made on the globally allocated IX and IY interface variables, and
If g_lLocks=0 Then 'a DestroyWindow() call and PostQuitMessage() call made on the main window
If hMainWnd Then 'and WinMain()'s message pump. If the program was started by COM and the
Call PostQuitMessage(0) 'main window is invisible, a WM_CLOSE message and PostQuitMessage() will be
Call SendMessage(hMainWnd, %WM_CLOSE, 0, 0) 'SendMessag()'ed from CCUnlock() when g_lLocks reaches 0.
End If
End If
Prnt "Leaving CCUnLock()", 1
End If
End Sub
That is where the condition is tested that can cause the program to end. The condition that will cause the program to end is when g_lLocks = 0. At that point a PostQuitMessage() call is made that will cause WinMain() to close and a WM_CLOSE message is sent to the main program window if it indeed still exists.
Let me point out that this could be a very common situation. Lets take the example of Microsoft Excel. Suppose you sat down at your computer to do some work with Excel and you started it up and started working on it. After awhile you decide to check your mutual funds/stock funds to see how you did today, and for that you have some kind of financial program like MS Money, Quicken, or something like that. So you minimize Excel and open your financial program. Now lets assume your financial program downloads today's stock market results, and you execute some program choice to calculate your results and display a report. Lets further assume that the financial program uses some functionality of MS Excel as an external COM object to calculate results or create a pie chart or something like that. Now just think what would happen after the financial program finished using Excel's functionality if Excel closed out and released itself from memory. You still have an instance of Excel running that may even have some data in it that has not as of yet been saved. If that program would terminate due to the unloading of the COM object Excel by your financial program, you probably wouldn't be happy – especially if you lost data. The way around this problem is to reference count the number of instances of ComObject.CC that are created in CCClassFactory_CreateInstance(), and to only terminate the program, i.e., exit WinMain(), when the lock count stored in g_lLocks is decremented to zero. Lets try a few experiments. Here is a PBWin 9 program that connects to ComObject.CC. Run it and fill in some of the IX Interface values ...
'LooksLikeVB.inc
$CLSID_CC = Guid$("{20000000-0000-0000-0000-000000000020}")
$IID_IX = Guid$("{20000000-0000-0000-0000-000000000021}")
$IID_IY = Guid$("{20000000-0000-0000-0000-000000000022}")
%EDIT_SET_X_INT = 1500 'from Main.inc
%BTN_SET_X_INT = 1505
%EDIT_GET_X_INT = 1510
%BTN_GET_X_INT = 1515
%EDIT_SET_X_TEXT = 1520
%BTN_SET_X_TEXT = 1525
%EDIT_GET_X_TEXT = 1530
%BTN_GET_X_TEXT = 1535
%EDIT_SET_Y_INT = 1540
%BTN_SET_Y_INT = 1545
%EDIT_GET_Y_INT = 1550
%BTN_GET_Y_INT = 1555
%EDIT_SET_Y_TEXT = 1560
%BTN_SET_Y_TEXT = 1565
%EDIT_GET_Y_TEXT = 1570
%BTN_GET_Y_TEXT = 1575
Type WndEventArgs
wParam As Long
lParam As Long
hWnd As Dword
hInst As Dword
End Type
Type MessageHandler
wMessage As Long
dwFnPtr As Dword
End Type 'end of what's in Main.inc
Declare Function FnPtr(wea As WndEventArgs) As Long
Global MsgHdlr() As MessageHandler
Interface I_X $IID_IX : Inherit IAutomation
Method SetXInt(Byval iXVal As Long)
Method GetXInt() As Long
Method SetXText(Byval strText As String)
Method GetXText() As String
End Interface
Interface I_Y $IID_IY : Inherit IAutomation
Method SetYInt(Byval iYVal As Long)
Method GetYInt() As Long
Method SetYText(Byval strText As String)
Method GetYText() As String
End Interface
Global pIX As I_X
Global pIY As I_Y
#Compile Exe "LooksLikeVB.exe"
#Dim All
#Register None
#Include "Win32Api.inc"
#Include "WinClient.inc"
Function Form_Load(wea As WndEventArgs) As Long
Local pCreateStruct As CREATESTRUCT Ptr
Local hCtl As Dword
pCreateStruct=wea.lParam
wea.hInst=@pCreateStruct.hInstance
hCtl=CreateWindowEx(0,"static","The IX Interface",%WS_CHILD Or %WS_VISIBLE,215,5,120,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Set X Int",%WS_CHILD Or %WS_VISIBLE,10,35,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,35,40,22,Wea.hWnd,%EDIT_SET_X_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Set X Int",%WS_CHILD Or %WS_VISIBLE,160,35,75,22,Wea.hWnd,%BTN_SET_X_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Get X Int",%WS_CHILD Or %WS_VISIBLE,280,35,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,380,35,40,22,Wea.hWnd,%EDIT_GET_X_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Get X Int",%WS_CHILD Or %WS_VISIBLE,440,35,75,22,Wea.hWnd,%BTN_GET_X_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Set X Text",%WS_CHILD Or %WS_VISIBLE,10,75,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,75,320,22,Wea.hWnd,%EDIT_SET_X_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Set X Text",%WS_CHILD Or %WS_VISIBLE,440,75,75,22,Wea.hWnd,%BTN_SET_X_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Get X Text",%WS_CHILD Or %WS_VISIBLE,10,115,110,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,115,320,22,Wea.hWnd,%EDIT_GET_X_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Get X Text",%WS_CHILD Or %WS_VISIBLE,440,115,75,22,Wea.hWnd,%BTN_GET_X_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","The IY Interface",%WS_CHILD Or %WS_VISIBLE,215,170,120,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Set Y Int",%WS_CHILD Or %WS_VISIBLE,10,195,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,195,40,22,Wea.hWnd,%EDIT_SET_Y_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Set Y Int",%WS_CHILD Or %WS_VISIBLE,160,195,75,22,Wea.hWnd,%BTN_SET_Y_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Get Y Int",%WS_CHILD Or %WS_VISIBLE,280,195,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,380,195,40,22,Wea.hWnd,%EDIT_GET_Y_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Get Y Int",%WS_CHILD Or %WS_VISIBLE,440,195,75,22,Wea.hWnd,%BTN_GET_Y_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Set Y Text",%WS_CHILD Or %WS_VISIBLE,10,235,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,235,320,22,Wea.hWnd,%EDIT_SET_Y_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Set Y Text",%WS_CHILD Or %WS_VISIBLE,440,235,75,22,Wea.hWnd,%BTN_SET_Y_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Get Y Text",%WS_CHILD Or %WS_VISIBLE,10,265,110,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,265,320,22,Wea.hWnd,%EDIT_GET_Y_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Get Y Text",%WS_CHILD Or %WS_VISIBLE,440,265,75,22,Wea.hWnd,%BTN_GET_Y_TEXT,Wea.hInst,Byval 0)
Let pIX = AnyCom "ComObject.CC"
If IsNothing(pIX) Then
hCtl=MsgBox("Can't Create ComObject.CC!",%MB_ICONERROR,"Something Isn't Working!")
Form_Load=-1
Exit Function
Else
pIY=pIX 'This will cause a QueryInterface() call for pIY
End If
Form_Load=0
End Function
Sub cmdSetXInt_OnClick(Wea As WndEventArgs)
Local szBuffer As Asciiz*128
Local x As Long
Call GetWindowText(GetDlgItem(Wea.hWnd,%EDIT_SET_X_INT),szBuffer,16)
x=Val(szBuffer)
pIX.SetXInt(x)
End Sub
Sub cmdGetXInt_OnClick(Wea As WndEventArgs)
Local szBuffer As Asciiz*128
Local x As Long
x=pIX.GetXInt()
szBuffer=Str$(x)
Call SetWindowText(GetDlgItem(Wea.hWnd,%EDIT_GET_X_INT),szBuffer)
End Sub
Sub cmdSetXText_OnClick(Wea As WndEventArgs)
Local szBuffer As Asciiz*128
Local strBuffer As String
Call GetWindowText(GetDlgItem(Wea.hWnd,%EDIT_SET_X_TEXT),szBuffer,128)
strBuffer=szBuffer
pIX.SetXText(strBuffer)
End Sub
Sub cmdGetXText_OnClick(Wea As WndEventArgs)
Local szBuffer As Asciiz*128
Local strBuffer As String
strBuffer=pIX.GetXText()
Call SetWindowText(GetDlgItem(Wea.hWnd,%EDIT_GET_X_TEXT),Byval Strptr(strBuffer))
End Sub
Sub cmdSetYInt_OnClick(Wea As WndEventArgs)
Local szBuffer As Asciiz*128
Local y As Long
Call GetWindowText(GetDlgItem(Wea.hWnd,%EDIT_SET_Y_INT),szBuffer,16)
y=Val(szBuffer)
pIY.SetYInt(y)
End Sub
Sub cmdGetYInt_OnClick(Wea As WndEventArgs)
Local szBuffer As Asciiz*128
Local y As Long
y=pIY.GetYInt()
szBuffer=Str$(y)
Call SetWindowText(GetDlgItem(Wea.hWnd,%EDIT_GET_Y_INT),szBuffer)
End Sub
Sub cmdSetYText_OnClick(Wea As WndEventArgs)
Local szBuffer As Asciiz*128
Local strBuffer As String
Call GetWindowText(GetDlgItem(Wea.hWnd,%EDIT_SET_Y_TEXT),szBuffer,128)
strBuffer=szBuffer
pIY.SetYText(strBuffer)
End Sub
Sub cmdGetYText_OnClick(Wea As WndEventArgs)
Local szBuffer As Asciiz*128
Local strBuffer As String
strBuffer=pIY.GetYText()
Call SetWindowText(GetDlgItem(Wea.hWnd,%EDIT_GET_Y_TEXT),Byval Strptr(strBuffer))
End Sub
Function fnWndProc_OnCommand(Wea As WndEventArgs) As Long
Select Case As Long Lowrd(Wea.wParam)
Case %BTN_SET_X_INT
Call cmdSetXInt_OnClick(Wea)
Case %BTN_GET_X_INT
Call cmdGetXInt_OnClick(Wea)
Case %BTN_SET_X_TEXT
Call cmdSetXText_OnClick(Wea)
Case %BTN_GET_X_TEXT
Call cmdGetXText_OnClick(Wea)
Case %BTN_SET_Y_INT
Call cmdSetYInt_OnClick(Wea)
Case %BTN_GET_Y_INT
Call cmdGetYInt_OnClick(Wea)
Case %BTN_SET_Y_TEXT
Call cmdSetYText_OnClick(Wea)
Case %BTN_GET_Y_TEXT
Call cmdGetYText_OnClick(Wea)
End Select
fnWndProc_OnCommand=0
End Function
Function Form_Paint(Wea As WndEventArgs) As Long
Local ps As PAINTSTRUCT
Local hDC As Dword
hDC=BeginPaint(Wea.hWnd, ps)
MoveToEx(hDC, 20, 155, Byval 0)
LineTo(hDC, 510, 155)
EndPaint(Wea.hWnd, ps)
Form_Paint=0
End Function
Function Form_UnLoad(Wea As WndEventArgs) As Long
Set pIX=Nothing : Set pIY=Nothing
Call DestroyWindow(Wea.hWnd)
PostQuitMessage(0)
Form_UnLoad=0
End Function
Function fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
Static wea As WndEventArgs
Register iReturn As Long
Register i As Long
For i=0 To 3
If wMsg=MsgHdlr(i).wMessage Then
wea.hWnd=hWnd: wea.wParam=wParam: wea.lParam=lParam
Call Dword MsgHdlr(i).dwFnPtr Using FnPtr(wea) To iReturn
fnWndProc=iReturn
Exit Function
End If
Next i
fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
End Function
Sub AttachMessageHandlers()
ReDim MsgHdlr(3) As MessageHandler 'Associate Windows Message With Message Handlers
MsgHdlr(0).wMessage=%WM_CREATE : MsgHdlr(0).dwFnPtr=CodePtr(Form_Load)
MsgHdlr(1).wMessage=%WM_COMMAND : MsgHdlr(1).dwFnPtr=CodePtr(fnWndProc_OnCommand)
MsgHdlr(2).wMessage=%WM_PAINT : MsgHdlr(2).dwFnPtr=CodePtr(Form_Paint)
MsgHdlr(3).wMessage=%WM_CLOSE : MsgHdlr(3).dwFnPtr=CodePtr(Form_UnLoad)
End Sub
Function WinMain(ByVal hInstance As Long, ByVal hPrev As Long, ByVal lpCmdLine As Asciiz Ptr, ByVal iShow As Long) As Long
Local szAppName As Asciiz*16
Local hMainWnd As Dword
Local wc As WndClassEx
Local Msg As tagMsg
szAppName="LooksLikeVB"
Call AttachMessageHandlers()
wc.cbSize=SizeOf(wc) : wc.style=%CS_HREDRAW Or %CS_VREDRAW
wc.lpfnWndProc=CodePtr(fnWndProc) : wc.cbClsExtra=0
wc.cbWndExtra=0 : wc.hInstance=hInstance
wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION) : wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)
wc.hbrBackground=%COLOR_BTNFACE+1 : wc.lpszMenuName=%NULL
wc.lpszClassName=VarPtr(szAppName)
Call RegisterClassEx(wc)
hMainWnd=CreateWindowEx(0,szAppName,szAppName,%WS_OVERLAPPEDWINDOW,400,200,545,350,0,0,hInstance,ByVal 0)
Call ShowWindow(hMainWnd, %SW_SHOWNORMAL) '<<<<<<<<Typical Location!
While GetMessage(Msg,%NULL,0,0)
TranslateMessage Msg
DispatchMessage Msg
Wend
WinMain=0
End Function
continued...
One thing you could try is start CC.exe and fill in some values for the IX interface. Then, while leaving that program open, start the one above. The cursor will be blinking waiting for you to hit a key, but before you do that click the 'x' button on CC.exe. Doing that will close out CC.exe, right? Wrong! CC.exe will disappear from the screen just like you would expect, but it will still be running a message loop even though it has no windows to receive messages from. Now return to LooksLikeVB.exe and fill in the IY Interface values. Note that
If you then hit a key to let PBWinClient.exe continue running you'll see that it doesn't crash like you would expect it might if closing CC.exe removed the Com Class from memory. When you finally hit another key on PBWinClient's console that program will exit and CC's g_lLocks will decrement to zero and a PostQuitMessage(0) will be sent to CC's message queene and CC will finally terminate.
Thinking back on Gui.bas above where I tore the GUI code out of CC.bas to show that it is logically distinct from the actual low level creation of the COM object through the code in CC.inc, it occurred to me that we could use Gui.exe's code and add a few lines of high level PowerBASIC COM code to actually load the local server and actually have something that works again. We havn't done that yet and it sounds like fun so lets do that. Here is that code. We'll call this one WinClient.exe. Here is WinClient.inc...
'WinClient.inc
$CLSID_CC = Guid$("{20000000-0000-0000-0000-000000000020}")
$IID_IX = Guid$("{20000000-0000-0000-0000-000000000021}")
$IID_IY = Guid$("{20000000-0000-0000-0000-000000000022}")
%EDIT_SET_X_INT = 1500
%BTN_SET_X_INT = 1505
%EDIT_GET_X_INT = 1510
%BTN_GET_X_INT = 1515
%EDIT_SET_X_TEXT = 1520
%BTN_SET_X_TEXT = 1525
%EDIT_GET_X_TEXT = 1530
%BTN_GET_X_TEXT = 1535
%EDIT_SET_Y_INT = 1540
%BTN_SET_Y_INT = 1545
%EDIT_GET_Y_INT = 1550
%BTN_GET_Y_INT = 1555
%EDIT_SET_Y_TEXT = 1560
%BTN_SET_Y_TEXT = 1565
%EDIT_GET_Y_TEXT = 1570
%BTN_GET_Y_TEXT = 1575
Type WndEventArgs
wParam As Long
lParam As Long
hWnd As Dword
hInst As Dword
End Type
Type MessageHandler
wMessage As Long
dwFnPtr As Dword
End Type
Declare Function FnPtr(wea As WndEventArgs) As Long
Global MsgHdlr() As MessageHandler
Interface I_X $IID_IX : Inherit IAutomation
Method SetXInt(Byval iXVal As Long)
Method GetXInt() As Long
Method SetXText(Byval strText As String)
Method GetXText() As String
End Interface
Interface I_Y $IID_IY : Inherit IAutomation
Method SetYInt(Byval iYVal As Long)
Method GetYInt() As Long
Method SetYText(Byval strText As String)
Method GetYText() As String
End Interface
Global pIX As I_X
Global pIY As I_Y
And here is WinClient.bas
#Compile Exe "WinClient.exe"
#Dim All
#Register None
#Include "Win32Api.inc"
#Include "WinClient.inc"
Function fnWndProc_OnCreate(wea As WndEventArgs) As Long
Local pCreateStruct As CREATESTRUCT Ptr
Local hCtl As Dword
pCreateStruct=wea.lParam
wea.hInst=@pCreateStruct.hInstance
hCtl=CreateWindowEx(0,"static","The IX Interface",%WS_CHILD Or %WS_VISIBLE,215,5,120,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Set X Int",%WS_CHILD Or %WS_VISIBLE,10,35,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,35,40,22,Wea.hWnd,%EDIT_SET_X_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Set X Int",%WS_CHILD Or %WS_VISIBLE,160,35,75,22,Wea.hWnd,%BTN_SET_X_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Get X Int",%WS_CHILD Or %WS_VISIBLE,280,35,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,380,35,40,22,Wea.hWnd,%EDIT_GET_X_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Get X Int",%WS_CHILD Or %WS_VISIBLE,440,35,75,22,Wea.hWnd,%BTN_GET_X_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Set X Text",%WS_CHILD Or %WS_VISIBLE,10,75,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,75,320,22,Wea.hWnd,%EDIT_SET_X_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Set X Text",%WS_CHILD Or %WS_VISIBLE,440,75,75,22,Wea.hWnd,%BTN_SET_X_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Get X Text",%WS_CHILD Or %WS_VISIBLE,10,115,110,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,115,320,22,Wea.hWnd,%EDIT_GET_X_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Get X Text",%WS_CHILD Or %WS_VISIBLE,440,115,75,22,Wea.hWnd,%BTN_GET_X_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","The IY Interface",%WS_CHILD Or %WS_VISIBLE,215,170,120,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Set Y Int",%WS_CHILD Or %WS_VISIBLE,10,195,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,195,40,22,Wea.hWnd,%EDIT_SET_Y_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Set Y Int",%WS_CHILD Or %WS_VISIBLE,160,195,75,22,Wea.hWnd,%BTN_SET_Y_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Get Y Int",%WS_CHILD Or %WS_VISIBLE,280,195,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,380,195,40,22,Wea.hWnd,%EDIT_GET_Y_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Get Y Int",%WS_CHILD Or %WS_VISIBLE,440,195,75,22,Wea.hWnd,%BTN_GET_Y_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Set Y Text",%WS_CHILD Or %WS_VISIBLE,10,235,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,235,320,22,Wea.hWnd,%EDIT_SET_Y_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Set Y Text",%WS_CHILD Or %WS_VISIBLE,440,235,75,22,Wea.hWnd,%BTN_SET_Y_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Get Y Text",%WS_CHILD Or %WS_VISIBLE,10,265,110,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,265,320,22,Wea.hWnd,%EDIT_GET_Y_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Get Y Text",%WS_CHILD Or %WS_VISIBLE,440,265,75,22,Wea.hWnd,%BTN_GET_Y_TEXT,Wea.hInst,Byval 0)
Let pIX = AnyCom "ComObject.CC"
If IsNothing(pIX) Then
hCtl=MsgBox("Can't Create ComObject.CC!",%MB_ICONERROR,"Something Isn't Working!")
fnWndProc_OnCreate=-1
Exit Function
End If
pIY=pIX
fnWndProc_OnCreate=0
End Function
Function fnWndProc_OnCommand(Wea As WndEventArgs) As Long
Local szBuffer As Asciiz*128
Local strBuffer As String
Local x,y As Long
Select Case As Long Lowrd(Wea.wParam)
Case %BTN_SET_X_INT
Call GetWindowText(GetDlgItem(Wea.hWnd,%EDIT_SET_X_INT),szBuffer,16)
x=Val(szBuffer)
pIX.SetXInt(x)
Case %BTN_GET_X_INT
x=pIX.GetXInt()
szBuffer=Str$(x)
Call SetWindowText(GetDlgItem(Wea.hWnd,%EDIT_GET_X_INT),szBuffer)
Case %BTN_SET_X_TEXT
Call GetWindowText(GetDlgItem(Wea.hWnd,%EDIT_SET_X_TEXT),szBuffer,128)
strBuffer=szBuffer
pIX.SetXText(strBuffer)
Case %BTN_GET_X_TEXT
strBuffer=pIX.GetXText()
Call SetWindowText(GetDlgItem(Wea.hWnd,%EDIT_GET_X_TEXT),Byval Strptr(strBuffer))
Case %BTN_SET_Y_INT
Call GetWindowText(GetDlgItem(Wea.hWnd,%EDIT_SET_Y_INT),szBuffer,16)
y=Val(szBuffer)
pIY.SetYInt(y)
Case %BTN_GET_Y_INT
y=pIY.GetYInt()
szBuffer=Str$(y)
Call SetWindowText(GetDlgItem(Wea.hWnd,%EDIT_GET_Y_INT),szBuffer)
_INT),szBuffer)
Case %BTN_SET_Y_TEXT
Call GetWindowText(GetDlgItem(Wea.hWnd,%EDIT_SET_Y_TEXT),szBuffer,128)
strBuffer=szBuffer
pIY.SetYText(strBuffer)
Case %BTN_GET_Y_TEXT
strBuffer=pIY.GetYText()
Call SetWindowText(GetDlgItem(Wea.hWnd,%EDIT_GET_Y_TEXT),Byval Strptr(strBuffer))
End Select
fnWndProc_OnCommand=0
End Function
Function fnWndProc_OnPaint(Wea As WndEventArgs) As Long
Local ps As PAINTSTRUCT
Local hDC As Dword
hDC=BeginPaint(Wea.hWnd, ps)
MoveToEx(hDC, 20, 155, Byval 0)
LineTo(hDC, 510, 155)
EndPaint(Wea.hWnd, ps)
fnWndProc_OnPaint=0
End Function
Function fnWndProc_OnClose(Wea As WndEventArgs) As Long
Set pIX=Nothing : Set pIY=Nothing
Call DestroyWindow(Wea.hWnd)
PostQuitMessage(0)
fnWndProc_OnClose=0
End Function
Function fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
Static wea As WndEventArgs
Register iReturn As Long
Register i As Long
For i=0 To 3
If wMsg=MsgHdlr(i).wMessage Then
wea.hWnd=hWnd: wea.wParam=wParam: wea.lParam=lParam
Call Dword MsgHdlr(i).dwFnPtr Using FnPtr(wea) To iReturn
fnWndProc=iReturn
Exit Function
End If
Next i
fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
End Function
Sub AttachMessageHandlers()
ReDim MsgHdlr(3) As MessageHandler 'Associate Windows Message With Message Handlers
MsgHdlr(0).wMessage=%WM_CREATE : MsgHdlr(0).dwFnPtr=CodePtr(fnWndProc_OnCreate)
MsgHdlr(1).wMessage=%WM_COMMAND : MsgHdlr(1).dwFnPtr=CodePtr(fnWndProc_OnCommand)
MsgHdlr(2).wMessage=%WM_PAINT : MsgHdlr(2).dwFnPtr=CodePtr(fnWndProc_OnPaint)
MsgHdlr(3).wMessage=%WM_CLOSE : MsgHdlr(3).dwFnPtr=CodePtr(fnWndProc_OnClose)
End Sub
Function WinMain(ByVal hInstance As Long, ByVal hPrev As Long, ByVal lpCmdLine As Asciiz Ptr, ByVal iShow As Long) As Long
Local szAppName As Asciiz*16
Local hMainWnd As Dword
Local wc As WndClassEx
Local Msg As tagMsg
Call AttachMessageHandlers()
szAppName="WinClient"
wc.cbSize=SizeOf(wc) : wc.style=%CS_HREDRAW Or %CS_VREDRAW
wc.lpfnWndProc=CodePtr(fnWndProc) : wc.cbClsExtra=0
wc.cbWndExtra=0 : wc.hInstance=hInstance
wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION) : wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)
wc.hbrBackground=%COLOR_BTNFACE+1 : wc.lpszMenuName=%NULL
wc.lpszClassName=VarPtr(szAppName)
Call RegisterClassEx(wc)
hMainWnd=CreateWindowEx(0,szAppName,szAppName,%WS_OVERLAPPEDWINDOW,400,200,545,350,0,0,hInstance,ByVal 0)
Call ShowWindow(hMainWnd, %SW_SHOWNORMAL) '<<<<<<<<Typical Location!
While GetMessage(Msg,%NULL,0,0)
TranslateMessage Msg
DispatchMessage Msg
Wend
WinMain=0
End Function
And here is a Visual Basicized version of the program any former VB'er would find familiar named LooksLikeVB.bas with its Form_Load(), Form_Paint() and Form_UnLoad()...
#Compile Exe "LooksLikeVB.exe"
#Dim All
#Register None
#Include "Win32Api.inc"
#Include "WinClient.inc"
Function Form_Load(wea As WndEventArgs) As Long
Local pCreateStruct As CREATESTRUCT Ptr
Local hCtl As Dword
pCreateStruct=wea.lParam
wea.hInst=@pCreateStruct.hInstance
hCtl=CreateWindowEx(0,"static","The IX Interface",%WS_CHILD Or %WS_VISIBLE,215,5,120,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Set X Int",%WS_CHILD Or %WS_VISIBLE,10,35,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,35,40,22,Wea.hWnd,%EDIT_SET_X_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Set X Int",%WS_CHILD Or %WS_VISIBLE,160,35,75,22,Wea.hWnd,%BTN_SET_X_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Get X Int",%WS_CHILD Or %WS_VISIBLE,280,35,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,380,35,40,22,Wea.hWnd,%EDIT_GET_X_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Get X Int",%WS_CHILD Or %WS_VISIBLE,440,35,75,22,Wea.hWnd,%BTN_GET_X_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Set X Text",%WS_CHILD Or %WS_VISIBLE,10,75,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,75,320,22,Wea.hWnd,%EDIT_SET_X_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Set X Text",%WS_CHILD Or %WS_VISIBLE,440,75,75,22,Wea.hWnd,%BTN_SET_X_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Get X Text",%WS_CHILD Or %WS_VISIBLE,10,115,110,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,115,320,22,Wea.hWnd,%EDIT_GET_X_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Get X Text",%WS_CHILD Or %WS_VISIBLE,440,115,75,22,Wea.hWnd,%BTN_GET_X_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","The IY Interface",%WS_CHILD Or %WS_VISIBLE,215,170,120,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Set Y Int",%WS_CHILD Or %WS_VISIBLE,10,195,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,195,40,22,Wea.hWnd,%EDIT_SET_Y_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Set Y Int",%WS_CHILD Or %WS_VISIBLE,160,195,75,22,Wea.hWnd,%BTN_SET_Y_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Get Y Int",%WS_CHILD Or %WS_VISIBLE,280,195,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,380,195,40,22,Wea.hWnd,%EDIT_GET_Y_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Get Y Int",%WS_CHILD Or %WS_VISIBLE,440,195,75,22,Wea.hWnd,%BTN_GET_Y_INT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Set Y Text",%WS_CHILD Or %WS_VISIBLE,10,235,80,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,235,320,22,Wea.hWnd,%EDIT_SET_Y_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Set Y Text",%WS_CHILD Or %WS_VISIBLE,440,235,75,22,Wea.hWnd,%BTN_SET_Y_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"static","Get Y Text",%WS_CHILD Or %WS_VISIBLE,10,265,110,20,Wea.hWnd,-1,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(%WS_EX_CLIENTEDGE,"edit","",%WS_CHILD Or %WS_VISIBLE,100,265,320,22,Wea.hWnd,%EDIT_GET_Y_TEXT,Wea.hInst,Byval 0)
hCtl=CreateWindowEx(0,"button","Get Y Text",%WS_CHILD Or %WS_VISIBLE,440,265,75,22,Wea.hWnd,%BTN_GET_Y_TEXT,Wea.hInst,Byval 0)
Let pIX = AnyCom "ComObject.CC"
If IsNothing(pIX) Then
hCtl=MsgBox("Can't Create ComObject.CC!",%MB_ICONERROR,"Something Isn't Working!")
Form_Load=-1
Exit Function
End If
pIY=pIX
Form_Load=0
End Function
Sub cmdSetXInt_OnClick(Wea As WndEventArgs)
Local szBuffer As Asciiz*128
Local x As Long
Call GetWindowText(GetDlgItem(Wea.hWnd,%EDIT_SET_X_INT),szBuffer,16)
x=Val(szBuffer)
pIX.SetXInt(x)
End Sub
Sub cmdGetXInt_OnClick(Wea As WndEventArgs)
Local szBuffer As Asciiz*128
Local x As Long
x=pIX.GetXInt()
szBuffer=Str$(x)
Call SetWindowText(GetDlgItem(Wea.hWnd,%EDIT_GET_X_INT),szBuffer)
End Sub
Sub cmdSetXText_OnClick(Wea As WndEventArgs)
Local szBuffer As Asciiz*128
Local strBuffer As String
Call GetWindowText(GetDlgItem(Wea.hWnd,%EDIT_SET_X_TEXT),szBuffer,128)
strBuffer=szBuffer
pIX.SetXText(strBuffer)
End Sub
Sub cmdGetXText_OnClick(Wea As WndEventArgs)
Local szBuffer As Asciiz*128
Local strBuffer As String
strBuffer=pIX.GetXText()
Call SetWindowText(GetDlgItem(Wea.hWnd,%EDIT_GET_X_TEXT),Byval Strptr(strBuffer))
End Sub
Sub cmdSetYInt_OnClick(Wea As WndEventArgs)
Local szBuffer As Asciiz*128
Local y As Long
Call GetWindowText(GetDlgItem(Wea.hWnd,%EDIT_SET_Y_INT),szBuffer,16)
y=Val(szBuffer)
pIY.SetYInt(y)
End Sub
Sub cmdGetYInt_OnClick(Wea As WndEventArgs)
Local szBuffer As Asciiz*128
Local y As Long
y=pIY.GetYInt()
szBuffer=Str$(y)
Call SetWindowText(GetDlgItem(Wea.hWnd,%EDIT_GET_Y_INT),szBuffer)
End Sub
Sub cmdSetYText_OnClick(Wea As WndEventArgs)
Local szBuffer As Asciiz*128
Local strBuffer As String
Call GetWindowText(GetDlgItem(Wea.hWnd,%EDIT_SET_Y_TEXT),szBuffer,128)
strBuffer=szBuffer
pIY.SetYText(strBuffer)
End Sub
Sub cmdGetYText_OnClick(Wea As WndEventArgs)
Local szBuffer As Asciiz*128
Local strBuffer As String
strBuffer=pIY.GetYText()
Call SetWindowText(GetDlgItem(Wea.hWnd,%EDIT_GET_Y_TEXT),Byval Strptr(strBuffer))
End Sub
Function fnWndProc_OnCommand(Wea As WndEventArgs) As Long
Select Case As Long Lowrd(Wea.wParam)
Case %BTN_SET_X_INT
Call cmdSetXInt_OnClick(Wea)
Case %BTN_GET_X_INT
Call cmdGetXInt_OnClick(Wea)
Case %BTN_SET_X_TEXT
Call cmdSetXText_OnClick(Wea)
Case %BTN_GET_X_TEXT
Call cmdGetXText_OnClick(Wea)
Case %BTN_SET_Y_INT
Call cmdSetYInt_OnClick(Wea)
Case %BTN_GET_Y_INT
Call cmdGetYInt_OnClick(Wea)
Case %BTN_SET_Y_TEXT
Call cmdSetYText_OnClick(Wea)
Case %BTN_GET_Y_TEXT
Call cmdGetYText_OnClick(Wea)
End Select
fnWndProc_OnCommand=0
End Function
Function Form_Paint(Wea As WndEventArgs) As Long
Local ps As PAINTSTRUCT
Local hDC As Dword
hDC=BeginPaint(Wea.hWnd, ps)
MoveToEx(hDC, 20, 155, Byval 0)
LineTo(hDC, 510, 155)
EndPaint(Wea.hWnd, ps)
Form_Paint=0
End Function
Function Form_UnLoad(Wea As WndEventArgs) As Long
Set pIX=Nothing : Set pIY=Nothing
Call DestroyWindow(Wea.hWnd)
PostQuitMessage(0)
Form_UnLoad=0
End Function
Function fnWndProc(ByVal hWnd As Long,ByVal wMsg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long
Static wea As WndEventArgs
Register iReturn As Long
Register i As Long
For i=0 To 3
If wMsg=MsgHdlr(i).wMessage Then
wea.hWnd=hWnd: wea.wParam=wParam: wea.lParam=lParam
Call Dword MsgHdlr(i).dwFnPtr Using FnPtr(wea) To iReturn
fnWndProc=iReturn
Exit Function
End If
Next i
fnWndProc=DefWindowProc(hWnd,wMsg,wParam,lParam)
End Function
Sub AttachMessageHandlers()
ReDim MsgHdlr(3) As MessageHandler 'Associate Windows Message With Message Handlers
MsgHdlr(0).wMessage=%WM_CREATE : MsgHdlr(0).dwFnPtr=CodePtr(Form_Load)
MsgHdlr(1).wMessage=%WM_COMMAND : MsgHdlr(1).dwFnPtr=CodePtr(fnWndProc_OnCommand)
MsgHdlr(2).wMessage=%WM_PAINT : MsgHdlr(2).dwFnPtr=CodePtr(Form_Paint)
MsgHdlr(3).wMessage=%WM_CLOSE : MsgHdlr(3).dwFnPtr=CodePtr(Form_UnLoad)
End Sub
Function WinMain(ByVal hInstance As Long, ByVal hPrev As Long, ByVal lpCmdLine As Asciiz Ptr, ByVal iShow As Long) As Long
Local szAppName As Asciiz*16
Local hMainWnd As Dword
Local wc As WndClassEx
Local Msg As tagMsg
Call AttachMessageHandlers()
szAppName="LooksLikeVB"
wc.cbSize=SizeOf(wc) : wc.style=%CS_HREDRAW Or %CS_VREDRAW
wc.lpfnWndProc=CodePtr(fnWndProc) : wc.cbClsExtra=0
wc.cbWndExtra=0 : wc.hInstance=hInstance
wc.hIcon=LoadIcon(%NULL, ByVal %IDI_APPLICATION) : wc.hCursor=LoadCursor(%NULL, ByVal %IDC_ARROW)
wc.hbrBackground=%COLOR_BTNFACE+1 : wc.lpszMenuName=%NULL
wc.lpszClassName=VarPtr(szAppName)
Call RegisterClassEx(wc)
hMainWnd=CreateWindowEx(0,szAppName,szAppName,%WS_OVERLAPPEDWINDOW,400,200,545,350,0,0,hInstance,ByVal 0)
Call ShowWindow(hMainWnd, %SW_SHOWNORMAL) '<<<<<<<<Typical Location!
While GetMessage(Msg,%NULL,0,0)
TranslateMessage Msg
DispatchMessage Msg
Wend
WinMain=0
End Function
This setup I use with function pointers set to the address of event handling procedures by CodePtr() actually isn't anything I dreamed up myself. All I did actually was translate the idea to PowerBASIC from Douglas Boling's "Programming Microsoft Windows CE" series of books from Microsoft Press. Douglas Boling is more or less the Charles Petzold of Windows CE programming and he writes books, consults on Windows CE issues, and teaches seminars on it etc. Here is what he has to say about this technique...
Quote
One criticism of the typical SDK style of Windows programming has always been the huge switch statement in the window procedure. The switch statement parses the message to the window procedure so that each message can be handled independently. This standard structure has the one great advantage of enforcing a similar structure across almost all Windows applications, making it much easier for one programmer to understand the workings of another programmer's code. The disadvantage is that all the variables for the entire window procedure typically appear jumbled at the top of the procedure.
Over the years, I've developed a different style for my Windows programs. The idea is to break up the WinMain and WinProc procedures into manageable units that can be easily understood and easily transferred to other Windows programs....
I break the window procedure into individual procedures, with each handling a specific message. What remains of the window procedure itself is a fragment of code that simply looks up the message that's being passed to see whether a procedure has been written to handle that message. If so, that procedure is called. If not, the message is passed to the default window procedure.
This struct divides the handling of messages into individual blocks that can be more easily understood. Also, with greater isolation of one message handling code fragment from another, you can more easily transfer the code that handles a specific message from one program to the next. I first saw this structure described a number of years ago by Ray Duncan in one of his old "Power Programming" columns in 'PC Magazine'. Ray is one of the ledgends in the field of MS-DOS and OS/2 programming. I've since modified the design a bit to fit my needs, but Ray should get the credit for this program structure.