[VB6] Unicode classes, functions...

[Merri]

This thread is dedicated for stable, tested & known to work solutions for your Unicode needs. This means:

• Code should be safe to use in your project. No unexpected crashes caused by the code itself.
• If the feature exists in ANSI (= provided by Microsoft as native VB6 feature or TLB/OCX component), the Unicode version should give the same minimum amount of features

I try to update this first post to keep it up-to-date. There is a lot into Unicode in VB6 and it is most of the time challenging to get it right, but these should provide some simple stuff that helps to get started. The hardest part are the controls and currently I do not know of a free control that wouldn't have issues, thus none listed here.


Classes

Unicode File Open/Save Dialog
Unicode Message Box (note: MsgBox function replacement below)


VB6 native method replacements

Command line parameters
This function is not an exact copy of native Command$: instead it parses the command line parameters and returns a string array. The return value is the number of parameters in the array.

If you want a direct Command$ replacement, have a look in this post for CommandW.

Option Explicit

Private Declare Function CommandLineToArgvW Lib "shell32" (ByVal lpCmdLine As Long, pNumArgs As Integer) As Long
Private Declare Function GetCommandLineW Lib "kernel32" () As Long
Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Ptr As Long, Value As Long)
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)
Private Declare Function SysAllocStringLen Lib "oleaut32" (ByVal Ptr As Long, ByVal Length As Long) As Long

Public Function Command(Parameters() As String, Optional EXE As String) As Long
    Dim A As Integer, I As Long, Ptr As Long, Pos As Long
    If Not Not Parameters Then Erase Parameters
    Debug.Assert App.hInstance
    Parameters = VBA.Split(vbNullString)
    Ptr = CommandLineToArgvW(GetCommandLineW, A)
    If Ptr <> 0 And A > 0 Then
        GetMem4 Ptr, Pos
        EXE = vbNullString
        PutMem4 VarPtr(EXE), SysAllocStringLen(Pos, lstrlenW(Pos))
        If A > 1 Then
            ReDim Parameters(0 To A - 2)
            For I = Ptr + 4 To Ptr + (A - 1) * 4 Step 4
                GetMem4 I, Pos
                PutMem4 VarPtr(Parameters(Command)), SysAllocStringLen(Pos, lstrlenW(Pos))
                Command = Command + 1
            Next I
        End If
        LocalFree Ptr
    End If
End Function

Form's Caption
Does not work when themes enabled via manifest & only works in XP/Vista/Windows 7, does not work in Windows 2000.

' this code can be pasted into any Form
Option Explicit

Private Declare Function DefWindowProcW Lib "user32" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (Destination As Any, Value As Any)
Private Declare Function SysAllocStringLen Lib "oleaut32" (ByVal OleStr As Long, ByVal bLen As Long) As Long

Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const WM_SETTEXT = &HC

Public Property Get CaptionW() As String
    Dim lngLen As Long, lngPtr As Long
    lngLen = DefWindowProcW(Me.hWnd, WM_GETTEXTLENGTH, 0, ByVal 0)
    If lngLen Then
        lngPtr = SysAllocStringLen(0, lngLen)
        PutMem4 ByVal VarPtr(CaptionW), ByVal lngPtr
        DefWindowProcW Me.hWnd, WM_GETTEXT, lngLen + 1, ByVal lngPtr
    End If
End Property

Public Property Let CaptionW(ByRef NewValue As String)
    DefWindowProcW Me.hWnd, WM_SETTEXT, 0, ByVal StrPtr(NewValue)
End Property

MsgBox
No HelpFile & HelpContext support, but adds custom resource icon & owner window support.

Option Explicit

Private Declare Function MessageBoxIndirectW Lib "user32" (lpMsgBoxParams As Any) As Long

Public Function MsgBox(Prompt As String, Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, Optional ByVal Title As String, Optional ResourceIcon As String, Optional ByVal hWndOwner As Long = -1) As VbMsgBoxResult
    Dim Params(0 To 9) As Long
    If hWndOwner = -1 Then
        hWndOwner = 0
        If Not VB.Screen.ActiveForm Is Nothing Then
            hWndOwner = Screen.ActiveForm.hWnd
        End If
    End If
    If StrPtr(Title) = 0 Then Title = App.Title
    If StrPtr(ResourceIcon) Then Buttons = (Buttons Or &H80&) And Not (&H70&)
    Params(0) = 40
    Params(1) = hWndOwner
    Params(2) = App.hInstance
    Params(3) = StrPtr(Prompt)
    Params(4) = StrPtr(Title)
    Params(5) = Buttons
    Params(6) = StrPtr(ResourceIcon)
    MsgBox = MessageBoxIndirectW(Params(0))
