Найдите ошибки

Dim myFile As String
Dim moiMASSIV() As Byte
Dim massivread1() As Byte
Dim massivread2() As Byte
Dim massivread3() As Byte
Dim odnatret As Long
Dim ID As Long
 
 
Private Sub Command1_Click()
myFile = "c:\iskomi.jpg"
    Open myFile For Binary As #1
    odnatret = Int(LOF(1) / 3)
    ReDim moiMASSIV(1 To LOF(1))
        For i = 1 To LOF(1)
            Get #1, i, moiMASSIV(i)
        Next i
 
 
    
    Open "c:\1.txt" For Binary As #2
        For q = 1 To odnatret
            If q <= odnatret Then
                Put #2, q, moiMASSIV(q)
            Else: Exit For
            End If
        Next q
    Close #2
    
   
    
    Open "c:\2.txt" For Binary As #3
        For q = q To (odnatret * 2)
             If q <= (odnatret * 2) Then
                Put #3, (q - odnatret), moiMASSIV(q)
            Else: Exit For
            End If
        Next q
    Close #3
    
 
    
    Open "c:\3.txt" For Binary As #4
        For q = q To LOF(1)
            ID = ID + 1
             If q <= LOF(1) Then
                Put #4, ID, moiMASSIV(q)
            Else: Exit For
            End If
        Next q
    Close #4
    
        Close #1
  ID = 0
  i = 0
 
End Sub
 
Private Sub Command2_Click()
    Open "c:\1.txt" For Binary As #1
    Open "c:\2.txt" For Binary As #2
    Open "c:\3.txt" For Binary As #3
    Open "c:\new.jpg" For Binary As #4
    ReDim massivread1(1 To LOF(1))
    ReDim massivread2(1 To LOF(2))
    ReDim massivread3(1 To LOF(3))
        For i = 1 To LOF(1)
            Get #1, i, massivread1(i)
            Get #2, i, massivread2(i)
            Get #3, i, massivread3(i)
        Next i
        Put #4, , massivread1
        Put #4, , massivread2
        Put #4, , massivread3
    Close #1
    Close #2
    Close #3
    Close #4
 
End Sub

Private Function ReadBytes(FileName$, Optional ByRef Start&, Optional ByVal dln&) As Byte()
    'Чтение байт из файла
    'Арг: Путь // Старт // Длина по умолчанию всего файла
    'Возврат: Массив байт и следующая позиция чтения
    Dim n, f: On Error Resume Next
    f = FreeFile
    Open FileName For Binary As #f
    If Start Then Else Start = 1
    n = LOF(f) - Start + 1
    If dln = 0 Or dln > n Then dln = n
    ReDim Preserve ReadBytes(dln - 1)
    Get #f, Start, ReadBytes: Close #f
    If Err = 0 Then Start = Start + UBound(ReadBytes) + 1
End Function

'::: Разрезать файл на три части
 
Sub Cut_File(finp As String, fo1 As String, fo2 As String, fo3 As String)
Dim fi    As Integer
Dim fo    As Integer
Dim Lf    As Long
Dim Sz    As Long
Dim Buf() As Byte
 
    fi = FreeFile
    Open finp For Binary Access Read As #fi
    
    Lf = LOF(1)
    Sz = Lf \ 3
    ReDim Buf(1 To Sz) As Byte
    
    fo = FreeFile
    Open fo1 For Binary Access Write As #fo
    
    Get #fi, , Buf
    Put #fo, , Buf
    
    Close fo
    
    fo = FreeFile
    Open fo2 For Binary Access Write As #fo
    
    Get #fi, , Buf
    Put #fo, , Buf
    
    Close fo
    
    Rest = Lf - 2 * Sz
    
    ReDim Buf(1 To Rest) As Byte
    
    fo = FreeFile
    Open fo3 For Binary Access Write As #fo
    
    Get #fi, , Buf
    Put #fo, , Buf
    
    Close fo
    Close fi
 
End Sub
 
'::: Склеить их обратно
 
Sub Merge_parts(fout As String, fi1 As String, fi2 As String, fi3 As String)
 
