_EXTENDING VISUAL BASIC'S COMM CONTROL_
by Michael Floyd

Listing One

' xmodem.bas  -- Michael Floyd -- Dr. Dobb's Journal, December 1995.)

Global Const RETRIES = 12
Global Const CRCTRIES = 2
Global Const PADCHAR = &H1A
Global Const SOH = &H1
Global Const EOT = &H4
Global Const ACK = &H6
Global Const NAK = &H15
Global Const CAN = &H18
Global Const CRC = "C"

Global tries, SecondsElapsed As Integer           
Global InBuffer As String

Sub Delay(Seconds)   
    SecondsElapsed = 0
    If Seconds < 1 Then
        Terminal.Timer1.Interval = 1000 * Seconds
    Else
        Terminal.Timer1.Interval = 1000
    End If
    Terminal.Timer1.Enabled = True       'Enable timer
    Do While SecondsElapsed <= Seconds
        If I Mod 10 = 0 Then DoEvents
        Terminal.Label1.Caption = SecondsElapsed
        I = I + 1
    Loop
    Terminal.Timer1.Enabled = False
End Sub

Sub download_xmodem(FileNum)
Dim buffer, Checksum, Block, RemoteChecksum, RemoteComplement, _
    RemoteBlockNumber, SOHChar As Integer
Dim ByteArray$(1 To 128)
    TerminalMode = False                'Disable output to terminal
    Block = 0
    SOHChar = 0
    fst = True
    Terminal.CommCtrl.InBufferCount = 0  'Flush the Input buffer
    Terminal.CommCtrl.InputLen = 1       'Receive one char at a time
    Terminal.CommCtrl.RThreshold = 0     'Disable generation  of OnComm Event
    tries = 0
    TIMEOUT = 6
    test_wordlen

    ' send NAKs until the sender starts sending
    Do While (SOHChar <> SOH) And (tries < RETRIES)
        tries = tries + 1
        Terminal.CommCtrl.Output = Chr$(NAK)
        Delay 1
        SOHChar = ReadComm()
        If SOHChar <> SOH Then
            Delay 6
        End If
    Loop
    Do While tries < RETRIES
        ' -- Receive the data and build the file --
        Terminal.Label1.Caption = "Block  " + Str(Block + 1)
        If Not (fst) Then
            TIMEOUT = 10
            SOHChar = ReadComm()
            If TimedOut() Then
                MsgBox "Timed Out"
            End If
            If SOHChar = CAN Then
                MsgBox "CAN Received"
                Exit Do
            End If
            If SOHChar = EOT Then
                Terminal.CommCtrl.Output = Chr$(ACK)
                MsgBox "EOT Received"
                Exit Do
            End If
            If SOHChar <> SOH Then
                If SOHChar = EOT Then
                    Terminal.CommCtrl.Output = Chr$(ACK)
                    MsgBox "EOT Received"
                    Exit Do
                End If
                Do While (SOHChar <> SOH)
                    If tries >= RETRIES Then
                        MsgBox "SOH errors!"
                        Exit Do
                    End If
                    tries = tries + 1
                    Terminal.CommCtrl.InBufferCount = 0  'Flush Input buffer
                    Terminal.CommCtrl.Output = Chr$(NAK)
                    Delay 1
                    SOHChar = ReadComm()
                Loop
            End If
        End If
        fst = False
        TIMEOUT = 1                         ' Switch to one sec. timeouts
        
        RemoteBlockNumber = ReadComm()      ' Read block number
        RemoteComplement = ReadComm()       ' Read 1's complement
        Checksum = 0
        DLInfo.Label1.Caption = "Block: " + Str(RemoteBlockNumber) + _
        " SOHChar: " + Str(SOHChar)
        ' ---- data block -----
        For I = 1 To 128
            buffer = ReadComm()
            ByteArray$(I) = Chr$(buffer)
            Checksum = Checksum + buffer
        Next
        Checksum = Checksum And 255
        ' ---- checksum  from sender ----
        RemoteChecksum = ReadComm()
        ' --- Handle resent blocks ---
        If RemoteBlockNumber = Block Then
            FilePos = Seek(FileNum)
            Seek FileNum, FilePos - 128
        ' --- handle out of synch block numbers ---
        ElseIf RemoteBlockNumber <> (Block + 1) Then
            receive_error "No next sequential block", CAN
            Exit Do
        End If
        Block = RemoteBlockNumber
        ' --- test the block # 1's complement ---
        BlocksComplement = (Not RemoteBlockNumber And &HFF)
        If (RemoteComplement And &HFF) <> BlocksComplement Then
            receive_error "One's complement does not match", NAK
        End If
        ' --- test chksum or crc vs one sent ---
        If Checksum <> RemoteChecksum Then
            receive_error "non-matching Checksums", NAK
        End If
        ' --- write the block to disk ---
        For I = 1 To 128
            If Asc(ByteArray$(I)) = PADCHAR Then
                Exit For
            End If
            Put #FileNum, , ByteArray$(I)
        Next
        Terminal.CommCtrl.Output = Chr$(ACK)
        Delay 0.5
    Loop
    If SOHChar = EOT Then
        MsgBox "Transfer Complete"
    Else
        MsgBox "Transfer Aborted"
    End If
    TIMEOUT = 10
    Terminal.CommCtrl.InBufferCount = 0  'Flush the buffer
    Terminal.CommCtrl.InputLen = 0       'Receive all chars in buffer
    Terminal.CommCtrl.RThreshold = 1     'Enable generation of OnComm Event
    TerminalMode = True                  'Enable output to terminal
End Sub

 Function ReadComm() As Integer
 Dim Tmp As String
 ' ReadComm reads a character from the Comm control's input buffer
 ' and returns the ASCII value of that character. If a null string is
 ' encountered, ReadComm returns 0.
 
    If Terminal.CommCtrl.InBufferCount > 0 Then
        Tmp = Terminal.CommCtrl.Input
        If Tmp <> "" Then
            ReadComm = Asc(Tmp)
        Else
            ReadComm = 0
        End If
    Else
        ReadComm = 0
    End If
End Function
Static Sub receive_error(ErrorMsg, Rtn)
    tries = tries + 1
    If TIMEOUT = 1 Then
        MsgBox "error  " + ErrorMsg
    End If
End Sub
Sub test_wordlen()
    Settings = Terminal.CommCtrl.Settings
    If InStr(Settings, ",8,") = 0 Then
        MsgBox "Must be 8 Data Bits"
        tries = RETRIES
    End If
End Sub
Function TimedOut() As Integer
    Ticker = 1
    If Ticker = 0 Then
        TimedOut = True
    Else
        TimedOut = False
    End If
End Function




Example 1: 

CommCtrl.CommPort = 1
CommCtrl.Settings = "9600,n,8,1"
CommCtrl.InputLen = 0
CommCtrl.PortOpen = True
CommCtrl.Output = "ATZ" + Chr(13)
Do
    DummyVar = DoEvents()
Loop Until CommCtrl.InBufferCount >= 2
InString$ = CommCtrl.Input
CommCtrl.PortOpen = False