Author Topic: COM Tutorial #3: Building Local Server With Low Level PowerBASIC Code  (Read 12213 times)

0 Members and 1 Guest are viewing this topic.

Offline Frederick J. Harris

  • Hero Member
  • *****
  • Posts: 914
  • User-Rate: +16/-0
    • Frederick J. Harris
Code: [Select]
#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...

Code: [Select]
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
« Last Edit: August 25, 2010, 09:39:48 PM by Frederick J. Harris »

Offline Frederick J. Harris

  • Hero Member
  • *****
  • Posts: 914
  • User-Rate: +16/-0
    • Frederick J. Harris
Re: COM Tutorial #3: Building Local Server With Low Level PowerBASIC Code
« Reply #1 on: August 24, 2010, 07:57:15 PM »
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.

Offline Frederick J. Harris

  • Hero Member
  • *****
  • Posts: 914
  • User-Rate: +16/-0
    • Frederick J. Harris
Re: COM Tutorial #3: Building Local Server With Low Level PowerBASIC Code
« Reply #2 on: August 24, 2010, 07:59:58 PM »
Here is a PowerBASIC Console Compiler 5.04 Program that connects to CC.exe...

Code: [Select]
#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

Offline Frederick J. Harris

  • Hero Member
  • *****
  • Posts: 914
  • User-Rate: +16/-0
    • Frederick J. Harris
Re: COM Tutorial #3: Building Local Server With Low Level PowerBASIC Code
« Reply #3 on: August 24, 2010, 08:04:31 PM »
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...

Code: [Select]
'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
« Last Edit: August 24, 2010, 08:07:15 PM by Frederick J. Harris »

Offline Frederick J. Harris

  • Hero Member
  • *****
  • Posts: 914
  • User-Rate: +16/-0
    • Frederick J. Harris
Re: COM Tutorial #3: Building Local Server With Low Level PowerBASIC Code
« Reply #4 on: August 24, 2010, 08:14:22 PM »
Here are Main.inc, Registry.inc, CC.idl, and CC.rc

Code: [Select]
'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

Code: [Select]
'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

Code: [Select]
'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;
 };
};

Code: [Select]
//CC.rc
1  typelib CC.TLB
//end cc.rc

Offline Frederick J. Harris

  • Hero Member
  • *****
  • Posts: 914
  • User-Rate: +16/-0
    • Frederick J. Harris
Re: COM Tutorial #3: Building Local Server With Low Level PowerBASIC Code
« Reply #5 on: August 24, 2010, 08:16:38 PM »
I'll post a VB.NET, C, and C++ client later when I have time.

Offline Frederick J. Harris

  • Hero Member
  • *****
  • Posts: 914
  • User-Rate: +16/-0
    • Frederick J. Harris
Re: COM Tutorial #3: Building Local Server With Low Level PowerBASIC Code
« Reply #6 on: August 24, 2010, 08:57:25 PM »
This would be a C client...

Code: [Select]
#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;
}

Offline Frederick J. Harris

  • Hero Member
  • *****
  • Posts: 914
  • User-Rate: +16/-0
    • Frederick J. Harris
Re: COM Tutorial #3: Building Local Server With Low Level PowerBASIC Code
« Reply #7 on: August 24, 2010, 09:00:07 PM »
...and a C++ version that's about the same...

Code: [Select]
#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.

Offline Frederick J. Harris

  • Hero Member
  • *****
  • Posts: 914
  • User-Rate: +16/-0
    • Frederick J. Harris
Re: COM Tutorial #3: Building Local Server With Low Level PowerBASIC Code
« Reply #8 on: August 25, 2010, 06:15:52 PM »
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.
« Last Edit: August 25, 2010, 06:48:15 PM by José Roca »

Offline Frederick J. Harris

  • Hero Member
  • *****
  • Posts: 914
  • User-Rate: +16/-0
    • Frederick J. Harris
Re: COM Tutorial #3: Building Local Server With Low Level PowerBASIC Code
« Reply #9 on: September 17, 2010, 08:39:46 PM »
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…

Code: [Select]
#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…

Code: [Select]
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()…

Code: [Select]
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 …

Code: [Select]
'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
 

Code: [Select]
#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...
« Last Edit: September 17, 2010, 08:47:04 PM by Frederick J. Harris »

Offline Frederick J. Harris

  • Hero Member
  • *****
  • Posts: 914
  • User-Rate: +16/-0
    • Frederick J. Harris
Re: COM Tutorial #3: Building Local Server With Low Level PowerBASIC Code
« Reply #10 on: September 17, 2010, 08:51:45 PM »
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…

Code: [Select]
'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

Code: [Select]
#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()…

Code: [Select]
#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.