VFP2C32 - Feature request

Topics: Enhancement Request
Developer
Jun 3, 2011 at 4:42 AM

Hi Christian, some suggestions for the VFP2C32 FRONT:

1. Can you add a property to the generated wrapper called maybe "VALUE" or something similar, with access and assign methods, so we can set and get the whole structure in one line of code? Right now I use this:

Procedure Value_Access()
*!* This returns the whole structure
Return Sys(2600, This.Address, This.SizeOf)
Endproc

Procedure Value_Assign(lnNewVal)
*!* This assigns a string to the structure as a whole
Sys(2600, This.Address, This.SizeOf, m.lnNewVal)
Endproc

2. Can you add the _MemberData property, for example:

	_MemberData = '<VFPData>' + ;
		'<memberdata name="address" type="property" display="Address"/>' + ;
		'<memberdata name="sizeof" type="property" display="SizeOf"/>' + ;
		'<memberdata name="embedded" type="property" display="Embedded"/>' + ;
		'<memberdata name="name" type="property" display="Name"/>' + ;
		'<memberdata name="width" type="property" display="width"/>' + ;
		'<memberdata name="height" type="property" display="height"/>' + ;
		'<memberdata name="stride" type="property" display="Stride"/>' + ;
		'<memberdata name="pixelformat" type="property" display="PixelFormat"/>' + ;
		'<memberdata name="scan0" type="property" display="Scan0"/>' + ;
		'<memberdata name="reserved" type="property" display="Reserved"/>' + ;
		'</VFPData>'

3. An option to add this kind of code to beginning of the wrapper:

Lparameters pnAddress

If Vartype(m.pnAddress) = "N" Then
	Return Createobject("BITMAPDATA", m.pnAddress)
Else
	Return Createobject("BITMAPDATA")
Endif

Define Class BITMAPDATA As Exception

This way the wrapper can be saved as a prg and to create a structure you just do:

m.loBitmapData = _STRUCT_BITMAPDATA()

I save the prgs with a "_struct_" prefix so I can easily identify the prgs that are structure classes.

4. A way to save the preferences like "Assertions",  "Memory management", etc, so we don´t have to select them every time.

Developer
Jun 3, 2011 at 7:06 AM

Hello Carlos,

i've implemented all but the 1. request.

The problem with the "Value" property is that using it can lead to all kind of wrong code (memory leaks etc.) of not used correctly. 
For simple structures consisting only of basic numeric types this approach works OK, but when a structure has substructures or pointers to strings for example this won't work.

Since I don't have the time to implement it in a 100% reliable way I won't implement that feature.
I think it isn't a problem to just copy & paste the code if you need it.

The rest of your requests should work so far.
I've already updated the latest release, so you can just redownload it to get the updated version of VFP2C32 Front.

Greetings
Christian 

 

Jun 8, 2011 at 2:52 PM
Edited Jun 8, 2011 at 2:55 PM

Hi Christian, I don't know if this is a feature request or if it's already there and i haven't found it, so I'll post it here; if it's not appropriate feel free to remove it.

I've read the help topic on CreateThreadObject() function and i can't figure out how to implement an object that runs a series of routines (the same routine in a timer) all on the created thread (even the Time() method) in such a way that whenever the routine ends it should call the main app with the results of the routine (or the OnCallComplete() method)

The way i see it, i could call the a method that does the setup (and starts the timer) and that method's end will trigger OnCallComplete() or successively call the desired routine within a timer that exists in the main app's thread.

I don't know if i expressed myself clearly, basically i'd like to know if i have the possibility to instantiate a self-sustaining object in a that that whenever it does something will "ping" the main app, if it's not will you consider adding such a feature ?!

I guess that it's something similar to the UpdateProgress() scenario .. 

Developer
Jun 8, 2011 at 4:56 PM

Works great, thanks.

Developer
Jun 10, 2011 at 1:26 PM
Edited Jun 10, 2011 at 1:38 PM

Hello,

