Option Explicit

Private Declare Function MultiByteToWideChar Lib "Kernel32.dll" ( _
    ByVal CodePage As Long, _
    ByVal dwFlags As Long, _
    ByVal lpMultiByteStr As Long, _
    ByVal cbMultiByte As Long, _
    ByVal lpWideCharStr As Long, _
    ByVal cchWideChar As Long _
) As Long

Private Declare Function WideCharToMultiByte Lib "Kernel32.dll" ( _
    ByVal CodePage As Long, _
    ByVal dwFlags As Long, _
    ByVal lpWideCharStr As Long, _
    ByVal cchWideChar As Long, _
    ByVal lpMultiByteStr As Long, _
    ByVal cbMultiByte As Long, _
    ByVal lpDefaultChar As Long, _
    ByVal lpUsedDefaultChar As Long _
) As Long

Private Const CP_ACP        As Long = 0         ' Default ANSI code page.
Private Const CP_UTF8       As Long = 65001     ' UTF8.
Private Const CP_UTF16_LE   As Long = 1200      ' UTF16 - little endian.
Private Const CP_UTF16_BE   As Long = 1201      ' UTF16 - big endian.
Private Const CP_UTF32_LE   As Long = 12000     ' UTF32 - little endian.
Private Const CP_UTF32_BE   As Long = 12001     ' UTF32 - big endian.

Private Sub Command_Click()

    Dim nCodePage                   As Long
    Dim iFileNoInput                As Integer
    Dim iFileNoOutput               As Integer
    Dim abytFileContents()          As Byte
    Dim nDataSize                   As Long
    Dim sFileContents               As String

    iFileNoInput = FreeFile

    nCodePage = OpenForInput("C:\input.txt", iFileNoInput)

    ' We want to read the entire contents of the file (not including any BOM value).
    ' After calling OpenForInput(), the file pointer should be positioned after any BOM.
    ' So size file contents buffer to <file size> - <current position> - 1.
    nDataSize = LOF(iFileNoInput) - Seek(iFileNoInput) - 1
    ReDim abytFileContents(1 To nDataSize)
    Get #iFileNoInput, , abytFileContents()

    Close iFileNoInput

    ' Now we must convert this to UTF-8. But we have to first convert to the Windows NT standard UTF-16 LE.
    sFileContents = FromCPStringToVBString(abytFileContents(), nCodePage)

    ' And then to UTF8.

    iFileNoOutput = FreeFile

    OpenForOutput "C:\output.txt", iFileNoOutput

    PrintUTF8 iFileNoOutput, sFileContents

    Close iFileNoOutput

End Sub

' Take a string whose bytes are in the byte array <the_abytCPString>, with code page <the_nCodePage>, convert to a VB string.
Private Function FromCPStringToVBString(ByRef the_abytCPString() As Byte, ByVal the_nCodePage As Long) As String

    Dim sOutput                     As String
    Dim nValueLen                   As Long
    Dim nOutputCharLen              As Long

    ' If the code page says this is already compatible with the VB string, then just copy it into the string. No messing.
    If the_nCodePage = CP_UTF16_LE Then
        FromCPStringToVBString = the_abytCPString()
    Else

        ' Cache the input length.
        nValueLen = UBound(the_abytCPString) - LBound(the_abytCPString) + 1

        ' See how big the output buffer will be.
        nOutputCharLen = MultiByteToWideChar(the_nCodePage, 0&, VarPtr(the_abytCPString(1)), nValueLen, 0&, 0&)

        ' Resize output byte array to the size of the UTF-8 string.
        sOutput = Space$(nOutputCharLen)

        ' Make this API call again, this time giving a pointer to the output byte array.
        MultiByteToWideChar the_nCodePage, 0&, VarPtr(the_abytCPString(1)), nValueLen, StrPtr(sOutput), nOutputCharLen

        ' Return the array.
        FromCPStringToVBString = sOutput

    End If

End Function

