Help for encoding a text file with VB6

[wqweto]

There is ConvertCp$, but you seem to have a reason to use VB6, can you explain why?

This either trolling level 11 or just very hilarious :-))

@aghamali: Try this implementation of a universal `ReadTextFile` function:

'--- for WideCharToMultiByte
Private Const CP_UTF8                       As Long = 65001

Private Declare Function IsTextUnicode Lib "advapi32" (lpBuffer As Any, ByVal cb As Long, lpi 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, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long

Private Function ReadTextFile(sFile As String) As String
    Const ForReading    As Long = 1
    Const BOM_UTF       As String = "п»ї"   '--- "\xEF\xBB\xBF"
    Const BOM_UNICODE   As String = "яю"    '--- "\xFF\xFE"
    Dim lSize           As Long
    Dim sPrefix         As String
    Dim nFile           As Integer
    Dim sCharset        As String
    Dim oStream         As Object
    
    On Error GoTo EH
    '--- get file size
    lSize = FileLen(sFile)
    If lSize = 0 Then
        Exit Function
    End If
    '--- read first 50 chars
    nFile = FreeFile()
    Open sFile For Binary Access Read As nFile
    sPrefix = String$(IIf(lSize < 50, lSize, 50), 0)
    Get nFile, , sPrefix
    Close nFile
    '--- figure out charset
    If Left$(sPrefix, 3) = BOM_UTF Then
        sCharset = "UTF-8"
    ElseIf Left$(sPrefix, 2) = BOM_UNICODE Or IsTextUnicode(ByVal sPrefix, Len(sPrefix), &HFFFF& - 2) <> 0 Then
        sCharset = "Unicode"
    ElseIf InStr(1, sPrefix, "<?xml", vbTextCompare) > 0 And InStr(1, sPrefix, "utf-8", vbTextCompare) > 0 Then
        '--- special xml encoding test
        sCharset = "UTF-8"
    Else
        sCharset = "Windows-1256"
    End If
    '--- plain text: direct VB6 read
    If LenB(ReadTextFile) = 0 And sCharset = "Windows-1256" Then
        nFile = FreeFile()
        Open sFile For Binary Access Read As nFile
        ReadTextFile = String$(lSize, 0)
        Get nFile, , ReadTextFile
        Close nFile
    End If
    '--- plain text + unicode: use FileSystemObject
    If LenB(ReadTextFile) = 0 And sCharset <> "UTF-8" Then
        On Error Resume Next  '--- checked
        ReadTextFile = CreateObject("Scripting.FileSystemObject").OpenTextFile(sFile, ForReading, False, sCharset = "Unicode").ReadAll()
        On Error GoTo EH
    End If
    '--- plain text + unicode + utf-8: use ADODB.Stream
    If LenB(ReadTextFile) = 0 Then
        Set oStream = CreateObject("ADODB.Stream")
        With oStream
            .Open
            .Charset = sCharset
            .LoadFromFile sFile
            ReadTextFile = .ReadText()
        End With
    End If
    '--- pseudo-fix UTF-8
    If sCharset = "Windows-1256" Then
        For lSize = &H80 To &HFF
            sPrefix = ToUtf8(Chr$(lSize))
            If InStr(ReadTextFile, sPrefix) > 0 Then
                ReadTextFile = Replace(ReadTextFile, sPrefix, Chr$(lSize))
            End If
        Next
    End If
    Exit Function
EH:
    Debug.Print Err.Description
End Function

Private Function ToUtf8(sText As String) As String
    Dim lSize           As Long
    
    ToUtf8 = String$(4 * Len(sText), 0)
    lSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sText), Len(sText), ByVal ToUtf8, Len(ToUtf8), 0, 0)
    ToUtf8 = Left$(ToUtf8, lSize)
End Function

Private Sub Command1_Click()
    Dim sText As String
    sText = ReadTextFile(App.Path & "\utf8.txt")
    Text1.SelText = "utf8.txt:" & vbCrLf & sText
    sText = ReadTextFile(App.Path & "\unicode.txt")
    Text1.SelText = "unicode.txt:" & vbCrLf & sText
    sText = ReadTextFile(App.Path & "\ascii.txt")
    Text1.SelText = "ascii.txt:" & vbCrLf & sText
End Sub

It should handle cp1256/utf-8/unicode text files in one go.

Edit: It tries to handle utf-8 w/o BOM files too (last "pseudo-fix" comment).

cheers,
</wqw>