A C-style approach to Visual Basic 6
December 1, 2024
An homage to a programming language which’s grammar and ideas don’t get much acclaim nowadays.
I grew up with Visual Basic 6. As terrible as it was, I still have a soft spot for it. For all of its shortcomings, VB6 taught me a surprising lot about computer internals.
Let’s say it is the year 2005, and you are into ricing your Windows XP setup. You decide that customizing your wallpaper switching logic would totally rock. And you decide to do that in VB6.
Now, generally VB6 would be a good choice in this ecosystem since anything Windows-related usually exposes itself through COM interfaces. VB6 makes using COM a breeze.
However, one would have to get access to the Active Desktop, which exposes itself through the IActiveDesktop interface. And VB6 does not support it, because IActiveDesktop does not inherit the IDispatch interface. Without it, VB6 can’t dynamically call the interface’s methods.
You’d have two choices: Hand-craft a COM type library and import it into your project. Or abuse and bend the language in horrific ways to avoid a single dependency. Since there’s no build system and manual build steps are unacceptable an… - option 2 it is.
The goal
If this were to be accomplished with C, this is what it would take. Straight forward.
IActiveDesktop* pActiveDesktop = NULL;
// Get an instance of IActiveDesktop
HRESULT hr = CoCreateInstance(&CLSID_ActiveDesktop, NULL, CLSCTX_INPROC_SERVER,
&IID_IActiveDesktop, (void**)&pActiveDesktop);
pActiveDesktop->lpVtbl->SetWallpaper(pActiveDesktop, pathToWallaper, 0);
pActiveDesktop->lpVtbl->ApplyChanges(pActiveDesktop, AD_APPLY_ALL);
// Decrement the ref counter, effectively destroying the instance
pActiveDesktop->lpVtbl->Release(pActiveDesktop);
Port it to Visual Basic
So C aside, let’s get us an instance of IActiveDesktop in our process:
Const CLSID_ActiveDesktop As String = _
"{75048700-EF1F-11D0-9888-006097DEACF9}"
Const IID_Unknown As String = _
"{00000000-0000-0000-C000-000000000046}"
Const CLSCTX_INPROC_SERVER As Long = &H1
Private Declare Function IIDFromString Lib "ole32.dll" ( _
ByVal lpszIID As Long, _
iid As Any) As Long
Private Declare Function CoCreateInstance Lib "ole32.dll" ( _
rclsid As Any, _
ByVal pUnkOuter As Long, _
ByVal dwClsContext As Long, _
riid As Any, _
ppv As Long) As Long
Private Type GUID
data1 As Long
data2 As Integer
data3 As Integer
data4(7) As Byte
End Type
Function GetActiveDesktop()
Dim iidUnknown As GUID
Dim classid As GUID
Dim hRes As Long
Dim obj As Long
IIDFromString StrPtr(CLSID_ActiveDesktop), classid
IIDFromString StrPtr(IID_UNKNOWN), iidUnknown
hRes = CoCreateInstance(classid, 0, CLSCTX_INPROC_SERVER, IID_IUnknown, obj)
If hRes <> 0 Then
Debug.Print "This should never happen TM"
End If
GetActiveDesktop = obj
End Function
The first difference is, there’s no predefined class/interface GUIDs. But there’s a Windows API function for that! IIDFromString will happily take a string and spit out a parsed GUID.
To make things short: VB6 strings are BSTR . A wide string with its length as a 32 bit integer preceding it. IIDFromString expects a LPCOLESTR, so just a wide string. Passing a BSTR will work if one skips the length field. Conveniently, this is what StrPtr does.
VB also allows passing a string directly to API functions, either ByVal or ByRef. However, when we pass by value, VB will convert the wide string to an Ansi string, and if we pass by reference, VB will pass it as a BSTR. Therefore the only proper option is to use the StrPtr function.
Anyways, you now have a pointer to an IActiveDesktop interface, typed as a Long, or rather a 32-bit integer. So what really is such an interface? It’s a VTable consisting of two interfaces, or expressed in C:
DECLARE_INTERFACE_IID_(IActiveDesktop, IUnknown, "f490eb00-1240-11d1-9888-006097deacf9")
{
// IUnknown methods
STDMETHOD(QueryInterface) (THIS_ _In_ REFIID riid, _Outptr_ void **ppv) PURE;
STDMETHOD_(ULONG,AddRef) (THIS) PURE;
STDMETHOD_(ULONG,Release) (THIS) PURE;
// IActiveDesktop methods
STDMETHOD (ApplyChanges)(THIS_ DWORD dwFlags) PURE;
STDMETHOD (GetWallpaper)(THIS_ _Out_writes_(cchWallpaper) PWSTR pwszWallpaper, UINT cchWallpaper, DWORD dwFlags) PURE;
STDMETHOD (SetWallpaper)(THIS_ _In_ PCWSTR pwszWallpaper, DWORD dwReserved) PURE;
STDMETHOD (GetWallpaperOptions)(THIS_ _Inout_ LPWALLPAPEROPT pwpo, DWORD dwReserved) PURE;
STDMETHOD (SetWallpaperOptions)(THIS_ _In_ LPCWALLPAPEROPT pwpo, DWORD dwReserved) PURE;
STDMETHOD (GetPattern)(THIS_ _Out_writes_(cchPattern) PWSTR pwszPattern, UINT cchPattern, DWORD dwReserved) PURE;
STDMETHOD (SetPattern)(THIS_ _In_ PCWSTR pwszPattern, DWORD dwReserved) PURE;
STDMETHOD (GetDesktopItemOptions)(THIS_ _Inout_ LPCOMPONENTSOPT pco, DWORD dwReserved) PURE;
STDMETHOD (SetDesktopItemOptions)(THIS_ _In_ LPCCOMPONENTSOPT pco, DWORD dwReserved) PURE;
STDMETHOD (AddDesktopItem)(THIS_ _In_ LPCCOMPONENT pcomp, DWORD dwReserved) PURE;
STDMETHOD (AddDesktopItemWithUI)(THIS_ _In_opt_ HWND hwnd, _In_ LPCOMPONENT pcomp, DWORD dwReserved) PURE;
STDMETHOD (ModifyDesktopItem)(THIS_ _Inout_ LPCCOMPONENT pcomp, DWORD dwFlags) PURE;
STDMETHOD (RemoveDesktopItem)(THIS_ _In_ LPCCOMPONENT pcomp, DWORD dwReserved) PURE;
STDMETHOD (GetDesktopItemCount)(THIS_ _Out_ int *pcItems, DWORD dwReserved) PURE;
STDMETHOD (GetDesktopItem)(THIS_ int nComponent, _Inout_ LPCOMPONENT pcomp, DWORD dwReserved) PURE;
STDMETHOD (GetDesktopItemByID)(THIS_ ULONG_PTR dwID, _Inout_ LPCOMPONENT pcomp, DWORD dwReserved) PURE;
STDMETHOD (GenerateDesktopItemHtml)(THIS_ _In_ PCWSTR pwszFileName, _In_ LPCOMPONENT pcomp, DWORD dwReserved) PURE;
STDMETHOD (AddUrl)(THIS_ _In_opt_ HWND hwnd, _In_ PCWSTR pszSource, _In_ LPCOMPONENT pcomp, DWORD dwFlags) PURE;
STDMETHOD (GetDesktopItemBySource)(THIS_ _In_ PCWSTR pwszSource, _Inout_ LPCOMPONENT pcomp, DWORD dwReserved) PURE;
};
VB6 has no concept of function pointers. So the closest we can get (in a 32 bit environment of course) is:
Type IActiveDesktop
' IUnknown
QueryInterface As Long
AddRef As Long
Release As Long
' IActiveDesktop
ApplyChanges As Long
GetWallpaper As Long
SetWallpaper As Long
GetWallpaperOptions As Long
SetWallpaperOptions As Long
GetPattern As Long
SetPattern As Long
GetDesktopItemOptions As Long
SetDesktopItemOptions As Long
AddDesktopItem As Long
AddDesktopItemWithUI As Long
ModifyDesktopItem As Long
RemoveDesktopItem As Long
GetDesktopItemCount As Long
GetDesktopItem As Long
GetDesktopItemByID As Long
GenerateDesktopItemHtml As Long
AddUrl As Long
GetDesktopItemBySource As Long
End Type
Using this knowledge, if one wanted to get the address of IActiveDesktop::SetWallpaper, one could read the 4 bytes at that exact memory offset. VB can’t do that though. But the Windows API can:
Declare Sub RtlMoveMemory Lib "kernel32" ( _
pDst As Any, _
pSrc As Any, _
ByVal dlen As Long)
...
Dim obj As Long
Dim vtbl As IActiveDesktop
Dim vtblptr As Long
obj = GetActiveDesktop()
RtlMoveMemory vtblptr, ByVal obj, 4
RtlMoveMemory vtbl, ByVal vtblptr, Len(vtbl)
Debug.Print vtbl.SetWallpaper
Getting so close! That’s a very promising looking memory address. It’s definitely not zero.
Again, VB6 has no concept of function pointers. How would one use this number to actually execute a call? You have one more trick up your sleeve: The Windows API. Namely CallWindowProcA. It takes in the address of what is hopefully a window message handling function and its 4 arguments and then simply calls it. You could abuse it to call any other function instead.
Looking at IActiveDesktop::SetWallpaper, you count 3 parameters (2 parameters + this pointer). This is an issue because of the calling convention of the function, stdcall.
- The arguments are pushed onto the stack from right to left. So the callee won’t even notice the extra argument. That’s good.
- But the callee must clean up the stack. It will leave the fourth argument on the stack, effectively corrupting it.
You’re almost there, if there was just some solution to not have the program crash after setting the wallpaper.
An assembler style approach to Visual Basic 6
If there was some kind of proxy, something that could convert from 4 arguments to 3, and clean the stack up properly? Something like this:
proxy:
POP EAX ; save return address to EAX
POP ECX ; remove unused argument
POP ECX ; remove unused argument
POP ECX ; remove unused argument
POP ECX ; remove unused argument
PUSH EAX ; put return address back
PUSH MY_ARG_3
PUSH MY_ARG_2
PUSH MY_ARG_1
CALL FUNC
RET
These instructions are not difficult to generate at runtime. One would simply have to call them then, using CallWindowProcA. Seems straight forward:
Private Function CallPointer(ByVal fnc As Long, ParamArray params()) As Long
Dim btASM(1024) As Byte
Dim pASM As Long
Dim i As Integer
pASM = VarPtr(btASM(0))
AddByte pASM, &H58 ' POP EAX
AddByte pASM, &H59 ' POP ECX
AddByte pASM, &H59 ' POP ECX
AddByte pASM, &H59 ' POP ECX
AddByte pASM, &H59 ' POP ECX
AddByte pASM, &H50 ' PUSH EAX
For i = UBound(params) To 0 Step -1
AddPush pASM, CLng(params(i)) ' PUSH dword
Next
AddCall pASM, fnc ' CALL rel addr
AddByte pASM, &HC3 ' RET
CallPointer = CallWindowProcA(VarPtr(btASM(0)), 0, 0, 0, 0)
End Function
Private Sub AddPush(pASM As Long, lng As Long)
AddByte pASM, &H68
AddLong pASM, lng
End Sub
Private Sub AddCall(pASM As Long, addr As Long)
AddByte pASM, &HE8
AddLong pASM, addr - pASM - 4
End Sub
Private Sub AddLong(pASM As Long, lng As Long)
RtlMoveMemory ByVal pASM, lng, 4
pASM = pASM + 4
End Sub
Private Sub AddByte(pASM As Long, bt As Byte)
RtlMoveMemory ByVal pASM, bt, 1
pASM = pASM + 1
End Sub
Note: This would crash nowadays. Instead of a local array, you should allocate an executable page using VirtualAlloc. Don’t jump into data sections.
Putting it all together
...
Dim vtbl As IActiveDesktop
Dim vtblptr As Long
Dim pathToJpeg As String
Dim iidActiveDesktop As GUID
Dim clsidActiveDesktop As GUID
Dim obj As Long
pathToJpeg = "win.jpg"
IIDFromString StrPtr(CLSID_ActiveDesktop), clsidActiveDesktop
IIDFromString StrPtr(IID_ActiveDesktop), iidActiveDesktop
CoCreateInstance clsidActiveDesktop, 0, CLSCTX_INPROC_SERVER, iidActiveDesktop, obj
RtlMoveMemory vtblptr, ByVal obj, 4
RtlMoveMemory vtbl, ByVal vtblptr, Len(vtbl)
CallPointer(vtbl.SetWallpaper, obj, StrPtr(pathToJpeg), 0)
CallPointer(vtbl.ApplyChanges, obj, AD_APPLY_ALL)
CallPointer vtbl.Release, obj
And there we have it. The zero dependency VB translation of the initial C code snippet. And we’re not far off:
IActiveDesktop* pActiveDesktop = NULL;
CoCreateInstance(&CLSID_ActiveDesktop, NULL, CLSCTX_INPROC_SERVER,
&IID_IActiveDesktop, (void**)&pActiveDesktop);
pActiveDesktop->lpVtbl->SetWallpaper(pActiveDesktop, pathToWallaper, 0);
pActiveDesktop->lpVtbl->ApplyChanges(pActiveDesktop, AD_APPLY_ALL);
pActiveDesktop->lpVtbl->Release(pActiveDesktop);