a normal VFP timer cannot be used within multithreaded COM objects, but one can use API based timers.

Here's some example code copied and slightly modified from one of my projects.

Project 1: Implements the COM object which is run on a secondary thread.

File "apistuff.prg": implements API based timers 

#INCLUDE "winapi.h"
 
FUNCTION GetLastError()
	DECLARE INTEGER GetLastError IN WIN32API
	RETURN GetLastError()
ENDFUNC

FUNCTION CloseHandle(hObject)
	DECLARE INTEGER CloseHandle IN WIN32API INTEGER hObject
	RETURN CloseHandle(m.hObject)
ENDFUNC

FUNCTION WaitForSingleObject(hHandle, dwMilliseconds)
	DECLARE INTEGER WaitForSingleObject IN WIN32API INTEGER hHandle, INTEGER dwMilliseconds
	RETURN WaitForSingleObject(m.hHandle, m.dwMilliseconds) 
ENDFUNC

FUNCTION WaitForMultipleObjects(nCount, lpHandles, bWaitAll, dwMilliseconds)
	DECLARE INTEGER WaitForMultipleObjects IN WIN32API INTEGER nCount, STRING lpHandles, INTEGER bWaitAll, INTEGER dwMilliseconds
	RETURN WaitForMultipleObjects(m.nCount, m.lpHandles, m.bWaitAll, m.dwMilliseconds)
ENDFUNC

FUNCTION CreateEvent(lpEventAttributes, bManualReset, bInitialState, lpName)
	DECLARE INTEGER CreateEvent IN WIN32API INTEGER lpEventAttributes, INTEGER bManualReset, INTEGER bInitialState, STRING lpName
	RETURN CreateEvent(m.lpEventAttributes, m.bManualReset, m.bInitialState, m.lpName)
ENDFUNC

FUNCTION SetEvent(hEvent)
	DECLARE INTEGER SetEvent IN WIN32API INTEGER hEvent
	RETURN SetEvent(m.hEvent)
ENDFUNC

FUNCTION CreateWaitableTimer(lpTimerAttributes, bManualReset, lpTimerName)
	DECLARE INTEGER CreateWaitableTimer IN WIN32API INTEGER lpTimerAttributes, INTEGER bManualReset, STRING lpTimerName
	RETURN CreateWaitableTimer(m.lpTimerAttributes, m.bManualReset, m.lpTimerName)
ENDFUNC

FUNCTION SetWaitableTimer(hTimer, pDueTime, lPeriod, pfnCompletionRoutine, lpArgToCompletionRoutine, fResume)
	DECLARE INTEGER SetWaitableTimer IN WIN32API INTEGER hTimer, INTEGER pDueTime, INTEGER lPeriod, INTEGER pfnCompletionRoutine, ;
				INTEGER lpArgToCompletionRoutine, INTEGER fResume
	RETURN SetWaitableTimer(m.hTimer, m.pDueTime, m.lPeriod, m.pfnCompletionRoutine, m.lpArgToCompletionRoutine, m.fResume)
ENDFUNC

FUNCTION CancelWaitableTimer(hTimer)
	DECLARE INTEGER CancelWaitableTimer IN WIN32API INTEGER hTimer
	RETURN CancelWaitableTimer(m.hTimer)
ENDFUNC

DEFINE CLASS ExceptionBase AS Exception

	StackTrace = ''
	
	&& reads the lineno and procedure from the stack information at the passed relative level
	PROTECTED FUNCTION GetStackInfo(lnStackLevel)
		LOCAL laStack[1], lnCount, lnLevel, lcStackTrace, xj
		m.lnCount = ASTACKINFO(m.laStack)
		IF m.lnCount - m.lnStackLevel >= 1
			m.lnLevel = m.lnCount - m.lnStackLevel
		ELSE
			m.lnLevel = m.lnCount
		ENDIF
		
		THIS.Procedure = m.laStack[m.lnLevel, 4]
		THIS.LineNo = m.laStack[m.lnLevel, 5]		
		THIS.StackLevel = m.laStack[m.lnLevel, 1]
		
		m.lcStackTrace = ''
		FOR m.xj = 1 TO m.lnLevel
			m.lcStackTrace = m.lcStackTrace + ALLTRIM(STR(m.laStack[m.xj, 1])) + PADR(': Line ' + ALLTRIM(STR(m.laStack[m.xj, 5])), 14, ' ') + ;
							 PADR(ALLTRIM(m.laStack[m.xj, 6]), 100, ' ') + ' -> ' + m.laStack[m.xj, 3] + ' (' + m.laStack[m.xj, 2] + ')' + CHR(13)
		ENDFOR
		THIS.StackTrace = m.lcStackTrace
	ENDFUNC
	
