Dim R(64)
    Dim By(64)
   
Text1.Text = ""
    Call DSReset                              'даём сброс
    Call DSOutByte(&HF0)                   'даём команду поиска ROM
         
         For i% = 0 To 63

        R(i%) = DSInTwoBit
         
         If R(i%) = 1 Then
         Call DSOutBit(True)
         By(i%) = 1
         mscDev.InBufferCount = 0   'чистим входной буфер
            Do 'чистим выходной буфер
            Loop Until mscDev.OutBufferCount = 0
         End If
         
         If R(i%) = 2 Then
         Call DSOutBit(False)
         By(i%) = 0
         mscDev.InBufferCount = 0 ' чистим входной буфер   
            Do '                         чистим выходной буфер
            Loop Until mscDev.OutBufferCount = 0
         End If
         
         If R(i%) = 3 Then
         MsgBox "Отвалилась!"
         Exit For
         End If
Next i%

   
  For i% = 0 To 63
  Debug.Print By(i%);
  Next i%

Private Sub DSendBit(DSBit As Boolean) 'подпрограмма вывода бита
        If DSBit Then
            mscDev.Output = Chr$(&HFF)   'передаем 1
        Else
            mscDev.Output = Chr$(&H0)    'передаем 0
        End If
        Do 'ждем когда выходной буфер очистится
        Loop Until mscDev.OutBufferCount = 0
    TMInTime# = Now + TimeSerial(0, 0, 1) / 18 ' 1/18 секунды на ответ
    Do 'ждем когда придет все эхо, с учетом тайм-аута
    Loop Until (mscDev.InBufferCount > 0) Or (TMInTime# < Now)
    mscDev.InBufferCount = 0    'обнуляем эхо в приемном буфере
End Sub