VisualFBEditor - IDE for FreeBasic

[ThePunkMaister]

Releases here:
https://github.com/XusinboyBekchanov/My ... k/releases
https://github.com/XusinboyBekchanov/Vi ... r/releases

Here is the first link to MyFbFramework.
Second link to VisualFBEditor.

OK thanks and my bad. One more question. Does FreeBasic require to be in a specific folder in the hard drive? I know that the long abandoned installer because is not compatible with newer versions of windows installed it there but windows 10 doesn't allow under any circumstances to decompress or write files into either Program Files or Program Files(x86) even with administrator privileges. I ask because another IDE editor just exits after trying to create any project as if it's looking God knows where for FreeBasic.

[Xusinboy Bekchanov]

OK thanks and my bad. One more question. Does FreeBasic require to be in a specific folder in the hard drive? I know that the long abandoned installer because is not compatible with newer versions of windows installed it there but windows 10 doesn't allow under any circumstances to decompress or write files into either Program Files or Program Files(x86) even with administrator privileges. I ask because another IDE editor just exits after trying to create any project as if it's looking God knows where for FreeBasic.

You need to unpack it to a folder where you have write permission. Because the IDE writes the settings inside its folder.

[ThePunkMaister]

OK thanks and my bad. One more question. Does FreeBasic require to be in a specific folder in the hard drive? I know that the long abandoned installer because is not compatible with newer versions of windows installed it there but windows 10 doesn't allow under any circumstances to decompress or write files into either Program Files or Program Files(x86) even with administrator privileges. I ask because another IDE editor just exits after trying to create any project as if it's looking God knows where for FreeBasic.

You need to unpack it to a folder where you have write permission. Because the IDE writes the settings inside its folder.

In that case the safest bet is the documents folder itself which is where my copy of FreeBasic currently reside I hope it doesn't go anywhere like the other IDE.

[PeterHu]

