Offset Gap in vTable UDT

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
Loe
Posts: 323
Joined: Apr 30, 2006 14:49

Offset Gap in vTable UDT

Post by Loe »

try to figure it out how vtable udt works
tlbinf32.dll will extract typelib info from ActiveX/COM, including vtable member offset for dual interface.

ax02.rc

Code: Select all

#define IDD_DLG1 1000
#define AX1 1001
#define btNxtDay 1004
#define btNxtMonth 1005
#define btNxtYear 1006
#define btPrvYear 1007
#define btPrvMonth 1008
#define btPrvDay 1009
#define btClrGrid 1002
#define btClrDay 1003
#define btClrBack 1010
#define btAbout 1011
#define IDC_STC1 1012

IDD_DLG1 DIALOGEX 6,6,189,172
CAPTION "Ax02-Ax Control vTable Call"
FONT 8,"MS Sans Serif",0,0,0
STYLE 0x10CF0800
BEGIN
  CONTROL "MSCAL.Calendar.7",AX1,"AtlAxWin71",0x50000000,0,0,188,131
  CONTROL "Next Day",btNxtDay,"Button",0x50010000,0,134,42,11
  CONTROL "Next Month",btNxtMonth,"Button",0x50010000,44,134,44,11
  CONTROL "Next Year",btNxtYear,"Button",0x50010000,90,134,42,11
  CONTROL "Prev Year",btPrvYear,"Button",0x50010000,90,147,42,11
  CONTROL "Prev Month",btPrvMonth,"Button",0x50010000,44,147,44,11
  CONTROL "Prev Day",btPrvDay,"Button",0x50010000,0,147,42,11
  CONTROL "Grid Color",btClrGrid,"Button",0x50010000,90,160,42,11
  CONTROL "Day Color",btClrDay,"Button",0x50010000,44,160,44,11
  CONTROL "Back Color",btClrBack,"Button",0x50010000,0,160,42,11
  CONTROL "About",btAbout,"Button",0x50010000,136,160,50,11
  CONTROL "Calendar Demo with AxSupport",IDC_STC1,"Static",0x50001001,134,134,54,22
END
ax02.bas

Code: Select all

'================================================
'Code generated by RC2CODE - RC To Code Generator
'Very first stage project, use at your own risk
'Contact Loe at webhasta[at]telkom.net
'================================================

'============================================================
'Tutorial 2 Using ActiveX Control with AxSupport vTable Call 
'============================================================ 

#Include once "windows.bi"
'#include once "C:\FbEdit\Projects\Ax01\Ax01.bi" 'exported names of resource file
'=========================================================================
'Include file of control
'=========================================================================
#Include once"win/ocidl.bi"
#Include Once "mscal.bi"

'=========================================================================
'Defined constant in .rc file. 
'Please delete this section if you have included exported names of resource.
'=========================================================================
#define IDD_DLG1 1000
#define AX1 1001
#define btNxtDay 1004
#define btNxtMonth 1005
#define btNxtYear 1006
#define btPrvYear 1007
#define btPrvMonth 1008
#define btPrvDay 1009
#define btClrGrid 1002
#define btClrDay 1003
#define btClrBack 1010
#define btAbout 1011
#define IDC_STC1 1012

'=========================================================================
'Global variable
'=========================================================================
dim shared as iCalendar Cal 'set Cal as Calendar object
Dim Shared As lpunknown punk
dim shared AxScode as scode

'=========================================================================
'Dialog callback procedure declaration
'=========================================================================
declare Function IDD_DLG1_DlgProc(byval hWin as HWND, byval uMsg as UINT, byval wParam as WPARAM, byval lParam as LPARAM) as integer
declare Function IDD_DLG1_Init(Byval hWin as hwnd,Byval wParam as wParam,Byval lParam as lParam)as Integer
declare Function IDD_DLG1_OnSize(Byval hWin as hwnd,Byval lState as long,Byval cx as long,Byval cy as long)as Integer
declare Function IDD_DLG1_OnClose(Byval hWin as hwnd)as Integer
declare Function IDD_DLG1_OnDestroy(Byval hWin as hwnd)as Integer
declare Function IDD_DLG1_OnNotify(Byval hWin as hwnd,Byval lCtlID as long,Byval lpNMHDR as NMHDR ptr,Byref lresult as long)as Integer
declare Function IDD_DLG1_OnTimer(Byval hWin as hwnd,Byval wTimerID as word)as Integer
declare function IDD_DLG1_btNxtDay_Clicked(Byval hWin as hwnd,Byval hCtrl as hwnd)as long
declare function IDD_DLG1_btNxtMonth_Clicked(Byval hWin as hwnd,Byval hCtrl as hwnd)as long
declare function IDD_DLG1_btNxtYear_Clicked(Byval hWin as hwnd,Byval hCtrl as hwnd)as long
declare function IDD_DLG1_btPrvYear_Clicked(Byval hWin as hwnd,Byval hCtrl as hwnd)as long
declare function IDD_DLG1_btPrvMonth_Clicked(Byval hWin as hwnd,Byval hCtrl as hwnd)as long
declare function IDD_DLG1_btPrvDay_Clicked(Byval hWin as hwnd,Byval hCtrl as hwnd)as long
declare function IDD_DLG1_btClrGrid_Clicked(Byval hWin as hwnd,Byval hCtrl as hwnd)as long
declare function IDD_DLG1_btClrDay_Clicked(Byval hWin as hwnd,Byval hCtrl as hwnd)as long
declare function IDD_DLG1_btClrBack_Clicked(Byval hWin as hwnd,Byval hCtrl as hwnd)as long
declare function IDD_DLG1_btAbout_Clicked(Byval hWin as hwnd,Byval hCtrl as hwnd)as Long
Declare FUNCTION AtlAxWinInit LIB "ATL71.DLL" ALIAS "AtlAxWinInit" () AS LONG
DECLARE FUNCTION AtlAxGetControl LIB "ATL71.DLL" ALIAS "AtlAxGetControl" (BYVAL hWnd AS hwnd, Byval pp AS uint ptr) AS uinteger
DECLARE FUNCTION AtlAxAttachControl LIB "ATL71.DLL" ALIAS "AtlAxAttachControl" (BYVAL pControl AS uint ptr, BYVAL hWnd AS hwnd, ByVal ppUnkContainer AS uint ptr) AS uinteger
DECLARE FUNCTION AtlAxCreateControlLic LIB "ATL71.DLL" ALIAS "AtlAxCreateControlLic" (BYVAL lpszName AS bstr, BYVAL hParent AS uinteger, BYVAL pStream AS uinteger, BYval ppUnkContainer AS uint ptr, BYVAL bstrLic AS bstr) AS uinteger

Function AxInit(ByVal host As Integer=false)As Integer
	AxScode=CoInitialize(null)	
	If host Then AxScode=atlaxwininit
	Function=AxScode