End Function

Tutorials

UTF-8 string conversions

[Merri]

The attached archive is a sample project displaying the usage of CaptionW, Command & MsgBox.

1. Command function is called to obtain command line parameters & executable name.
2. MsgBox function is called to display VB6 Command$ (ANSI) and Command function results.
3. Form's title is changed with CaptionW to contain the executable filename. If the filename contains Unicode characters you should see them (but only in XP/Vista/Windows 7!)

Alternative Command usage

Private Sub Form_Load()
    Dim I As Long, strEXE As String, strParam() As String
    For I = 0 To Command(strParam, strEXE) - 1
        MsgBox strParam(I), vbInformation, "Parameter " & I + 1
    Next I
    Me.CaptionW = strEXE
End Sub

This will display each individual command line parameter in it's own message box. If no parameters are given the form will just open up.


Important!
The ZIP archive contains Unicode filenames. You need Unicode aware decompression software such as IZarc 4 or later to be able to extract the files.

Also, the archive also contains a precompiled executable. This is provided for convenience as it is prenamed to Unicode filename. If you do not trust the file simply compile the project and rename the compiled executable to the name of the exe provided.

Edit!
And one more update: the Unicode characters used by the filenames are Japanese. Thus you need East Asian language support installed or you see boxes. You can do this in Regional settings @ Control Panel (links to Google Images).

[petersen]

To include somebody else's title under one's own book cover, the title's original author should be explicitly stated (to avoid misleading the page browser). It should be clearly specified in the following manner:

Unicode File Open/Save Dialog - By La Volpe

[Merri]

It is clear by clicking the link that the code is by LaVolpe, as it links directly to his thread. I'm not claiming all the code to be mine anywhere in the text. Thus this should be perfectly okay. To put things in perspective... when people link to Planet Source Code or other code sites they rarely tell who is the actual author of the code, because it is apparent from the linked page. This is the exact same thing.

The code provided here is to help. There is a lot of Unicode capable code available for VB6, but the vast majority of samples are buggy, partially implemented or otherwise unusable (and this includes a lot of stuff by me as well).

[petersen]

Of course nowhere you have explcitly claimed the title is yours, and I never doubt you ever would. The point is, in your postings in various threads you show a conspicuous link to this page. When people click the link to come this page they see the listed title. They might or might not click the title. For those who do not click the title, they got an impression that the title is your own (implicitly so), thus having a chance of being mislead. That is why I suggested "to avoid misleading" which can be done easily.

[Merri]

I'm leaving it undone thanks to the tone you use to write your messages. It seems you're slowly but surely waging a personal war, not only in this thread, but other threads as well – some of which I haven't even been a part of. That isn't very constructive, mature or wise.

Unless you have any tips to share or questions on the posted code I can only suggest to quit complaining. I help people here on my free time under various states of mind, be it fresh minded, sleepy or in a hurry. Most of the time I'm strictly in the subject, so if I hurt anyone's feelings then it often comes from the reader's own mind. Be it cultural difference, misunderstood text or personal incompatibilities.

[petersen]

I've removed the last sentence accordingly. It is my opnion that in any forum discussion, one should stick to the point and follow the logic.

To include somebody else's title under one's own book cover, the title's original author should be explicitly stated (to avoid misleading the page browser). It should be clearly specified in the following manner:

Unicode File Open/Save Dialog - By La Volpe

Of course nowhere you have explcitly claimed the title is yours, and I never doubt you ever would. The point is, in your postings in various threads you show a conspicuous link to this page. When people click the link to come this page they see the listed title. They might or might not click the title. For those who do not click the title, they got an impression that the title is your own (implicitly so), thus having a chance of being mislead. That is why I suggested "to avoid misleading" which can be done easily.

[Merri]

UTF-8 string conversions

As you may already know VB6 stores strings internally as UTF-16. Yet, when you open and save text files you will not get UTF-16 files. Instead, the files will be saved and opened using the locale of the system (commonly Windows-1252 in the US & many Western European countries). This relatively short tutorial helps you to use UTF-8 with VB6 using two generic conversion functions that behave like the native StrConv.

