Изменить кодировку текста в поле Text1 на VB6

Option Explicit
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 cbMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (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 MessageBox Lib "user32" Alias "MessageBoxW" (ByVal hwnd As Long, ByVal lpText As Long, ByVal lpCaption As Long, ByVal wType As Long) As Long
Private Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal olestr As Long, ByVal BLen As Long) As Long
Private Declare Function SysAllocStringLen Lib "oleaut32" (ByVal olestr As Long, ByVal BLen As Long) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)
 
Private Const CP_UTF8 As Long = 65001
Dim strTXT As String
 
' Конвертировать любой текст в UTF-8
Private Function ConvertToUTF8(strText As String) As String
    Dim nOutputByteLen As Long
    Dim arr() As Byte
    
    If Len(strText) > 0 Then
        nOutputByteLen = WideCharToMultiByte(CP_UTF8, 0&, StrPtr(strText), Len(strText), 0&, 0&, 0&, 0&)
        
        If nOutputByteLen > 0 Then
            ReDim arr(nOutputByteLen - 1)
            WideCharToMultiByte CP_UTF8, 0&, StrPtr(strText), Len(strText), VarPtr(arr(0)), nOutputByteLen, 0&, 0&
            
            ConvertToUTF8 = arr
        End If
    End If
End Function
 
' Конвертировать UTF8 текст в Win-1251
Private Function ConvertUTF8ToWin1251(strText As String) As String
    Dim nOutputCharLen As Long
    Dim numread As Long
    Dim stringbuffer As String
    Dim stringbuffer2 As String
    Dim lpMultiByteStr As Long
    Dim TextByteLenSize As Long
    
    If Len(strText) > 0 Then
        TextByteLenSize = LenB(strText)
        
        If TextByteLenSize > 0 Then
            PutMem4 VarPtr(stringbuffer), SysAllocStringByteLen(0&, TextByteLenSize) ' Мгновенно выделить память для строки
            lpMultiByteStr = StrPtr(strText)
            nOutputCharLen = MultiByteToWideChar(CP_UTF8, 0&, lpMultiByteStr, TextByteLenSize, 0&, 0&) ' Получить размер буфера в символах
            
            If nOutputCharLen > 0 Then
                PutMem4 VarPtr(stringbuffer2), SysAllocStringLen(0&, nOutputCharLen)
                
                ' Преобразовать кодировки
                If MultiByteToWideChar(CP_UTF8, 0&, lpMultiByteStr, TextByteLenSize, StrPtr(stringbuffer2), nOutputCharLen) > 0 Then
                    ConvertUTF8ToWin1251 = stringbuffer2
                End If
            End If
        End If
    End If
End Function
 
Private Sub Command1_Click()
    Dim str As String
    
    str = ConvertToUTF8(Text1.Text)
    
    Text1.Text = str
    MessageBox hwnd, StrPtr(str), StrPtr("Получен новый текст"), ByVal 0&
    strTXT = str
End Sub
 
Private Sub Command2_Click()
    Dim str As String
    
    ' не указывать Text1.Text так как в нём содержится искаверканный текст
    str = ConvertUTF8ToWin1251(strTXT)
    
    Text1.Text = str
    'MessageBox hwnd, StrPtr(str), ByVal 0&, ByVal 0&
End Sub

Private Sub Command2_Click()
    Dim str As String
    
    If Len(strTXT) > 0 Then
        ' не указывать Text1.Text так как в нём содержится искаверканный текст
        str = ConvertUTF8ToWin1251(strTXT)
        
        Text1.Text = str
        'MessageBox hwnd, StrPtr(str), ByVal 0&, ByVal 0&
    Else
        strTXT = Text1.Text
        Text1.Text = ConvertUTF8ToWin1251(strTXT)
    End If
End Sub

Private Declare Function OemToChar Lib "user32.dll" Alias "OemToCharA" (ByVal lpszScr As String, ByVal lpszDst As String) As Long

Option Explicit
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 cbMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (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 MessageBox Lib "user32" Alias "MessageBoxW" (ByVal hwnd As Long, ByVal lpText As Long, ByVal lpCaption As Long, ByVal wType As Long) As Long
Private Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal olestr As Long, ByVal BLen As Long) As Long
Private Declare Function SysAllocStringLen Lib "oleaut32" (ByVal olestr As Long, ByVal BLen As Long) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileW" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToWrite As Long, ByRef lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function OemToChar Lib "user32.dll" Alias "OemToCharA" (ByVal lpszScr As String, ByVal lpszDst As String) As Long
 