Dim fi    As Integer
Dim fo    As Integer
Dim Lf    As Long
Dim Buf() As Byte
 
    fo = FreeFile
    Open fout For Binary Access Write As #fo
    
    fi = FreeFile
    Open fi1 For Binary Access Read As #fi
    
    Sz = LOF(fi)
    ReDim Buf(1 To Sz) As Byte
    
    Get #fi, , Buf
    Put #fo, , Buf
    
    Close #fi
    
    fi = FreeFile
    Open fi2 For Binary Access Read As #fi
    
    Sz = LOF(fi)
    ReDim Buf(1 To Sz) As Byte
    
    Get #fi, , Buf
    Put #fo, , Buf
    
    Close #fi
    
    fi = FreeFile
    Open fi3 For Binary Access Read As #fi
    
    Sz = LOF(fi)
    ReDim Buf(1 To Sz) As Byte
    
    Get #fi, , Buf
    Put #fo, , Buf
    
    Close #fi
    
    Close #fo
 
End Sub
 
'::: Тестирование в VBA Excel
 
Sub Test()
 
    HomeDir$ = ThisWorkbook.Path
    
    Cut_File HomeDir & "\Cat-117.jpg", HomeDir & "\Cat1.bin", HomeDir & "\Cat2.bin", HomeDir & "\Cat3.bin"
    
    Merge_parts HomeDir & "\Cat-new.jpg", HomeDir & "\Cat1.bin", HomeDir & "\Cat2.bin", HomeDir & "\Cat3.bin"
 
End Sub

Private Function WriteBytes(FileName$, Bytes() As Byte, Optional ByRef Start&, _
Optional Overwrite As Boolean)
    'Запись байт в файл
    'Арг: Путь // Массив байт // Старт // Флаг перезаписи
    'Возврат: Следующая позиция записи (при успешном выполнении)
    Dim n, f: On Error Resume Next
    If Start Then Else Start = 1
    f = FreeFile 'Определяем номер свободного файла
    If Overwrite Then Kill FileName
    Open FileName$ For Binary As #f: Put #f, 1, Bytes: Close #f 'Копируем !
    If Err = 0 Then WriteBytes = Start + UBound(Bytes) + 1
End Function

'::: Разрезать файл на три части
 
Sub Cut_File(finp As String, fo1 As String, fo2 As String, fo3 As String)
Dim fi    As Integer  ' номер входного файла
Dim fo    As Integer ' номер выходного файла
Dim Lf    As Long  ' длина входного файла
Dim Sz    As Long ' длина трети файла 
Dim Buf() As Byte ' байтовый буфер
 
    fi = FreeFile  ' получаем свободный номер файла
    Open finp For Binary Access Read As #fi ' открываем входной для чтения
    
    Lf = LOF(1)  ' получаем длину входного
    Sz = Lf \ 3  ' делим на 3
    ReDim Buf(1 To Sz) As Byte ' выделяем буфер для очередного куска
    
    fo = FreeFile ' свободный номер файла
    Open fo1 For Binary Access Write As #fo ' открываем для записи
    
    Get #fi, , Buf  'читаем первую треть
    Put #fo, , Buf ' сбрасываем в первый файл
    
    Close #fo  ' закрываем первый выходной
    
    '::: а дальше повторяем еще два раза
 
    fo = FreeFile
    Open fo2 For Binary Access Write As #fo
    
    Get #fi, , Buf
    Put #fo, , Buf
    
    Close fo
    
    Rest = Lf - 2 * Sz ' длина последней порции может отличаться от остальных
                             ' если Lf не кратно трем
    
    ReDim Buf(1 To Rest) As Byte
    
    fo = FreeFile
    Open fo3 For Binary Access Write As #fo
    
    Get #fi, , Buf
    Put #fo, , Buf
    
    Close fo
    Close fi  ' закрывем входной
 
End Sub
 
'::: Склеить их обратно
 
Sub Merge_parts(fout As String, fi1 As String, fi2 As String, fi3 As String)
 
Dim fi    As Integer
Dim fo    As Integer
Dim Lf    As Long
Dim Buf() As Byte
 
    fo = FreeFile  ' номер для вых. файла
    Open fout For Binary Access Write As #fo ' открываем...
    
    fi = FreeFile ' номер для первого из входных
    Open fi1 For Binary Access Read As #fi ' открываем
    
    Sz = LOF(fi)  ' определяем длину файла
    ReDim Buf(1 To Sz) As Byte ' выделяем буфер
    
    Get #fi, , Buf   ' читаем буфер
    Put #fo, , Buf  ' сбрасываем в выходной
    
    Close #fi ' закрываем первый входной
    
    '::: Повторяем еще два раза...
 
    fi = FreeFile
    Open fi2 For Binary Access Read As #fi
    
    Sz = LOF(fi)
    ReDim Buf(1 To Sz) As Byte
    
    Get #fi, , Buf
    Put #fo, , Buf
    
    Close #fi
    
    fi = FreeFile
    Open fi3 For Binary Access Read As #fi
    
    Sz = LOF(fi)
    ReDim Buf(1 To Sz) As Byte
    
    Get #fi, , Buf
    Put #fo, , Buf
    
    Close #fi
    
    Close #fo  ' закрываем выходной
 