' StrConvUTF8.bas
Option Explicit

Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)
Private Declare Function SysAllocStringLen Lib "oleaut32" (ByVal Ptr As Long, ByVal Length As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, lpUsedDefaultChar As Long) As Long

Public Function StrConvFromUTF8(Text As String) As String
    ' get length
    Dim lngLen As Long, lngPtr As Long: lngLen = LenB(Text)
    ' has any?
    If lngLen Then
        ' create a BSTR over twice that length
        lngPtr = SysAllocStringLen(0, lngLen * 1.25)
        ' place it in output variable
        PutMem4 VarPtr(StrConvFromUTF8), lngPtr
        ' convert & get output length
        lngLen = MultiByteToWideChar(65001, 0, ByVal StrPtr(Text), lngLen, ByVal lngPtr, LenB(StrConvFromUTF8))
        ' resize the buffer
        StrConvFromUTF8 = Left$(StrConvFromUTF8, lngLen)
    End If
End Function

Public Function StrConvToUTF8(Text As String) As String
    ' get length
    Dim lngLen As Long, lngPtr As Long: lngLen = LenB(Text)
    ' has any?
    If lngLen Then
        ' create a BSTR over twice that length
        lngPtr = SysAllocStringLen(0, lngLen * 1.25)
        ' place it in output variable
        PutMem4 VarPtr(StrConvToUTF8), lngPtr
        ' convert & get output length
        lngLen = WideCharToMultiByte(65001, 0, ByVal StrPtr(Text), Len(Text), ByVal lngPtr, LenB(StrConvToUTF8), ByVal 0&, ByVal 0&)
        ' resize the buffer
        StrConvToUTF8 = LeftB$(StrConvToUTF8, lngLen)
    End If
End Function

These two functions are usable for each case you are dealing with UTF-8: reading & writing text files, interaction with websites via Winsock, internal space saving solutions (or avoiding NULL byte issues), DLL libraries that use UTF-8 (which are very rare on Windows)... however, as these are generic functions you have to pay attention on how to use them.

Saving UTF-8

The biggest issue with these functions is that they are not usable with native VB6 file methods or API calls (when passing strings As String). Each time VB6 sees a String it assumes it is UTF-16 – yet because of this it will do Unicode <-> ANSI conversions (ANSI is a Microsoft term for anything other character set than Unicode). And this is what we do not want! All this means you can't use code like the following:

Open "testing.txt" For Output As #1
    Print #1, StrConvToUTF8(strTesting);
Close #1

Why? Well, VB6 messes up here, because after the StrConvToUTF8 call the string is what could be called an ANSI string or a byte string: it holds the exact byte representation of the earlier UTF-16 string, but as UTF-8. So one character is not two bytes like it normally is. What VB6 will do to this string is to assume it is still UTF-16 and it'll apply conversion from UTF-16 to the system ANSI character set.

At this point one could think, why not just use the native StrConv and patch the issue like this:

Open "testing.txt" For Output As #1
    Print #1, StrConv(StrConvToUTF8(strTesting), vbUnicode);
Close #1

It seems to work fine... if you're on a Windows-1252 locale that is! Things start to mess up when other, non 8-bit character sets are being used. Some bytes will not be understood and get ignored or handled incorrectly. There is only one conclusion: Do NOT use StrConv like this! Every time you are handling binary data you should never have a StrConv messing things up in the middle. UTF-8 can be considered to be binary from VB6 standpoint.

Finally the solution is a simple one: use a byte array instead! VB6 does not touch the contents of a byte array when saving or loading it, so it is safe to use it. It is very easy to convert between byte arrays and strings too!

Dim B() As Byte

Open "testing.txt" For Binary Access Write As #1
    B = StrConvToUTF8(strTesting)
    Put #1, , B
Close #1

This will fully solve the issue of saving a UTF-8 file. However, on Windows it is a convention to include a Byte-order Mark even on UTF-8 text files even though it is not required. Officially there is no BoM for UTF-8, instead it is known as a "signature". Including such a signature is easy:

B = UTF16toUTF8(ChrW$(&HFEFF) & strTesting)

Alternatively if you deal with big strings are afraid string concatenation will slow down your processing too much, you can also write direct UTF-8 bytes into the file:

' EF BB BF (first two bytes as Integer, third byte as Byte)
Put #1, , &HBBEF
Put #1, , CByte(&HBF)

Loading UTF-8