ENDDEFINE

DEFINE CLASS Win32Exception AS ExceptionBase
	
	NativeErrorCode = 0
	Name = 'Win32Exception'
	
	FUNCTION Init(lnErrorNo, lcFunction, lcMessage)
		THIS.GetStackInfo(2)
		THIS.NativeErrorCode = m.lnErrorNo
		THIS.Details = IIF(VARTYPE(m.lcFunction) = 'C', m.lcFunction, '')
		THIS.Message = IIF(VARTYPE(m.lcMessage) = 'C', m.lcMessage, FormatMessageEx(m.lnErrorNo))
	ENDFUNC
	
ENDDEFINE

DEFINE CLASS CWaitableHandleBase As Custom
	
	PROTECTED hHandle
	hHandle = 0
	PROTECTED bOwner
	bOwner = .T.

	FUNCTION Destroy
		THIS.Close()
	ENDFUNC
	
	FUNCTION Close()
		IF THIS.hHandle != 0
			IF THIS.bOwner
				CloseHandle(THIS.hHandle)
			ENDIF
			THIS.hHandle = 0
		ENDIF
	ENDFUNC

	FUNCTION IsSignaled()
		LOCAL lnRet
		m.lnRet = WaitForSingleObject(THIS.hHandle, 0)
		DO CASE
			CASE m.lnRet = WAIT_OBJECT_0
				RETURN .T.
			CASE m.lnRet = WAIT_TIMEOUT
				RETURN .F.
			CASE m.lnRet = WAIT_FAILED
				THROW CREATEOBJECT('Win32Exception', GetLastError(), 'WaitForSingleObject')
		ENDCASE
	ENDFUNC

	FUNCTION Wait(lnTimeOut, laEvents)
		LOCAL lcHandles, lnHandleCount, lnRet, lnCount, xj
		EXTERNAL ARRAY laEvents
		m.lnHandleCount = 1
		m.lcHandles = Long2Str(THIS.hHandle)

		IF VARTYPE(m.lnTimeOut) != 'N'
			m.lnTimeOut = INFINITE
		ENDIF
		
		DO CASE
			CASE TYPE('m.laEvents', 1) = 'A'
				m.lnCount = ALEN(m.laEvents)
				FOR m.xj = 1 TO m.lnCount
					DO CASE
						CASE VARTYPE(m.laEvents[m.xj]) = 'N'					
							m.lcHandles = m.lcHandles + Long2Str(m.laEvents)
							m.lnHandleCount = m.lnHandleCount + 1
						CASE VARTYPE(m.laEvents[m.xj]) = 'O'
							m.lcHandles = m.lcHandles + Long2Str(m.laEvents.GetGandle())
							m.lnHandleCount = m.lnHandleCount + 1
					ENDCASE
				ENDFOR
				
			CASE VARTYPE(m.laEvents) = 'N'
				m.lnHandleCount = 2
				m.lcHandles = m.lcHandles + Long2Str(m.laEvents)

			CASE VARTYPE(m.laEvents) = 'O'
				m.lnHandleCount = 2
				m.lcHandles = m.lcHandles + Long2Str(m.laEvents.GetHandle())
			
		ENDCASE

		m.lnRet = WaitForMultipleObjects(m.lnHandleCount, m.lcHandles, FALSE, m.lnTimeOut)
		IF m.lnRet = WAIT_FAILED
			THROW CREATEOBJECT('Win32Exception', GetLastError(), 'WaitForMultipleObjects')
		ENDIF
		RETURN m.lnRet
	ENDFUNC

	FUNCTION Attach(hHandle, bOwner)
		THIS.Close()
		THIS.hHandle = m.hHandle
		IF PCOUNT() = 1
			THIS.bOwner = .T.
		ELSE
			THIS.bOwner = m.bOwner
		ENDIF
	ENDFUNC

	FUNCTION GetHandle()
		RETURN THIS.hHandle
	ENDFUNC