End Sub
 
'::: Тестирование в VBA Excel
 
Sub Test()
 
    HomeDir$ = ThisWorkbook.Path
    
    Cut_File HomeDir & "\Cat-117.jpg", HomeDir & "\Cat1.bin", HomeDir & "\Cat2.bin", HomeDir & "\Cat3.bin"
    
    Merge_parts HomeDir & "\Cat-new.jpg", HomeDir & "\Cat1.bin", HomeDir & "\Cat2.bin", HomeDir & "\Cat3.bin"
 
End Sub

Option Explicit
Option Compare Text
'
'Программа для разделения и сборки файлов
'© by the Fever Brain 2016
'
Const r& = 90, gen$ = "prt", stic$ = "cut.ico", jpg = "W.jpg", sl$ = "", t$ = ".", s1$ = "(", s2$ = ")", mxprt& = 20
 
Dim WithEvents cbx1 As ComboBox, WithEvents cbx2 As ComboBox
Dim WithEvents l1 As Label, WithEvents l2 As Label
Dim WithEvents cm1 As CommandButton, WithEvents cm2 As CommandButton
Dim WithEvents ch1 As CheckBox, WithEvents ch2 As CheckBox
Dim WithEvents cm3 As CommandButton, WithEvents ch3 As CheckBox
Dim WithEvents im As Image
Dim m_hMod As Long
Dim ll&, tt&, w&, hh&, i&, mfso As Object, mshapp As Object, dic As Object, fldr$, oldD$, sz&
 
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
 
Private Sub Form_Initialize()
    m_hMod = LoadLibrary("shell32.dll")
    InitCommonControls
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    'Заходим в первоначальную папку, и сохраняем настройки
    ChDir oldD
    SaveSetting "Divisor", "Check", "1", ch1.Value
    SaveSetting "Divisor", "Check", "2", ch2.Value
    SaveSetting "Divisor", "Check", "3", ch3.Value
    FreeLibrary m_hMod
End Sub
 
 
Private Sub cbx1_Click()
    Dim ge As Boolean, fe As Boolean, sys As Boolean
    With fso
        cbx2Ref
        fe = .fileexists(cbx1.Text)
        ge = .GetExtensionName(cbx1.Text) = gen
        sys = .GetFile(cbx1.Text).Attributes And 4 'Если системный
        cm2.Enabled = fe And ge
        cm3.Enabled = fe And (Not cm2.Enabled) And cbx2.ListCount > 0
        cbx2.Enabled = Not (cm2.Enabled)
        ch1.Enabled = fe And (Not ge) And (Not sys)
        ch2.Enabled = fe And ge
    End With
End Sub
 
Private Sub cm3_Click()
    Dim del&, s$, part&, os&, b() As Byte, i&, n&
    'Разбиение
    s = Split(cbx2.Text)(0): If IsNumeric(s) Then del = s
    
    s = ""
    part = sz \ del
    os = sz Mod del
    For i = 1 To sz Step part
        b = ReadBytes(cbx1.Text, (i), part)
        n = n + 1: WriteBytes cbx1.Text & s1 & n & ").prt", b, , 1
    Next
    If i <= sz Then
         b = ReadBytes(cbx1.Text, (i), os)
        n = n + 1: WriteBytes cbx1.Text & s1 & n & ").prt", b, , 1
    End If
    For n = n + 1 To mxprt + 1
        'Удаление частей с высшей нумерацией
        s = cbx1.Text & s1 & n & s2 & t & gen
        If fso.fileexists(s) Then fso.DeleteFile s, 1
    Next
    If ch1.Value > 0 And ch1.Enabled = 1 Then
         'Удаление родительского файла
         fso.DeleteFile cbx1.Text, 1
    End If
    s = cbx1.Text & s1 & 1 & s2 & t & gen
    If fso.fileexists(s) Then cbx1.Text = s
    fldrRef
    If ch3.Value > 0 Then PlaySound "Windows Vista Notify.wav", 0, &H1 Or &H20000