As with saving you cannot use the native VB6 text mode. Instead it is better to use binary mode and load the string into a byte array first:

Dim B() As Byte

Open "testing.txt" For Binary Access Read As #1
    If LOF(1) Then
        ReDim B(LOF(1) - 1)
        Get #1, , B
        strTesting = StrConvFromUTF8(CStr(B))
    End If
Close #1

You can use AscW(strTesting) to find out whether the first character is a signature ("BoM") or not. AscW will return &HFEFF (-257 as Integer or 65279 As Long). You can use Mid$(strTesting, 2) to ignore it.


For more details on Unicode & BoM you can read the official FAQ: UTF-8, UTF-16, UTF-32 & BOM.

[Bonnie West]

Private Declare Function GetCommandLineW Lib "kernel32.dll" () As Long
Private Declare Function PathGetArgsW Lib "shlwapi.dll" (ByVal pszPath As Long) As Long
Private Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long

'Pointer-driven Command$ replacement
Public Function CommandW() As String
    If Not InIDE Then
        SysReAllocString VarPtr(CommandW), PathGetArgsW(GetCommandLineW)
        If LenB(CommandW) Then If AscW(CommandW) = 32 Then CommandW = LTrim$(CommandW)
    Else
        CommandW = Command$
    End If
End Function

Private Function InIDE(Optional ByRef B As Boolean = True) As Boolean
    If B Then Debug.Assert Not InIDE(InIDE) Else B = True
End Function

[wqweto]

Recently stumbled upon the Everyone quotes command line arguments the wrong way article and took to heart authors request for `ArgvQuote` function to "translate it into your language and coding style of choice".

Here is both a simplified VB6 wrapper of `CommandLineToArgvW` API function and an regexp impl of `ArgvQuote` with a (somewhat) complete test suite to confirm command line arguments oddities are handled both ways correctly.

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function CommandLineToArgvW Lib "shell32" (ByVal lpCmdLine As Long, pNumArgs As Long) As Long
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function ApiSysAllocString Lib "oleaut32" Alias "SysAllocString" (ByVal Ptr As Long) As Long
'Private Declare Function GetCommandLineW Lib "kernel32" () As Long

Private Function SplitArgs(sText As String) As Variant
    Dim vRetVal         As Variant
    Dim lPtr            As Long
    Dim lArgc           As Long
    Dim lIdx            As Long
    Dim lArgPtr         As Long
    
    If LenB(sText) <> 0 Then
        lPtr = CommandLineToArgvW(StrPtr(sText), lArgc)
    End If
    If lArgc > 0 Then
        ReDim vRetVal(0 To lArgc - 1) As String
        For lIdx = 0 To UBound(vRetVal)
            Call CopyMemory(lArgPtr, ByVal lPtr + 4 * lIdx, 4)
            vRetVal(lIdx) = SysAllocString(lArgPtr)
        Next
    Else
        vRetVal = Split(vbNullString)
    End If
    Call LocalFree(lPtr)
    SplitArgs = vRetVal
End Function

Private Function SysAllocString(ByVal lPtr As Long) As String
    Dim lTemp           As Long
    
    lTemp = ApiSysAllocString(lPtr)
    Call CopyMemory(ByVal VarPtr(SysAllocString), lTemp, 4)
End Function

' based on https://blogs.msdn.microsoft.com/twistylittlepassagesallalike/2011/04/23/everyone-quotes-command-line-arguments-the-wrong-way
Private Function ArgvQuote(sArg As String, Optional ByVal Force As Boolean) As String
    Const WHITESPACE As String = "*[ " & vbTab & vbVerticalTab & vbCrLf & "]*"
    
    If Not Force And LenB(sArg) <> 0 And Not sArg Like WHITESPACE Then
        ArgvQuote = sArg
    Else
        With CreateObject("VBScript.RegExp")
            .Global = True
            .Pattern = "(\\+)($|"")|(\\+)"
            ArgvQuote = """" & Replace(.Replace(sArg, "$1$1$2$3"), """", "\""") & """"
        End With
    End If
End Function

Private Sub Form_Load()
    Dim sCommand        As String
    Dim vSplit          As Variant
    