Done.Thank you.
If “include path” window in IDE accept relative path (relative to "The project<root folder>"as well,it should be great.

Improved: The IDE looks for Components first in the project folder:
https://github.com/XusinboyBekchanov/Vi ... b3aaacd25b

Great!

But when I compiled & built the latest IDE and try to compile Bass sample in the example folder,the compiler complianed can't find mmf/form.bi.

May I expect any examples for common libraries developed & used in the projects,say containers,string manipulations,etc. will be available in the future?So that I can adventure/learn FB in one place.

These examples are in the compiler folder. And in the IDE directory there is a Compilers folder. If you install a compiler there, you can see all the examples regarding the FreeBASIC language.
I think that in the VisualFBEditor folder there should be examples regarding the IDE, and in the MyFbFramework folder there should be examples regarding only the library itself.

Yes,sure. just a personal impression when I adventured wxwidgets,it's samples folder is so rich almost every component/wxLibraries can be studied in deep.

By the way,it is really great to see VisualFBEditor has more and more examples in the project.This recalls me when I was adventuring wxwidgets and QT,their rich demos/samples folder provides almost everything you want to know about the library,every detail about every component.

Yes, these examples are added by users and contributors of the IDE and library, thanks to them for this. I think that over time there will be more examples.

Just wondering is there any smtp/sending email sdk/library/functions/demos accompany with mff/vfe?Never mind if not.

[Xusinboy Bekchanov]

Just wondering is there any smtp/sending email sdk/library/functions/demos accompany with mff/vfe?Never mind if not.

This is how you can send mail:

SimpleVariantPlus.bi (I created this using COMWrapperBuilder tool):

Code: Select all

'SimpleVariantPlus.bi: a "lean and mean" (not library-dependent) LateBound-Helper-Module for FreeBasic
'Author:      Olaf Schmidt (June 2016)
'Updated by Xusinboy Bekchanov to support 64-bit (August 2020)
'The Vartype-Letters, as used for the ByName...-Methods are as follows:
'    u: 8BitU-Integer(FB UByte)
'    i: 16Bit-Integer(FB Short)
'    l: 32Bit-Integer(FB Long)
'    c: 64Bit-Integer(FB LongInt, mapped between 64Bit-FB-Int and -OLEVariant-Currency)
'    b: 16Bit-Boolean(FB Boolean, mapped between 8Bit-FB and 16Bit-OLEVariant-Booleans)
'    f: 32Bit-FlPoint(FB Single)
'    d: 64Bit-FlPoint(FB Double)
'    t: 64BitDateTime(FB Double)
'    s: 8Bit-per-Char(FB String)  !!! note, that only in normal ANSI-FB-Source-Modules, String-Literals can be passed as "s"...
'    w: 16Bit-per-Chr(FB WString) !!! ...in FB-Source-Modules that are Unicode, String-Literals need to be passed as "w" instead
'    v: OleVariant (which always need to be passed with their VarPtr -> @VariantVariable
'When used in the TypeChars-Param of the CallByName-Func, an UpperCase-Letter signifies
'"ByRef"-passing (the FB-Variable needs to be prefixed by an @ in these cases)

#include once "vbcompat.bi"
#include once "windows.bi"
#include once "win/ole2.bi"
#include once "crt/string.bi"

#ifdef __FB_WIN32__ 'this is necessary, because FB maps the original FB-Long-Def to Boolean somehow (remove when Fix is available in the Compiler)
	#undef  Long
	#define Long Integer '...though it should not do any harm to leave it as is... on Win32 it's the same BitLength (+ we filtered with the #IfDef)
	#undef  CLng
	#define CLng CInt 'same thing here - a redefinition is necessary to work around the FB-Win32-Compiler-Bug
	#undef Call 'to allow usage of that KeyWord as an UDT-Method (it's not used anyways in lang -fb)
#endif

'the following Const is used in the (Variant)Conversions from BSTRs to FB-Strings
Dim Shared DefaultCodePage_StringConv As UINT
#ifdef UNICODE
	DefaultCodePage_StringConv = CP_UTF8 'an 8Bit-FB-String will hold an UTF8-Stream when a vbVariant is casted to it
#else
	DefaultCodePage_StringConv = CP_ACP 'that conforms to the normal ANSI-Conversion
#endif

'the Const below is relevant for the Variant-Conversions (Strings <-> Numbers or DateValues) - we avoid LOCALE_USER_DEFAULT,
'since that would convert e.g. a DoubleValue of 1.1 to a String-Representation of 1,1 on a german system, instead LOCALE_INVARIANT ...
Const DefaultLocale_VariantConv As Long = LOCALE_INVARIANT '...conforms to FB-StringConv-Representations of Dates and rational Numbers

Type tCOMErr
	Number As UINT
	Description As String
End Type
Dim Shared COMErr As tCOMErr, EInfo As tagEXCEPINFO, ShowCOMErrors As Boolean = True

Dim Shared Done As Boolean 'anything COM-related needs to CoInitialize... (shell32 and comctl32 are preloaded, to play nicely with Manifested Apps)
If Not Done Then Done = True: CoInitializeEx(0, 2): DyLibLoad("shell32.dll"): DyLibLoad("comctl32.dll")

Function AppName() As String
	Static S As String
	If Len(S) = 0 Then S = Command(0):S = Mid(S, InStrRev(S, "\") + 1): S = Left(S, Len(S) - 4)
	Return S
End Function

Function MsgBox cdecl Overload (ByVal Msg As LPCWSTR, ByVal Flags As Long = MB_ICONINFORMATION) As Long
	Return MessageBoxW(GetActiveWindow, Msg, AppName, Flags)
End Function

Private Function HandleCOMErr(ByVal HRes As HResult, ByVal MethodName As LPOLESTR) As HResult
	Static Msg As WString Ptr: If Msg = NULL Then Msg = CAllocate(8192 + 2)
	
	Function = HRes
	If HRes = DISP_E_EXCEPTION Then
		COMErr.Number = EInfo.sCode
		COMErr.Description= "Err(&H" & Hex(HRes) & ") in " & *Cast(WString Ptr, EInfo.bstrSource) & ", whilst calling: " & *Cast(WString Ptr, MethodName) & Chr(10) & *Cast(WString Ptr, EInfo.bstrDescription)
	ElseIf HRes Then
		FormatMessageW FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, NULL, HRes, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), Msg, 4096, NULL
		COMErr.Number = HRes
		COMErr.Description= "Err(&H" & Hex(HRes) & ") in SimpleVariant.bi, whilst calling: " & *Cast(WString Ptr, MethodName) & Chr(10) & *Msg
	End If
	If CBool(HRes) And ShowCOMErrors Then MsgBox COMErr.Description
End Function

'the usual Instantiation-Helper for COM-Objects which are known in the Win-Registry (e.g. CreateObject("Scripting.Dictionary")
Function CreateObject(ByVal ProgID As LPCOLESTR) As tagVariant
	If Not Done Then Done = True: CoInitializeEx(0, 2): DyLibLoad("shell32.dll"): DyLibLoad("comctl32.dll")
	
	COMErr.Number = 0
	Dim CLSID As CLSID, RetVal As tagVariant
	If HandleCOMErr(CLSIDFromProgID(ProgID, @ClsID), "CLSIDFromProgID") Then Return RetVal
	If HandleCOMErr(CoCreateInstance(@ClsID, NULL, CLSCTX_SERVER, @IID_IDispatch, @RetVal.pDispVal), "CreateObject") Then Return RetVal
	RetVal.VT = VT_DISPATCH
	Return RetVal
End Function

'but here's a helper-function to create COM-Objects regfree, in case the user provided a *.manifest-File (and placed it beside the COM-Dll-File)
Function CreateObjectRegFree(ProgID As WString Ptr, ManifestFileName As WString Ptr) As tagVariant
	Static ACW As ACTCTXW
	ACW.cbSize = Len(ACW)
	ACW.lpSource = ManifestFileName
	
	COMErr.Number = 0
	
	Dim hActCtx As HANDLE, Cookie As ULONG_PTR
	hActCtx = CreateActCtxW(@ACW)
	If (hActCtx = INVALID_HANDLE_VALUE) Then
		COMErr.Number = &H80020009
		COMErr.Description = "Couldn't create ActCtx from Manifest: " & *ManifestFileName
		If ShowCOMErrors Then MsgBox COMErr.Description
		Exit Function
	End If
	
	If ActivateActCtx(hActCtx, @Cookie) Then
		Dim OrigDir As String, DllPath As String = Left(*ManifestFileName, InStrRev(*ManifestFileName, "\"))
		OrigDir = CurDir()
		ChDir DllPath
		Function = CreateObject(ProgID)
		ChDir OrigDir
		DeactivateActCtx 0, Cookie
	Else
		COMErr.Number = &H80020009
		COMErr.Description = "Couldn't activate ActCtx from Manifest: " & *ManifestFileName
		If ShowCOMErrors Then MsgBox COMErr.Description
	End If
	
	ReleaseActCtx hActCtx
End Function

Function BSTR2S cdecl (ByVal BS As Const BSTR, ByVal CodePage As UINT = DefaultCodePage_StringConv) As String
	Dim BytesNeeded As UINT, S As String
	BytesNeeded = WideCharToMultiByte(CodePage, 0, BS, SysStringLen(BS), 0, 0, 0, 0)
	S = String(BytesNeeded, 0)
	WideCharToMultiByte CodePage, 0, BS, SysStringLen(BS), StrPtr(S), BytesNeeded, 0, 0
	Return S
End Function
Function S2BSTR cdecl (S As Const String, ByVal CodePage As UINT = DefaultCodePage_StringConv) As BSTR 'the caller is responsible for freeing the returned BSTR per SysFreeString
	Dim WCharsNeeded As UINT, BS As BSTR
	WCharsNeeded = MultiByteToWideChar(CodePage, 0, StrPtr(S), Len(S), 0, 0)
	BS = SysAllocStringLen(BS, WCharsNeeded)
	MultiByteToWideChar CodePage, 0, StrPtr(S), Len(S), BS, WCharsNeeded
	Return BS
End Function

Function BSTR2W(ByVal BS As Const BSTR) As WString Ptr 'the caller is responsible for freeing the returned WString per DeAllocate
	Dim W As WString Ptr
	W = CAllocate(SysStringByteLen(BS) + 2)
	If BS Then memcpy W, BS, SysStringByteLen(BS)
	Return W
End Function
Function W2BSTR(ByVal W As Const WString Ptr) As BSTR 'the caller is responsible for freeing the returned BSTR per SysFreeString
	Return SysAllocString(W)
End Function

'well, this is the workhorse for all the Dispatch-Calls (IDispatch::Invoke)... there's easier Wrapper-Methods around this at the end of this module)
Dim Shared LastDispID As Long = 0, UseDispId As Long = 0
#ifdef __FB_64BIT__
	Function CallByName cdecl (vDisp As tagVariant, ByVal MethodName As LPOLESTR, ByVal CallFlag As Word, TypeChars As String = "", ByVal Arg0 As Any Ptr = 0, ByVal Arg1 As Any Ptr = 0, ByVal Arg2 As Any Ptr = 0, ByVal Arg3 As Any Ptr = 0, ByVal Arg4 As Any Ptr = 0, ByVal Arg5 As Any Ptr = 0, ByVal Arg6 As Any Ptr = 0, ByVal Arg7 As Any Ptr = 0, ByVal Arg8 As Any Ptr = 0, ByVal Arg9 As Any Ptr = 0, ByVal Arg10 As Any Ptr = 0, ByVal Arg11 As Any Ptr = 0, ByVal Arg12 As Any Ptr = 0, ByVal Arg13 As Any Ptr = 0, ByVal Arg14 As Any Ptr = 0, ByVal Arg15 As Any Ptr = 0, ByVal Arg16 As Any Ptr = 0, ByVal Arg17 As Any Ptr = 0, ByVal Arg18 As Any Ptr = 0, ByVal Arg19 As Any Ptr = 0, ByVal Arg20 As Any Ptr = 0, ByVal Arg21 As Any Ptr = 0, ByVal Arg22 As Any Ptr = 0, ByVal Arg23 As Any Ptr = 0, ByVal Arg24 As Any Ptr = 0,ByVal Arg25 As Any Ptr = 0,ByVal Arg26 As Any Ptr = 0,ByVal Arg27 As Any Ptr = 0,ByVal Arg28 As Any Ptr = 0,ByVal Arg29 As Any Ptr = 0,ByVal Arg30 As Any Ptr = 0,ByVal Arg31 As Any Ptr = 0) As tagVariant
		Static DispParams As DISPPARAMS, DispidNamed As DISPID = DISPID_PROPERTYPUT
		Static VParams(31) As tagVariant, SArr(31) As BSTR, ArgsArr(31) As Any Ptr
		Const As UByte l=108,i=105,b=98,d=100,f=102,t=116,v=118,w=119,s=115,c=99,u=117,sR=83,wR=87 'to make the Type-Selects more readable
		Dim TypeChar As UByte, IsByRef As Boolean, VRes As tagVariant, DispId As DISPID
		Dim Args(31) As Any Ptr => {Arg0, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9, Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29, Arg30, Arg31}
		Dim k As Integer

		If UseDispID Then DispID = UseDispID: UseDispID = 0
		COMErr.Number = 0
		If DispID = 0 Then
			LastDispID = 0
			If HandleCOMErr(vDisp.pDispVal->lpVtbl->GetIDsOfNames(vDisp.pDispVal, @IID_NULL, @MethodName, 1, LOCALE_USER_DEFAULT, @DispId), MethodName) Then Return VRes
			LastDispID = DispId
		End If
		
		DispParams.cArgs = Len(TypeChars)
		DispParams.rgVarg = @VParams(0)
		DispParams.cNamedArgs = IIf(CallFlag >= DISPATCH_PROPERTYPUT, 1, 0)
		DispParams.rgdispidNamedArgs = IIf(CallFlag >= DISPATCH_PROPERTYPUT, @DispidNamed, 0)
		
		k = -1
		For j As Integer = DispParams.cArgs - 1 To 0 Step -1
			k = k + 1
			TypeChar = TypeChars[DispParams.cArgs - j - 1]
			IsByRef  = TypeChar < 97
			If IsByRef Then TypeChar += 32 'since the ByRef-Info is now retrieved, we work further with just the lower-case letter
			
			'in a first pass, we set only the proper Variant-Type-Members
			Select Case TypeChar
			Case s,w: VParams(j).VT = VT_BSTR    Or VT_BYREF
			Case u:   VParams(j).VT = VT_UI1     Or VT_BYREF
			Case i:   VParams(j).VT = VT_I2      Or VT_BYREF
			Case l:   VParams(j).VT = VT_I4      Or VT_BYREF
			Case c:   VParams(j).VT = VT_CY      Or IIf(IsByRef, VT_BYREF, 0)
			Case b:   VParams(j).VT = VT_BOOL    Or IIf(IsByRef, VT_BYREF, 0)
			Case f:   VParams(j).VT = VT_R4      Or IIf(IsByRef, VT_BYREF, 0)
			Case d:   VParams(j).VT = VT_R8      Or VT_BYREF
			Case t:   VParams(j).VT = VT_DATE    Or VT_BYREF
			Case v:   VParams(j).VT = VT_VARIANT Or VT_BYREF
			End Select
			
			'in a second pass, we set the Variant-Value-Members of our (static) VParams-Array
			Select Case TypeChar
			Case s,w:  If IsByRef Then ArgsArr(j) = Args(k)
				If SArr(j) Then SysFreeString SArr(j): SArr(j) = 0 'destroy the previous allocation from our static BSTR-Cache
				Select Case TypeChar
				Case s: If IsByRef Then SArr(j) = S2BSTR(*Cast(String Ptr, Args(k)))      Else SArr(j) = S2BSTR(*Cast(ZString Ptr, Args(k)))
				Case w: If IsByRef Then SArr(j) = W2BSTR(*Cast(WString Ptr Ptr, Args(k))) Else SArr(j) = W2BSTR(*Cast(WString Ptr, Args(k)))
				End Select
				VParams(j).pbstrVal = @SArr(j)
			Case v:    VParams(j) = *Cast(tagVARIANT Ptr, Args(k))
			Case f:    If IsByRef Then VParams(j).pbVal = Args(k) Else VParams(j).fltVal = CSng(*Cast(Double Ptr, Args(k)))
			Case b:    If IsByRef Then VParams(j).pbVal = Args(k) Else VParams(j).boolVal = CShort(*Cast(Boolean Ptr, Args(k)))
			Case c:    If IsByRef Then VParams(j).pbVal = Args(k) Else VParams(j).llVal = *Cast(LongInt Ptr, Args(k)) * 10000
			Case Else: If IsByRef Then VParams(j).pbVal = Args(k) Else VParams(j).pbVal  = Args(k)
			End Select
			
			'		'what remains is the type-based Args-Shift
			'		Select Case TypeChar
			'		Case s,w,v: Args = va_next(Args, Any Ptr)
			'		Case f,d,t: If IsByRef Then Args = va_next(Args, Any Ptr) Else Args = va_next(Args, Double)
			'		Case i:     If IsByRef Then Args = va_next(Args, Any Ptr) Else Args = va_next(Args, Short)
			'		Case l:     If IsByRef Then Args = va_next(Args, Any Ptr) Else Args = va_next(Args, Long)
			'		Case b:     If IsByRef Then Args = va_next(Args, Any Ptr) Else Args = va_next(Args, Boolean)
			'		Case u:     If IsByRef Then Args = va_next(Args, Any Ptr) Else Args = va_next(Args, UByte)
			'		Case c:     If IsByRef Then Args = va_next(Args, Any Ptr) Else Args = va_next(Args, LongInt)
			'		End Select
		Next
		
		HandleCOMErr vDisp.pDispVal->lpVtbl->Invoke(VDisp.pDispVal, DispId, @IID_NULL, LOCALE_USER_DEFAULT, CallFlag, @DispParams, @VRes, @EInfo, NULL), MethodName
		
		'this is needed, to pass back any StringValues from our SArr-BSTR-Cache into the FB-StringVariables (in the ByRef-case)
		For j As Integer = DispParams.cArgs - 1 To 0 Step -1
			If VParams(j).VT = (VT_BSTR Or VT_BYREF) Then
				Select Case TypeChars[DispParams.cArgs - j - 1]
				Case sR: *Cast(String Ptr, ArgsArr(j))      = BSTR2S(SArr(j)) 'pass back, in case it was a FB-ByRef-String
				Case wR: *Cast(WString Ptr Ptr, ArgsArr(j)) = BSTR2W(SArr(j)) 'pass back, in case it was a FB-ByRef-WString
				End Select
			End If
		Next
		
		Return VRes
	End Function
#else
	Function CallByName cdecl (vDisp As tagVariant, ByVal MethodName As LPOLESTR, ByVal CallFlag As Word, TypeChars As String = "", ByVal Args As Any Ptr) As tagVariant
		Static DispParams As DISPPARAMS, DispidNamed As DISPID = DISPID_PROPERTYPUT
		Static VParams(31) As tagVariant, SArr(31) As BSTR, ArgsArr(31) As Any Ptr
		Const As UByte l=108,i=105,b=98,d=100,f=102,t=116,v=118,w=119,s=115,c=99,u=117,sR=83,wR=87 'to make the Type-Selects more readable
		Dim TypeChar As UByte, IsByRef As Boolean, VRes As tagVariant, DispId As DISPID
		
		If UseDispID Then DispID = UseDispID: UseDispID = 0
		COMErr.Number = 0
		If DispID = 0 Then
			LastDispID = 0
			If HandleCOMErr(vDisp.pDispVal->lpVtbl->GetIDsOfNames(vDisp.pDispVal, @IID_NULL, @MethodName, 1, LOCALE_USER_DEFAULT, @DispId), MethodName) Then Return VRes
			LastDispID = DispId
		End If
		
		DispParams.cArgs = Len(TypeChars)
		DispParams.rgVarg = @VParams(0)
		DispParams.cNamedArgs = IIf(CallFlag >= DISPATCH_PROPERTYPUT, 1, 0)
		DispParams.rgdispidNamedArgs = IIf(CallFlag >= DISPATCH_PROPERTYPUT, @DispidNamed, 0)
		
		For j As Integer = DispParams.cArgs - 1 To 0 Step -1
			TypeChar = TypeChars[DispParams.cArgs - j - 1]
			IsByRef  = TypeChar < 97
			If IsByRef Then TypeChar += 32 'since the ByRef-Info is now retrieved, we work further with just the lower-case letter
			
			'in a first pass, we set only the proper Variant-Type-Members
			Select Case TypeChar
			Case s,w: VParams(j).VT = VT_BSTR    Or VT_BYREF
			Case u:   VParams(j).VT = VT_UI1     Or VT_BYREF
			Case i:   VParams(j).VT = VT_I2      Or VT_BYREF
			Case l:   VParams(j).VT = VT_I4      Or VT_BYREF
			Case c:   VParams(j).VT = VT_CY      Or IIf(IsByRef, VT_BYREF, 0)
			Case b:   VParams(j).VT = VT_BOOL    Or IIf(IsByRef, VT_BYREF, 0)
			Case f:   VParams(j).VT = VT_R4      Or IIf(IsByRef, VT_BYREF, 0)
			Case d:   VParams(j).VT = VT_R8      Or VT_BYREF
			Case t:   VParams(j).VT = VT_DATE    Or VT_BYREF
			Case v:   VParams(j).VT = VT_VARIANT Or VT_BYREF
			End Select
			
			'in a second pass, we set the Variant-Value-Members of our (static) VParams-Array
			Select Case TypeChar
			Case s,w:  If IsByRef Then ArgsArr(j) = Args
				If SArr(j) Then SysFreeString SArr(j): SArr(j) = 0 'destroy the previous allocation from our static BSTR-Cache
				Select Case TypeChar
				Case s: If IsByRef Then SArr(j) = S2BSTR(*va_arg(Args, String Ptr))      Else SArr(j) = S2BSTR(*va_arg(Args, ZString Ptr))
				Case w: If IsByRef Then SArr(j) = W2BSTR(*va_arg(Args, WString Ptr Ptr)) Else SArr(j) = W2BSTR(*va_arg(Args, WString Ptr))
				End Select
				VParams(j).pbstrVal = @SArr(j)
			Case v:    VParams(j) = *va_arg(Args, tagVARIANT Ptr)
			Case f:    If IsByRef Then VParams(j).pbVal = va_arg(Args, Any Ptr) Else VParams(j).fltVal = CSng(va_arg(Args, Double))
			Case b:    If IsByRef Then VParams(j).pbVal = va_arg(Args, Any Ptr) Else VParams(j).boolVal = CShort(va_arg(Args, Boolean))
			Case c:    If IsByRef Then VParams(j).pbVal = va_arg(Args, Any Ptr) Else VParams(j).llVal = va_arg(Args, LongInt) * 10000
			Case Else: If IsByRef Then VParams(j).pbVal = va_arg(Args, Any Ptr) Else VParams(j).pbVal  = Args
			End Select
			
			'what remains is the type-based Args-Shift
			Select Case TypeChar
			Case s,w,v: Args = va_next(Args, Any Ptr)
			Case f,d,t: If IsByRef Then Args = va_next(Args, Any Ptr) Else Args = va_next(Args, Double)
			Case i:     If IsByRef Then Args = va_next(Args, Any Ptr) Else Args = va_next(Args, Short)
			Case l:     If IsByRef Then Args = va_next(Args, Any Ptr) Else Args = va_next(Args, Long)
			Case b:     If IsByRef Then Args = va_next(Args, Any Ptr) Else Args = va_next(Args, Boolean)
			Case u:     If IsByRef Then Args = va_next(Args, Any Ptr) Else Args = va_next(Args, UByte)
			Case c:     If IsByRef Then Args = va_next(Args, Any Ptr) Else Args = va_next(Args, LongInt)
			End Select
		Next
		
		HandleCOMErr vDisp.pDispVal->lpVtbl->Invoke(VDisp.pDispVal, DispId, @IID_NULL, LOCALE_USER_DEFAULT, CallFlag, @DispParams, @VRes, @EInfo, NULL), MethodName
		
		'this is needed, to pass back any StringValues from our SArr-BSTR-Cache into the FB-StringVariables (in the ByRef-case)
		For j As Integer = DispParams.cArgs - 1 To 0 Step -1
			If VParams(j).VT = (VT_BSTR Or VT_BYREF) Then
				Select Case TypeChars[DispParams.cArgs - j - 1]
				Case sR: *va_arg(ArgsArr(j), String Ptr)      = BSTR2S(SArr(j)) 'pass back, in case it was a FB-ByRef-String
				Case wR: *va_arg(ArgsArr(j), WString Ptr Ptr) = BSTR2W(SArr(j)) 'pass back, in case it was a FB-ByRef-WString
				End Select
			End If
		Next
		
		Return VRes
	End Function
#endif
'*************************** Begin of the Variant-Wrapper-Section *******************************

Enum vbVarType
	vbEmpty    = &H0000
	vbNull     = &H0001
	vbInteger  = &H0002
	vbLong     = &H0003
	vbSingle   = &H0004
	vbDouble   = &H0005
	vbCurrency = &H0006
	vbDate     = &H0007
	vbString   = &H0008
	vbObject   = &H0009
	vbError    = &H000A
	vbBoolean  = &H000B
	vbVariant  = &H000C
	vbDecimal  = &H000E
	vbByte     = &H0011
	vbArray    = &H2000
	vbByRef    = &H4000
End Enum

Type vbVariant
	V As tagVariant
	Declare Constructor()
	Declare Destructor()
	Declare Sub Clear()
	
	Declare Function VarType()  As vbVarType
	Declare Function TypeName() As String
	Declare Function IsEmpty()  As Boolean
	Declare Function IsArray()  As Boolean
	Declare Function IsObject() As Boolean
	
	Declare Constructor (ByVal RHS As Boolean)
	Declare Operator Let(ByVal RHS As Boolean)
	Declare Operator Cast() As Boolean
	
	Declare Constructor (ByVal RHS As UByte)
	Declare Operator Let(ByVal RHS As UByte)
	Declare Operator Cast() As UByte
	
	Declare Constructor (ByVal RHS As Short)
	Declare Operator Let(ByVal RHS As Short)
	Declare Operator Cast() As Short
	
	Declare Constructor (ByVal RHS As Long)
	Declare Operator Let(ByVal RHS As Long)
	Declare Operator Cast() As Long
	
	Declare Constructor (ByVal RHS As LongInt)
	Declare Operator Let(ByVal RHS As LongInt)
	Declare Operator Cast() As LongInt
	
	Declare Constructor (ByVal RHS As Single)
	Declare Operator Let(ByVal RHS As Single)
	Declare Operator Cast() As Single
	
	Declare Constructor (ByVal RHS As Double)
	Declare Operator Let(ByVal RHS As Double)
	Declare Operator Cast() As Double
	
	Declare Constructor (RHS As String)
	Declare Operator Let(RHS As String)
	Declare Operator Cast()  As String
	
	Declare Constructor (ByVal RHS As Const WString Ptr)
	Declare Operator Let(ByVal RHS As Const WString Ptr)
	Declare Operator Cast() As WString Ptr
	
	Declare Constructor (RHS As tagVariant)
	Declare Operator Let(RHS As tagVariant)
	Declare Operator Cast()  As tagVariant
	
	Declare Constructor (RHS As vbVariant)
	Declare Operator Let(RHS As vbVariant)
	
	#ifdef __FB_64BIT__
		Declare Function Call cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ByVal Arg0 As Any Ptr = 0, ByVal Arg1 As Any Ptr = 0, ByVal Arg2 As Any Ptr = 0, ByVal Arg3 As Any Ptr = 0, ByVal Arg4 As Any Ptr = 0, ByVal Arg5 As Any Ptr = 0, ByVal Arg6 As Any Ptr = 0, ByVal Arg7 As Any Ptr = 0, ByVal Arg8 As Any Ptr = 0, ByVal Arg9 As Any Ptr = 0, ByVal Arg10 As Any Ptr = 0, ByVal Arg11 As Any Ptr = 0, ByVal Arg12 As Any Ptr = 0, ByVal Arg13 As Any Ptr = 0, ByVal Arg14 As Any Ptr = 0, ByVal Arg15 As Any Ptr = 0, ByVal Arg16 As Any Ptr = 0, ByVal Arg17 As Any Ptr = 0, ByVal Arg18 As Any Ptr = 0, ByVal Arg19 As Any Ptr = 0, ByVal Arg20 As Any Ptr = 0, ByVal Arg21 As Any Ptr = 0, ByVal Arg22 As Any Ptr = 0, ByVal Arg23 As Any Ptr = 0, ByVal Arg24 As Any Ptr = 0, ByVal Arg25 As Any Ptr = 0, ByVal Arg26 As Any Ptr = 0, ByVal Arg27 As Any Ptr = 0, ByVal Arg28 As Any Ptr = 0, ByVal Arg29 As Any Ptr = 0, ByVal Arg30 As Any Ptr = 0, ByVal Arg31 As Any Ptr = 0) As vbVariant
		Declare Function  Get cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ByVal Arg0 As Any Ptr = 0, ByVal Arg1 As Any Ptr = 0, ByVal Arg2 As Any Ptr = 0, ByVal Arg3 As Any Ptr = 0, ByVal Arg4 As Any Ptr = 0, ByVal Arg5 As Any Ptr = 0, ByVal Arg6 As Any Ptr = 0, ByVal Arg7 As Any Ptr = 0, ByVal Arg8 As Any Ptr = 0, ByVal Arg9 As Any Ptr = 0, ByVal Arg10 As Any Ptr = 0, ByVal Arg11 As Any Ptr = 0, ByVal Arg12 As Any Ptr = 0, ByVal Arg13 As Any Ptr = 0, ByVal Arg14 As Any Ptr = 0, ByVal Arg15 As Any Ptr = 0, ByVal Arg16 As Any Ptr = 0, ByVal Arg17 As Any Ptr = 0, ByVal Arg18 As Any Ptr = 0, ByVal Arg19 As Any Ptr = 0, ByVal Arg20 As Any Ptr = 0, ByVal Arg21 As Any Ptr = 0, ByVal Arg22 As Any Ptr = 0, ByVal Arg23 As Any Ptr = 0, ByVal Arg24 As Any Ptr = 0, ByVal Arg25 As Any Ptr = 0, ByVal Arg26 As Any Ptr = 0, ByVal Arg27 As Any Ptr = 0, ByVal Arg28 As Any Ptr = 0, ByVal Arg29 As Any Ptr = 0, ByVal Arg30 As Any Ptr = 0, ByVal Arg31 As Any Ptr = 0) As vbVariant
		Declare Sub       Put cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ByVal Arg0 As Any Ptr = 0, ByVal Arg1 As Any Ptr = 0, ByVal Arg2 As Any Ptr = 0, ByVal Arg3 As Any Ptr = 0, ByVal Arg4 As Any Ptr = 0, ByVal Arg5 As Any Ptr = 0, ByVal Arg6 As Any Ptr = 0, ByVal Arg7 As Any Ptr = 0, ByVal Arg8 As Any Ptr = 0, ByVal Arg9 As Any Ptr = 0, ByVal Arg10 As Any Ptr = 0, ByVal Arg11 As Any Ptr = 0, ByVal Arg12 As Any Ptr = 0, ByVal Arg13 As Any Ptr = 0, ByVal Arg14 As Any Ptr = 0, ByVal Arg15 As Any Ptr = 0, ByVal Arg16 As Any Ptr = 0, ByVal Arg17 As Any Ptr = 0, ByVal Arg18 As Any Ptr = 0, ByVal Arg19 As Any Ptr = 0, ByVal Arg20 As Any Ptr = 0, ByVal Arg21 As Any Ptr = 0, ByVal Arg22 As Any Ptr = 0, ByVal Arg23 As Any Ptr = 0, ByVal Arg24 As Any Ptr = 0, ByVal Arg25 As Any Ptr = 0, ByVal Arg26 As Any Ptr = 0, ByVal Arg27 As Any Ptr = 0, ByVal Arg28 As Any Ptr = 0, ByVal Arg29 As Any Ptr = 0, ByVal Arg30 As Any Ptr = 0, ByVal Arg31 As Any Ptr = 0)
		Declare Sub       Set cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ByVal Arg0 As Any Ptr = 0, ByVal Arg1 As Any Ptr = 0, ByVal Arg2 As Any Ptr = 0, ByVal Arg3 As Any Ptr = 0, ByVal Arg4 As Any Ptr = 0, ByVal Arg5 As Any Ptr = 0, ByVal Arg6 As Any Ptr = 0, ByVal Arg7 As Any Ptr = 0, ByVal Arg8 As Any Ptr = 0, ByVal Arg9 As Any Ptr = 0, ByVal Arg10 As Any Ptr = 0, ByVal Arg11 As Any Ptr = 0, ByVal Arg12 As Any Ptr = 0, ByVal Arg13 As Any Ptr = 0, ByVal Arg14 As Any Ptr = 0, ByVal Arg15 As Any Ptr = 0, ByVal Arg16 As Any Ptr = 0, ByVal Arg17 As Any Ptr = 0, ByVal Arg18 As Any Ptr = 0, ByVal Arg19 As Any Ptr = 0, ByVal Arg20 As Any Ptr = 0, ByVal Arg21 As Any Ptr = 0, ByVal Arg22 As Any Ptr = 0, ByVal Arg23 As Any Ptr = 0, ByVal Arg24 As Any Ptr = 0, ByVal Arg25 As Any Ptr = 0, ByVal Arg26 As Any Ptr = 0, ByVal Arg27 As Any Ptr = 0, ByVal Arg28 As Any Ptr = 0, ByVal Arg29 As Any Ptr = 0, ByVal Arg30 As Any Ptr = 0, ByVal Arg31 As Any Ptr = 0)
	#else
		Declare Function Call cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ...) As vbVariant
		Declare Function  Get cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ...) As vbVariant
		Declare Sub       Put cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ...)
		Declare Sub       Set cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ...)
	#endif
	Declare Function  vbV() As vbVariant

	Declare Property Configuration As vbVariant
	Declare Property Configuration(ByRef Param1 As vbVariant)
	Declare Property From As vbVariant
	Declare Property From(ByRef Param1 As vbVariant)
	Declare Property To_ As vbVariant
	Declare Property To_(ByRef Param1 As vbVariant)
	Declare Property Subject As vbVariant
	Declare Property Subject(ByRef Param1 As vbVariant)
	Declare Property textBody As vbVariant
	Declare Property textBody(ByRef Param1 As vbVariant)
	Declare Property Charset As vbVariant
	Declare Property Charset(ByRef Param1 As vbVariant)
	Declare Function BodyPart As vbVariant
	Declare Property HTMLBody As vbVariant
	Declare Property HTMLBody(ByRef Param1 As vbVariant)
	Declare Function AddAttachment(ByRef Param1 As vbVariant) As vbVariant
	Declare Property Value As vbVariant
	Declare Property Value(ByRef Param1 As vbVariant)
	Declare Function Item(ByRef Param1 As vbVariant) As vbVariant
	Declare Function Fields As vbVariant
	Declare Function Update As vbVariant
	Declare Function Send As vbVariant