End Sub
 
 
Private Sub cm2_Click()
    'Сборка
    Dim s$(4), ss$, j$(), i&, ii&, start&, b() As Byte
    dic.RemoveAll
    With fso
        s(0) = sss(cbx1.Text, s(1), s(2), s(3), s(4))
        ss = s(4)
        For i = 0 To cbx1.ListCount - 1
            On Error Resume Next
            Erase s
            s(0) = sss(cbx1.List(i), s(1), s(2), s(3), s(4))
            If s(4) = ss And IsNumeric(s(3)) Then dic.Add i, s(0)
        Next
        ii = dic.Count - 1: ReDim j(ii)
        For i = mxprt + 1 To 1 Step -1
            s(0) = ss & s1 & i & s2 & "." & gen
            If .fileexists(s(0)) Then j(ii) = s(0): ii = ii - 1
        Next
    End With
 
    For i = 0 To UBound(j)
        b = ReadBytes(j(i))
        start = WriteBytes(ss, b, (start), i = 0)
         'Удаление
        If ch2.Value = 1 And ch2.Enabled = 1 Then
            fso.DeleteFile j(i), 1
        End If
    Next
 
    
    cbx1.Text = ss
    fldrRef
    If ch3.Value > 0 Then PlaySound "Windows Vista Notify.wav", 0, &H1 Or &H20000
End Sub
 
Function sss(ss0$, ss1$, ss2$, ss3$, ss4$) As String
    'Фильтрация
    With fso
        sss = ss0
        ss1 = .GetExtensionName(ss0)
        ss2 = StrReverse(.GetBaseName(ss0))
        ss3 = Split(Split(ss2, s1, 2)(0), s2, 2)(1)
        ss4 = StrReverse(Split(ss2, s1, 2)(1))
    End With
End Function
 
Sub cbx2Ref()
    With cbx2
        sz = fso.GetFile(cbx1.Text).Size
        cbx1.ToolTipText = "Файл: " & fso.GetAbsolutePathName(cbx1.Text) & "    Размер: " & sz
        .Clear
        For i = mxprt To 2 Step -1
            If (sz \ i) > 0 Then .AddItem i & IIf(i > 3, " Частей", " Части"), 0
        Next
        If .ListCount Then
            .ListIndex = 0
        Else
            .Text = "Разбить нельзя"
        End If
    End With
End Sub
 
Private Sub Form_Resize()
    Me.WindowState = 0
    Me.Width = cm3.Left + cm3.Width + (Me.Width - Me.ScaleWidth) + r * 2
    Me.Height = cm3.Top + cm3.Height + (Me.Height - Me.ScaleHeight) + r * 2
End Sub
 
Private Sub cm1_Click()
    On Error GoTo ext
    fldr = shapp.BrowseForFolder(0, "Текущая, установленная  папка " & vbLf & fldr, 100, "").self.Path
    fldrRef
    cbx1_Click
ext:
End Sub
 
 
Sub fldrRef()
    'Обновление папки
    Dim v, s$
    ChDir fldr
    s = cbx1.Text
    With fso.GetFolder(fldr)
        cbx1.Clear
        For Each v In .Files
            cbx1.AddItem v.Name
        Next
        If fso.fileexists(s) Then cbx1.Text = s: cbx1_Click Else cbx1.ListIndex = 0
    End With
End Sub
 
 
Private Property Get shapp() As Object
    If mshapp Is Nothing Then Set mshapp = CreateObject("Shell.Application")
    Set shapp = mshapp
End Property
 
Private Property Get fso() As Object
    If mfso Is Nothing Then Set mfso = CreateObject("scripting.filesystemobject")
    Set fso = mfso
End Property
 
Private Sub cbx1_KeyPress(KeyAscii As Integer): KeyAscii = 0: End Sub
Private Sub cbx2_KeyPress(KeyAscii As Integer): KeyAscii = 0: End Sub
 