'    vSplit = SplitArgs(SysAllocString(GetCommandLineW()))
    vSplit = SplitArgs(Command$())
    sCommand = "1 2 ""3"" ""4 5 6"" /ini:""C:\TEMP\a b"" ""/ini:C:\TEMP\a b"" ""aaa\\bbb"" ""aaa\\\\"" aaa\\ ""aaa\\\""bbb"""
    vSplit = SplitArgs(sCommand)
    Debug.Assert vSplit(0) = "1"
    Debug.Assert vSplit(1) = "2"
    Debug.Assert vSplit(2) = "3"
    Debug.Assert vSplit(3) = "4 5 6"
    Debug.Assert vSplit(4) = "/ini:C:\TEMP\a b"
    Debug.Assert vSplit(5) = "/ini:C:\TEMP\a b"
    Debug.Assert vSplit(6) = "aaa\\bbb"
    Debug.Assert vSplit(7) = "aaa\\"
    Debug.Assert vSplit(8) = "aaa\\"
    Debug.Assert vSplit(9) = "aaa\""bbb"
    
    ReDim vSplit(0 To 9) As String
    vSplit(0) = ArgvQuote("1")
    vSplit(1) = ArgvQuote("2")
    vSplit(2) = ArgvQuote("3", Force:=True)         '-> "3"
    vSplit(3) = ArgvQuote("4 5 6")                  '-> "4 5 6"
    vSplit(4) = "/ini:" & ArgvQuote("C:\TEMP\a b")  '-> /ini:"C:\TEMP\a b"
    vSplit(5) = ArgvQuote("/ini:C:\TEMP\a b")       '-> "/ini:C:\TEMP\a b"
    vSplit(6) = ArgvQuote("aaa\\bbb", Force:=True)  '-> "aaa\\bbb"
    vSplit(7) = ArgvQuote("aaa\\", Force:=True)     '-> "aaa\\\\"
    vSplit(8) = ArgvQuote("aaa\\")                  '-> aaa\\
    vSplit(9) = ArgvQuote("aaa\""bbb", Force:=True) '-> "aaa\\\"bbb"
    Debug.Assert sCommand = Join(vSplit, " ")
End Sub

Take a look at these debug asserts for really odd use cases, e.g. the syntax /option:"something quoted" is not an invention of vbscript/cscript interpreter but is baked into the OS it seems.

cheers,
</wqw>

[DEXWERX]

ChrW$(VERT_TAB) can be vbVerticalTab

nitpicking but I'm impressed. I didn't even think it was possible using a RegEx, after seeing all the custom Command line parsing routines.

edit: Too bad MS was notoriously bad at messing up arg quotes in their build tools.

[wqweto]

@DEXWERX: 10x, that's why I love sharing code here.

I extracted to whole whitespace pattern in a Const to be sure it gets concatenated at compile time. Fixed a bug and simplified the regexp in `ArgvQuote`. Note that `ArgvQuote` is used in the reverse use-case of `CommandLineToArgvW`, i.e. when you have to pass arguments to a child process.

Using the `CommandLineToArgvW` API for command line parsing is the canonical way to treat the result of built-in `Command$` function. This is what C/C++ runtime puts in argv/argc pair and what every command line utility sees as actual process arguments.

So correct argv quoting from VB6 is critical when shelling external (console) applications, just putting double quotes around long directory and file names like everyone does is simply... wrong on many different levels.

cheers,
</wqw>

[baka]

One function I use to replace app.path is

Private Declare Function GetShortPathName Lib "kernel32.dll" Alias "GetShortPathNameW" (ByVal lpszLongPath As Long, ByVal lpszShortPath As Long, ByVal cchBuffer As Long) As Long
Private Declare Function GetModuleFileName Lib "kernel32.dll" Alias "GetModuleFileNameW" (ByVal hModule As Long, ByVal lpFileName As Long, ByVal nSize As Long) As Long

Private Function GetAppShortPath() As String
    Dim lBuffer As String
    
    If CBool(App.LogMode = 0) Then
        GetAppShortPath = App.Path
    Else
        GetAppShortPath = Space$(260)
        lBuffer = GetAppShortPath
        GetModuleFileName 0&, StrPtr(lBuffer), 260
        GetShortPathName StrPtr(lBuffer), StrPtr(GetAppShortPath), 260
        GetAppShortPath = Left$(GetAppShortPath, InStrRev(GetAppShortPath, "\") - 1)
    End If
End Function

since app.path is not unicode aware, this function will return the short folder name of the application. I use it all the time and its working well.
of course it is possible to return the long folder name of the application, if you need that you simply skip GetShortPathName and change the 260 to 32767