Private Sub Command1_Click()
If Dir(file1) = "" Then MsgBox "Указанный вами файл не существует!", vbCritical: Exit Sub
If Dir(file2) <> "" Then If MsgBox("Файл уже существует, перезаписать?", vbQuestion + vbYesNo) = vbNo Then Exit Sub Else Kill (file2)

Dim bte As Byte
Dim uprbyte As Integer
Open file1 For Binary As 1
Open file2 For Binary As 2
adr2 = 1
adr1 = Val("&H" + Adress) + 1


Get #1, adr1, bte
If bte > 16 Then MsgBox "Неверный адрес начала архива!": Close: Exit Sub
'MsgBox "Считан начальный байт " & Hex(bte) & " по адресу " & Hex$(adr1 - 1)
adr1 = adr1 + 1
num = 16 - bte
dic = 2 ^ bte - 1

getuprbyte:
Get #1, adr1, bte
'If bte > 16 Then MsgBox "ROM не правильного формата!": Close: Exit Sub
'MsgBox "Считан управляющий байт " & Hex(bte) & " по адресу " & Hex$(adr1 - 1)
cnt = 0
adr1 = adr1 + 1
uprbyte = bte
If uprbyte = 0 Then
    MsgBox "Управляющий байт по адресу " & Hex$(adr1 - 1) & " равен нулю - выход."
    GoTo ENDUNP
End If
    

count:
cnt = cnt + 1
If cnt = 8 Or uprbyte = 0 Then GoTo getuprbyte  '
If uprbyte / 2 = uprbyte \ 2 Then rbit = 0 Else rbit = 1
'MsgBox "Правый бит байта " & Hex(uprbyte) & " равен " & rbit
uprbyte = uprbyte \ 2
If rbit = 1 Then
    Get #1, adr1, bte: adr1 = adr1 + 1
    Put #2, adr2, bte: adr2 = adr2 + 1
    'MsgBox "Правый бит равен 1, просто считываем байт " & Hex(bte) & " по адресу " & Hex(adr1 - 2) & " и пишем байт " & Hex(bte) & " по адресу " & Hex(adr2 - 2)
    GoTo count
Else
    Get #1, adr1, bte: adr1 = adr1 + 1: pbyte1 = bte
    Get #1, adr1, bte: adr1 = adr1 + 1: pbyte2 = bte
    'MsgBox "Правый бит равен 0, читаем байты " & Hex(pbyte1) & " и " & Hex(pbyte2) & " по адресу " & Hex(adr1 - 3)
    'pbyte = Val("&h" + Right$("00" + Hex$(pbyte1), 2) + Right$("00" + Hex$(pbyte2), 2))
    'If pbyte < 0 Then
        pbyte = (pbyte1 * 256) + pbyte2
        'MsgBox pbyte
    'End If
    For koef = 1 To 16
    If pbyte / 2 = pbyte \ 2 Then bitst = "0" & bitst Else bitst = "1" & bitst
        pbyte = pbyte \ 2
    Next koef
  Right(Str$(bitsn1), Len(Str$(bitsn1)) - 1), 8)
    'MsgBox bitsn2 & bitsn1 & "|" & bitst & "|" & Hex(adr1 - 3) & "|" & pbyte1 & " " & pbyte2 & "|" & pbyte
    
    

    bits2 = Right(bitst, 16 - num)
    bits1 = Left(bitst, num)
    
    For r = 0 To Len(bits1) - 1
        byte1 = byte1 + Val(Mid(bits1, Len(bits1) - r, 1)) * (2 ^ r)
    Next r
    For r = 0 To Len(bits2) - 1
        byte2 = byte2 + Val(Mid(bits2, Len(bits2) - r, 1)) * (2 ^ r)
    Next r
    
 
    If byte2 = 0 Then byte2 = 2048
    adr2b = adr2 - byte2
  
   If adr2b < 1 Then MsgBox adr2b & "   " & adr2 & " - " & byte2 & "|||" & Hex(adr1 - 3) & "   " & bitst
 
    
    If byte1 = 0 Then byte1 = 32
    
    For cntr = 1 To byte1
    Get #2, adr2b, bte: adr2b = adr2b + 1
    Put #2, adr2, bte: adr2 = adr2 + 1
    If bte < 0 Then MsgBox adr1 & "   " & adr2 & "    " & adr2b
    Next cntr
    End If
    bitst = ""
    pbyte = 0
    bits = 0
    bitsn1 = 0
    bitsn2 = 0
    byte1 = 0
    byte2 = 0
    adr2b = 0
    GoTo count
    MsgBox "Почему выход?"
ENDUNP:
Close
MsgBox "Всё! Последний байт по адресу " & Hex$(adr1 - 1)
End Sub