Private Sub Form_Load()
    ll = r: tt = r: w = r * 10: hh = r * 2
    Dim v
    For Each v In Controls: v.Visible = 0: Next
    If fso.fileexists(jpg) Then
        Set im = Controls.Add("vb.image", "im")
        With im
            .Move ll, tt, w, r * 23
            .Stretch = 1
            .Picture = LoadPicture(jpg)
            .Visible = 1
        End With
        ll = ll + w + r
    End If
    Set l1 = Controls.Add("vb.Label", "l1")
    With l1
        .Move ll, tt, w, hh
        .Caption = "Файл:"
        .Visible = 1
    End With
    Set cbx1 = Controls.Add("vb.ComboBox", "cbx1")
    With cbx1
        .Move ll + l1.Width + r, tt, r * 30 ', hh
        .Visible = 1
    End With
    tt = tt + l1.Height + r * 2
    Set l2 = Controls.Add("vb.Label", "l2")
    With l2
        .Move ll, tt, w, hh
        .Caption = "Разбить на:"
        .Visible = 1
    End With
    Set cbx2 = Controls.Add("vb.ComboBox", "cbx2")
    With cbx2
        .Move ll + l1.Width + r, tt, r * 30 ', hh
        .ToolTipText = "Максимум на сколько частей можно разбить этот файл"
        .Visible = 1
    End With
    tt = tt + l2.Height + r * 2
    
    Set ch1 = Controls.Add("vb.CheckBox", "ch1")
    With ch1
        .Move ll, tt, r * 40, r * 3
        .Caption = "Удалить родительский файл"
        .Visible = 1
    End With
    tt = tt + l2.Height + r * 2
    Set ch2 = Controls.Add("vb.CheckBox", "ch2")
    With ch2
        .Move ll, tt, r * 40, r * 3
        .Caption = "Удалить части"
        .Visible = 1
    End With
    tt = tt + l2.Height + r * 2
    Set ch3 = Controls.Add("vb.CheckBox", "ch3")
    With ch3
        .Move ll, tt, r * 40, r * 3
        .Caption = "Звуки"
        .Visible = 1
    End With
    tt = tt + l2.Height + r * 2
    Set cm1 = Controls.Add("vb.CommandButton", "cm1")
    With cm1
        .Move ll, tt, r * 13, r * 3
        .Caption = "Папка .."
        .Visible = 1
    End With
    Set cm2 = Controls.Add("vb.CommandButton", "cm2")
    With cm2
        .Move ll + r * 14, tt, r * 13, r * 3
        .Caption = "Собрать"
        .Visible = 1
    End With
    Set cm3 = Controls.Add("vb.CommandButton", "cm3")
    With cm3
        .Move ll + r * 28, tt, r * 13, r * 3
        .Caption = "Разбить"
        .Visible = 1
    End With
    Set dic = CreateObject("scripting.dictionary")
    dic.CompareMode = 1
    ch1.Value = GetSetting("Divisor", "Check", "1", 0)
    ch2.Value = GetSetting("Divisor", "Check", "2", 0)
    ch3.Value = GetSetting("Divisor", "Check", "3", 1)
    oldD = CurDir$
    ChDir App.Path
    fldr = App.Path
    fldrRef
    cbx1_Click
    On Error Resume Next
    With Me
        .Icon = LoadPicture(stic)
        .Caption = "Разбиение файлов"
        Me.Left = (Screen.Width - Me.Left) / 3
        Me.Top = (Screen.Height - Me.Top) / 3
    End With
End Sub
 
Private Function ReadBytes(FileName$, Optional ByRef start&, Optional ByVal dln&) As Byte()
    'Чтение байт из файла
    'Арг: Путь // Старт // Длина по умолчанию всего файла
    'Возврат: Массив байт и следующая позиция чтения
    Dim n, f: On Error Resume Next
    f = FreeFile
    Open FileName For Binary As #f
    If start Then Else start = 1
    n = LOF(f) - start + 1
    If dln = 0 Or dln > n Then dln = n
    ReDim Preserve ReadBytes(dln - 1)
    Get #f, start, ReadBytes: Close #f
    start = start + UBound(ReadBytes) + 1
End Function
 
Private Function WriteBytes(FileName$, Bytes() As Byte, Optional ByRef start&, _
Optional Overwrite As Boolean)
    'Запись байт в файл
    'Арг: Путь // Массив байт // Старт // Флаг перезаписи
    'Возврат: Следующая позиция записи (при успешном выполнении)
    Dim n, f: On Error Resume Next
    If start Then Else start = 1
    f = FreeFile 'Определяем номер свободного файла
    If Overwrite Then Kill FileName
    Open FileName$ For Binary As #f: Put #f, start, Bytes: Close #f 'Копируем !
    WriteBytes = start + UBound(Bytes) + 1
End Function