Перенос строки

Option Explicit
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 GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value 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 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 ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
Private Const FILE_SHARE_READ = &H1
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const OPEN_EXISTING As Long = 3
Private Const GENERIC_READ As Long = &H80000000
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const CP_UTF8 As Long = 65001
 
Private Sub Form_Load()
    Dim LoadFilePath As String
    Dim hFile As Long
    Dim FileSize As Long
    Dim stringbuffer As String
    Dim stringbuffer2 As String
    Dim numread As Long
    Dim nOutputCharLen As Long
    Dim lpMultiByteStr As Long
    Dim arrTextFileStrings() As String
    Dim i As Long
    
    LoadFilePath = App.Path & "\test.txt"
    
    ' Загрузка списка
    hFile = CreateFile(StrPtr(LoadFilePath), GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_ARCHIVE, 0)
    
    If hFile <> INVALID_HANDLE_VALUE Then
        ' Получить размер файла
        FileSize = GetFileSize(hFile, ByVal 0&) ' Этот метод только до 2Гб
        
        If FileSize > 0 Then
            PutMem4 VarPtr(stringbuffer), SysAllocStringByteLen(0&, FileSize) ' Мгновенно выделить память для строки
            
            ' Прочитать файл, ровно столько байтов, сколько нужно
            If ReadFile(hFile, StrPtr(stringbuffer), FileSize, numread, ByVal 0&) > 0 Then
                If MidB$(stringbuffer, 1, 3) = ChrW(&HBBEF) & ChrB(&HBF) Then ' Если есть запись BOM
                    lpMultiByteStr = StrPtr(stringbuffer) + 3
                    numread = numread - 3
                Else
                    lpMultiByteStr = StrPtr(stringbuffer)
                End If
                
                nOutputCharLen = MultiByteToWideChar(CP_UTF8, 0&, lpMultiByteStr, numread, 0&, 0&) ' Получить размер буфера в символах
                If nOutputCharLen > 0 Then
                    PutMem4 VarPtr(stringbuffer2), SysAllocStringLen(0&, nOutputCharLen)
                    
                    ' Преобразовать кодировки
                    If MultiByteToWideChar(CP_UTF8, 0&, lpMultiByteStr, numread, StrPtr(stringbuffer2), nOutputCharLen) > 0 Then
                        QuickSplit2 stringbuffer2, arrTextFileStrings, vbNewLine ' Быстро преобразовать строку в массив
                    End If
                End If
            End If
        End If
        
        CloseHandle hFile
        
        ' Пример чтения файла
        For i = 0 To UBound(arrTextFileStrings)
            If i < 50 Then ' Прочитать только первые 50 строк текстового файла, для примера отображения чисто
                Print arrTextFileStrings(i)
            End If
        Next
    End If
End Sub

Option Explicit
 
Private Declare Function SafeArrayRedim Lib "oleaut32" (ByVal saPtr As Long, saBound As Any) As Long
 
Public Sub QuickSplit2(Expression As String, ResultSplit() As String, Optional Delimiter As String = " ", Optional ByVal Limit As Long = -1)
    ' general variables that we need
    Dim i As Long, J As Long, K As Long, C As Long, LD As Long, LE As Long, Ptr As Long, R() As Long
    ' some dummy variables that we happen to need
    Dim Compare As VbCompareMethod
    ' length information
    LE = LenB(Expression)
    LD = LenB(Delimiter)
    ' figure output array safe array pointer
    Ptr = Not Not ResultSplit
    Debug.Assert App.hInstance
    ' validate lengths and limit (limit must be larger than 0 or it must be unlimited)
    If LE > 0 And LD > 0 And (Limit > 0 Or Limit = -1&) Then
        ' now look up for the first position
        i = InStrB(1, Expression, Delimiter)
        ' InStrB is very fast, but it may give "between characters" results
        Do Until (i And 1) Or (i = 0)
            ' this is why we look for odd positions (1, 3, 5, 7 etc. are a valid position)
            i = InStrB(i + 1, Expression, Delimiter)
        Loop
        ' unlimited or limited?
        If Limit = -1& Then
            ' unlimited, reserve space for maximum possible amount of returned items
            ReDim R(0 To LE \ LD)
            ' index positions until none is found
            Do While i > 0
                ' remember this position
                R(C) = i
                ' look for the next one
                i = InStrB(i + LD, Expression, Delimiter)
                Do Until (i And 1) Or (i = 0)
                    i = InStrB(i + 1, Expression, Delimiter)
                Loop
                ' increase found counter
                C = C + 1
            Loop
        Else
            ' limited, reserve space for the wanted amount of items
            ReDim R(0 To Limit - 1)
            ' index positions until none is found or until counter hits limitation
            Do While i > 0 And C < Limit
                ' remember this position
                R(C) = i
                ' look for the next one
                i = InStrB(i + LD, Expression, Delimiter)
                Do Until (i And 1) Or (i = 0)
                    i = InStrB(i + 1, Expression, Delimiter)
                Loop
                ' increase found counter
                C = C + 1
            Loop
        End If
        ' set results to actual findings
        If Ptr Then
            If UBound(ResultSplit) <> C Then ReDim Preserve ResultSplit(0 To C)
        Else
            ReDim ResultSplit(0 To C)
        End If
        ' see if we found any results
        If C = 0 Then
            ' nope, just set the only item to be the whole string
            If LenB(ResultSplit(0)) = LenB(Expression) Then
                MidB$(ResultSplit(0), 1, LenB(Expression)) = Expression
            Else
                ResultSplit(0) = Expression
            End If
        Else
            ' get the first item
            J = R(0) - 1
            K = LenB(ResultSplit(0)) - J
            If K Then
                ResultSplit(0) = LeftB$(Expression, R(0) - 1)
            ElseIf J Then
                MidB$(ResultSplit(0), 1, J) = LeftB$(Expression, J)
            End If
            i = R(0) + LD
            ' get the other items except the last one
            For C = 1 To C - 1
                J = R(C) - i
                K = LenB(ResultSplit(C)) - J
                If K Then
                    ResultSplit(C) = MidB$(Expression, i, J)
                ElseIf J Then
                    MidB$(ResultSplit(C), 1, J) = MidB$(Expression, i, J)
                End If
                i = R(C) + LD
            Next C
            ' get the last item
            ResultSplit(C) = RightB$(Expression, LE - i + 1)
        End If
        ' avoid the item removal code
        Ptr = 0
    ElseIf Ptr = 0 Then
        ' create array that we can reduce to nothing
        ReDim ResultSplit(0 To 0)
        Ptr = Not Not ResultSplit
        Debug.Assert App.hInstance
    End If
    ' custom redimension: remove the items (this duplicates the VB6 Split behavior)
    If Ptr Then SafeArrayRedim Ptr, 0@
End Sub