ENDDEFINE

DEFINE CLASS CEvent AS CWaitableHandleBase

	FUNCTION Init(bManualReset, bInitialState, cName)
		IF PCOUNT() > 0
			THIS.Create(m.bManualReset, m.bInitialState, m.cName)
		ENDIF
	ENDFUNC

	FUNCTION Create(bManualReset, bInitialState, cName)
		IF VARTYPE(cName) != 'C'
			m.cName = .NULL.
		ENDIF
		THIS.Close()
		THIS.hHandle = CreateEvent(0, IIF(m.bManualReset, TRUE, FALSE), IIF(m.bInitialState, TRUE, FALSE), m.cName)
		IF THIS.hHandle = 0
			THROW CREATEOBJECT('Win32Exception', GetLastError(), 'CreateEvent')
		ENDIF
		THIS.bOwner = .T.
	ENDFUNC

	FUNCTION Signal()
		IF SetEvent(THIS.hHandle) = 0
			THROW CREATEOBJECT('Win32Exception', GetLastError(), 'SetEvent')
		ENDIF
	ENDFUNC

ENDDEFINE

DEFINE CLASS CWaitableTimer AS CWaitableHandleBase

	FUNCTION Init(bManualReset, cName)
		IF PCOUNT() > 0
			THIS.Create(m.bManualReset, m.cName)
		ENDIF
	ENDFUNC

	FUNCTION Create(bManualReset, cName)
		IF VARTYPE(cName) != 'C'
			m.cName = .NULL.
		ENDIF
		THIS.Close()
		THIS.hHandle = CreateWaitableTimer(0, IIF(m.bManualReset, TRUE, FALSE), m.cName)
		IF THIS.hHandle = 0
			THROW CREATEOBJECT('Win32Exception', GetLastError(), 'CreateWaitableTimer')
		ENDIF
		THIS.bOwner = .T.
	ENDFUNC

	FUNCTION SetTimer(nInterval, tStartTime)
		LOCAL lnRet, loFileTime
		m.loFileTime = CREATEOBJECT('FILETIME')
		DO CASE
			CASE VARTYPE(m.tStartTime) = 'T'
				m.loFileTime.mDate = m.tStartTime
			CASE VARTYPE(m.tStartTime) = 'N'
				m.loFileTime.dwQuadPart = m.tStartTime * -10000
			OTHERWISE
				m.loFileTime.dwQuadPart = m.nInterval * -10000
		ENDCASE
		m.lnRet = SetWaitableTimer(THIS.hHandle, m.loFileTime.Address, m.nInterval, 0, 0, 0)
		IF m.lnRet = 0
			THROW CREATEOBJECT('Win32Exception', GetLastError(), 'SetWaitableTimer')
		ENDIF
	ENDFUNC

	FUNCTION CancelTimer
		IF CancelWaitableTimer(THIS.hHandle) = 0
			THROW CREATEOBJECT('Win32Exception', GetLastError(), 'CancelWaitableTimer')
		ENDIF
	ENDFUNC

ENDDEFINE