End Type

Property vbVariant.Configuration As vbVariant
	Return This.Get("Configuration")
End Property
Property vbVariant.Configuration(ByRef Param1 As vbVariant)
	This.Put("Configuration", "v", @Param1)
End Property
Property vbVariant.From As vbVariant
	Return This.Get("From")
End Property
Property vbVariant.From(ByRef Param1 As vbVariant)
	This.Put("From", "v", @Param1)
End Property
Property vbVariant.To_ As vbVariant
	Return This.Get("To")
End Property
Property vbVariant.To_(ByRef Param1 As vbVariant)
	This.Put("To", "v", @Param1)
End Property
Property vbVariant.Subject As vbVariant
	Return This.Get("Subject")
End Property
Property vbVariant.Subject(ByRef Param1 As vbVariant)
	This.Put("Subject", "v", @Param1)
End Property
Property vbVariant.textBody As vbVariant
	Return This.Get("textBody")
End Property
Property vbVariant.textBody(ByRef Param1 As vbVariant)
	This.Put("textBody", "v", @Param1)
End Property
Property vbVariant.Charset As vbVariant
	Return This.Get("Charset")
End Property
Property vbVariant.Charset(ByRef Param1 As vbVariant)
	This.Put("Charset", "v", @Param1)
End Property
Function vbVariant.BodyPart As vbVariant
	Return This.Get("BodyPart")
End Function
Property vbVariant.HTMLBody As vbVariant
	Return This.Get("HTMLBody")
End Property
Property vbVariant.HTMLBody(ByRef Param1 As vbVariant)
	This.Put("HTMLBody", "v", @Param1)
End Property
Function vbVariant.AddAttachment(ByRef Param1 As vbVariant) As vbVariant
	Return This.Get("AddAttachment", "v", @Param1)
End Function
Property vbVariant.Value As vbVariant
	Return This.Get("Value")
End Property
Property vbVariant.Value(ByRef Param1 As vbVariant)
	This.Put("Value", "v", @Param1)
End Property
Function vbVariant.Item(ByRef Param1 As vbVariant) As vbVariant
	Return This.Get("Item", "v", @Param1)
End Function
Function vbVariant.Fields As vbVariant
	Return This.Get("Fields")
End Function
Function vbVariant.Update As vbVariant
	Return This.Get("Update")
End Function
Function vbVariant.Send As vbVariant
	Return This.Get("Send")
End Function
Function vbVariant.vbV() As vbVariant
	Return This
End Function
Constructor vbVariant()
	'we dont't do anything here in the base constructor currently
End Constructor
Destructor vbVariant()
	'MsgBox "Destructor of: " & TypeName
	If V.vt Then VariantClear @V
End Destructor
Sub vbVariant.Clear() 'usable on the Outside, e.g. to dereference an Object "early"
	If V.vt Then VariantClear @V: VariantInit @V
End Sub

Function WCacheValue(BSTR2Copy As BSTR) As WString Ptr 'a little Helper, to avoid leaking with the WString-DataType (in the User-Code)
	Const  CacheSize As Integer = 1024
	Static Cache(0 To CacheSize-1) As WString Ptr, NxtIdx As Integer
	NxtIdx= (NxtIdx + 1) Mod CacheSize
	If Cache(NxtIdx) Then Deallocate Cache(NxtIdx)
	Cache(NxtIdx) = BSTR2W(BSTR2Copy)
	Return Cache(NxtIdx)
End Function

Function vbVariant.VarType() As vbVarType
	Return V.vt
End Function
Function vbVariant.TypeName() As String
	Dim T As String
	Select Case V.vt And Not (vbArray Or vbByRef)
	Case vbVarType.vbEmpty:    T = "Empty"
	Case vbVarType.vbNull:     T = "Null"
	Case vbVarType.vbInteger:  T = "Integer"
	Case vbVarType.vbLong:     T = "Long"
	Case vbVarType.vbSingle:   T = "Single"
	Case vbVarType.vbDouble:   T = "Double"
	Case vbVarType.vbCurrency: T = "Currency"
	Case vbVarType.vbDate:     T = "Date"
	Case vbVarType.vbString:   T = "String"
	Case vbVarType.vbObject:   T = "Object"
	Case vbVarType.vbError:    T = "Error"
	Case vbVarType.vbBoolean:  T = "Boolean"
	Case vbVarType.vbVariant:  T = "Variant"
	Case vbVarType.vbDecimal:  T = "Decimal"
	Case vbVarType.vbByte:     T = "Byte"
	Case Else:                 T = "UnsupportedType(" & Hex(V.vt) & ")"
	End Select
	If V.vt And vbArray Then Return T & "()"
	Return T
End Function
Function vbVariant.IsEmpty() As Boolean
	Return V.vt = vbEmpty
End Function
Function vbVariant.IsArray() As Boolean
	If V.vt And vbArray Then Return True
End Function
Function vbVariant.IsObject() As Boolean
	Return V.vt = vbObject
End Function


Constructor vbVariant(ByVal RHS As Boolean)
	This = RHS
End Constructor
Operator vbVariant.Let(ByVal RHS As Boolean)
	If V.vt <> vbBoolean  And V.vt <> vbEmpty Then VariantClear @V
	V.vt =  vbBoolean: V.boolVal = CShort(RHS)
End Operator
Operator vbVariant.Cast() As Boolean
	If V.vt = vbBoolean Then
		Return CBool(V.boolVal)
	Else
		Dim VV As tagVariant
		HandleCOMErr VariantChangeTypeEx(@VV, @V, DefaultLocale_VariantConv, VARIANT_NOVALUEPROP Or VARIANT_ALPHABOOL, vbBoolean), "SimpleVariant.Cast_Boolean"
		Return CBool(VV.boolVal)
	End If
End Operator


Constructor vbVariant(ByVal RHS As UByte)
	This = RHS
End Constructor
Operator vbVariant.Let(ByVal RHS As UByte)
	If V.vt <> vbByte  And V.vt <> vbEmpty Then VariantClear @V
	V.vt =  vbByte: V.bVal = RHS
End Operator
Operator vbVariant.Cast() As UByte
	If V.vt = vbByte Then
		Return V.bVal
	Else
		Dim VV As tagVARIANT
		HandleCOMErr VariantChangeTypeEx(@VV, @V, DefaultLocale_VariantConv, VARIANT_NOVALUEPROP, vbByte), "SimpleVariant.Cast_UByte"
		Return VV.bVal
	End If
End Operator


Constructor vbVariant(ByVal RHS As Short)
	This = RHS
End Constructor
Operator vbVariant.Let(ByVal RHS As Short)
	If V.vt <> vbInteger  And V.vt <> vbEmpty Then VariantClear @V
	V.vt =  vbInteger: V.iVal = RHS
End Operator
Operator vbVariant.Cast() As Short
	If V.vt = vbInteger Then
		Return V.iVal
	Else
		Dim VV As tagVariant
		HandleCOMErr VariantChangeTypeEx(@VV, @V, DefaultLocale_VariantConv, VARIANT_NOVALUEPROP, vbInteger), "SimpleVariant.Cast_Short"
		Return VV.iVal
	End If
End Operator


Constructor vbVariant(ByVal RHS As Long)
	This = RHS
End Constructor
Operator vbVariant.Let(ByVal RHS As Long)
	If V.vt <> vbLong  And V.vt <> vbEmpty Then VariantClear @V
	V.vt =  vbLong: V.lVal = RHS
End Operator
Operator vbVariant.Cast() As Long
	If V.vt = vbLong Then
		Return V.lVal
	Else
		Dim VV As tagVARIANT
		HandleCOMErr VariantChangeTypeEx(@VV, @V, DefaultLocale_VariantConv, VARIANT_NOVALUEPROP, vbLong), "SimpleVariant.Cast_Long"
		Return VV.lVal
	End If
End Operator


Constructor vbVariant(ByVal RHS As LongInt)
	This = RHS
End Constructor
Operator vbVariant.Let(ByVal RHS As LongInt)
	If V.vt <> vbCurrency  And V.vt <> vbEmpty Then VariantClear @V
	V.vt =  vbCurrency: V.llVal = RHS * 10000
End Operator
Operator vbVariant.Cast() As LongInt
	If V.vt = vbCurrency Then
		Return V.llVal / 10000
	Else
		Dim VV As tagVariant
		HandleCOMErr VariantChangeTypeEx(@VV, @V, DefaultLocale_VariantConv, VARIANT_NOVALUEPROP, VT_I8), "SimpleVariant.Cast_LongInt"
		Return VV.llVal
	End If
End Operator


Constructor vbVariant(ByVal RHS As Single)
	This = RHS
End Constructor
Operator vbVariant.Let(ByVal RHS As Single)
	If V.vt <> vbSingle  And V.vt <> vbEmpty Then VariantClear @V
	V.vt =  vbSingle: V.fltVal = RHS