end Function

' ****************************************************************************************
' Retrieves the interface of the ActiveX control given the handle of its ATL container
' ****************************************************************************************
SUB AtlAxGetDispatch (BYVAL hWndControl AS hwnd, BYREF ppvObj AS lpvoid)
	Dim ppUnk AS lpunknown
	dim ppDispatch as pvoid
	'dim IID_IDispatch as IID
	
	' Get the IUnknown of the OCX hosted in the control
	AxScode = AtlAxGetControl(hWndControl, @ppUnk)
	IF AxScode<>0 OR ppUnk=0 THEN EXIT SUB
	' Query for the existence of the dispatch interface
	'IIDFromString("{00020400-0000-0000-c000-000000000046}",@IID_IDispatch)
	AxScode=IUnknown_QueryInterface(ppUnk, @IID_IDispatch, @ppDispatch)
	' If not found, return the IUnknown of the control
	IF AxScode<>0 OR ppDispatch=0 THEN
		ppvObj = ppUnk
		EXIT SUB
	END IF
	' Release the IUnknown of the control
	IUnknown_Release(ppUnk)
	' Return the retrieved address
	ppvObj = ppDispatch
End SUB

Function IDD_DLG1_Init(Byval hWin as hwnd,Byval wParam as wParam,Byval lParam as lParam)as Integer
	AtlaxgetDispatch GetDlgItem(hwin,AX1),cal 'get Calendar control address
End Function

Function IDD_DLG1_OnSize(ByVal hWin as hwnd,Byval lState as long,Byval cx as long,Byval cy as long)as Integer
End Function

Function IDD_DLG1_OnClose(Byval hWin As hwnd)as Integer
	cal->lpvtbl->Release(cal) 'release calendar object
	couninitialize
End Function

Function IDD_DLG1_OnDestroy(Byval hWin as hwnd)as Integer
End Function

Function IDD_DLG1_OnNotify(Byval hWin as hwnd,Byval lCtlID as long,Byval lpNMHDR as NMHDR ptr,Byref lresult as long)as Integer
End Function

Function IDD_DLG1_OnTimer(Byval hWin as hwnd,Byval wTimerID as word)as Integer
End Function

function IDD_DLG1_btNxtDay_Clicked(Byval hWin as hwnd,Byval hCtrl as hwnd)as long
	cal->lpvtbl->NextDay(cal) 'call NextDay method
end function

function IDD_DLG1_btNxtMonth_Clicked(Byval hWin as hwnd,Byval hCtrl as hwnd)as long
	cal->lpvtbl->NextMonth(cal) 'call NextMonth method
end function

function IDD_DLG1_btNxtYear_Clicked(Byval hWin as hwnd,Byval hCtrl as hwnd)as long
	cal->lpvtbl->NextYear(cal) 'call nextyear method
end function

function IDD_DLG1_btPrvYear_Clicked(Byval hWin as hwnd,Byval hCtrl as hwnd)as long
	cal->lpvtbl->PreviousYear(cal) 'call PreviousYear method
end function

function IDD_DLG1_btPrvMonth_Clicked(Byval hWin as hwnd,Byval hCtrl as hwnd)as long
	cal->lpvtbl->PreviousMonth(cal) 'call PreviousMonth method
end function

function IDD_DLG1_btPrvDay_Clicked(Byval hWin as hwnd,Byval hCtrl as hwnd)as long
	cal->lpvtbl->PreviousDay(cal) 'call PreviousDay method
end function

function IDD_DLG1_btClrGrid_Clicked(Byval hWin as hwnd,Byval hCtrl as hwnd)as Long
	cal->lpvtbl->putGridFontColor(cal,bgr(Rnd*255,Rnd*255,Rnd*255)) 'put gridcolor property	
end function

function IDD_DLG1_btClrDay_Clicked(Byval hWin as hwnd,Byval hCtrl as hwnd)as long
	cal->lpvtbl->putDayFontColor(cal,bgr(Rnd*255,Rnd*255,Rnd*255)) 'put daycolor property	
end function

Function IDD_DLG1_btClrBack_Clicked(Byval hWin as hwnd,Byval hCtrl as hwnd)as long
	cal->lpvtbl->putBackColor(cal,bgr(Rnd*255,Rnd*255,Rnd*255)) 'put backcolor property
end function

function IDD_DLG1_btAbout_Clicked(Byval hWin as hwnd,Byval hCtrl as hwnd)as long
	cal->lpvtbl->AboutBox(cal)
end function

'=========================================================================
'Initial code of control
'=========================================================================
axinit(true) 'initialize axsupport with atl71 hosted ActiveX control

DialogBoxParam(GetModuleHandle(NULL), Cast(zstring ptr,IDD_DLG1), NULL, @IDD_DLG1_DlgProc, NULL)
ExitProcess(0)
end

'=========================================================================
'Dialog callback procedure
'=========================================================================
Function IDD_DLG1_DlgProc(byval hWin as HWND, byval uMsg as UINT, byval wParam as WPARAM, byval lParam as LPARAM) as integer
	dim as long id,event,lresult
	dim lpNMHDR as NMHDR ptr

	select case uMsg
		case WM_INITDIALOG
			if IDD_DLG1_Init(hWin,wparam,lparam) then
				function=false
				exit function
			endif
		case WM_COMMAND
			id=loword(wParam)
			event=hiword(wParam)
			if id=btNxtDay then
				if event = BN_CLICKED THEN
					if IDD_DLG1_btNxtDay_Clicked(hWin,lparam) then
						function=false
						exit function
					endif
				endif
			end if
			if id=btNxtMonth then
				if event = BN_CLICKED THEN
					if IDD_DLG1_btNxtMonth_Clicked(hWin,lparam) then
						function=false
						exit function
					endif
				endif
			end if
			if id=btNxtYear then
				if event = BN_CLICKED THEN
					if IDD_DLG1_btNxtYear_Clicked(hWin,lparam) then
						function=false
						exit function
					endif
				endif
			end if
			if id=btPrvYear then
				if event = BN_CLICKED THEN
					if IDD_DLG1_btPrvYear_Clicked(hWin,lparam) then
						function=false
						exit function
					endif
				endif
			end if
			if id=btPrvMonth then
				if event = BN_CLICKED THEN
					if IDD_DLG1_btPrvMonth_Clicked(hWin,lparam) then
						function=false
						exit function
					endif
				endif
			end if
			if id=btPrvDay then
				if event = BN_CLICKED THEN
					if IDD_DLG1_btPrvDay_Clicked(hWin,lparam) then
						function=false
						exit function
					endif
				endif
			end if
			if id=btClrGrid then
				if event = BN_CLICKED THEN
					if IDD_DLG1_btClrGrid_Clicked(hWin,lparam) then
						function=false
						exit function
					endif
				endif
			end if
			if id=btClrDay then
				if event = BN_CLICKED THEN
					if IDD_DLG1_btClrDay_Clicked(hWin,lparam) then
						function=false
						exit function
					endif
				endif
			end if
			if id=btClrBack then
				if event = BN_CLICKED THEN
					if IDD_DLG1_btClrBack_Clicked(hWin,lparam) then
						function=false
						exit function
					endif
				endif
			end if
			if id=btAbout then
				if event = BN_CLICKED THEN
					if IDD_DLG1_btAbout_Clicked(hWin,lparam) then
						function=false
						exit function
					endif
				endif
			end if

		case WM_SIZE
			if IDD_DLG1_OnSize(hWin,wparam,loword(lparam),hiword(lparam)) then
				function=false
				exit function
			endif
		case WM_NOTIFY
			lpNMHDR=lparam
			id=lpnmhdr->idfrom
			event=lpnmhdr->code

			if IDD_DLG1_OnNotify(hWin,wparam,lparam,lresult) then
				function=lresult
				exit function
			endif
		case WM_TIMER
			if IDD_DLG1_OnTimer(hWin,wparam) then
				function=false
				exit function
			endif
		case WM_CLOSE
			if IDD_DLG1_OnClose(hWin) then
				function=false
				exit function
			endif
			EndDialog(hWin,0)
		case WM_DESTROY

			IDD_DLG1_OnDestroy(hWin)
			function=false
			exit function
		case else
			return FALSE
	end select
	return TRUE