Private Const CP_UTF8 As Long = 65001
Private Const GENERIC_WRITE As Long = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const CREATE_ALWAYS = 2
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const INVALID_HANDLE_VALUE As Long = -1
 
Dim strTXT As String
 
' Конвертировать любой текст в UTF-8
Private Function ConvertToUTF8(strText As String) As String
    Dim nOutputByteLen As Long
    Dim arr() As Byte
    
    If Len(strText) > 0 Then
        nOutputByteLen = WideCharToMultiByte(CP_UTF8, 0&, StrPtr(strText), Len(strText), 0&, 0&, 0&, 0&)
        
        If nOutputByteLen > 0 Then
            ReDim arr(nOutputByteLen - 1)
            WideCharToMultiByte CP_UTF8, 0&, StrPtr(strText), Len(strText), VarPtr(arr(0)), nOutputByteLen, 0&, 0&
            
            ConvertToUTF8 = arr
        End If
    End If
End Function
 
' Конвертировать UTF8 текст в Win-1251
Private Function ConvertUTF8ToWin1251(strText As String) As String
    Dim nOutputCharLen As Long
    Dim numread As Long
    Dim stringbuffer As String
    Dim stringbuffer2 As String
    Dim lpMultiByteStr As Long
    Dim TextByteLenSize As Long
    
    If Len(strText) > 0 Then
        TextByteLenSize = LenB(strText)
        
        If TextByteLenSize > 0 Then
            PutMem4 VarPtr(stringbuffer), SysAllocStringByteLen(0&, TextByteLenSize) ' Мгновенно выделить память для строки
            lpMultiByteStr = StrPtr(strText)
            nOutputCharLen = MultiByteToWideChar(CP_UTF8, 0&, lpMultiByteStr, TextByteLenSize, 0&, 0&) ' Получить размер буфера в символах
            
            If nOutputCharLen > 0 Then
                PutMem4 VarPtr(stringbuffer2), SysAllocStringLen(0&, nOutputCharLen)
                
                ' Преобразовать кодировки
                If MultiByteToWideChar(CP_UTF8, 0&, lpMultiByteStr, TextByteLenSize, StrPtr(stringbuffer2), nOutputCharLen) > 0 Then
                    ConvertUTF8ToWin1251 = stringbuffer2
                End If
            End If
        End If
    End If
End Function
 
Private Sub Command1_Click()
    Dim str As String
    
    str = ConvertToUTF8(Text1.Text)
    
    Text1.Text = str
    MessageBox hwnd, StrPtr(str), StrPtr("Получен новый текст"), ByVal 0&
    strTXT = str
End Sub
 
Private Sub Command2_Click()
    Dim str As String
    
    If Len(strTXT) > 0 Then
        ' не указывать Text1.Text так как в нём содержится искаверканный текст
        str = ConvertUTF8ToWin1251(strTXT)
        
        Text1.Text = str
        'MessageBox hwnd, StrPtr(str), ByVal 0&, ByVal 0&
    Else
        strTXT = Text1.Text
        Text1.Text = ConvertUTF8ToWin1251(strTXT)
    End If
End Sub
 
Private Sub Command3_Click()
    Dim hFile As Long
    Dim str As String
    
    strTXT = CreateObject("WScript.Shell").Exec("powershell.exe dir").StdOut.ReadAll()
    
    str = Space$(Len(strTXT))
    OemToChar strTXT, str
    Text1.Text = str ' ANSI
    
    strTXT = Text1.Text ' To UTF16
    
    ' Скинуть дамп в TXT-файл (UTF-16)
    ' Хотя на самом деле в ANSI лучше так как в ANSI хранится информация изначально, но это пофиг уже не важно
    hFile = CreateFile(StrPtr(App.Path & "\dump.txt"), GENERIC_WRITE, FILE_SHARE_READ, ByVal 0&, CREATE_ALWAYS, FILE_ATTRIBUTE_ARCHIVE, 0)
    
    If hFile <> INVALID_HANDLE_VALUE Then
        WriteFile hFile, StrPtr(strTXT), LenB(strTXT), 0, ByVal 0&
        CloseHandle hFile
    End If
End Sub