' Analogue of 'Open "fileName" For Input As #fileNo' - but also return what type of text this is via a Code Page value.
' There are only five valid return values:
'   CP_ACP        ANSI code page
'   CP_UTF16LE    UTF-16 Little Endian (VB and NT default string encoding)
'   CP_UTF16BE    UTF-16 Big Endian
'   CP_UTF32LE    UTF-32 Little Endian
'   CP_UTF32BE    UTF-32 Big Endian
Private Function OpenForInput(ByRef the_sFilename As String, ByVal the_iFileNo As Integer) As Long

    ' Note if we want to take account of every case, we should read in the first four bytes and check for UTF-32 low and high endian BOMs, then
    ' check for the first two bytes to check for UTF-16 low and hight endian BOMs.
    Dim abytBOM(1 To 4)  As Byte
    Dim nCodePage       As Long

    Open the_sFilename For Binary Access Read As #the_iFileNo

    ' Pull in the first four bytes to determines the BOM (byte order marker).
    Get #the_iFileNo, , abytBOM()

    ' The following are the BOMs for text files:
    '
    ' FF FE         UTF-16, little endian
    ' FE FF         UTF-16, big endian
    ' FF FE 00 00   UTF-32, little endian
    ' 00 00 FE FF   UTF-32, big-endian
    '
    ' Work out the code page from this information.

    ' Default value.
    nCodePage = CP_ACP

    Select Case abytBOM(1)
    Case &HFF
        If abytBOM(2) = &HFE Then
            If abytBOM(3) = 0 And abytBOM(4) = 0 Then
                nCodePage = CP_UTF32_LE
            Else
                nCodePage = CP_UTF16_LE
            End If
        End If
    Case &HFE
        If abytBOM(2) = &HFF Then
            nCodePage = CP_UTF16_BE
        End If
    Case &H0
        If abytBOM(2) = &H0 And abytBOM(3) = &HFE And abytBOM(4) = &HFF Then
            nCodePage = CP_UTF32_BE
        End If
    End Select

    ' Reset the file pointer to the beginning of the file.
    Select Case nCodePage
    Case CP_ACP
        Seek #the_iFileNo, 1
    Case CP_UTF16_BE, CP_UTF16_LE
        Seek #the_iFileNo, 3
    End Select

    OpenForInput = nCodePage

End Function

' Analogue of 'Open "fileName" For Append As #fileNo'
Private Sub OpenForAppend(ByRef the_sFilename As String, ByVal the_iFileNo As Integer)

    ' Open the file and move to the end of the file.
    Open the_sFilename For Binary Access Write As #the_iFileNo
    Seek the_iFileNo, LOF(the_iFileNo) + 1

End Sub

' Analogue of 'Open "fileName" For Output As #fileNo'
Private Sub OpenForOutput(ByRef the_sFilename As String, ByVal the_iFileNo As Integer)

    ' Ensure we overwrite the file by deleting it ...
    On Error Resume Next
    Kill the_sFilename
    On Error GoTo 0

    ' ... before creating it.
    Open the_sFilename For Binary Access Write As #the_iFileNo

End Sub

' Analogue of the 'Print #fileNo, value' statement. But only one value allowed.
' Setting <the_bAppendNewLine> = False is analagous to 'Print #fileNo, value;'.
Private Sub PrintUTF8(ByVal the_iFileNo As Integer, ByRef the_sValue As String, Optional ByVal the_bAppendNewLine As Boolean = True)

    Const kbytCarriageReturn        As Byte = 13
    Const kbytNewLine               As Byte = 10

    Put #the_iFileNo, , ToUTF8(the_sValue)

    If the_bAppendNewLine Then
        Put #the_iFileNo, , kbytCarriageReturn
        Put #the_iFileNo, , kbytNewLine
    End If

End Sub

' Converts a VB string (UTF-16) to UTF8 - as a binary array.
Private Function ToUTF8(ByRef the_sValue As String) As Byte()

    Dim abytOutput()                As Byte
    Dim nValueLen                   As Long
    Dim nOutputByteLen              As Long

    ' Cache the input length.
    nValueLen = Len(the_sValue)

    ' See how big the output buffer will be.
    nOutputByteLen = WideCharToMultiByte(CP_UTF8, 0&, StrPtr(the_sValue), nValueLen, 0&, 0&, 0&, 0&)

    ' Resize output byte array to the size of the UTF-8 string.
    ReDim abytOutput(1 To nOutputByteLen)

    ' Make this API call again, this time giving a pointer to the output byte array.
    WideCharToMultiByte CP_UTF8, 0&, StrPtr(the_sValue), nValueLen, VarPtr(abytOutput(1)), nOutputByteLen, 0&, 0&

    ' Return the array.
    ToUTF8 = abytOutput

End Function