End Function
above are test code.

this is my 1st attempt to build vtable UDT
mscal.bi

Code: Select all

'----------------------------------------------------------------------------------------------------
'	vTable Call - Microsoft Calendar Control 11.0
'	TypeLib CLSID="{8E27C92E-1264-101C-8A2F-040224009C02}"
'----------------------------------------------------------------------------------------------------

' --------------------------------------------------------------------------------------------
' Runtime license key
' --------------------------------------------------------------------------------------------
Const LICKEY_MSCALCalendar7 = ""

' --------------------------------------------------------------------------------------------
' ProgIds
' --------------------------------------------------------------------------------------------
Const PROGID_MSCALCalendar7 = "MSCAL.Calendar.7"

'----------------------------------------------------------------------------------------------------
'Interface ICalendar
'GUID = {8E27C92C-1264-101C-8A2F-040224009C02}
'----------------------------------------------------------------------------------------------------
Type ICalendarVtbl
	getBackColor As Function (Byval pThis As Any ptr,Byref pclrBackColor As Uinteger) As hResult
	putBackColor As Function (Byval pThis As Any ptr,Byval pclrBackColor As Uinteger) As hResult
	getDay As Function (Byval pThis As Any ptr,Byref pnDay As Short) As hResult
	putDay As Function (Byval pThis As Any ptr,Byval pnDay As Short) As hResult
	getDayFont As Function (Byval pThis As Any ptr,Byref ppfontDayFont As lpunknown /'Font dispinterface'/) As hResult
	putDayFont As Function (Byval pThis As Any ptr,Byval ppfontDayFont As lpunknown /'Font dispinterface'/) As hResult
	getDayFontColor As Function (Byval pThis As Any ptr,Byref pclrDayFontColor As Uinteger) As hResult
	putDayFontColor As Function (Byval pThis As Any ptr,Byval pclrDayFontColor As Uinteger) As hResult
	getDayLength As Function (Byval pThis As Any ptr,Byref pnDayLength As Short) As hResult
	putDayLength As Function (Byval pThis As Any Ptr,Byval pnDayLength As Short) As hResult
	getFirstDay As Function (Byval pThis As Any ptr,Byref pnFirstDay As Short) As hResult
	putFirstDay As Function (Byval pThis As Any ptr,Byval pnFirstDay As Short) As hResult
	getGridCellEffect As Function (Byval pThis As Any ptr,Byref plGridCellEffect As Integer) As hResult
	putGridCellEffect As Function (Byval pThis As Any ptr,Byval plGridCellEffect As Integer) As hResult
	getGridFont As Function (Byval pThis As Any ptr,Byref ppfontGridFont As lpunknown /'Font dispinterface'/) As hResult
	putGridFont As Function (Byval pThis As Any ptr,Byval ppfontGridFont As lpunknown /'Font dispinterface'/) As hResult
	getGridFontColor As Function (Byval pThis As Any ptr,Byref pclrGridFontColor As Uinteger) As hResult
	putGridFontColor As Function (Byval pThis As Any ptr,Byval pclrGridFontColor As Uinteger) As hResult
	getGridLinesColor As Function (Byval pThis As Any ptr,Byref pclrGridLinesColor As Uinteger) As hResult
	putGridLinesColor As Function (Byval pThis As Any ptr,Byval pclrGridLinesColor As Uinteger) As hResult
	getMonth As Function (Byval pThis As Any ptr,Byref pnMonth As Short) As hResult
	putMonth As Function (Byval pThis As Any ptr,Byval pnMonth As Short) As hResult
	getMonthLength As Function (Byval pThis As Any ptr,Byref pnMonthLength As Short) As hResult
	putMonthLength As Function (Byval pThis As Any ptr,Byval pnMonthLength As Short) As hResult
	getShowDateSelectors As Function (Byval pThis As Any ptr,Byref pfShowDateSelectors As Boolean) As hResult
	putShowDateSelectors As Function (Byval pThis As Any ptr,Byval pfShowDateSelectors As Boolean) As hResult
	getShowDays As Function (Byval pThis As Any ptr,Byref pfShowDays As Boolean) As hResult
	putShowDays As Function (Byval pThis As Any ptr,Byval pfShowDays As Boolean) As hResult
	getShowHorizontalGrid As Function (Byval pThis As Any ptr,Byref pfShowHorizontalGrid As Boolean) As hResult
	putShowHorizontalGrid As Function (Byval pThis As Any ptr,Byval pfShowHorizontalGrid As Boolean) As hResult
	getShowTitle As Function (Byval pThis As Any ptr,Byref pfShowTitle As Boolean) As hResult
	putShowTitle As Function (Byval pThis As Any ptr,Byval pfShowTitle As Boolean) As hResult
	getShowVerticalGrid As Function (Byval pThis As Any ptr,Byref pfShowVerticalGrid As Boolean) As hResult
	putShowVerticalGrid As Function (Byval pThis As Any ptr,Byval pfShowVerticalGrid As Boolean) As hResult
	getTitleFont As Function (Byval pThis As Any ptr,Byref ppfontTitleFont As lpunknown /'Font dispinterface'/) As hResult
	putTitleFont As Function (Byval pThis As Any ptr,Byval ppfontTitleFont As lpunknown /'Font dispinterface'/) As hResult
	getTitleFontColor As Function (Byval pThis As Any ptr,Byref pclrTitleFontColor As Uinteger) As hResult
	putTitleFontColor As Function (Byval pThis As Any ptr,Byval pclrTitleFontColor As Uinteger) As hResult
	getValue As Function (Byval pThis As Any ptr,Byref pvarValue As Variant) As hResult
	putValue As Function (Byval pThis As Any ptr,Byval pvarValue As Variant) As hResult
	get_Value As Function (Byval pThis As Any ptr,Byref pvarValue As Variant) As hResult
	put_Value As Function (Byval pThis As Any ptr,Byval pvarValue As Variant) As hResult
	getValueIsNull As Function (Byval pThis As Any ptr,Byref pfValueIsNull As Boolean) As hResult
	putValueIsNull As Function (Byval pThis As Any ptr,Byval pfValueIsNull As Boolean) As hResult
	getYear As Function (Byval pThis As Any ptr,Byref pnYear As Short) As hResult
	putYear As Function (Byval pThis As Any ptr,Byval pnYear As Short) As hResult
	NextDay As Function (Byval pThis As Any ptr) As hResult
	NextMonth As Function (Byval pThis As Any ptr) As hResult
	NextWeek As Function (Byval pThis As Any ptr) As hResult
	NextYear As Function (Byval pThis As Any ptr) As hResult
	PreviousDay As Function (Byval pThis As Any ptr) As hResult
	PreviousMonth As Function (Byval pThis As Any ptr) As hResult
	PreviousWeek As Function (Byval pThis As Any ptr) As hResult
	PreviousYear As Function (Byval pThis As Any ptr) As hResult
	Refresh As Function (Byval pThis As Any ptr) As hResult
	Today As Function (Byval pThis As Any ptr) As hResult
	AboutBox As Function (Byval pThis As Any ptr) As hResult
	setDayFont As Function (Byval pThis As Any ptr,Byval ppfontDayFont As lpunknown /'Font dispinterface'/) As hResult
	setGridFont As Function (Byval pThis As Any ptr,Byval ppfontGridFont As lpunknown /'Font dispinterface'/) As hResult
	setTitleFont As Function (Byval pThis As Any ptr,Byval ppfontTitleFont As lpunknown /'Font dispinterface'/) As hResult