DEFINE CLASS FILETIME AS Exception

	Address = 0
	SizeOf = 8
	PROTECTED Embedded	
	Embedded = .F.
	&& structure fields
	dwLowDateTime = .F.
	dwHighDateTime = .F.
	dwQuadPart = .F.
	&& additional properties to convert the filetime structure to/from a VFP datetime 
	mDate = .F.
	mUTCDate = .F.
	
	PROCEDURE Init(lnAddress)
		IF PCOUNT() = 0
			THIS.Address = AllocMem(THIS.SizeOf)
		ELSE
			ASSERT VARTYPE(m.lnAddress) = 'N' AND m.lnAddress != 0 MESSAGE 'Address of structure must be specified!'
			THIS.Address = m.lnAddress
			THIS.Embedded = .T.
		ENDIF
	ENDPROC
	
	PROCEDURE Destroy()
		IF !THIS.Embedded
			FreeMem(THIS.Address)
		ENDIF
	ENDPROC

	PROCEDURE dwLowDateTime_Access()
		RETURN ReadUInt(THIS.Address)
	ENDPROC

	PROCEDURE dwLowDateTime_Assign(lnNewVal)
		WriteUInt(THIS.Address, m.lnNewVal)
	ENDPROC

	PROCEDURE dwHighDateTime_Access()
		RETURN ReadUInt(THIS.Address + 4)
	ENDPROC

	PROCEDURE dwHighDateTime_Assign(lnNewVal)
		WriteUInt(THIS.Address + 4, m.lnNewVal)
	ENDPROC

	PROCEDURE dwQuadPart_Access()
		RETURN ReadUInt64(THIS.Address)
	ENDPROC

	PROCEDURE dwQuadPart_Assign(lnNewVal)
		WriteUInt64(THIS.Address, m.lnNewVal)
	ENDPROC
	
	PROCEDURE mDate_Access()
		RETURN FT2DT(THIS.Address)
	ENDPROC

	PROCEDURE mDate_Assign(lnNewVal)
		DT2FT(m.lnNewVal, THIS.Address)
	ENDPROC

	PROCEDURE mUTCDate_Access()
		RETURN FT2DT(THIS.Address, .T.)
	ENDPROC

	PROCEDURE mUTCDate_Assign(lnNewVal)
		DT2FT(lnNewVal,THIS.Address, .T.)
	ENDPROC

ENDDEFINE

 

File: timerthread.prg: implements the COM object

#INCLUDE "foxpro.h"
#INCLUDE "vfp2c.h"
#INCLUDE "winapi.h"