End Operator
Operator vbVariant.Cast() As Single
	If V.vt = vbSingle Then
		Return V.fltVal
	Else
		Dim VV As tagVARIANT
		HandleCOMErr VariantChangeTypeEx(@VV, @V, DefaultLocale_VariantConv, VARIANT_NOVALUEPROP, vbSingle), "SimpleVariant.Cast_Single"
		Return VV.fltVal
	End If
End Operator


Constructor vbVariant(ByVal RHS As Double)
	This = RHS
End Constructor
Operator vbVariant.Let(ByVal RHS As Double)
	If V.vt <> vbDouble  And V.vt <> vbEmpty Then VariantClear @V
	V.vt =  vbDouble: V.dblVal = RHS
End Operator
Operator vbVariant.Cast() As Double
	If V.vt = vbDouble Then
		Return V.dblVal
	Else
		Dim VV As tagVariant
		HandleCOMErr VariantChangeTypeEx(@VV, @V, DefaultLocale_VariantConv, VARIANT_NOVALUEPROP, vbDouble), "SimpleVariant.Cast_Double"
		Return VV.dblVal
	End If
End Operator


Constructor vbVariant(RHS As String)
	This = RHS
End Constructor
Operator vbVariant.Let(RHS As String)
	If V.vt Then VariantClear @V
	V.vt = vbString: V.bstrVal = S2BSTR(RHS)
End Operator
Operator vbVariant.Cast() As String
	If V.vt = vbString Then
		Return BSTR2S(V.bstrVal)
	Else
		Dim VV As tagVARIANT
		HandleCOMErr VariantChangeTypeEx(@VV, @V, DefaultLocale_VariantConv, VARIANT_NOVALUEPROP Or VARIANT_ALPHABOOL, vbString), "SimpleVariant.Cast_String"
		If V.vt = (vbArray Or vbByte) Then
			Dim S As String = String(SysStringByteLen(VV.bstrVal), 0)
			memcpy StrPtr(S), VV.bstrVal, Len(S)
			Operator = S
		Else
			Operator = BSTR2S(VV.bstrVal)
		End If
		VariantClear @VV
	End If
End Operator


Constructor vbVariant(ByVal RHS As Const WString Ptr)
	This = RHS
End Constructor
Operator vbVariant.Let(ByVal RHS As Const WString Ptr)
	If V.VT Then VariantClear @V
	V.vt = vbString: V.bstrVal = W2BSTR(RHS)
End Operator
Operator vbVariant.Cast() As WString Ptr
	If V.vt = vbString Then
		Return WCacheValue(V.bstrVal)
	Else
		Dim VV As tagVARIANT
		HandleCOMErr VariantChangeTypeEx(@VV, @V, DefaultLocale_VariantConv, VARIANT_NOVALUEPROP Or VARIANT_ALPHABOOL, vbString), "SimpleVariant.Cast_WString"
		Operator = WCacheValue(VV.bstrVal)
		VariantClear @VV
	End If
End Operator


Constructor vbVariant(RHS As tagVARIANT)
	If @This = @RHS Then Exit Constructor
	If V.vt Then VariantClear @V
	V=RHS '<- we go with a shallow copy here (to not mess-up RefCounts - e.g. when normal tagVariants come in from Function-Results)
End Constructor
Operator vbVariant.Let(RHS As tagVARIANT)
	If @This = @RHS Then Exit Operator
	If V.vt Then VariantClear @V
	VariantCopy @V, @RHS
End Operator
Operator vbVariant.Cast() As tagVARIANT
	Dim Dst As tagVARIANT
	VariantCopy @Dst, @V
	Return Dst
End Operator


Constructor vbVariant(RHS As vbVariant)
	If @This = @RHS Then Exit Constructor
	If V.vt Then VariantClear @V
	VariantCopy @V, @RHS.V
End Constructor
Operator vbVariant.Let(RHS As vbVariant)
	If @This = @RHS Then Exit Operator
	If V.vt Then VariantClear @V
	VariantCopy @V, @RHS.V
End Operator

#ifdef __FB_64BIT__
	Function vbVariant.Call cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ByVal Arg0 As Any Ptr = 0, ByVal Arg1 As Any Ptr = 0, ByVal Arg2 As Any Ptr = 0, ByVal Arg3 As Any Ptr = 0, ByVal Arg4 As Any Ptr = 0, ByVal Arg5 As Any Ptr = 0, ByVal Arg6 As Any Ptr = 0, ByVal Arg7 As Any Ptr = 0, ByVal Arg8 As Any Ptr = 0, ByVal Arg9 As Any Ptr = 0, ByVal Arg10 As Any Ptr = 0, ByVal Arg11 As Any Ptr = 0, ByVal Arg12 As Any Ptr = 0, ByVal Arg13 As Any Ptr = 0, ByVal Arg14 As Any Ptr = 0, ByVal Arg15 As Any Ptr = 0, ByVal Arg16 As Any Ptr = 0, ByVal Arg17 As Any Ptr = 0, ByVal Arg18 As Any Ptr = 0, ByVal Arg19 As Any Ptr = 0, ByVal Arg20 As Any Ptr = 0, ByVal Arg21 As Any Ptr = 0, ByVal Arg22 As Any Ptr = 0, ByVal Arg23 As Any Ptr = 0, ByVal Arg24 As Any Ptr = 0, ByVal Arg25 As Any Ptr = 0, ByVal Arg26 As Any Ptr = 0, ByVal Arg27 As Any Ptr = 0, ByVal Arg28 As Any Ptr = 0, ByVal Arg29 As Any Ptr = 0, ByVal Arg30 As Any Ptr = 0, ByVal Arg31 As Any Ptr = 0) As vbVariant
		Dim tv As tagVARIANT
		tv = CallByName(V, MethodName, DISPATCH_METHOD Or DISPATCH_PROPERTYGET, TypeChars, Arg0, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9, Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29, Arg30, Arg31)
		Function = tv
	End Function
	Function vbVariant.Get cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ByVal Arg0 As Any Ptr = 0, ByVal Arg1 As Any Ptr = 0, ByVal Arg2 As Any Ptr = 0, ByVal Arg3 As Any Ptr = 0, ByVal Arg4 As Any Ptr = 0, ByVal Arg5 As Any Ptr = 0, ByVal Arg6 As Any Ptr = 0, ByVal Arg7 As Any Ptr = 0, ByVal Arg8 As Any Ptr = 0, ByVal Arg9 As Any Ptr = 0, ByVal Arg10 As Any Ptr = 0, ByVal Arg11 As Any Ptr = 0, ByVal Arg12 As Any Ptr = 0, ByVal Arg13 As Any Ptr = 0, ByVal Arg14 As Any Ptr = 0, ByVal Arg15 As Any Ptr = 0, ByVal Arg16 As Any Ptr = 0, ByVal Arg17 As Any Ptr = 0, ByVal Arg18 As Any Ptr = 0, ByVal Arg19 As Any Ptr = 0, ByVal Arg20 As Any Ptr = 0, ByVal Arg21 As Any Ptr = 0, ByVal Arg22 As Any Ptr = 0, ByVal Arg23 As Any Ptr = 0, ByVal Arg24 As Any Ptr = 0, ByVal Arg25 As Any Ptr = 0, ByVal Arg26 As Any Ptr = 0, ByVal Arg27 As Any Ptr = 0, ByVal Arg28 As Any Ptr = 0, ByVal Arg29 As Any Ptr = 0, ByVal Arg30 As Any Ptr = 0, ByVal Arg31 As Any Ptr = 0) As vbVariant
		Return CallByName(V, MethodName, DISPATCH_METHOD Or DISPATCH_PROPERTYGET, TypeChars, Arg0, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9, Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29, Arg30, Arg31)
	End Function
	Sub vbVariant.Put cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ByVal Arg0 As Any Ptr = 0, ByVal Arg1 As Any Ptr = 0, ByVal Arg2 As Any Ptr = 0, ByVal Arg3 As Any Ptr = 0, ByVal Arg4 As Any Ptr = 0, ByVal Arg5 As Any Ptr = 0, ByVal Arg6 As Any Ptr = 0, ByVal Arg7 As Any Ptr = 0, ByVal Arg8 As Any Ptr = 0, ByVal Arg9 As Any Ptr = 0, ByVal Arg10 As Any Ptr = 0, ByVal Arg11 As Any Ptr = 0, ByVal Arg12 As Any Ptr = 0, ByVal Arg13 As Any Ptr = 0, ByVal Arg14 As Any Ptr = 0, ByVal Arg15 As Any Ptr = 0, ByVal Arg16 As Any Ptr = 0, ByVal Arg17 As Any Ptr = 0, ByVal Arg18 As Any Ptr = 0, ByVal Arg19 As Any Ptr = 0, ByVal Arg20 As Any Ptr = 0, ByVal Arg21 As Any Ptr = 0, ByVal Arg22 As Any Ptr = 0, ByVal Arg23 As Any Ptr = 0, ByVal Arg24 As Any Ptr = 0, ByVal Arg25 As Any Ptr = 0, ByVal Arg26 As Any Ptr = 0, ByVal Arg27 As Any Ptr = 0, ByVal Arg28 As Any Ptr = 0, ByVal Arg29 As Any Ptr = 0, ByVal Arg30 As Any Ptr = 0, ByVal Arg31 As Any Ptr = 0)
		CallByName(V, MethodName, DISPATCH_PROPERTYPUT, TypeChars, Arg0, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9, Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29, Arg30, Arg31)
	End Sub
	Sub vbVariant.Set cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ByVal Arg0 As Any Ptr = 0, ByVal Arg1 As Any Ptr = 0, ByVal Arg2 As Any Ptr = 0, ByVal Arg3 As Any Ptr = 0, ByVal Arg4 As Any Ptr = 0, ByVal Arg5 As Any Ptr = 0, ByVal Arg6 As Any Ptr = 0, ByVal Arg7 As Any Ptr = 0, ByVal Arg8 As Any Ptr = 0, ByVal Arg9 As Any Ptr = 0, ByVal Arg10 As Any Ptr = 0, ByVal Arg11 As Any Ptr = 0, ByVal Arg12 As Any Ptr = 0, ByVal Arg13 As Any Ptr = 0, ByVal Arg14 As Any Ptr = 0, ByVal Arg15 As Any Ptr = 0, ByVal Arg16 As Any Ptr = 0, ByVal Arg17 As Any Ptr = 0, ByVal Arg18 As Any Ptr = 0, ByVal Arg19 As Any Ptr = 0, ByVal Arg20 As Any Ptr = 0, ByVal Arg21 As Any Ptr = 0, ByVal Arg22 As Any Ptr = 0, ByVal Arg23 As Any Ptr = 0, ByVal Arg24 As Any Ptr = 0, ByVal Arg25 As Any Ptr = 0, ByVal Arg26 As Any Ptr = 0, ByVal Arg27 As Any Ptr = 0, ByVal Arg28 As Any Ptr = 0, ByVal Arg29 As Any Ptr = 0, ByVal Arg30 As Any Ptr = 0, ByVal Arg31 As Any Ptr = 0)
		CallByName(V, MethodName, DISPATCH_PROPERTYPUTREF,  TypeChars, Arg0, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9, Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29, Arg30, Arg31)
	End Sub
#else
	Function vbVariant.Call cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ...) As vbVariant
		Dim tv As tagVARIANT
		tv = CallByName(V, MethodName, DISPATCH_METHOD Or DISPATCH_PROPERTYGET, TypeChars, va_first)
		Function = tv
	End Function
	Function vbVariant.Get cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ...) As vbVariant
		Return CallByName(V, MethodName, DISPATCH_METHOD Or DISPATCH_PROPERTYGET, TypeChars, va_first)
	End Function
	Sub vbVariant.Put cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ...)
		CallByName(V, MethodName, DISPATCH_PROPERTYPUT, TypeChars, va_first)
	End Sub
	Sub vbVariant.Set cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ...)
		CallByName(V, MethodName, DISPATCH_PROPERTYPUTREF,  TypeChars, va_first)
	End Sub
#endif
'finally a MsgBox-OverLoad, which accepts a vbVariant as the Msg-Parameter
Function MsgBox cdecl (ByVal Msg As vbVariant, ByVal Flags As Long = MB_ICONINFORMATION) As Long
	If Msg.V.vt = vbString Then
		Return MessageBoxW(GetActiveWindow, Msg.V.bstrVal, AppName, Flags)
	Else
		Dim VV As tagVARIANT
		HandleCOMErr VariantChangeTypeEx(@VV, @Msg.V, DefaultLocale_VariantConv, VARIANT_NOVALUEPROP Or VARIANT_ALPHABOOL, vbString), "SimpleVariant.MsgBox"
		Function = MessageBoxW(GetActiveWindow, VV.bstrVal, AppName, Flags)
		VariantClear @VV
	End If
End Function

#define Set
#define Nothing 0

Example:

Code: Select all

#include once "SimpleVariantPlus.bi"