End Type

Type ICalendar_
	lpVtbl As ICalendarVtbl ptr
End Type

Type ICalendar As ICalendar_ ptr
this the 2nd attempt
mscal.bi

Code: Select all

'----------------------------------------------------------------------------------------------------
'	vTable Call - Microsoft Calendar Control 11.0
'	TypeLib CLSID="{8E27C92E-1264-101C-8A2F-040224009C02}"
'----------------------------------------------------------------------------------------------------

' --------------------------------------------------------------------------------------------
' Runtime license key
' --------------------------------------------------------------------------------------------
Const LICKEY_MSCALCalendar7 = ""

' --------------------------------------------------------------------------------------------
' ProgIds
' --------------------------------------------------------------------------------------------
Const PROGID_MSCALCalendar7 = "MSCAL.Calendar.7"

'----------------------------------------------------------------------------------------------------
'Interface ICalendar
'GUID = {8E27C92C-1264-101C-8A2F-040224009C02}
'----------------------------------------------------------------------------------------------------
Type ICalendarVtbl
	QueryInterface As Function (Byval pThis As Any ptr,Byref riid As GUID,Byref ppvObj As Dword) As hResult
	AddRef As Function (Byval pThis As Any ptr) As hResult
	Release As Function (Byval pThis As Any ptr) As hResult
	Offset28(15) As Byte
	getBackColor As Function (Byval pThis As Any ptr,Byref pclrBackColor As Uinteger) As hResult
	putBackColor As Function (Byval pThis As Any ptr,Byval pclrBackColor As Uinteger) As hResult
	getDay As Function (Byval pThis As Any ptr,Byref pnDay As Short) As hResult
	putDay As Function (Byval pThis As Any ptr,Byval pnDay As Short) As hResult
	getDayFont As Function (Byval pThis As Any ptr,Byref ppfontDayFont As lpunknown /'Font dispinterface'/) As hResult
	putDayFont As Function (Byval pThis As Any ptr,Byval ppfontDayFont As lpunknown /'Font dispinterface'/) As hResult
	getDayFontColor As Function (Byval pThis As Any ptr,Byref pclrDayFontColor As Uinteger) As hResult
	putDayFontColor As Function (Byval pThis As Any ptr,Byval pclrDayFontColor As Uinteger) As hResult
	getDayLength As Function (Byval pThis As Any ptr,Byref pnDayLength As Short) As hResult
	putDayLength As Function (Byval pThis As Any Ptr,Byval pnDayLength As Short) As hResult
	getFirstDay As Function (Byval pThis As Any ptr,Byref pnFirstDay As Short) As hResult
	putFirstDay As Function (Byval pThis As Any ptr,Byval pnFirstDay As Short) As hResult
	getGridCellEffect As Function (Byval pThis As Any ptr,Byref plGridCellEffect As Integer) As hResult
	putGridCellEffect As Function (Byval pThis As Any ptr,Byval plGridCellEffect As Integer) As hResult
	getGridFont As Function (Byval pThis As Any ptr,Byref ppfontGridFont As lpunknown /'Font dispinterface'/) As hResult
	putGridFont As Function (Byval pThis As Any ptr,Byval ppfontGridFont As lpunknown /'Font dispinterface'/) As hResult
	getGridFontColor As Function (Byval pThis As Any ptr,Byref pclrGridFontColor As Uinteger) As hResult
	putGridFontColor As Function (Byval pThis As Any ptr,Byval pclrGridFontColor As Uinteger) As hResult
	getGridLinesColor As Function (Byval pThis As Any ptr,Byref pclrGridLinesColor As Uinteger) As hResult
	putGridLinesColor As Function (Byval pThis As Any ptr,Byval pclrGridLinesColor As Uinteger) As hResult
	getMonth As Function (Byval pThis As Any ptr,Byref pnMonth As Short) As hResult
	putMonth As Function (Byval pThis As Any ptr,Byval pnMonth As Short) As hResult
	getMonthLength As Function (Byval pThis As Any ptr,Byref pnMonthLength As Short) As hResult
	putMonthLength As Function (Byval pThis As Any ptr,Byval pnMonthLength As Short) As hResult
	getShowDateSelectors As Function (Byval pThis As Any ptr,Byref pfShowDateSelectors As Boolean) As hResult
	putShowDateSelectors As Function (Byval pThis As Any ptr,Byval pfShowDateSelectors As Boolean) As hResult
	getShowDays As Function (Byval pThis As Any ptr,Byref pfShowDays As Boolean) As hResult
	putShowDays As Function (Byval pThis As Any ptr,Byval pfShowDays As Boolean) As hResult
	getShowHorizontalGrid As Function (Byval pThis As Any ptr,Byref pfShowHorizontalGrid As Boolean) As hResult
	putShowHorizontalGrid As Function (Byval pThis As Any ptr,Byval pfShowHorizontalGrid As Boolean) As hResult
	getShowTitle As Function (Byval pThis As Any ptr,Byref pfShowTitle As Boolean) As hResult
	putShowTitle As Function (Byval pThis As Any ptr,Byval pfShowTitle As Boolean) As hResult
	getShowVerticalGrid As Function (Byval pThis As Any ptr,Byref pfShowVerticalGrid As Boolean) As hResult
	putShowVerticalGrid As Function (Byval pThis As Any ptr,Byval pfShowVerticalGrid As Boolean) As hResult
	getTitleFont As Function (Byval pThis As Any ptr,Byref ppfontTitleFont As lpunknown /'Font dispinterface'/) As hResult
	putTitleFont As Function (Byval pThis As Any ptr,Byval ppfontTitleFont As lpunknown /'Font dispinterface'/) As hResult
	getTitleFontColor As Function (Byval pThis As Any ptr,Byref pclrTitleFontColor As Uinteger) As hResult
	putTitleFontColor As Function (Byval pThis As Any ptr,Byval pclrTitleFontColor As Uinteger) As hResult
	getValue As Function (Byval pThis As Any ptr,Byref pvarValue As Variant) As hResult
	putValue As Function (Byval pThis As Any ptr,Byval pvarValue As Variant) As hResult
	get_Value As Function (Byval pThis As Any ptr,Byref pvarValue As Variant) As hResult
	put_Value As Function (Byval pThis As Any ptr,Byval pvarValue As Variant) As hResult
	getValueIsNull As Function (Byval pThis As Any ptr,Byref pfValueIsNull As Boolean) As hResult
	putValueIsNull As Function (Byval pThis As Any ptr,Byval pfValueIsNull As Boolean) As hResult
	getYear As Function (Byval pThis As Any ptr,Byref pnYear As Short) As hResult
	putYear As Function (Byval pThis As Any ptr,Byval pnYear As Short) As hResult
	NextDay As Function (Byval pThis As Any ptr) As hResult
	NextMonth As Function (Byval pThis As Any ptr) As hResult
	NextWeek As Function (Byval pThis As Any ptr) As hResult
	NextYear As Function (Byval pThis As Any ptr) As hResult
	PreviousDay As Function (Byval pThis As Any ptr) As hResult
	PreviousMonth As Function (Byval pThis As Any ptr) As hResult
	PreviousWeek As Function (Byval pThis As Any ptr) As hResult
	PreviousYear As Function (Byval pThis As Any ptr) As hResult
	Refresh As Function (Byval pThis As Any ptr) As hResult
	Today As Function (Byval pThis As Any ptr) As hResult
	AboutBox As Function (Byval pThis As Any ptr) As hResult
	setDayFont As Function (Byval pThis As Any ptr,Byval ppfontDayFont As lpunknown /'Font dispinterface'/) As hResult
	setGridFont As Function (Byval pThis As Any ptr,Byval ppfontGridFont As lpunknown /'Font dispinterface'/) As hResult
	setTitleFont As Function (Byval pThis As Any ptr,Byval ppfontTitleFont As lpunknown /'Font dispinterface'/) As hResult
