Decorating with This_Access

Lately I have been busy coding VFP Solution Explorer, but I thought I would take a short break (don't tell Craig) to share this with you.

 

I had a situation(s) where I needed to sub-class a non-sub-classable(?) object, like a COM object. I naturally started to implement a decorator pattern but was faced with a mountain of tedious coding to implement the COM objects' interface (properties, events, and methods) even using the object browser to generate the basic class definition.

 

Having never really used the This_Access method in anger before, I decided to have a second look. This saved me loads of time as it relived the need to implement all those PEMs I was not really interested in.

 

Here is a simplified example of how I used the This_Access method as a shortcut for my decorator class.

 

* Set this constant to an existing project you have somewhere

#Define PROJECT_FILE    "MyProjectFile.pjx"

 

Local oMyProject As MyProject

 

* Create an instance of our project class passing the project file to the Init method.

oMyProject = NewObject("MyProject", "", "", PROJECT_FILE)

 

* Display some project properties to the desktop

? oMyProject.HomeDir

? oMyProject.Files.Count

 

* Call our Close method so we can execute our code before and after the project closes.

oMyProject.Close()

 

Return

 

Define Class MyProject As Custom

 

      IFoxProject = Null

     

      Function Init(lpcProjectFile As String)

     

            * Check if project is open

            If Type([Application.Projects("] + lpcProjectFile + [")]) = "U"

                  * Open project

                  Modify Project (lpcProjectFile) NoWait Save NoShow

            EndIf

           

            * Set a reference to the project object

            This.IFoxProject = Application.Projects(lpcProjectFile)

           

      EndFunc

     

      Function This_Access(lpcMemberName As String)

     

            * Check if we wish to handle this or just pass it on to the IFoxProject object

            If Not InList(lpcMemberName, "ifoxproject", "build", "close")

 

                  * Check we have a reference to the project object

                  If Not IsNull(This.IFoxProject)

                        Return This.IFoxProject

                  EndIf      

 

            EndIf

           

            * Return the reference to this class

            Return This

           

      EndFunc

     

      Function Close()

     

            *** Write code or raise a before close event here ***

           

            This.IFoxProject.Close()

           

            *** Write code or raise an after close event here ***

           

      EndFunc

     

      Function Build(   lpcOutputName As String, lpnBuildAction As Integer,;

                        lpbRebuildAll As Boolean, lpbShowErrors As Boolean,;

                        lpbBuildNewGUIDs As Boolean)

     

            *** Write code or raise a before build event here ***

           

            This.IFoxProject.Build( lpcOutputName As String, lpnBuildAction As Integer,;

                                   lpbRebuildAll As Boolean, lpbShowErrors As Boolean,;

                                   lpbBuildNewGUIDs As Boolean)

           

            *** Write code or raise an after build event here ***

           

      EndFunc

 

EndDefine

 

As you can see from the code, I have defined my project decorator class with only those members I need to extend (the Close and Build methods in the example). In the This_Access method, I check at runtime what member is being accessed (or assigned) and "switch" between returning my object instance and returning the object instance I am decorating.

 

The attractiveness of this approach is the amount of code required when only a few PEMs need to be sub-classed. When new requirements present, new PEMs can be added to your class and those member names added to the list in This_Access. (you could even use PEMSTATUS() to test if the member name parameter is defined on your class and never have to touch the This_Access again).

 

Further benefits to this design allows the interface your decorating (sub-classing) to extend with out breaking your code (excluding member name conflicts and changes to the existing interface, but those are current sub-classing issues as well aren't they). That is, if the implemented class adds a new property, your class will inherit the property as if you sub-classed.

 

On the down side, the caller is somewhat blind to the PEMs'. That is, by using the This_Access method, the PEMs' are only made available "just in time". Try using PEMSTATUS() or AMEMBERS() on the oMyProject object and see what is returned?

 

I will let you know how this design holds up in the VFP Solution Explorer project.

 

Powered By Qumana

AMEMBERS Gotcha

Again, here I hope to save a few fellow tax payers some time and possibly hardware. I have just spent two to three hours on this one and my head is still spinning. I'm joking about the hardware, I have a strict "three strikes and out" policy towards cruelty to IO devices.

 

I was unit testing some code I was writing for VFP Solution Explorer. The code was doing some type discovery of sorts on some user defined class instances based on the Empty class. In particular, I was using AMEMBERS() to place the properties of the passed object into an array.

 

I had similar code in a number of places and it was working in all but one. After a lengthy process of elimination, it turned out the only difference was the code that was failing was inside a FOR EACH...NEXT loop.

 

The following sample code demonstrates this

 

Local oCollection As Collection, oUser As Object, lnIndex As Integer

 

* Create an instance of a collection class so we can iterate

*     through the collection using For Each..Next and For..Next

oCollection = NewObject("Collection")

 

* Add a couple user defined objects to the collection

For lnIndex = 1 to 3

 

      * Create an user defined object with a couple of properties

      oUser = NewObject("Empty")

      AddProperty(oUser, "Property1", "Value1")

      AddProperty(oUser, "Property2", "Value2")

 

      * Add to collection

      oCollection.Add(oUser) 

Next

 

* Output the number of properties returned by AMembers() when

*     passed our user defined object in different ways

Clear

? "* First item of collection" + Chr(9), "Properties found: ", AMembers(laAtttributes, oCollection(1), 0)

 

* Using a For Each...Next loop

For Each oUser In oCollection

      ? "* For Each loop" + Chr(9) + Chr(9), "Properties found: ", AMembers(laAtttributes, oUser, 0)

      Exit

Next

 

* Using a For...Next loop

For lnIndex = 1 To oCollection.Count

      oUser = oCollection.Item(lnIndex)

      ? "* For Next loop" + Chr(9) + Chr(9), "Properties found: ", AMembers(laAtttributes, oUser, 0)

      Exit

Next

 

Notice, when inside a FOR EACH..NEXT loop, AMEMBERS() fails to retrieve any property information from the user defined object.

 

I favour using FOR EACH...NEXT loops over FOR...NEXT loops as I like to work with collections over arrays. But even when using arrays, Fox allows me to keep consistent and use FOR EACH...NEXT loops when iterating through arrays...perhaps not?

 

Powered By Qumana

BindEvent() and Compile

Recently I have been working on a Fox IDE tool called FoxTabs. FoxTabs utilises my favourite feature of VFP 9.0, binding to Windows message events. The design approach is to hook into window events within the Fox IDE and manage multiple editing windows via tab controls on a toolbar. We, Craig and I, have just posted a beta version for all to check out. However there is one issue preventing me from getting some well earned sleep. (issue posted by Alan Stevens on the forum)

 

When running FoxTabs, if an error occurs during compiling your source code, VFP crashes. I admit, its only a minor issue. I mean, who writes code with bugs in it right? :-P

 

So what's happening? We have event bindings to all WM_CREATE events received by Fox. When a window is created, we interrogate its properties to see if it is an IDE window we want to manage via a toolbar tab. When the compile error occurs, Fox will create a dialog box to display the error. It is when we process the WM_CREATE event of this dialog box we get the fatal crash.

 

Here is some simplified code to demonstrate this:

 

* Window messaging constants

#define GWL_WNDPROC           (-4)

#define WM_CREATE             0x0001

#define WM_DESTROY            0x0002

#define WM_SETTEXT            0x000C

 

* Create an instance of the wnHandler class

Public wmHandler As wmHandler

wmHandler = NewObject("wmHandler")

 

* Bind to all window create notifications

BindEvent(0, WM_CREATE, wmHandler, "wmEventHandler")

 

Return

 

* Define Windows messages event handler class

Define Class wmHandler As Custom

 

      PrevWndFunc       = 0

      IgnoreEvents      = .F.

     

      Function wmEventHandler(hWnd As Integer, Msg As Integer, wParam As Integer, lParam As Integer)

     

            Local lnReturn As Integer

           

            Do Case

                  Case This.IgnoreEvents

                        ? "Ignoring WM events"

 

                  Case Msg = WM_CREATE

                        ? Transform(hWnd, "@0x"), "WM_CREATE", Transform(wParam, "@0x"), Transform(lParam, "@0x")

 

                        * Bind to the WM_SETTEXT messages received by this window

                        BindEvent(hWnd, WM_SETTEXT, wmHandler, "wmEventHandler")

 

                  Case Msg = WM_SETTEXT        

                        ? Transform(hWnd, "@0x"), "WM_SETTEXT", Transform(wParam, "@0x"), Transform(lParam, "@0x")

 

                  Case Msg = WM_DESTROY

                        * Remove all WM event bindings to this window

                        UnBindEvents(hWnd)

 

            EndCase

 

            * Pass the WM event to the intended Window procedure

            lnReturn = CallWindowProc(This.PrevWndFunc, hWnd, Msg, wParam, lParam)

           

            Return lnReturn

           

      EndFunc

 

      Function Init()

           

            * Declare Win32 API functions

            Declare Integer CallWindowProc In Win32API Integer lpPrevWndFunc, Integer hWnd, Integer Msg, Integer wParam, Integer lParam

            Declare Integer GetWindowLong In Win32API Integer hWnd, Integer nIndex

 

            * Store handle for use in CallWindowProc

            This.PrevWndFunc = GetWindowLong(_Vfp.hWnd, GWL_WNDPROC)

 

      EndFunc

 

      Function Destroy()

     

            * Remove all WM event bindings

            UnBindEvents(0)

           

      EndFunc

     

EndDefine

 

Copy the code into a PRG and run. Open some IDE editing windows and observe the text outputted to the desktop. To reproduce the crash, open a new PRG and enter some junk (anything that will generate a compilation error). Compile the PRG...Bugger!

 

Now run the test again, only this time before you compile the PRG, go the command window and type

 

wmHandler.IgnoreEvents = .T.

 

Compile the PRG and notice the sky does not fall in.

 

So it would seem that the solution may be to implement some sort of BeforeCompile() event hook and disable my Windows message event processing. But how can I determine whether Fox is in the middle of compiling some code? I have tried the call stack but no luck there.

 

I have no choice, I am going to have to use the emergency red phone (the Fox phone) and contact Calvin. After all, it was Calvin who coded all this great functionality. If he can not help me, I am truly Wallaby Ted's brother Roo!

 

Powered By Qumana

COM Servers shutting down

I've been working with COM servers in Fox for some time now and I am still finding new tips and functions that help me solve issues. I thought I might share one issue and its solution with the hope it may save you a few precious hours, perhaps days.

 

The issue arose when a business object I was exposing as web service would suddenly shutdown and stop responding to requests. The object was written in 8.0 and compiled as a multi-threaded dll. I then installed the component into a COM+ application and exposed it as a web service.

 

The business object would query a Fox database, transform the resultant dataset into xml, and pass the xml document string back down the wire to the caller. This solution tested well in development and I deployed to the client's production environment where it ran successfully. Another satisfied client...or so I thought.

 

A few days went by when the client contacted me and reported the web service had just stopped responding. I was able to confirm this from my location and decided to log onto their server and check the logs. After establishing the remote desktop connection, I found no logs reporting component failure or trouble with the IIS service. So I test again locally, and hey it works. Further tests from my remote location are also successful.

 

So what we had was a web service that would suddenly stop responding and the act of logging onto the IIS server seem to fix the problem. It took a number of days, and many shutdowns, to identify the cause of the issue. We found that Fox was responding to the log off event of the console account and shutting down.

 

After much research, I had one of those great Fox moments. I came across an obscure SYS function that completely solved my problem.

SYS(2340 [,0 | 1 ])

This function intercepts Windows logoff messages (WM_QUERYENDSESSION and WM_ENDSESSION) to Visual FoxPro and specifies whether to keep Visual FoxPro COM Server instances running or to shut them down. A Visual FoxPro application will terminate when the current user logs off Windows. If the application is a Windows Service, then that service will terminate. Enabling support for NT service will make it possible for Visual FoxPro applications to continue even if the current user logs off Windows.

I added one line of code to the Init() of my business object

* Enable NT support
SYS(2340, 1)

re-compiled and deployed to the client. Now my Fox component, exposed as a web service via COM+, ignores the Windows log off notifications preventing the service from shutting down.

 

Powered By Qumana

Class name during Init()

While working on an enhancement to my label base class control I stumbled across a real gotcha with the way VFP instantiates objects.

 

Craig had showed me some great code he had implemented on his label base class to allow user defined captions. On the Init() of the label control, a check would be made for a stored user defined caption in a table. If one is found, the caption property is set to the user defined value otherwise the default caption isused. The user was able to change the caption by right clicking on the control.I used the label object’s hierarchy, SYS(1272), as the key on my lookup table.

 

What I found was, during object instantiation the value returned by SYS(1272) differed to the returned value after the object was instantiated. This can be demonstrated with the following code example:

 

Local oLabel As Label

 

Clear

? "*** On Init ***"

_Screen.NewObject("NewInstance", "SubContainer")

 

? "*** After Init ***"

For Each oLabel In _Screen.NewInstance.Controls

      oLabel.Init()

Next

_Screen.NewInstance.Init()

 

* All done

_Screen.RemoveObject("NewInstance")

 

Return

 

Define Class SubContainer As BaseContainer

 

      * Try commenting out this line

      Name = "SubContainer"

 

      Add Object lblSubLabel As BaseLabel

 

EndDefine

 

Define Class BaseContainer As Container

 

      * Try commenting out this line

      Name = "BaseContainer"

 

      Function Init()

            ? "BaseContainer.Init: " + Sys(1272, This)

      EndFunc

 

      Add Object lblBaseLabel As BaseLabel

     

EndDefine

 

Define Class BaseLabel As Label

 

      Name = "BaseLabel"

 

      Function Init()

            ? "BaseLabel.Init: " + Sys(1272, This)

      EndFunc

     

EndDefine

 

After executing this code, you will notice the object name changes when the object's Init() method executes. Try commenting out the Name properties on each of the class definitions. Notice that the object name remains consistent during instantiation.

 

So the answer is simple, do not explicitly set object names when defining objects.Well, that’s fine in this example, but this is what VFP actually does within the VCX. Try browsing the VCX table and see for yourself what’s going on under the hood.