Dim loConfig As vbVariant = CreateObject("CDO.Configuration")
Dim loCdoMessage As vbVariant = CreateObject("CDO.Message")
loCdoMessage.Configuration = loConfig
loCdoMessage.From    = "My mail"""" <info@mymail.com>"
loCdoMessage.To_     = "To mail@tomail.com"
loCdoMessage.Subject = "Report"
loCdoMessage.textBody = "Report"
'loCdoMessage.BodyPart.Charset = "windows-1251"
'loCdoMessage.HTMLBody = ""
loCdoMessage.AddAttachment("The_path_to_the_file")
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing").Value = 2
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver").Value = "smtp.mail.ru"
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport").Value = "465"
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate").Value = 1
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername").Value = "info@mymail.com"
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword").Value = "Password"
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl").Value = 1
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout").Value = 60
loConfig.Fields.Update()
loCdoMessage.Send()

[PeterHu]

Just wondering is there any smtp/sending email sdk/library/functions/demos accompany with mff/vfe?Never mind if not.

This is how you can send mail:

SimpleVariantPlus.bi (I created this using COMWrapperBuilder tool):

Code: Select all

'SimpleVariantPlus.bi: a "lean and mean" (not library-dependent) LateBound-Helper-Module for FreeBasic
'Author:      Olaf Schmidt (June 2016)
'Updated by Xusinboy Bekchanov to support 64-bit (August 2020)
'The Vartype-Letters, as used for the ByName...-Methods are as follows:
'    u: 8BitU-Integer(FB UByte)
'    i: 16Bit-Integer(FB Short)
'    l: 32Bit-Integer(FB Long)
'    c: 64Bit-Integer(FB LongInt, mapped between 64Bit-FB-Int and -OLEVariant-Currency)
'    b: 16Bit-Boolean(FB Boolean, mapped between 8Bit-FB and 16Bit-OLEVariant-Booleans)
'    f: 32Bit-FlPoint(FB Single)
'    d: 64Bit-FlPoint(FB Double)
'    t: 64BitDateTime(FB Double)
'    s: 8Bit-per-Char(FB String)  !!! note, that only in normal ANSI-FB-Source-Modules, String-Literals can be passed as "s"...
'    w: 16Bit-per-Chr(FB WString) !!! ...in FB-Source-Modules that are Unicode, String-Literals need to be passed as "w" instead
'    v: OleVariant (which always need to be passed with their VarPtr -> @VariantVariable
'When used in the TypeChars-Param of the CallByName-Func, an UpperCase-Letter signifies
'"ByRef"-passing (the FB-Variable needs to be prefixed by an @ in these cases)

#include once "vbcompat.bi"
#include once "windows.bi"
#include once "win/ole2.bi"
#include once "crt/string.bi"

#ifdef __FB_WIN32__ 'this is necessary, because FB maps the original FB-Long-Def to Boolean somehow (remove when Fix is available in the Compiler)
	#undef  Long
	#define Long Integer '...though it should not do any harm to leave it as is... on Win32 it's the same BitLength (+ we filtered with the #IfDef)
	#undef  CLng
	#define CLng CInt 'same thing here - a redefinition is necessary to work around the FB-Win32-Compiler-Bug
	#undef Call 'to allow usage of that KeyWord as an UDT-Method (it's not used anyways in lang -fb)
#endif

'the following Const is used in the (Variant)Conversions from BSTRs to FB-Strings
Dim Shared DefaultCodePage_StringConv As UINT
#ifdef UNICODE
	DefaultCodePage_StringConv = CP_UTF8 'an 8Bit-FB-String will hold an UTF8-Stream when a vbVariant is casted to it
#else
	DefaultCodePage_StringConv = CP_ACP 'that conforms to the normal ANSI-Conversion
#endif

'the Const below is relevant for the Variant-Conversions (Strings <-> Numbers or DateValues) - we avoid LOCALE_USER_DEFAULT,
'since that would convert e.g. a DoubleValue of 1.1 to a String-Representation of 1,1 on a german system, instead LOCALE_INVARIANT ...
Const DefaultLocale_VariantConv As Long = LOCALE_INVARIANT '...conforms to FB-StringConv-Representations of Dates and rational Numbers

Type tCOMErr
	Number As UINT
	Description As String
End Type
Dim Shared COMErr As tCOMErr, EInfo As tagEXCEPINFO, ShowCOMErrors As Boolean = True

Dim Shared Done As Boolean 'anything COM-related needs to CoInitialize... (shell32 and comctl32 are preloaded, to play nicely with Manifested Apps)
If Not Done Then Done = True: CoInitializeEx(0, 2): DyLibLoad("shell32.dll"): DyLibLoad("comctl32.dll")

Function AppName() As String
	Static S As String
	If Len(S) = 0 Then S = Command(0):S = Mid(S, InStrRev(S, "\") + 1): S = Left(S, Len(S) - 4)
	Return S
End Function

Function MsgBox cdecl Overload (ByVal Msg As LPCWSTR, ByVal Flags As Long = MB_ICONINFORMATION) As Long
	Return MessageBoxW(GetActiveWindow, Msg, AppName, Flags)
End Function

Private Function HandleCOMErr(ByVal HRes As HResult, ByVal MethodName As LPOLESTR) As HResult
	Static Msg As WString Ptr: If Msg = NULL Then Msg = CAllocate(8192 + 2)
	
	Function = HRes
	If HRes = DISP_E_EXCEPTION Then
		COMErr.Number = EInfo.sCode
		COMErr.Description= "Err(&H" & Hex(HRes) & ") in " & *Cast(WString Ptr, EInfo.bstrSource) & ", whilst calling: " & *Cast(WString Ptr, MethodName) & Chr(10) & *Cast(WString Ptr, EInfo.bstrDescription)
	ElseIf HRes Then
		FormatMessageW FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, NULL, HRes, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), Msg, 4096, NULL
		COMErr.Number = HRes
		COMErr.Description= "Err(&H" & Hex(HRes) & ") in SimpleVariant.bi, whilst calling: " & *Cast(WString Ptr, MethodName) & Chr(10) & *Msg
	End If
	If CBool(HRes) And ShowCOMErrors Then MsgBox COMErr.Description
End Function

'the usual Instantiation-Helper for COM-Objects which are known in the Win-Registry (e.g. CreateObject("Scripting.Dictionary")
Function CreateObject(ByVal ProgID As LPCOLESTR) As tagVariant
	If Not Done Then Done = True: CoInitializeEx(0, 2): DyLibLoad("shell32.dll"): DyLibLoad("comctl32.dll")
	
	COMErr.Number = 0
	Dim CLSID As CLSID, RetVal As tagVariant
	If HandleCOMErr(CLSIDFromProgID(ProgID, @ClsID), "CLSIDFromProgID") Then Return RetVal
	If HandleCOMErr(CoCreateInstance(@ClsID, NULL, CLSCTX_SERVER, @IID_IDispatch, @RetVal.pDispVal), "CreateObject") Then Return RetVal
	RetVal.VT = VT_DISPATCH
	Return RetVal
End Function

'but here's a helper-function to create COM-Objects regfree, in case the user provided a *.manifest-File (and placed it beside the COM-Dll-File)
Function CreateObjectRegFree(ProgID As WString Ptr, ManifestFileName As WString Ptr) As tagVariant
	Static ACW As ACTCTXW
	ACW.cbSize = Len(ACW)
	ACW.lpSource = ManifestFileName
	
	COMErr.Number = 0
	
	Dim hActCtx As HANDLE, Cookie As ULONG_PTR
	hActCtx = CreateActCtxW(@ACW)
	If (hActCtx = INVALID_HANDLE_VALUE) Then
		COMErr.Number = &H80020009
		COMErr.Description = "Couldn't create ActCtx from Manifest: " & *ManifestFileName
		If ShowCOMErrors Then MsgBox COMErr.Description
		Exit Function
	End If
	
	If ActivateActCtx(hActCtx, @Cookie) Then
		Dim OrigDir As String, DllPath As String = Left(*ManifestFileName, InStrRev(*ManifestFileName, "\"))
		OrigDir = CurDir()
		ChDir DllPath
		Function = CreateObject(ProgID)
		ChDir OrigDir
		DeactivateActCtx 0, Cookie
	Else
		COMErr.Number = &H80020009
		COMErr.Description = "Couldn't activate ActCtx from Manifest: " & *ManifestFileName
		If ShowCOMErrors Then MsgBox COMErr.Description
	End If
	
	ReleaseActCtx hActCtx
End Function

Function BSTR2S cdecl (ByVal BS As Const BSTR, ByVal CodePage As UINT = DefaultCodePage_StringConv) As String
	Dim BytesNeeded As UINT, S As String
	BytesNeeded = WideCharToMultiByte(CodePage, 0, BS, SysStringLen(BS), 0, 0, 0, 0)
	S = String(BytesNeeded, 0)
	WideCharToMultiByte CodePage, 0, BS, SysStringLen(BS), StrPtr(S), BytesNeeded, 0, 0
	Return S
End Function
Function S2BSTR cdecl (S As Const String, ByVal CodePage As UINT = DefaultCodePage_StringConv) As BSTR 'the caller is responsible for freeing the returned BSTR per SysFreeString
	Dim WCharsNeeded As UINT, BS As BSTR
	WCharsNeeded = MultiByteToWideChar(CodePage, 0, StrPtr(S), Len(S), 0, 0)
	BS = SysAllocStringLen(BS, WCharsNeeded)
	MultiByteToWideChar CodePage, 0, StrPtr(S), Len(S), BS, WCharsNeeded
	Return BS
End Function

Function BSTR2W(ByVal BS As Const BSTR) As WString Ptr 'the caller is responsible for freeing the returned WString per DeAllocate
	Dim W As WString Ptr
	W = CAllocate(SysStringByteLen(BS) + 2)
	If BS Then memcpy W, BS, SysStringByteLen(BS)
	Return W
End Function
Function W2BSTR(ByVal W As Const WString Ptr) As BSTR 'the caller is responsible for freeing the returned BSTR per SysFreeString
	Return SysAllocString(W)
End Function

'well, this is the workhorse for all the Dispatch-Calls (IDispatch::Invoke)... there's easier Wrapper-Methods around this at the end of this module)
Dim Shared LastDispID As Long = 0, UseDispId As Long = 0
#ifdef __FB_64BIT__
	Function CallByName cdecl (vDisp As tagVariant, ByVal MethodName As LPOLESTR, ByVal CallFlag As Word, TypeChars As String = "", ByVal Arg0 As Any Ptr = 0, ByVal Arg1 As Any Ptr = 0, ByVal Arg2 As Any Ptr = 0, ByVal Arg3 As Any Ptr = 0, ByVal Arg4 As Any Ptr = 0, ByVal Arg5 As Any Ptr = 0, ByVal Arg6 As Any Ptr = 0, ByVal Arg7 As Any Ptr = 0, ByVal Arg8 As Any Ptr = 0, ByVal Arg9 As Any Ptr = 0, ByVal Arg10 As Any Ptr = 0, ByVal Arg11 As Any Ptr = 0, ByVal Arg12 As Any Ptr = 0, ByVal Arg13 As Any Ptr = 0, ByVal Arg14 As Any Ptr = 0, ByVal Arg15 As Any Ptr = 0, ByVal Arg16 As Any Ptr = 0, ByVal Arg17 As Any Ptr = 0, ByVal Arg18 As Any Ptr = 0, ByVal Arg19 As Any Ptr = 0, ByVal Arg20 As Any Ptr = 0, ByVal Arg21 As Any Ptr = 0, ByVal Arg22 As Any Ptr = 0, ByVal Arg23 As Any Ptr = 0, ByVal Arg24 As Any Ptr = 0,ByVal Arg25 As Any Ptr = 0,ByVal Arg26 As Any Ptr = 0,ByVal Arg27 As Any Ptr = 0,ByVal Arg28 As Any Ptr = 0,ByVal Arg29 As Any Ptr = 0,ByVal Arg30 As Any Ptr = 0,ByVal Arg31 As Any Ptr = 0) As tagVariant
		Static DispParams As DISPPARAMS, DispidNamed As DISPID = DISPID_PROPERTYPUT
		Static VParams(31) As tagVariant, SArr(31) As BSTR, ArgsArr(31) As Any Ptr
		Const As UByte l=108,i=105,b=98,d=100,f=102,t=116,v=118,w=119,s=115,c=99,u=117,sR=83,wR=87 'to make the Type-Selects more readable
		Dim TypeChar As UByte, IsByRef As Boolean, VRes As tagVariant, DispId As DISPID
		Dim Args(31) As Any Ptr => {Arg0, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9, Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29, Arg30, Arg31}
		Dim k As Integer

		If UseDispID Then DispID = UseDispID: UseDispID = 0
		COMErr.Number = 0
		If DispID = 0 Then
			LastDispID = 0
			If HandleCOMErr(vDisp.pDispVal->lpVtbl->GetIDsOfNames(vDisp.pDispVal, @IID_NULL, @MethodName, 1, LOCALE_USER_DEFAULT, @DispId), MethodName) Then Return VRes
			LastDispID = DispId
		End If
		
		DispParams.cArgs = Len(TypeChars)
		DispParams.rgVarg = @VParams(0)
		DispParams.cNamedArgs = IIf(CallFlag >= DISPATCH_PROPERTYPUT, 1, 0)
		DispParams.rgdispidNamedArgs = IIf(CallFlag >= DISPATCH_PROPERTYPUT, @DispidNamed, 0)
		
		k = -1
		For j As Integer = DispParams.cArgs - 1 To 0 Step -1
			k = k + 1
			TypeChar = TypeChars[DispParams.cArgs - j - 1]
			IsByRef  = TypeChar < 97
			If IsByRef Then TypeChar += 32 'since the ByRef-Info is now retrieved, we work further with just the lower-case letter
			
			'in a first pass, we set only the proper Variant-Type-Members
			Select Case TypeChar
			Case s,w: VParams(j).VT = VT_BSTR    Or VT_BYREF
			Case u:   VParams(j).VT = VT_UI1     Or VT_BYREF
			Case i:   VParams(j).VT = VT_I2      Or VT_BYREF
			Case l:   VParams(j).VT = VT_I4      Or VT_BYREF
			Case c:   VParams(j).VT = VT_CY      Or IIf(IsByRef, VT_BYREF, 0)
			Case b:   VParams(j).VT = VT_BOOL    Or IIf(IsByRef, VT_BYREF, 0)
			Case f:   VParams(j).VT = VT_R4      Or IIf(IsByRef, VT_BYREF, 0)
			Case d:   VParams(j).VT = VT_R8      Or VT_BYREF
			Case t:   VParams(j).VT = VT_DATE    Or VT_BYREF
			Case v:   VParams(j).VT = VT_VARIANT Or VT_BYREF
			End Select
			
			'in a second pass, we set the Variant-Value-Members of our (static) VParams-Array
			Select Case TypeChar
			Case s,w:  If IsByRef Then ArgsArr(j) = Args(k)
				If SArr(j) Then SysFreeString SArr(j): SArr(j) = 0 'destroy the previous allocation from our static BSTR-Cache
				Select Case TypeChar
				Case s: If IsByRef Then SArr(j) = S2BSTR(*Cast(String Ptr, Args(k)))      Else SArr(j) = S2BSTR(*Cast(ZString Ptr, Args(k)))
				Case w: If IsByRef Then SArr(j) = W2BSTR(*Cast(WString Ptr Ptr, Args(k))) Else SArr(j) = W2BSTR(*Cast(WString Ptr, Args(k)))
				End Select
				VParams(j).pbstrVal = @SArr(j)
			Case v:    VParams(j) = *Cast(tagVARIANT Ptr, Args(k))
			Case f:    If IsByRef Then VParams(j).pbVal = Args(k) Else VParams(j).fltVal = CSng(*Cast(Double Ptr, Args(k)))
			Case b:    If IsByRef Then VParams(j).pbVal = Args(k) Else VParams(j).boolVal = CShort(*Cast(Boolean Ptr, Args(k)))
			Case c:    If IsByRef Then VParams(j).pbVal = Args(k) Else VParams(j).llVal = *Cast(LongInt Ptr, Args(k)) * 10000
			Case Else: If IsByRef Then VParams(j).pbVal = Args(k) Else VParams(j).pbVal  = Args(k)
			End Select
			
			'		'what remains is the type-based Args-Shift
			'		Select Case TypeChar
			'		Case s,w,v: Args = va_next(Args, Any Ptr)
			'		Case f,d,t: If IsByRef Then Args = va_next(Args, Any Ptr) Else Args = va_next(Args, Double)
			'		Case i:     If IsByRef Then Args = va_next(Args, Any Ptr) Else Args = va_next(Args, Short)
			'		Case l:     If IsByRef Then Args = va_next(Args, Any Ptr) Else Args = va_next(Args, Long)
			'		Case b:     If IsByRef Then Args = va_next(Args, Any Ptr) Else Args = va_next(Args, Boolean)
			'		Case u:     If IsByRef Then Args = va_next(Args, Any Ptr) Else Args = va_next(Args, UByte)
			'		Case c:     If IsByRef Then Args = va_next(Args, Any Ptr) Else Args = va_next(Args, LongInt)
			'		End Select
		Next
		
		HandleCOMErr vDisp.pDispVal->lpVtbl->Invoke(VDisp.pDispVal, DispId, @IID_NULL, LOCALE_USER_DEFAULT, CallFlag, @DispParams, @VRes, @EInfo, NULL), MethodName
		
		'this is needed, to pass back any StringValues from our SArr-BSTR-Cache into the FB-StringVariables (in the ByRef-case)
		For j As Integer = DispParams.cArgs - 1 To 0 Step -1
			If VParams(j).VT = (VT_BSTR Or VT_BYREF) Then
				Select Case TypeChars[DispParams.cArgs - j - 1]
				Case sR: *Cast(String Ptr, ArgsArr(j))      = BSTR2S(SArr(j)) 'pass back, in case it was a FB-ByRef-String
				Case wR: *Cast(WString Ptr Ptr, ArgsArr(j)) = BSTR2W(SArr(j)) 'pass back, in case it was a FB-ByRef-WString
				End Select
			End If
		Next
		
		Return VRes
	End Function
#else
	Function CallByName cdecl (vDisp As tagVariant, ByVal MethodName As LPOLESTR, ByVal CallFlag As Word, TypeChars As String = "", ByVal Args As Any Ptr) As tagVariant
		Static DispParams As DISPPARAMS, DispidNamed As DISPID = DISPID_PROPERTYPUT
		Static VParams(31) As tagVariant, SArr(31) As BSTR, ArgsArr(31) As Any Ptr
		Const As UByte l=108,i=105,b=98,d=100,f=102,t=116,v=118,w=119,s=115,c=99,u=117,sR=83,wR=87 'to make the Type-Selects more readable
		Dim TypeChar As UByte, IsByRef As Boolean, VRes As tagVariant, DispId As DISPID
		
		If UseDispID Then DispID = UseDispID: UseDispID = 0
		COMErr.Number = 0
		If DispID = 0 Then
			LastDispID = 0
			If HandleCOMErr(vDisp.pDispVal->lpVtbl->GetIDsOfNames(vDisp.pDispVal, @IID_NULL, @MethodName, 1, LOCALE_USER_DEFAULT, @DispId), MethodName) Then Return VRes
			LastDispID = DispId
		End If
		
		DispParams.cArgs = Len(TypeChars)
		DispParams.rgVarg = @VParams(0)
		DispParams.cNamedArgs = IIf(CallFlag >= DISPATCH_PROPERTYPUT, 1, 0)
		DispParams.rgdispidNamedArgs = IIf(CallFlag >= DISPATCH_PROPERTYPUT, @DispidNamed, 0)
		
		For j As Integer = DispParams.cArgs - 1 To 0 Step -1
			TypeChar = TypeChars[DispParams.cArgs - j - 1]
			IsByRef  = TypeChar < 97
			If IsByRef Then TypeChar += 32 'since the ByRef-Info is now retrieved, we work further with just the lower-case letter
			
			'in a first pass, we set only the proper Variant-Type-Members
			Select Case TypeChar
			Case s,w: VParams(j).VT = VT_BSTR    Or VT_BYREF
			Case u:   VParams(j).VT = VT_UI1     Or VT_BYREF
			Case i:   VParams(j).VT = VT_I2      Or VT_BYREF
			Case l:   VParams(j).VT = VT_I4      Or VT_BYREF
			Case c:   VParams(j).VT = VT_CY      Or IIf(IsByRef, VT_BYREF, 0)
			Case b:   VParams(j).VT = VT_BOOL    Or IIf(IsByRef, VT_BYREF, 0)
			Case f:   VParams(j).VT = VT_R4      Or IIf(IsByRef, VT_BYREF, 0)
			Case d:   VParams(j).VT = VT_R8      Or VT_BYREF
			Case t:   VParams(j).VT = VT_DATE    Or VT_BYREF
			Case v:   VParams(j).VT = VT_VARIANT Or VT_BYREF
			End Select
			
			'in a second pass, we set the Variant-Value-Members of our (static) VParams-Array
			Select Case TypeChar
			Case s,w:  If IsByRef Then ArgsArr(j) = Args
				If SArr(j) Then SysFreeString SArr(j): SArr(j) = 0 'destroy the previous allocation from our static BSTR-Cache
				Select Case TypeChar
				Case s: If IsByRef Then SArr(j) = S2BSTR(*va_arg(Args, String Ptr))      Else SArr(j) = S2BSTR(*va_arg(Args, ZString Ptr))
				Case w: If IsByRef Then SArr(j) = W2BSTR(*va_arg(Args, WString Ptr Ptr)) Else SArr(j) = W2BSTR(*va_arg(Args, WString Ptr))
				End Select
				VParams(j).pbstrVal = @SArr(j)
			Case v:    VParams(j) = *va_arg(Args, tagVARIANT Ptr)
			Case f:    If IsByRef Then VParams(j).pbVal = va_arg(Args, Any Ptr) Else VParams(j).fltVal = CSng(va_arg(Args, Double))
			Case b:    If IsByRef Then VParams(j).pbVal = va_arg(Args, Any Ptr) Else VParams(j).boolVal = CShort(va_arg(Args, Boolean))
			Case c:    If IsByRef Then VParams(j).pbVal = va_arg(Args, Any Ptr) Else VParams(j).llVal = va_arg(Args, LongInt) * 10000
			Case Else: If IsByRef Then VParams(j).pbVal = va_arg(Args, Any Ptr) Else VParams(j).pbVal  = Args
			End Select
			
			'what remains is the type-based Args-Shift
			Select Case TypeChar
			Case s,w,v: Args = va_next(Args, Any Ptr)
			Case f,d,t: If IsByRef Then Args = va_next(Args, Any Ptr) Else Args = va_next(Args, Double)
			Case i:     If IsByRef Then Args = va_next(Args, Any Ptr) Else Args = va_next(Args, Short)
			Case l:     If IsByRef Then Args = va_next(Args, Any Ptr) Else Args = va_next(Args, Long)
			Case b:     If IsByRef Then Args = va_next(Args, Any Ptr) Else Args = va_next(Args, Boolean)
			Case u:     If IsByRef Then Args = va_next(Args, Any Ptr) Else Args = va_next(Args, UByte)
			Case c:     If IsByRef Then Args = va_next(Args, Any Ptr) Else Args = va_next(Args, LongInt)
			End Select
		Next
		
		HandleCOMErr vDisp.pDispVal->lpVtbl->Invoke(VDisp.pDispVal, DispId, @IID_NULL, LOCALE_USER_DEFAULT, CallFlag, @DispParams, @VRes, @EInfo, NULL), MethodName
		
		'this is needed, to pass back any StringValues from our SArr-BSTR-Cache into the FB-StringVariables (in the ByRef-case)
		For j As Integer = DispParams.cArgs - 1 To 0 Step -1
			If VParams(j).VT = (VT_BSTR Or VT_BYREF) Then
				Select Case TypeChars[DispParams.cArgs - j - 1]
				Case sR: *va_arg(ArgsArr(j), String Ptr)      = BSTR2S(SArr(j)) 'pass back, in case it was a FB-ByRef-String
				Case wR: *va_arg(ArgsArr(j), WString Ptr Ptr) = BSTR2W(SArr(j)) 'pass back, in case it was a FB-ByRef-WString
				End Select
			End If
		Next
		
		Return VRes
	End Function
#endif
'*************************** Begin of the Variant-Wrapper-Section *******************************

Enum vbVarType
	vbEmpty    = &H0000
	vbNull     = &H0001
	vbInteger  = &H0002
	vbLong     = &H0003
	vbSingle   = &H0004
	vbDouble   = &H0005
	vbCurrency = &H0006
	vbDate     = &H0007
	vbString   = &H0008
	vbObject   = &H0009
	vbError    = &H000A
	vbBoolean  = &H000B
	vbVariant  = &H000C
	vbDecimal  = &H000E
	vbByte     = &H0011
	vbArray    = &H2000
	vbByRef    = &H4000
End Enum

Type vbVariant
	V As tagVariant
	Declare Constructor()
	Declare Destructor()
	Declare Sub Clear()
	
	Declare Function VarType()  As vbVarType
	Declare Function TypeName() As String
	Declare Function IsEmpty()  As Boolean
	Declare Function IsArray()  As Boolean
	Declare Function IsObject() As Boolean
	
	Declare Constructor (ByVal RHS As Boolean)
	Declare Operator Let(ByVal RHS As Boolean)
	Declare Operator Cast() As Boolean
	
	Declare Constructor (ByVal RHS As UByte)
	Declare Operator Let(ByVal RHS As UByte)
	Declare Operator Cast() As UByte
	
	Declare Constructor (ByVal RHS As Short)
	Declare Operator Let(ByVal RHS As Short)
	Declare Operator Cast() As Short
	
	Declare Constructor (ByVal RHS As Long)
	Declare Operator Let(ByVal RHS As Long)
	Declare Operator Cast() As Long
	
	Declare Constructor (ByVal RHS As LongInt)
	Declare Operator Let(ByVal RHS As LongInt)
	Declare Operator Cast() As LongInt
	
	Declare Constructor (ByVal RHS As Single)
	Declare Operator Let(ByVal RHS As Single)
	Declare Operator Cast() As Single
	
	Declare Constructor (ByVal RHS As Double)
	Declare Operator Let(ByVal RHS As Double)
	Declare Operator Cast() As Double
	
	Declare Constructor (RHS As String)
	Declare Operator Let(RHS As String)
	Declare Operator Cast()  As String
	
	Declare Constructor (ByVal RHS As Const WString Ptr)
	Declare Operator Let(ByVal RHS As Const WString Ptr)
	Declare Operator Cast() As WString Ptr
	
	Declare Constructor (RHS As tagVariant)
	Declare Operator Let(RHS As tagVariant)
	Declare Operator Cast()  As tagVariant
	
	Declare Constructor (RHS As vbVariant)
	Declare Operator Let(RHS As vbVariant)
	
	#ifdef __FB_64BIT__
		Declare Function Call cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ByVal Arg0 As Any Ptr = 0, ByVal Arg1 As Any Ptr = 0, ByVal Arg2 As Any Ptr = 0, ByVal Arg3 As Any Ptr = 0, ByVal Arg4 As Any Ptr = 0, ByVal Arg5 As Any Ptr = 0, ByVal Arg6 As Any Ptr = 0, ByVal Arg7 As Any Ptr = 0, ByVal Arg8 As Any Ptr = 0, ByVal Arg9 As Any Ptr = 0, ByVal Arg10 As Any Ptr = 0, ByVal Arg11 As Any Ptr = 0, ByVal Arg12 As Any Ptr = 0, ByVal Arg13 As Any Ptr = 0, ByVal Arg14 As Any Ptr = 0, ByVal Arg15 As Any Ptr = 0, ByVal Arg16 As Any Ptr = 0, ByVal Arg17 As Any Ptr = 0, ByVal Arg18 As Any Ptr = 0, ByVal Arg19 As Any Ptr = 0, ByVal Arg20 As Any Ptr = 0, ByVal Arg21 As Any Ptr = 0, ByVal Arg22 As Any Ptr = 0, ByVal Arg23 As Any Ptr = 0, ByVal Arg24 As Any Ptr = 0, ByVal Arg25 As Any Ptr = 0, ByVal Arg26 As Any Ptr = 0, ByVal Arg27 As Any Ptr = 0, ByVal Arg28 As Any Ptr = 0, ByVal Arg29 As Any Ptr = 0, ByVal Arg30 As Any Ptr = 0, ByVal Arg31 As Any Ptr = 0) As vbVariant
		Declare Function  Get cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ByVal Arg0 As Any Ptr = 0, ByVal Arg1 As Any Ptr = 0, ByVal Arg2 As Any Ptr = 0, ByVal Arg3 As Any Ptr = 0, ByVal Arg4 As Any Ptr = 0, ByVal Arg5 As Any Ptr = 0, ByVal Arg6 As Any Ptr = 0, ByVal Arg7 As Any Ptr = 0, ByVal Arg8 As Any Ptr = 0, ByVal Arg9 As Any Ptr = 0, ByVal Arg10 As Any Ptr = 0, ByVal Arg11 As Any Ptr = 0, ByVal Arg12 As Any Ptr = 0, ByVal Arg13 As Any Ptr = 0, ByVal Arg14 As Any Ptr = 0, ByVal Arg15 As Any Ptr = 0, ByVal Arg16 As Any Ptr = 0, ByVal Arg17 As Any Ptr = 0, ByVal Arg18 As Any Ptr = 0, ByVal Arg19 As Any Ptr = 0, ByVal Arg20 As Any Ptr = 0, ByVal Arg21 As Any Ptr = 0, ByVal Arg22 As Any Ptr = 0, ByVal Arg23 As Any Ptr = 0, ByVal Arg24 As Any Ptr = 0, ByVal Arg25 As Any Ptr = 0, ByVal Arg26 As Any Ptr = 0, ByVal Arg27 As Any Ptr = 0, ByVal Arg28 As Any Ptr = 0, ByVal Arg29 As Any Ptr = 0, ByVal Arg30 As Any Ptr = 0, ByVal Arg31 As Any Ptr = 0) As vbVariant
		Declare Sub       Put cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ByVal Arg0 As Any Ptr = 0, ByVal Arg1 As Any Ptr = 0, ByVal Arg2 As Any Ptr = 0, ByVal Arg3 As Any Ptr = 0, ByVal Arg4 As Any Ptr = 0, ByVal Arg5 As Any Ptr = 0, ByVal Arg6 As Any Ptr = 0, ByVal Arg7 As Any Ptr = 0, ByVal Arg8 As Any Ptr = 0, ByVal Arg9 As Any Ptr = 0, ByVal Arg10 As Any Ptr = 0, ByVal Arg11 As Any Ptr = 0, ByVal Arg12 As Any Ptr = 0, ByVal Arg13 As Any Ptr = 0, ByVal Arg14 As Any Ptr = 0, ByVal Arg15 As Any Ptr = 0, ByVal Arg16 As Any Ptr = 0, ByVal Arg17 As Any Ptr = 0, ByVal Arg18 As Any Ptr = 0, ByVal Arg19 As Any Ptr = 0, ByVal Arg20 As Any Ptr = 0, ByVal Arg21 As Any Ptr = 0, ByVal Arg22 As Any Ptr = 0, ByVal Arg23 As Any Ptr = 0, ByVal Arg24 As Any Ptr = 0, ByVal Arg25 As Any Ptr = 0, ByVal Arg26 As Any Ptr = 0, ByVal Arg27 As Any Ptr = 0, ByVal Arg28 As Any Ptr = 0, ByVal Arg29 As Any Ptr = 0, ByVal Arg30 As Any Ptr = 0, ByVal Arg31 As Any Ptr = 0)
		Declare Sub       Set cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ByVal Arg0 As Any Ptr = 0, ByVal Arg1 As Any Ptr = 0, ByVal Arg2 As Any Ptr = 0, ByVal Arg3 As Any Ptr = 0, ByVal Arg4 As Any Ptr = 0, ByVal Arg5 As Any Ptr = 0, ByVal Arg6 As Any Ptr = 0, ByVal Arg7 As Any Ptr = 0, ByVal Arg8 As Any Ptr = 0, ByVal Arg9 As Any Ptr = 0, ByVal Arg10 As Any Ptr = 0, ByVal Arg11 As Any Ptr = 0, ByVal Arg12 As Any Ptr = 0, ByVal Arg13 As Any Ptr = 0, ByVal Arg14 As Any Ptr = 0, ByVal Arg15 As Any Ptr = 0, ByVal Arg16 As Any Ptr = 0, ByVal Arg17 As Any Ptr = 0, ByVal Arg18 As Any Ptr = 0, ByVal Arg19 As Any Ptr = 0, ByVal Arg20 As Any Ptr = 0, ByVal Arg21 As Any Ptr = 0, ByVal Arg22 As Any Ptr = 0, ByVal Arg23 As Any Ptr = 0, ByVal Arg24 As Any Ptr = 0, ByVal Arg25 As Any Ptr = 0, ByVal Arg26 As Any Ptr = 0, ByVal Arg27 As Any Ptr = 0, ByVal Arg28 As Any Ptr = 0, ByVal Arg29 As Any Ptr = 0, ByVal Arg30 As Any Ptr = 0, ByVal Arg31 As Any Ptr = 0)
	#else
		Declare Function Call cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ...) As vbVariant
		Declare Function  Get cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ...) As vbVariant
		Declare Sub       Put cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ...)
		Declare Sub       Set cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ...)
	#endif
	Declare Function  vbV() As vbVariant

	Declare Property Configuration As vbVariant
	Declare Property Configuration(ByRef Param1 As vbVariant)
	Declare Property From As vbVariant
	Declare Property From(ByRef Param1 As vbVariant)
	Declare Property To_ As vbVariant
	Declare Property To_(ByRef Param1 As vbVariant)
	Declare Property Subject As vbVariant
	Declare Property Subject(ByRef Param1 As vbVariant)
	Declare Property textBody As vbVariant
	Declare Property textBody(ByRef Param1 As vbVariant)
	Declare Property Charset As vbVariant
	Declare Property Charset(ByRef Param1 As vbVariant)
	Declare Function BodyPart As vbVariant
	Declare Property HTMLBody As vbVariant
	Declare Property HTMLBody(ByRef Param1 As vbVariant)
	Declare Function AddAttachment(ByRef Param1 As vbVariant) As vbVariant
	Declare Property Value As vbVariant
	Declare Property Value(ByRef Param1 As vbVariant)
	Declare Function Item(ByRef Param1 As vbVariant) As vbVariant
	Declare Function Fields As vbVariant
	Declare Function Update As vbVariant
	Declare Function Send As vbVariant
End Type

Property vbVariant.Configuration As vbVariant
	Return This.Get("Configuration")
End Property
Property vbVariant.Configuration(ByRef Param1 As vbVariant)
	This.Put("Configuration", "v", @Param1)
End Property
Property vbVariant.From As vbVariant
	Return This.Get("From")
End Property
Property vbVariant.From(ByRef Param1 As vbVariant)
	This.Put("From", "v", @Param1)
End Property
Property vbVariant.To_ As vbVariant
	Return This.Get("To")
End Property
Property vbVariant.To_(ByRef Param1 As vbVariant)
	This.Put("To", "v", @Param1)
End Property
Property vbVariant.Subject As vbVariant
	Return This.Get("Subject")
End Property
Property vbVariant.Subject(ByRef Param1 As vbVariant)
	This.Put("Subject", "v", @Param1)
End Property
Property vbVariant.textBody As vbVariant
	Return This.Get("textBody")
End Property
Property vbVariant.textBody(ByRef Param1 As vbVariant)
	This.Put("textBody", "v", @Param1)
End Property
Property vbVariant.Charset As vbVariant
	Return This.Get("Charset")
End Property
Property vbVariant.Charset(ByRef Param1 As vbVariant)
	This.Put("Charset", "v", @Param1)
End Property
Function vbVariant.BodyPart As vbVariant
	Return This.Get("BodyPart")
End Function
Property vbVariant.HTMLBody As vbVariant
	Return This.Get("HTMLBody")
End Property
Property vbVariant.HTMLBody(ByRef Param1 As vbVariant)
	This.Put("HTMLBody", "v", @Param1)
End Property
Function vbVariant.AddAttachment(ByRef Param1 As vbVariant) As vbVariant
	Return This.Get("AddAttachment", "v", @Param1)
End Function
Property vbVariant.Value As vbVariant
	Return This.Get("Value")
End Property
Property vbVariant.Value(ByRef Param1 As vbVariant)
	This.Put("Value", "v", @Param1)
End Property
Function vbVariant.Item(ByRef Param1 As vbVariant) As vbVariant
	Return This.Get("Item", "v", @Param1)
End Function
Function vbVariant.Fields As vbVariant
	Return This.Get("Fields")
End Function
Function vbVariant.Update As vbVariant
	Return This.Get("Update")
End Function
Function vbVariant.Send As vbVariant
	Return This.Get("Send")
End Function
Function vbVariant.vbV() As vbVariant
	Return This
End Function
Constructor vbVariant()
	'we dont't do anything here in the base constructor currently
End Constructor
Destructor vbVariant()
	'MsgBox "Destructor of: " & TypeName
	If V.vt Then VariantClear @V
End Destructor
Sub vbVariant.Clear() 'usable on the Outside, e.g. to dereference an Object "early"
	If V.vt Then VariantClear @V: VariantInit @V
End Sub

Function WCacheValue(BSTR2Copy As BSTR) As WString Ptr 'a little Helper, to avoid leaking with the WString-DataType (in the User-Code)
	Const  CacheSize As Integer = 1024
	Static Cache(0 To CacheSize-1) As WString Ptr, NxtIdx As Integer
	NxtIdx= (NxtIdx + 1) Mod CacheSize
	If Cache(NxtIdx) Then Deallocate Cache(NxtIdx)
	Cache(NxtIdx) = BSTR2W(BSTR2Copy)
	Return Cache(NxtIdx)
End Function

Function vbVariant.VarType() As vbVarType
	Return V.vt
End Function
Function vbVariant.TypeName() As String
	Dim T As String
	Select Case V.vt And Not (vbArray Or vbByRef)
	Case vbVarType.vbEmpty:    T = "Empty"
	Case vbVarType.vbNull:     T = "Null"
	Case vbVarType.vbInteger:  T = "Integer"
	Case vbVarType.vbLong:     T = "Long"
	Case vbVarType.vbSingle:   T = "Single"
	Case vbVarType.vbDouble:   T = "Double"
	Case vbVarType.vbCurrency: T = "Currency"
	Case vbVarType.vbDate:     T = "Date"
	Case vbVarType.vbString:   T = "String"
	Case vbVarType.vbObject:   T = "Object"
	Case vbVarType.vbError:    T = "Error"
	Case vbVarType.vbBoolean:  T = "Boolean"
	Case vbVarType.vbVariant:  T = "Variant"
	Case vbVarType.vbDecimal:  T = "Decimal"
	Case vbVarType.vbByte:     T = "Byte"
	Case Else:                 T = "UnsupportedType(" & Hex(V.vt) & ")"
	End Select
	If V.vt And vbArray Then Return T & "()"
	Return T
End Function
Function vbVariant.IsEmpty() As Boolean
	Return V.vt = vbEmpty
End Function
Function vbVariant.IsArray() As Boolean
	If V.vt And vbArray Then Return True
End Function
Function vbVariant.IsObject() As Boolean
	Return V.vt = vbObject
End Function


Constructor vbVariant(ByVal RHS As Boolean)
	This = RHS
End Constructor
Operator vbVariant.Let(ByVal RHS As Boolean)
	If V.vt <> vbBoolean  And V.vt <> vbEmpty Then VariantClear @V
	V.vt =  vbBoolean: V.boolVal = CShort(RHS)
End Operator
Operator vbVariant.Cast() As Boolean
	If V.vt = vbBoolean Then
		Return CBool(V.boolVal)
	Else
		Dim VV As tagVariant
		HandleCOMErr VariantChangeTypeEx(@VV, @V, DefaultLocale_VariantConv, VARIANT_NOVALUEPROP Or VARIANT_ALPHABOOL, vbBoolean), "SimpleVariant.Cast_Boolean"
		Return CBool(VV.boolVal)
	End If
End Operator


Constructor vbVariant(ByVal RHS As UByte)
	This = RHS
End Constructor
Operator vbVariant.Let(ByVal RHS As UByte)
	If V.vt <> vbByte  And V.vt <> vbEmpty Then VariantClear @V
	V.vt =  vbByte: V.bVal = RHS
End Operator
Operator vbVariant.Cast() As UByte
	If V.vt = vbByte Then
		Return V.bVal
	Else
		Dim VV As tagVARIANT
		HandleCOMErr VariantChangeTypeEx(@VV, @V, DefaultLocale_VariantConv, VARIANT_NOVALUEPROP, vbByte), "SimpleVariant.Cast_UByte"
		Return VV.bVal
	End If
End Operator


Constructor vbVariant(ByVal RHS As Short)
	This = RHS
End Constructor
Operator vbVariant.Let(ByVal RHS As Short)
	If V.vt <> vbInteger  And V.vt <> vbEmpty Then VariantClear @V
	V.vt =  vbInteger: V.iVal = RHS
End Operator
Operator vbVariant.Cast() As Short
	If V.vt = vbInteger Then
		Return V.iVal
	Else
		Dim VV As tagVariant
		HandleCOMErr VariantChangeTypeEx(@VV, @V, DefaultLocale_VariantConv, VARIANT_NOVALUEPROP, vbInteger), "SimpleVariant.Cast_Short"
		Return VV.iVal
	End If
End Operator


Constructor vbVariant(ByVal RHS As Long)
	This = RHS
End Constructor
Operator vbVariant.Let(ByVal RHS As Long)
	If V.vt <> vbLong  And V.vt <> vbEmpty Then VariantClear @V
	V.vt =  vbLong: V.lVal = RHS
End Operator
Operator vbVariant.Cast() As Long
	If V.vt = vbLong Then
		Return V.lVal
	Else
		Dim VV As tagVARIANT
		HandleCOMErr VariantChangeTypeEx(@VV, @V, DefaultLocale_VariantConv, VARIANT_NOVALUEPROP, vbLong), "SimpleVariant.Cast_Long"
		Return VV.lVal
	End If
End Operator


Constructor vbVariant(ByVal RHS As LongInt)
	This = RHS
End Constructor
Operator vbVariant.Let(ByVal RHS As LongInt)
	If V.vt <> vbCurrency  And V.vt <> vbEmpty Then VariantClear @V
	V.vt =  vbCurrency: V.llVal = RHS * 10000
End Operator
Operator vbVariant.Cast() As LongInt
	If V.vt = vbCurrency Then
		Return V.llVal / 10000
	Else
		Dim VV As tagVariant
		HandleCOMErr VariantChangeTypeEx(@VV, @V, DefaultLocale_VariantConv, VARIANT_NOVALUEPROP, VT_I8), "SimpleVariant.Cast_LongInt"
		Return VV.llVal
	End If
End Operator


Constructor vbVariant(ByVal RHS As Single)
	This = RHS
End Constructor
Operator vbVariant.Let(ByVal RHS As Single)
	If V.vt <> vbSingle  And V.vt <> vbEmpty Then VariantClear @V
	V.vt =  vbSingle: V.fltVal = RHS
End Operator
Operator vbVariant.Cast() As Single
	If V.vt = vbSingle Then
		Return V.fltVal
	Else
		Dim VV As tagVARIANT
		HandleCOMErr VariantChangeTypeEx(@VV, @V, DefaultLocale_VariantConv, VARIANT_NOVALUEPROP, vbSingle), "SimpleVariant.Cast_Single"
		Return VV.fltVal
	End If
End Operator


Constructor vbVariant(ByVal RHS As Double)
	This = RHS
End Constructor
Operator vbVariant.Let(ByVal RHS As Double)
	If V.vt <> vbDouble  And V.vt <> vbEmpty Then VariantClear @V
	V.vt =  vbDouble: V.dblVal = RHS
End Operator
Operator vbVariant.Cast() As Double
	If V.vt = vbDouble Then
		Return V.dblVal
	Else
		Dim VV As tagVariant
		HandleCOMErr VariantChangeTypeEx(@VV, @V, DefaultLocale_VariantConv, VARIANT_NOVALUEPROP, vbDouble), "SimpleVariant.Cast_Double"
		Return VV.dblVal
	End If
End Operator


Constructor vbVariant(RHS As String)
	This = RHS
End Constructor
Operator vbVariant.Let(RHS As String)
	If V.vt Then VariantClear @V
	V.vt = vbString: V.bstrVal = S2BSTR(RHS)
End Operator
Operator vbVariant.Cast() As String
	If V.vt = vbString Then
		Return BSTR2S(V.bstrVal)
	Else
		Dim VV As tagVARIANT
		HandleCOMErr VariantChangeTypeEx(@VV, @V, DefaultLocale_VariantConv, VARIANT_NOVALUEPROP Or VARIANT_ALPHABOOL, vbString), "SimpleVariant.Cast_String"
		If V.vt = (vbArray Or vbByte) Then
			Dim S As String = String(SysStringByteLen(VV.bstrVal), 0)
			memcpy StrPtr(S), VV.bstrVal, Len(S)
			Operator = S
		Else
			Operator = BSTR2S(VV.bstrVal)
		End If
		VariantClear @VV
	End If
End Operator


Constructor vbVariant(ByVal RHS As Const WString Ptr)
	This = RHS
End Constructor
Operator vbVariant.Let(ByVal RHS As Const WString Ptr)
	If V.VT Then VariantClear @V
	V.vt = vbString: V.bstrVal = W2BSTR(RHS)
End Operator
Operator vbVariant.Cast() As WString Ptr
	If V.vt = vbString Then
		Return WCacheValue(V.bstrVal)
	Else
		Dim VV As tagVARIANT
		HandleCOMErr VariantChangeTypeEx(@VV, @V, DefaultLocale_VariantConv, VARIANT_NOVALUEPROP Or VARIANT_ALPHABOOL, vbString), "SimpleVariant.Cast_WString"
		Operator = WCacheValue(VV.bstrVal)
		VariantClear @VV
	End If
End Operator


Constructor vbVariant(RHS As tagVARIANT)
	If @This = @RHS Then Exit Constructor
	If V.vt Then VariantClear @V
	V=RHS '<- we go with a shallow copy here (to not mess-up RefCounts - e.g. when normal tagVariants come in from Function-Results)
End Constructor
Operator vbVariant.Let(RHS As tagVARIANT)
	If @This = @RHS Then Exit Operator
	If V.vt Then VariantClear @V
	VariantCopy @V, @RHS
End Operator
Operator vbVariant.Cast() As tagVARIANT
	Dim Dst As tagVARIANT
	VariantCopy @Dst, @V
	Return Dst
End Operator


Constructor vbVariant(RHS As vbVariant)
	If @This = @RHS Then Exit Constructor
	If V.vt Then VariantClear @V
	VariantCopy @V, @RHS.V
End Constructor
Operator vbVariant.Let(RHS As vbVariant)
	If @This = @RHS Then Exit Operator
	If V.vt Then VariantClear @V
	VariantCopy @V, @RHS.V
End Operator

#ifdef __FB_64BIT__
	Function vbVariant.Call cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ByVal Arg0 As Any Ptr = 0, ByVal Arg1 As Any Ptr = 0, ByVal Arg2 As Any Ptr = 0, ByVal Arg3 As Any Ptr = 0, ByVal Arg4 As Any Ptr = 0, ByVal Arg5 As Any Ptr = 0, ByVal Arg6 As Any Ptr = 0, ByVal Arg7 As Any Ptr = 0, ByVal Arg8 As Any Ptr = 0, ByVal Arg9 As Any Ptr = 0, ByVal Arg10 As Any Ptr = 0, ByVal Arg11 As Any Ptr = 0, ByVal Arg12 As Any Ptr = 0, ByVal Arg13 As Any Ptr = 0, ByVal Arg14 As Any Ptr = 0, ByVal Arg15 As Any Ptr = 0, ByVal Arg16 As Any Ptr = 0, ByVal Arg17 As Any Ptr = 0, ByVal Arg18 As Any Ptr = 0, ByVal Arg19 As Any Ptr = 0, ByVal Arg20 As Any Ptr = 0, ByVal Arg21 As Any Ptr = 0, ByVal Arg22 As Any Ptr = 0, ByVal Arg23 As Any Ptr = 0, ByVal Arg24 As Any Ptr = 0, ByVal Arg25 As Any Ptr = 0, ByVal Arg26 As Any Ptr = 0, ByVal Arg27 As Any Ptr = 0, ByVal Arg28 As Any Ptr = 0, ByVal Arg29 As Any Ptr = 0, ByVal Arg30 As Any Ptr = 0, ByVal Arg31 As Any Ptr = 0) As vbVariant
		Dim tv As tagVARIANT
		tv = CallByName(V, MethodName, DISPATCH_METHOD Or DISPATCH_PROPERTYGET, TypeChars, Arg0, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9, Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29, Arg30, Arg31)
		Function = tv
	End Function
	Function vbVariant.Get cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ByVal Arg0 As Any Ptr = 0, ByVal Arg1 As Any Ptr = 0, ByVal Arg2 As Any Ptr = 0, ByVal Arg3 As Any Ptr = 0, ByVal Arg4 As Any Ptr = 0, ByVal Arg5 As Any Ptr = 0, ByVal Arg6 As Any Ptr = 0, ByVal Arg7 As Any Ptr = 0, ByVal Arg8 As Any Ptr = 0, ByVal Arg9 As Any Ptr = 0, ByVal Arg10 As Any Ptr = 0, ByVal Arg11 As Any Ptr = 0, ByVal Arg12 As Any Ptr = 0, ByVal Arg13 As Any Ptr = 0, ByVal Arg14 As Any Ptr = 0, ByVal Arg15 As Any Ptr = 0, ByVal Arg16 As Any Ptr = 0, ByVal Arg17 As Any Ptr = 0, ByVal Arg18 As Any Ptr = 0, ByVal Arg19 As Any Ptr = 0, ByVal Arg20 As Any Ptr = 0, ByVal Arg21 As Any Ptr = 0, ByVal Arg22 As Any Ptr = 0, ByVal Arg23 As Any Ptr = 0, ByVal Arg24 As Any Ptr = 0, ByVal Arg25 As Any Ptr = 0, ByVal Arg26 As Any Ptr = 0, ByVal Arg27 As Any Ptr = 0, ByVal Arg28 As Any Ptr = 0, ByVal Arg29 As Any Ptr = 0, ByVal Arg30 As Any Ptr = 0, ByVal Arg31 As Any Ptr = 0) As vbVariant
		Return CallByName(V, MethodName, DISPATCH_METHOD Or DISPATCH_PROPERTYGET, TypeChars, Arg0, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9, Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29, Arg30, Arg31)
	End Function
	Sub vbVariant.Put cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ByVal Arg0 As Any Ptr = 0, ByVal Arg1 As Any Ptr = 0, ByVal Arg2 As Any Ptr = 0, ByVal Arg3 As Any Ptr = 0, ByVal Arg4 As Any Ptr = 0, ByVal Arg5 As Any Ptr = 0, ByVal Arg6 As Any Ptr = 0, ByVal Arg7 As Any Ptr = 0, ByVal Arg8 As Any Ptr = 0, ByVal Arg9 As Any Ptr = 0, ByVal Arg10 As Any Ptr = 0, ByVal Arg11 As Any Ptr = 0, ByVal Arg12 As Any Ptr = 0, ByVal Arg13 As Any Ptr = 0, ByVal Arg14 As Any Ptr = 0, ByVal Arg15 As Any Ptr = 0, ByVal Arg16 As Any Ptr = 0, ByVal Arg17 As Any Ptr = 0, ByVal Arg18 As Any Ptr = 0, ByVal Arg19 As Any Ptr = 0, ByVal Arg20 As Any Ptr = 0, ByVal Arg21 As Any Ptr = 0, ByVal Arg22 As Any Ptr = 0, ByVal Arg23 As Any Ptr = 0, ByVal Arg24 As Any Ptr = 0, ByVal Arg25 As Any Ptr = 0, ByVal Arg26 As Any Ptr = 0, ByVal Arg27 As Any Ptr = 0, ByVal Arg28 As Any Ptr = 0, ByVal Arg29 As Any Ptr = 0, ByVal Arg30 As Any Ptr = 0, ByVal Arg31 As Any Ptr = 0)
		CallByName(V, MethodName, DISPATCH_PROPERTYPUT, TypeChars, Arg0, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9, Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29, Arg30, Arg31)
	End Sub
	Sub vbVariant.Set cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ByVal Arg0 As Any Ptr = 0, ByVal Arg1 As Any Ptr = 0, ByVal Arg2 As Any Ptr = 0, ByVal Arg3 As Any Ptr = 0, ByVal Arg4 As Any Ptr = 0, ByVal Arg5 As Any Ptr = 0, ByVal Arg6 As Any Ptr = 0, ByVal Arg7 As Any Ptr = 0, ByVal Arg8 As Any Ptr = 0, ByVal Arg9 As Any Ptr = 0, ByVal Arg10 As Any Ptr = 0, ByVal Arg11 As Any Ptr = 0, ByVal Arg12 As Any Ptr = 0, ByVal Arg13 As Any Ptr = 0, ByVal Arg14 As Any Ptr = 0, ByVal Arg15 As Any Ptr = 0, ByVal Arg16 As Any Ptr = 0, ByVal Arg17 As Any Ptr = 0, ByVal Arg18 As Any Ptr = 0, ByVal Arg19 As Any Ptr = 0, ByVal Arg20 As Any Ptr = 0, ByVal Arg21 As Any Ptr = 0, ByVal Arg22 As Any Ptr = 0, ByVal Arg23 As Any Ptr = 0, ByVal Arg24 As Any Ptr = 0, ByVal Arg25 As Any Ptr = 0, ByVal Arg26 As Any Ptr = 0, ByVal Arg27 As Any Ptr = 0, ByVal Arg28 As Any Ptr = 0, ByVal Arg29 As Any Ptr = 0, ByVal Arg30 As Any Ptr = 0, ByVal Arg31 As Any Ptr = 0)
		CallByName(V, MethodName, DISPATCH_PROPERTYPUTREF,  TypeChars, Arg0, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9, Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29, Arg30, Arg31)
	End Sub
#else
	Function vbVariant.Call cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ...) As vbVariant
		Dim tv As tagVARIANT
		tv = CallByName(V, MethodName, DISPATCH_METHOD Or DISPATCH_PROPERTYGET, TypeChars, va_first)
		Function = tv
	End Function
	Function vbVariant.Get cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ...) As vbVariant
		Return CallByName(V, MethodName, DISPATCH_METHOD Or DISPATCH_PROPERTYGET, TypeChars, va_first)
	End Function
	Sub vbVariant.Put cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ...)
		CallByName(V, MethodName, DISPATCH_PROPERTYPUT, TypeChars, va_first)
	End Sub
	Sub vbVariant.Set cdecl (ByVal MethodName As LPOLESTR, TypeChars As String = "", ...)
		CallByName(V, MethodName, DISPATCH_PROPERTYPUTREF,  TypeChars, va_first)
	End Sub
#endif
'finally a MsgBox-OverLoad, which accepts a vbVariant as the Msg-Parameter
Function MsgBox cdecl (ByVal Msg As vbVariant, ByVal Flags As Long = MB_ICONINFORMATION) As Long
	If Msg.V.vt = vbString Then
		Return MessageBoxW(GetActiveWindow, Msg.V.bstrVal, AppName, Flags)
	Else
		Dim VV As tagVARIANT
		HandleCOMErr VariantChangeTypeEx(@VV, @Msg.V, DefaultLocale_VariantConv, VARIANT_NOVALUEPROP Or VARIANT_ALPHABOOL, vbString), "SimpleVariant.MsgBox"
		Function = MessageBoxW(GetActiveWindow, VV.bstrVal, AppName, Flags)
		VariantClear @VV
	End If
End Function

#define Set
#define Nothing 0

Example:

Code: Select all

#include once "SimpleVariantPlus.bi"

Dim loConfig As vbVariant = CreateObject("CDO.Configuration")
Dim loCdoMessage As vbVariant = CreateObject("CDO.Message")
loCdoMessage.Configuration = loConfig
loCdoMessage.From    = "My mail"""" <info@mymail.com>"
loCdoMessage.To_     = "To mail@tomail.com"
loCdoMessage.Subject = "Report"
loCdoMessage.textBody = "Report"
'loCdoMessage.BodyPart.Charset = "windows-1251"
'loCdoMessage.HTMLBody = ""
loCdoMessage.AddAttachment("The_path_to_the_file")
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing").Value = 2
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver").Value = "smtp.mail.ru"
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport").Value = "465"
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate").Value = 1
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername").Value = "info@mymail.com"
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword").Value = "Password"
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl").Value = 1
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout").Value = 60
loConfig.Fields.Update()
loCdoMessage.Send()