End Type

Type ICalendar_
	lpVtbl As ICalendarVtbl ptr
End Type

Type ICalendar As ICalendar_ ptr
why the 2nd UDT work and the 1st not?
if we look at the offset table, the first member offset is 28 (&h1C), that why when we call first member it it point to the wrong offset (0).
to resolve this problem, we must rearrange "location" of memeber to its correct offset.
if we take a look at 2nd UDT we'll see addition of 3 default member of vtable:

Code: Select all

QueryInterface As Function (Byval pThis As Any ptr,Byref riid As GUID,Byref ppvObj As Dword) As hResult 'offset 0
AddRef As Function (Byval pThis As Any ptr) As hResult 'offset 4
Release As Function (Byval pThis As Any ptr) As hResult 'offset 8
and we need to add dummy member to fill offset gap, so location of the member will have the correct address.

Code: Select all

Offset28(15) As Byte 'offset 12, gap 16 bytes
so the first member offset will be 12+16=28, corrected.
some of the ActiveX/COM have >16 bytes gap like ADO recordset20 have 260 bytes gap between first member and release member.

Code: Select all

'----------------------------------------------------------------------------------------------------
'Interface Recordset20
'GUID = {0000054F-0000-0010-8000-00AA006D2EA4}
'----------------------------------------------------------------------------------------------------
Type Recordset20Vtbl
	QueryInterface As Function (Byval pThis As Any ptr,Byref riid As GUID,Byref ppvObj As Dword) As hResult
	AddRef As Function (Byval pThis As Any ptr) As hResult
	Release As Function (Byval pThis As Any ptr) As hResult
	Offset272(259) As Byte
	Cancel As Function (Byval pThis As Any ptr) As hResult
	getDataSource As Function (Byval pThis As Any ptr,Byref ppunkDataSource As Dword /'VT_UNKNOWN'/) As hResult
	setDataSource As Function (Byval pThis As Any ptr,Byval ppunkDataSource As Dword /'VT_UNKNOWN'/) As hResult
	_xSave As Function (Byval pThis As Any ptr,Byval FileName As Bstr=0,Byval PersistFormat As PersistFormatEnum /'enum'/=0) As hResult
	getActiveCommand As Function (Byval pThis As Any ptr,Byref ppCmd As Any ptr /'VT_DISPATCH'/) As hResult
	putStayInSync As Function (Byval pThis As Any ptr,Byval pbStayInSync As Boolean) As hResult
	getStayInSync As Function (Byval pThis As Any ptr,Byref pbStayInSync As Boolean) As hResult
	GetString As Function (Byval pThis As Any ptr,Byval StringFormat As StringFormatEnum /'enum'/=2,Byval NumRows As Integer=-1,Byval ColumnDelimeter As Bstr=0,Byval RowDelimeter As Bstr=0,Byval NullExpr As Bstr=0,Byref pRetString As Bstr) As hResult
	getDataMember As Function (Byval pThis As Any ptr,Byref pbstrDataMember As Bstr) As hResult
	putDataMember As Function (Byval pThis As Any ptr,Byval pbstrDataMember As Bstr) As hResult
	CompareBookmarks As Function (Byval pThis As Any ptr,Byval Bookmark1 As Variant,Byval Bookmark2 As Variant,Byref pCompare As CompareEnum /'enum'/) As hResult
	Clone As Function (Byval pThis As Any ptr,Byval LockType As LockTypeEnum /'enum'/=-1,Byref ppvObject As _Recordset /'dispinterface'/) As hResult
	Resync As Function (Byval pThis As Any ptr,Byval AffectRecords As AffectEnum /'enum'/=3,Byval ResyncValues As ResyncEnum /'enum'/=2) As hResult