DEFINE CLASS TimerThread AS Session OLEPUBLIC

	DataSession = 2
	CallInfo = .NULL.
		
	FUNCTION StartTimer(loCallback AS Object) As Void
		TRY
			SET LIBRARY TO vfp2c32t.fll ADDITIVE
			INITVFP2C32(VFP2C_INIT_MARSHAL)
			&& create a timer with an interval of 1 minute
			LOCAL loTimer
			m.loTimer = CREATEOBJECT('CWaitableTimer', .F.)
			m.loTimer.SetTimer(60 * 1000)

			DO WHILE .T.
				&& wait for timer and thread abort event
				IF m.loTimer.Wait(INFINITE, THIS.CallInfo.AbortEvent) = WAIT_OBJECT_0
					THIS.OnTimer(loCallback)
				ELSE
					EXIT
				ENDIF
			ENDDO

		CATCH TO loExc
			THIS.ThrowError(m.loExc)
		ENDTRY

	ENDFUNC
	
	FUNCTION OnTimer(loCallback AS Object) AS VOID
		&& do some work here
		m.loCallback.TestCallback() && call a method on the main VFP thread
	ENDFUNC
	
	ThrowError_COMATTRIB = COMATTRIB_RESTRICTED && don't expose error event
	FUNCTION ThrowError(loExc)
		LOCAL lcError, lcMessage

		TRY

			DO CASE
				CASE VARTYPE(m.loExc.UserValue) = 'O' AND m.loExc.UserValue.Name = 'Win32Exception'
					m.lcError = 'Win32Exception' + CHR(10) + ;
						'Error No : ' + TRANSFORM(m.loExc.UserValue.ErrorNo) + CHR(10) + ;
					    'Function : ' + m.loExc.UserValue.Details + CHR(10) + ;
					    'Program : ' + m.loExc.UserValue.Procedure + CHR(10) + ;
					    'LineNo: ' + TRANSFORM(m.loExc.UserValue.LineNo) + CHR(10) + ;
					    'StackTrace: ' + m.loExc.UserValue.StackTrace
					m.lcMessage = m.loExc.UserValue.Message
					
				CASE m.loExc.ErrorNo = 1098
					LOCAL laError[1]
					AERROREX('laError')		
					m.lcError = 'Error No : ' + TRANSFORM(m.laError[1]) + CHR(10) + ;
							    'Function : ' + m.laError[2] + CHR(10) + ;
							    'LineNo: ' + + TRANSFORM(m.loExc.LineNo)
					m.lcMessage = m.laError[3]
					
				OTHERWISE
					m.lcError = 'Error No : ' + TRANSFORM(m.loExc.ErrorNo) + CHR(10) + ;
						    'LineContents : ' + m.loExc.LineContents + CHR(10) + ;
	   					    'LineNo: ' + + TRANSFORM(m.loExc.LineNo) + CHR(10) + ;				    
	   					    'Program : ' + m.loExc.Procedure + CHR(10)
	   				m.lcMessage = m.loExc.Message
	   				
	   			ENDCASE

		CATCH TO loExc2

			m.lcError = 'Error No : ' + TRANSFORM(m.loExc2.ErrorNo) + CHR(10) + ;
				    'LineContents : ' + m.loExc2.LineContents + CHR(10) + ;
				    'LineNo: ' + + TRANSFORM(m.loExc2.LineNo) + CHR(10) + ;				    
				    'Program : ' + m.loExc2.Procedure + CHR(10)
			m.lcMessage = m.loExc2.Message
	
		ENDTRY

		COMRETURNERROR(m.lcError, m.lcMessage)
	ENDFUNC	
		
ENDDEFINE

 

File "winapi.h": some needed windows API definintions

#DEFINE FALSE	0
#DEFINE TRUE	1
#DEFINE INVALID_HANDLE_VALUE -1
#DEFINE WAIT_OBJECT_0		0
#DEFINE WAIT_FAILED			0xFFFFFFFF
#DEFINE WAIT_TIMEOUT		258
#DEFINE INFINITE			0xFFFFFFFF

You also need to add "vfp2c.h", "foxpro.h" and "vfp2c32t.fll" to the project.

 

Project 2: somewhere in your main project which uses the above COM class define the following class. The "TestCallback" function will be called every time the timer fires.

DEFINE CLASS TimerCallback AS Custom
	
	FUNCTION TestCallback()
		WAIT WINDOW 'Callback called @' + TRANSFORM(DATETIME()) NOWAIT NOCLEAR
	ENDFUNC	
	
ENDDEFINE

 

and here some code to set everything up:

loCallback = CREATEOBJECT('TimerCallback')
loTimerThread = CREATETHREADOBJECT('NameOfProject1.TimerThread')
loTimerThread.StartTimer(loCallback)

The object references need to stay in scope, so either make them PUBLIC or store the them directly into properties of _SCREEN for example.

to stop the timer and force the method in the thread to exit you can call:

loTimerThread.AbortCall()

 

That's the basic setup ... 

Greetings
Christian 

Jun 11, 2011 at 12:27 AM
Edited Aug 13, 2011 at 9:45 PM

Thank you Christian, this is more than i hoped for :)

Cheers,
Eduard. 

---------------
Edit - 26.07.2011: This may be a stupid question, but where do i find a complete/original "winapi.h" ?! I can't find it anywhere on my system and on the internet this header file seems to be customized for for the use of its application (open source software mostly). I thought this was a "standard" of some kind .. :|

---------------
Edit - 14.08.2011:  Christian, may I suggest that the example for continuous thread operation (with timer) that you've placed here would be a nice addition to the CreateTheardObject() topic in vfp2c32.chm ? Or at least for the 'vfp2c32examples' directory in the release archive.