Thanks.It compiles but failed to send the email out.Both "proxy" and "connection to server" failed.
fyi.failed sending also when using libcurl+c to find a workable solution.Neet more time to try.

[Xusinboy Bekchanov]

Thanks.It compiles but failed to send the email out.Both "proxy" and "connection to server" failed.
fyi.failed sending also when using libcurl+c to find a workable solution.Neet more time to try.

In this example, the mail.ru settings are set, in your case there will be other settings smtpserver, smtpserverport. In mail.ru, a separate Password is created specifically for programs.

What email are you using to send the message?

[Xusinboy Bekchanov]

To send through a proxy you need to add these codes:

Code: Select all

loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/urlproxyserver").Value = "Server:80"
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/urlproxybypass").Value = "<local>"
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/urlgetlatestversion").Value = True

[PeterHu]

Thanks.It compiles but failed to send the email out.Both "proxy" and "connection to server" failed.
fyi.failed sending also when using libcurl+c to find a workable solution.Neet more time to try.

In this example, the mail.ru settings are set, in your case there will be other settings smtpserver, smtpserverport. In mail.ru, a separate Password is created specifically for programs.

What email are you using to send the message?

The sender mail is outlook.com,AFAIK the SMTP setting should be smtp-mail.outlook.com,the port should be 587(but I don't know how to handle STARTTLS in the source code).The receiver mailbox to test is QQ mailbox,that is userQQid@qq.com.In my case,
Sender:Peter
Sender mailbox:peterhu.peterhu@outlook.com
Receiver mailbox:1182389690@qq.com

In the source code how to configure the above?

[Xusinboy Bekchanov]

The sender mail is outlook.com,AFAIK the SMTP setting should be smtp-mail.outlook.com,the port should be 587(but I don't know how to handle STARTTLS in the source code).The receiver mailbox to test is QQ mailbox,that is userQQid@qq.com.In my case,
Sender:Peter
Sender mailbox:peterhu.peterhu@outlook.com
Receiver mailbox:1182389690@qq.com

In the source code how to configure the above?

This is how it works:

Code: Select all

#include once "SimpleVariantPlus.bi"

Dim loConfig As vbVariant = CreateObject("CDO.Configuration")
Dim loCdoMessage As vbVariant = CreateObject("CDO.Message")
loCdoMessage.Configuration = loConfig
loCdoMessage.From    = "Peter"""" <peterhu.peterhu@outlook.com>"
loCdoMessage.To_     = "1182389690@qq.com"
loCdoMessage.Subject = "Report"
loCdoMessage.textBody = "Report"
'loCdoMessage.BodyPart.Charset = "windows-1251"
'loCdoMessage.HTMLBody = ""
'loCdoMessage.AddAttachment("The_path_to_the_file")
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing").Value = 2
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver").Value = "smtp-mail.outlook.com"
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport").Value = "25"
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate").Value = 1
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername").Value = "peterhu.peterhu@outlook.com"
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword").Value = "Password"
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl").Value = 1
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout").Value = 60
loConfig.Fields.Update()
loCdoMessage.Send()

[PeterHu]

The sender mail is outlook.com,AFAIK the SMTP setting should be smtp-mail.outlook.com,the port should be 587(but I don't know how to handle STARTTLS in the source code).The receiver mailbox to test is QQ mailbox,that is userQQid@qq.com.In my case,
Sender:Peter
Sender mailbox:peterhu.peterhu@outlook.com
Receiver mailbox:1182389690@qq.com

In the source code how to configure the above?

This is how it works:

Code: Select all

#include once "SimpleVariantPlus.bi"

Dim loConfig As vbVariant = CreateObject("CDO.Configuration")
Dim loCdoMessage As vbVariant = CreateObject("CDO.Message")
loCdoMessage.Configuration = loConfig
loCdoMessage.From    = "Peter"""" <peterhu.peterhu@outlook.com>"
loCdoMessage.To_     = "1182389690@qq.com"
loCdoMessage.Subject = "Report"
loCdoMessage.textBody = "Report"
'loCdoMessage.BodyPart.Charset = "windows-1251"
'loCdoMessage.HTMLBody = ""
'loCdoMessage.AddAttachment("The_path_to_the_file")
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing").Value = 2
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver").Value = "smtp-mail.outlook.com"
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport").Value = "25"
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate").Value = 1
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername").Value = "peterhu.peterhu@outlook.com"
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword").Value = "Password"
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl").Value = 1
loConfig.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout").Value = 60
loConfig.Fields.Update()
loCdoMessage.Send()

Wonderful!

The first try in this afternoon I set:
loCdoMessage.From="peterhu.peterhu@outlook.com" '''---->Compare to :loCdoMessage.From = "Peter"""" <peterhu.peterhu@outlook.com>"
smtpserverport->Value=587 '''----->25

then failed to connect and send.

After changing these two settings according to your last post,it works now.

[Xusinboy Bekchanov]

Wonderful!

The first try in this afternoon I set:
loCdoMessage.From="peterhu.peterhu@outlook.com" '''---->Compare to :loCdoMessage.From = "Peter"""" <peterhu.peterhu@outlook.com>"
smtpserverport->Value=587 '''----->25

then failed to connect and send.

After changing these two settings according to your last post,it works now.

I'm glad it worked out for you.

The first parameter can be written like yours, but the second parameter is the most important.

[fan2006]

are there any functions for strings conversion between ansi/utf-8/unicode?when i use "debug.print webbrowser.Getbody" it gets nothing output.

[Xusinboy Bekchanov]

are there any functions for strings conversion between ansi/utf-8/unicode?

Hello, yes there are functions ToUTF8 and FromUTF8.
https://github.com/XusinboyBekchanov/My ... iki/ToUtf8
https://github.com/XusinboyBekchanov/My ... i/FromUtf8

when i use "debug.print webbrowser.Getbody" it gets nothing output.

Are you using WebView2? The GetBody function has not yet been made for WebView2.

[Xusinboy Bekchanov]

when i use "debug.print webbrowser.Getbody" it gets nothing output.

Added: GetBody function to WebBrowser in WebView2 mode:
https://github.com/XusinboyBekchanov/My ... 8a54ad8fb5

Added: SetBody method to WebBrowser in WebView2 mode:
https://github.com/XusinboyBekchanov/My ... c528e70a27