End Type

Type Recordset20_
	lpVtbl As Recordset20Vtbl ptr
End Type

Type Recordset20 As Recordset20_ ptr
and dabooda2DTurbo has many offset gap.

Code: Select all

'----------------------------------------------------------------------------------------------------
'Interface _DBTurbo2DEngine
'GUID = {4789A64B-59DC-4314-97EB-E50E4287BF12}
'----------------------------------------------------------------------------------------------------
Type _DBTurbo2DEngineVtbl
	QueryInterface As Function (Byval pThis As Any ptr,Byref riid As GUID,Byref ppvObj As Dword) As hResult
	AddRef As Function (Byval pThis As Any ptr) As hResult
	Release As Function (Byval pThis As Any ptr) As hResult
	Offset28(15) As Byte
	getDBMath As Function (Byval pThis As Any ptr,Byref DBMath As _DBMath /'dispinterface'/) As hResult
	Offset36(3) As Byte
	setDBMath As Function (Byval pThis As Any ptr,Byval DBMath As _DBMath /'dispinterface'/) As hResult
	getDBTexture As Function (Byval pThis As Any ptr,Byref DBTexture As _DBTexture /'dispinterface'/) As hResult
	Offset48(3) As Byte
	setDBTexture As Function (Byval pThis As Any ptr,Byval DBTexture As _DBTexture /'dispinterface'/) As hResult
	getDBOverlay As Function (Byval pThis As Any ptr,Byref DBOverlay As _DBOverlay /'dispinterface'/) As hResult
	Offset60(3) As Byte
	setDBOverlay As Function (Byval pThis As Any ptr,Byval DBOverlay As _DBOverlay /'dispinterface'/) As hResult
	getDBFPS As Function (Byval pThis As Any ptr,Byref DBFPS As _DBFPS /'dispinterface'/) As hResult
	Offset72(3) As Byte
	setDBFPS As Function (Byval pThis As Any ptr,Byval DBFPS As _DBFPS /'dispinterface'/) As hResult
	getDBText As Function (Byval pThis As Any ptr,Byref DBText As _DBText /'dispinterface'/) As hResult
	Offset84(3) As Byte
	setDBText As Function (Byval pThis As Any ptr,Byval DBText As _DBText /'dispinterface'/) As hResult
	getDBMap As Function (Byval pThis As Any ptr,Byref DBMap As _DBMap /'dispinterface'/) As hResult
	Offset96(3) As Byte
	setDBMap As Function (Byval pThis As Any ptr,Byval DBMap As _DBMap /'dispinterface'/) As hResult
	getDBSubMap As Function (Byval pThis As Any ptr,Byref DBSubMap As _DBSubMap /'dispinterface'/) As hResult
	Offset108(3) As Byte
	setDBSubMap As Function (Byval pThis As Any ptr,Byval DBSubMap As _DBSubMap /'dispinterface'/) As hResult
	getDBSprite As Function (Byval pThis As Any ptr,Byref DBSprite As _DBSprite /'dispinterface'/) As hResult
	Offset120(3) As Byte
	setDBSprite As Function (Byval pThis As Any ptr,Byval DBSprite As _DBSprite /'dispinterface'/) As hResult
	getDBAutoMove As Function (Byval pThis As Any ptr,Byref DBAutoMove As _DBAutoMove /'dispinterface'/) As hResult
	Offset132(3) As Byte
	setDBAutoMove As Function (Byval pThis As Any ptr,Byval DBAutoMove As _DBAutoMove /'dispinterface'/) As hResult
	getDBKeyInput As Function (Byval pThis As Any ptr,Byref DBKeyInput As _DBKeyInput /'dispinterface'/) As hResult
	Offset144(3) As Byte
	setDBKeyInput As Function (Byval pThis As Any ptr,Byval DBKeyInput As _DBKeyInput /'dispinterface'/) As hResult
	getDBJoyStick As Function (Byval pThis As Any ptr,Byref DBJoyStick As _DBJoyStick /'dispinterface'/) As hResult
	Offset156(3) As Byte
	setDBJoyStick As Function (Byval pThis As Any ptr,Byval DBJoyStick As _DBJoyStick /'dispinterface'/) As hResult
	getDBMouse As Function (Byval pThis As Any ptr,Byref DBMouse As _DBMouse /'dispinterface'/) As hResult
	Offset168(3) As Byte
	setDBMouse As Function (Byval pThis As Any ptr,Byval DBMouse As _DBMouse /'dispinterface'/) As hResult
	getDBMusic As Function (Byval pThis As Any ptr,Byref DBMusic As _DBMusic /'dispinterface'/) As hResult
	Offset180(3) As Byte
	setDBMusic As Function (Byval pThis As Any ptr,Byval DBMusic As _DBMusic /'dispinterface'/) As hResult
	getDBSound As Function (Byval pThis As Any ptr,Byref DBSound As _DBSound /'dispinterface'/) As hResult
	Offset192(3) As Byte
	setDBSound As Function (Byval pThis As Any ptr,Byval DBSound As _DBSound /'dispinterface'/) As hResult
	getDBMapData As Function (Byval pThis As Any ptr,Byref DBMapData As _DBMapData /'dispinterface'/) As hResult
	Offset204(3) As Byte
	setDBMapData As Function (Byval pThis As Any ptr,Byval DBMapData As _DBMapData /'dispinterface'/) As hResult
	getDBCounter As Function (Byval pThis As Any ptr,Byref DBCounter As _DBCounter /'dispinterface'/) As hResult
	Offset216(3) As Byte
	setDBCounter As Function (Byval pThis As Any ptr,Byval DBCounter As _DBCounter /'dispinterface'/) As hResult
	getDBResource As Function (Byval pThis As Any ptr,Byref DBResource As _DBResource /'dispinterface'/) As hResult
	Offset228(3) As Byte
	setDBResource As Function (Byval pThis As Any ptr,Byval DBResource As _DBResource /'dispinterface'/) As hResult
	InitializeDisplay As Function (Byval pThis As Any ptr,Byref hwnd As Integer,Byref dWindowed As Boolean,Byref dWidth As Integer=320,Byref dHeight As Integer=240,Byref dAdapter As Integer=0,Byref DevType As CONST_D3DDEVTYPE /'enum'/=0) As hResult
	SetTextureStage As Function (Byval pThis As Any ptr,Byref TType As CONST_D3DTEXTURESTAGESTATETYPE /'enum'/,Byref TState As Integer) As hResult
	SetRenderState As Function (Byval pThis As Any ptr,Byref RType As CONST_D3DRENDERSTATETYPE /'enum'/,Byref Value As Integer) As hResult
	SetUpViewPort As Function (Byval pThis As Any ptr,Byref X As Integer,Byref Y As Integer,Byref Width As Integer,Byref Height As Integer) As hResult
	SetBackColorRed As Function (Byval pThis As Any ptr,Byref Value As Short) As hResult
	SetBackColorGreen As Function (Byval pThis As Any ptr,Byref Value As Short) As hResult
	SetBackColorBlue As Function (Byval pThis As Any ptr,Byref Value As Short) As hResult
	GetBackColorRed As Function (Byval pThis As Any ptr,Byref  As Short) As hResult
	GetBackColorGreen As Function (Byval pThis As Any ptr,Byref  As Short) As hResult
	GetBackColorBlue As Function (Byval pThis As Any ptr,Byref  As Short) As hResult
	SetWindowedObject As Function (Byval pThis As Any ptr,Byref Form As Any ptr /'VT_DISPATCH'/) As hResult
	SetUpMapView As Function (Byval pThis As Any ptr,Byref mLeft As Single,Byref mTop As Single,Byref mRight As Single,Byref mBottom As Single,Byref mClip As Single) As hResult
	SetMaxLevel As Function (Byval pThis As Any ptr,Byref Value As Short) As hResult
	GetMaxLevel As Function (Byval pThis As Any ptr,Byref  As Short) As hResult
	GetDisplayOn As Function (Byval pThis As Any ptr,Byref  As Boolean) As hResult
	GetSoundOn As Function (Byval pThis As Any ptr,Byref  As Boolean) As hResult
	GetMusicOn As Function (Byval pThis As Any ptr,Byref  As Boolean) As hResult
	GetKeyInputOn As Function (Byval pThis As Any ptr,Byref  As Boolean) As hResult
	GetMouseOn As Function (Byval pThis As Any ptr,Byref  As Boolean) As hResult
	GetJoyStickOn As Function (Byval pThis As Any ptr,Byref  As Boolean) As hResult
	GetFontOn As Function (Byval pThis As Any ptr,Byref  As Boolean) As hResult
	Render As Function (Byval pThis As Any ptr) As hResult
	ClearScreen As Function (Byval pThis As Any ptr) As hResult
End Type

Type _DBTurbo2DEngine_
	lpVtbl As _DBTurbo2DEngineVtbl ptr
End Type

Type _DBTurbo2DEngine As _DBTurbo2DEngine_ ptr
Excel vTable is the most interesting, there are many Dummy function existed. is offset gap is the reason?
if someone interrested, I'll post code to extract vTable UDT from ActiveX/COM with no offset gap.
Top
Sisophon2001
Posts: 1706
Joined: May 27, 2005 6:34
Location: Cambodia, Thailand, Lao, Ireland etc.
Contact:
Contact Sisophon2001

Post by Sisophon2001 »

I think you are missing some of the default functions, but it has been five years since I looked at code like this, and I need time to reorient myself.

This is what you have:

Code: Select all

QueryInterface As Function (Byval pThis As Any Ptr,Byref riid As GUID,Byref ppvObj As Dword) As hResult
AddRef As Function (Byval pThis As Any Ptr) As hResult
Release As Function (Byval pThis As Any Ptr) As hResult
Offset28(15) As Byte
setDBMath As Function (Byval pThis As Any Ptr,Byval DBMath As _DBMath) As hResult

etc.
And this is what I expected to see (code incomplete).

Code: Select all

QueryInterface As Function (Byval pThis As Any Ptr,Byref riid As GUID,Byref ppvObj As Dword) As hResult
AddRef As Function (Byval pThis As Any Ptr) As hResult
Release As Function (Byval pThis As Any Ptr) As hResult
GetTypeInfoCount(byval pThis as any ptr,  pctinfo as uinteger ptr)
GetTypeInfo(byval pThis as any ptr,itinfo as uniteger, lcid as .... etc
GetIDsOfNames(byval pThis as any ptr, .... etc)
Invoke(byval pThis as any ptr, etc ....)
setDBMath As Function (Byval pThis As Any Ptr,Byval DBMath As _DBMath) As hResult

etc.
So the four missing default functions, used for runtime linking with script languages, equal your fake offset of 16 bytes.

Garvan
Top
Loe
Posts: 323
Joined: Apr 30, 2006 14:49

Post by Loe »

Hi Sisophon2001
Glad to have someone looked at this,
considering to DirectX8, not all vTable has the rest default member.

Code: Select all

'----------------------------------------------------------------------------------------------------
'Interface Direct3DDevice8
'GUID = {7385E5DF-8FE8-41D5-86B6-D7B48547B6CF}
'----------------------------------------------------------------------------------------------------
Type Direct3DDevice8Vtbl
	QueryInterface As Function (Byval pThis As Any ptr,Byref riid As GUID,Byref ppvObj As Dword) As hResult
	AddRef As Function (Byval pThis As Any ptr) As hResult
	Release As Function (Byval pThis As Any ptr) As hResult
	TestCooperativeLevel As Function (Byval pThis As Any ptr) As hResult
as you can see at the offset, there is no gap between TestCooperativeLevel member and its release.
Some activex/com, even list default member to their typelib, like OLE Automation.

Code: Select all

'----------------------------------------------------------------------------------------------------
'Interface IUnknown
'GUID = {00000000-0000-0000-C000-000000000046}
'----------------------------------------------------------------------------------------------------
Type IUnknownVtbl
	QueryInterface As Function (Byval pThis As Any ptr,Byref riid As GUID,Byref ppvObj As Dword) As hResult
	AddRef As Function (Byval pThis As Any ptr) As hResult
	Release As Function (Byval pThis As Any ptr) As hResult
	QueryInterface As Function (Byval pThis As Any ptr,Byval riid As GUID /'record'/,Byref ppvObj As Any Ptr /'VT_VOID'/) As hResult
	AddRef As Function (Byval pThis As Any ptr) As hResult
	Release As Function (Byval pThis As Any ptr) As hResult
End Type

Type IUnknown_
	lpVtbl As IUnknownVtbl ptr
End Type

Type IUnknown As IUnknown_ ptr
thats why the generator wrote it twice :-(, I should add checking mechanism for this.
Top
Sisophon2001
Posts: 1706
Joined: May 27, 2005 6:34
Location: Cambodia, Thailand, Lao, Ireland etc.
Contact:
Contact Sisophon2001

Post by Sisophon2001 »

An activeX dll with a typelib that is incomplete or incorrect or even completely missing will still work perfectly, because it is not used in early, intermediate or late binding, is for documentation purposes only.

In the case of the DirectX8, it appears (from the hearer files) this dll is not possible to use with early binding. I think this is not typical.

I would use the header files as a more reliable documentation of the function definitions on the dll. If a C header file is published then there is never any doubt. If no C header file is published, then I would assume a VB dll, and use early binding only.

Again, apologies because it is a long time since I looked at this. The terminology and structure of ActiveX dll's is just starting to seep back in.

Garvan
Top
crysstaafur
Posts: 40
Joined: Aug 06, 2007 8:06
Location: Altus, Ok, USA
Contact:
Contact crysstaafur

Post by crysstaafur »

Seeing as I am one of the dev's working on dabooda Turbo (2D is the old name..) The Engine class may have some of those gaps due to initializing it's 'sub-classes' such as DBMath, DBTexture, and DBSprite.. You've probably noticed that DBVertex and (if your looking at 1.5 alpha) DBPeer2Peer will likely have completely different gaps as they are classes that are independant of the main Engine Class.

Simply put, you are able to use them as they are, and not have to startup Engine to access them, where the other classes you will need engine first.

DBVertex was made that way so you can have more than one instance of it, thereby allowing you to have multiple pseudo-3d objects in the 2d engine.

DBPeer2Peer was made that way by accident of design, Recently I could have gone back and integrated it into Engine, but I didn't. Just in case someone wanted to build a networking app with it, but didn't need the other stuff.

It's an educated guess, but still a guess. I hope it does provide some insight though.. btw.. if you need a copy of the dbt 1.4 or dbt 1.5a visual basic source you know how to reach me..

one last quick note: the 1.5a is binary-compatible with code made for 1.4
so this may also explain some of the gap craziness in the 1.5a vtable. This will likely change when 1.5 is ready for a final release as I am planning a 'clean-break' so as to not break any existing dbt 1.4 programs out there...
Top
Loe
Posts: 323
Joined: Apr 30, 2006 14:49

Post by Loe »

@Sisophon2001
In the case of the DirectX8, it appears (from the hearer files) this dll is not possible to use with early binding. I think this is not typical.,
yupz you right, thank you.
now i add some mechanism to check 1st member vtable offset
- if it zero then it could be a default function (ex OLE Automation)
- if it 12, there should be 3 default member add to vtable (ex DirectX)
- if it >28, there should be 7 default member add to vtable, and the rest is offset gap (ex ADO)

@crysstaafur
one last quick note: the 1.5a is binary-compatible with code made for 1.4
so this may also explain some of the gap craziness in the 1.5a vtable.
when I start this project, I thought that offset gap appear only at begining.
But when I try the vtable on dbt engine, it didnt work, then I realized that offset could be existed anywhere in vtable.

I still have some questione before I can finalize this project
this is about variable type from Variant VT, anybody have the complete list for FB?

Code: Select all

Function GetVarTypeStr (BYVAL VarType AS LONG) AS STRING	
	dim s AS STRING
	
	SELECT CASE VarType
		CASE     0 : s = "Dword"     & " /'VT_EMPTY'/"
		CASE     1 : s = "Dword"     & " /'VT_NULL'/"
		CASE     2 : s = "Short"     '& " /'VT_I2'/"
		CASE     3 : s = "Integer"   '& " /'VT_I4'/"
		CASE     4 : s = "Single"    '& " /'VT_R4'/"
		CASE     5 : s = "Double"    '& " /'VT_R8'/"
		CASE     6 : s = "CY"        '& " /'VT_CY'/"
		CASE     7 : s = "Date"      '& " /'VT_DATE'/"
		CASE     8 : s = "Bstr"      '& " /'VT_BSTR'/"
		CASE     9 : s = "Any ptr"   & " /'VT_DISPATCH'/"
		CASE    10 : s = "Dword"     & " /'VT_ERROR'/"
		CASE    11 : s = "Long"      '& " /'VT_BOOL'/"
		CASE    12 : s = "Variant"   '& " /'VT_VARIANT'/"
		CASE    13 : s = "Dword"     & " /'VT_UNKNOWN'/"
		CASE    14 : s = "Decimal"   '&  " /'VT_DECIMAL'/"
		CASE    16 : s = "Byte"      '& " /'VT_I1'/"
		CASE    17 : s = "UByte"     '& " /'VT_UI1'/"
		CASE    18 : s = "Ushort"    '& " /'VT_UI2'/"
		CASE    19 : s = "Uinteger"  '& " /'VT_UI4'/"
		CASE    20 : s = "Longint"   '& " /'VT_I8'/"
		CASE    21 : s = "Ulongint"  '& " /'VT_UI8'/"
		CASE    22 : s = "Integer"   '& " /'VT_INT'/"
		CASE    23 : s = "Uinteger"  '& " /'VT_UINT'/"
		CASE    24 : s = "Any Ptr"     & " /'VT_VOID'/"
		CASE    25 : s = "Integer"     & " /'VT_HRESULT'/"
		CASE    26 : s = "Any Ptr"     & " /'VT_PTR'/"
		CASE    27 : s = "Any Ptr"     & " /'VT_SAFEARRAY'/"
		CASE    28 : s = "Any Ptr"     & " /'VT_CARRAY'/"
		CASE    29 : s = "Any Ptr"     & " /'VT_USERDEFINED'/"
		CASE    30 : s = "String"      & " /'VT_LPSTR'/"
		CASE    31 : s = "wString ptr" & " /'VT_LPWSTR'/"
		CASE    36 : s = "Any Ptr"     & " /'VT_RECORD'/"
		CASE    64 : s = "Filetime"    '& " /'VT_FILETIME'/"
		CASE    65 : s = "BLOB"        '& " /'VT_BLOB'/"
		CASE    66 : s = "Any Ptr"     & " /'VT_STREAM'/"
		CASE    67 : s = "Any Ptr"     & " /'VT_STORAGE'/"
		CASE    68 : s = "Any Ptr"     & " /'VT_STREAMED_OBJECT'/"
		CASE    69 : s = "Any Ptr"     & " /'VT_STORED_OBJECT'/"
		CASE    70 : s = "Any Ptr"     & " /'VT_BLOB_OBJECT'/"
		CASE    71 : s = "Dword"       & " /'VT_CF'/"
		CASE    72 : s = "Guid"        '& " /'VT_CLSID'/"
		CASE  4096 : s = "Any Ptr"     & " /'VT_VECTOR'/"
		CASE  8192 : s = "Any Ptr"     & " /'VT_ARRAY'/"
		CASE 16384 : s = "Any Ptr"     & "/'VT_Byref'/"
		Case 32768 : s = "Any Ptr"     & "/'VT_Reserved'/"
		Case Else  : s = "Any Ptr"     & "/'[" & vartype & "'/"
	END SELECT
	FUNCTION = s
END Function
some note, we cant use FB Boolean for VT_BOOL, we use instead LONG for this type. dont know why
Top
Loe
Posts: 323
Joined: Apr 30, 2006 14:49

Post by Loe »

try this:
http://freefile.kristopherw.us/uploads/ ... te_exe.txt
please rename it as axsuite.exe

to try it, see the first post, you need mscal.ocx
or you can changes other samples in axsupport package from vtcall version to vtable version.
I'll post the source in FB archive, after variable type translation is fixed.

Any comment are welcome.
Top
Post Reply

Return to “Sources, Examples, Tips and Tricks”