Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/XFER10.ZIP/XFER.PAS

Pascal/Delphi Source File | 1990-01-20 | 25.7 KB | 612 lines

{ Xmodem Checksum/CRC/1K Transfer 1.0

 By Andrew Bartels
 A Product of Digital Innovations

 Placed in the Public Domain, January, 1990, By Andrew Bartels  }


Program Transfer_Protocol_Driver;

{$V-}     {Variables of any length can match in procedure headers}

{$S-,R-}  {Turn stack and range check off now that I'm done deugging}

Uses DOS,            { File I/O Routines }
     CRT,            { Video Display Routines / Keyboard }
     IBMCom;         { Use Wayne Conrad's Public Domain COM routines }

Const RX = 1;        { OpCode for Receiving Xmodem }
      SX = 2;        { OpCode for Sending Xmodem   }

      Wt = True;     { Used to determine if OpenFile opens for }
      Rd = False;    { Write (True) or Read (False)            }

Const ACK = #6;      { Acknowledgement     = ASCII Code 6     }
                     { This is sent by receiver to indicate   }
                     { transmitter that the block received    }
                     { had no errors, and that the next block }
                     { can be received.                       }


      CAN = #24;     { Cancel              = ASCII Code 24    }
                     { This signals that the protocol is to   }
                     { be immediately terminated.  Receipt of }
                     { two of these in a row when expecting   }
                     { an SOH, STX, ACK, NAK, or EOT means    }
                     { to abort.                              }

      EOT = #4;      { End Of Transmission = ASCII Code 4    }
                     { Indicates that the tranmitter has     }
                     { successfully transmitted all blocks,  }
                     { and that the protocol is to terminate }

      SOH = #1;      { Start Of Header     = ASCII Code 1     }
                     { This indicates start of a new block    }
                     { of 128 bytes of data.                  }

      STX = #2;      { Start Of Text       = ASCII Code 2     }
                     { This code is used exactly as the SOH   }
                     { by the transmitter to signal block     }
                     { beginning.  However, its use indicates }
                     { the block will have 1K of data         }

      NAK = #21;     { Negative Acknowledgement = ASCII Code  21  }
                     { This is sent to receiver to indicate that  }
                     { the last block failed it's error check, or }
                     { is sent to transmitter to indicate √sum    }
                     { error checking is to be used.              }


{ This code has its own built-in error trapping code, designed to report  }
{ errors to the user as accurately as possible.  Each error condition has }
{ a number associated with it, as described below.  Upon receipt of an    }
{ error, the proper error description is printed via the InterpretCode    }
{ procedure, and the code itself becomes the exit code as the program     }
{ terminates.  Error code of zero means no error.                         }

{ Exit Codes To Define Error Conditions Are As Follows:                   }


      NoError                 = 0;  { No error happened - all is well  }
      FileError               = 1;  { Can't open a file                }
      OperatorAbortError      = 2;  { Operator aborted transfer        }
      RemoteCancelError       = 3;  { Remote side aborted transfer     }
      MaxTimeOutError         = 4;  { TimeOut Limit exceeded           }
      BlockOutOfSequenceError = 5;  { Block received out of seq.       }
      EOTTimeOut              = 6;  { Timeout on receiving second EOT. }
      CarrierLostError        = 7;  { Can't xfer if we don't have one  }
{      .
       .
       .
       .                                       }
      InvalidOperation        = 252; { An invalid operation was used      }
      InvalidSwitch           = 253; { An invalid command switch was used }
      InvalidBaudRate         = 254; { An invalid baud rate was specified }
      InvalidCOMPort          = 255; { An Invalid COM Port was specified  }


Type BlockType = Array[1..1024] of Byte;  { Use this type for all blocks }


{ Variables used in opening command line interpretation routines:         }


Var Count         : Integer;      { pointer to next ParamStr item         }

    OneK,                         { True if 1K blocks are to be used      }

    CRCMode       : Boolean;      { True if CRC correction is to be used, }
                                  { False if Checksum is to be used       }

    FileName      : String;       { Holds path/filename specified on      }
                                  { command line.                         }

    OpCode        : Byte;         { Determines which transfer operation   }
                                  { was specified.                        }

    ComPort,                      { Holds COM Port specified, or 1 as a   }
                                  { default if none was specified.        }

    Place         : Word;         { Points to correct COM Port I/O Address}

    Hold          : Byte;         { Holds a temp. value when determining  }
                                  { the port's initial baud rate          }

    Baud          : Word;         { Defaults to current COM Port speed, or}
                                  { becomes desired baud when specified   }

    Code,                         { Holds returned error when COM Port is }
                                  { initialized.                          }

    Status        : Word;         { Holds error status when converting the}
                                  { COM Port or Baud rate from string to  }
                                  { a number.                             }

    ExitStatus    : Byte;         { Is assigned an error code indicating  }
                                  { results of operation.  This value is  }
                                  { eventually returned as a process exit }
                                  { code via Halt. See Const defs above.  }



Function Uppercase (Line : String) : String;  { Make a string all uppercase }
                                              { ...used on filename         }
Var Count : Integer;
Begin
  If Length(Line) > 0
    then
      For Count := 1 to Length(Line) do       { Loop through each character }
        Line[Count] := UpCase(Line[Count]);   { Uppercase it if needed      }
  Uppercase := Line;                          { Return results via function }
End;


{ This procedure updates the CRC value of the block.  The CRC is initially }
{ set to zero, then as data is received or sent, a call for each byte in   }
{ the dat ais made here.  The old CRC value is passed too, and it is       }
{ updated to include the data byte being processed.  The result is that    }
{ once all the data has been sent/received, you have the CRC all ready for }
{ sending or checking against the one from the transmitter.  The only      }
{ thing you need to watch is this:  After the data has been run through    }
{ this routine byte by byte, the CRC you have is bitwise reversed from the }
{ value actually to be sent.  Transmission standards say that the CRC is to}
{ be transmitted high bit first.  But standards also say a byte is sent low}
{ bit first.  Thus, in order to get the desired value to send, use the     }
{ ReverseWord procedure below.  The value you have after ReverseWord       }
{ *** IS NOT *** the CRC, but rather the bit-reversed CRC, all ready to be }
{ transmitted.  The machine on the other end then has to reverse the bits  }
{ back again to get the CRC value.  It's kinda crazy to have to reverse the}
{ bits, but that's the way the IEEE says you do it.              -Andrew   }


Function UpdCRC (Data    : Byte;
                 CRCTemp : Word) : Word;

{ We figure the CRC with an uncommonly small data table here: }

Const Table : Array[0..15] of Word = ($0000,$1081,$2102,$3183,
                                      $4204,$5285,$6306,$7387,
                                      $8408,$9489,$A50A,$B58B,
                                      $C60C,$D68D,$E70E,$F78F);

Var Index : Byte;        { Index pointer to the data table above }
    Power,               { bit pointer used in reversing byte    }
    Power2 : Byte;       { ditto                                 }
    Data2  : Byte;       { second version of byte, bit reversed  }
    Count  : Integer;    { iterates from 1 to 8 for it reversal  }

Begin

 { Before we can figure out the CRC with this byte, we have to reverse it's }
 { bits - due to the fact that data is normally transmitted low-bit first   }

  Data2 := 0;                          { Hold new reversed data here }
  Power := 1;                          { Power of 2 counter going up }
  Power2 := 128;                       { Power of 2 counter going down }
  For Count := 1 to 8 do               { Do 8 bits of the byte         }
    Begin
      If (Data and Power) <> 0         { If lower bit is a 1, then ... }
        then
          Data2 := Data2 or Power2;    { ....set the higher bit        }
      Power2 := Power2 shr 1;          { Shift higher power of 2 down  }
      Power  := Power  shl 1;          { Shift lower power of 2 up     }
    End;
  Data := Data2;                       { Data is assigned it's reverse }

  { Now we can start doing the CRC divide with the following polynomial: }
  {        16     12    5                                                }
  {       X   +  X   + X  + 1   , where X = 2                            }

  { Thus, we're talking about an actual value of $11021.  The divide is  }
  { done with Modulo Two arithmetic (XOR).  We don't actually divide here}
  { because the table already takes care of it for us.  For a very       }
  { clear and easy to understand description of the CRC-CCITT, and other }
  { types of CRC, etc, please see "C Programmer's Guide To NetBIOS," by  }
  { W. David Schwaderer, pages 167-217, published by Howard W. Sams &    }
  { Company.  This code uses the same method of CRC calculation as is    }
  { shown on pages 204 - 205 of the above book.                -AB       }

  Index := ((CRCTemp xor Data) and $000F);  { Figure an index to table }

  { Xor table data into CRC }
  CRCTemp := ((CRCTemp shr 4) and $0FFF) xor (Table[Index]);

  Data := Data shr 4;   {Now, do it all again for lower nibble of Data}

  Index := ((CRCTemp xor Data) and $000F);  { Figure an index to table }

  { Xor table data into CRC }
  CRCTemp := ((CRCTemp shr 4) and $0FFF) xor (Table[Index]);

  UpdCRC := CRCTemp;   { Set function result to new CRC value }
End;


{ This procedure simply reverses the bits of the word sent by parameter. }
{ Used to reverse bits of the CRC before sending.  I'd hope there would  }
{ be a much more efficient way to do such a simple little operation, but }
{ this was all that came to mind at the time I wrote it.  We only use it }
{ once for each 128 or 1024 (in 1K transfers) bytes, so I guess it does  }
{ not need to be extremely efficient.                                    }

Procedure ReverseWord (Var CRC : Word);
Var CRC2   : Word;     { Holds reversed Word     }
    Power,             { bit pointer in reversal }
    Power2 : Word;     { ditto                   }
    Count  : Integer;  { interates for 16 bits   }
Begin
  Power  := 1;                     { Start one pointer at low bit }
  Power2 := 32768;                 { Other pointer at high bit    }
  CRC2   := 0;                     { new word starts out zero.    }

  For Count := 1 to 16 do          { Iterate for all 16 bits      }
    Begin
      If (CRC and Power) <> 0      { If lower bit is 1, then....  }
        then
          CRC2 := CRC2 or Power2;  { ...Set higher bit            }

      Power  := Power  shl 1;      { Shift bit pointers by one    }
      Power2 := Power2 shr 1;
    End;
  CRC := CRC2;                     { Return reversed word to caller }
End;


Procedure Beep;   { Big Deal - Makes A Beep }
Begin
  Sound(500);
  Delay(20);
  NoSound;
End;


{ This procedure is vital to timing of transfers.  We can use it to     }
{ determine if a timeout has occured (i.e., too long of time passes     }
{ between chars received from remote machine).  The SecsToWait param.   }
{ specifies the number of seconds to wait before declaring that a       }
{ timeout has occurred.  This can be from 1 to 60 secs wait.  A value   }
{ over 60 will cause errors in timing.  The TimeDone param is assigned  }
{ True when the time in SecsToWait has passed, while receiving no chars }
{ from the remote end.  If, however, a char comes in before the alloted }
{ SecsToWait passes, then TimeDone becomes False, and Ch returns the    }
{ character received.   This is VERY useful in Xmodem implementation.   }
{ This routine is accurate to within ± 1 second.                        }


Procedure MonitorReceive (Var Ch         : Char;
                               SecsToWait : Byte;
                           Var TimeDone   : Boolean);

Var Hour,                 { Hold Hours from GetTime             }
    Min,                  { Hold Mins  from GetTime             }
    Sec,                  { Hold Secs  from GetTime             }
    LookFor,              { Hold second value we're waiting for }
    Hund       : Word;    { Hold Hundredths from GetTime        }

    Done       : Boolean; { Used in telling whether we've got a char }
                          { in Repeat/Unit loop.                     }

Begin

  TimeDone := False;      { Automatically assume we've got a character }

  If not Com_RX_Empty     { If one is waiting, receive it & return     }
    then
      Begin
        Ch := Com_RX;
        Exit;
      End;

  GetTime(Hour,Min,Sec,Hund);    { Otherwise, get the start time         }
  LookFor := Sec + SecsToWait;   { Figure destination time to the second }

  While LookFor > 59 do          { Map it to a value from 0 to 59        }
    LookFor := LookFor - 60;

  Done := False;                 { Assume no char received now.          }
  Repeat
    GetTime(Hour,Min,Sec,Hund);  { Get current time now                  }
    TimeDone := Sec = LookFor;   { TimeDone is true if the time is up    }
    If Not Com_RX_Empty          { If we did get a character in, then....}
      then
        Begin
          Ch := Com_RX;          { ....Get it....                        }
          TimeDone := False;     { ....Specify no TimeOut occurred....   }
          Done     := True;      { ....And get us out of the loop.       }
        End;
  Until Done or TimeDone;        { Keep looping until we either run out  }
                                 { of time, or get a character.          }
End;


{ This routine is used to handle opening a file for read/write with error }
{ trapping capabilities.  OpenFile attempts to open the file in FileName  }
{ for Read or Write (depending on Direction), to a record length of       }
{ RecordSize bytes, using File1 for a file handle.  If this operation is  }
{ successful, the function returns True, else False.  A null Filename is  }
{ NOT counted as valid, although Pascal will allow such an operation.     }


Function OpenFile (Var File1        : File;
                       Direction    : Boolean;  {True = Write, False = read}
                       RecordSize   : Integer;
                   Var FileName     : String) : Boolean;

Begin
  If FileName = ''                { If no filename, then we have an error }
    then
      Begin
        OpenFile := False;
      End
    else
      Begin
        Assign(File1,Filename);    { Else, associate Filename with File1 }
        {$I-}
        If Direction                     { Attempt open for Read/Write   }
          then
            ReWrite(File1,RecordSize)
          else
            ReSet(File1,RecordSize);
        {$I+}
        OpenFile := not (IOResult > 0);  { If there was an error, return }
                                         { False, else return True.      }
      End;
End;



{ This procedure will transmit a data block.  The data is passed as a VAR }
{ parameter (to save on stack space), the length of the data (128 or 1024)}
{ comes next.  The procedure also is sent the block number to send the    }
{ data as, as well as whether CRC or Checksum error correction is used.   }


Procedure SendBlock (Var Data : BlockType;
                     DataLen  : Integer;
                     BlockNum : Byte;
                     CRCMode  : Boolean     );

Var Count    : Integer;  { Iteration counter                        }
    CRC      : Word;     { Have WORD ready to handle CRC correction }
    Checksum : Byte;     { Have a BYTE ready incase of checksum     }
Begin
  Case DataLen of              { If data is 128 bytes, then....     }
    128  : Com_TX(SOH);        { ....tell receiver this, else....   }
    1024 : Com_TX(STX);        { ....tell receiver it's 1K long     }
  End;{Case}

  Com_TX(Chr(BlockNum));        { Transmit block number              }
  Com_Tx(Chr(not BlockNum));    { Transmit one's complement of the   }
                                { block number                       }

  If CRCMode                    { If we're doing CRC, then.....      }
    then
      CRC := 0                  { ....initialize CRC variable, else  }
    else
      Checksum := 0;            { initialize the Checksum variable   }

  For Count := 1 to DataLen do  { Loop for all data bytes in block   }
    Begin
      Com_Tx(Chr(Data[Count])); { Transmit the data byte             }
      If CRCMode
        then
          CRC := UpdCRC(Data[Count],CRC)  { If CRC, then update CRC  }
        else
          Checksum := Checksum + Data[Count];  { Else update the Checksum }
    End;
  If CRCMode                     { If CRC, then transmit reversed CRC }
    then
      Begin
        ReverseWord(CRC);
        Com_TX( Chr(Hi(CRC)) );
        Com_TX( Chr(Lo(CRC)) );
      End
    else
      Com_TX(Chr(Checksum));    { else transmit the chechsum }

  Repeat Until Com_TX_Empty;    { Wait until the buffer has been cleared. }
                                { THIS IS VERY IMPORTANT!  If we return   }
                                { before the data has actually been sent, }
                                { then the calling code might start trying}
                                { to wait for a response from the other   }
                                { end before the data actually arrives.   }
                                { If the baud rate is 300 baud or so, the }
                                { calling routine could conceivably get a }
                                { timeout error before the data was even  }
                                { completely sent from the buffer!  By    }
                                { waiting for the data to get sent, we    }
                                { don't have such worries.                }
End;



{$I SXRX.INC}   { Include XmodemSend and XmodemReceive procedures here}
                { Other protocols soon to follow!                     }



{ Here is where the exit status messages are reported back to the user }
{ at program termination.                                              }

Procedure InterpretCode (Code : Byte);
Begin
  Writeln;
  Case Code of
    NoError                 : Writeln('Receive Complete.');
    FileError               : Writeln('Error Opening File!');
    OperatorAbortError      : Writeln('Operator Abort!');
    RemoteCancelError       : Writeln('Transfer Canceled By Remote!');
    MaxTimeoutError         : Writeln('Maximum Timeout Count Exceeded!');
    BlockOutOfSequenceError : Writeln('Block Number Out Of Sequence Error!');
    EOTTimeOut              : Writeln('Timeout On Second EOT - Protocol Assumed Complete.');
    CarrierLostError        : Writeln('No Carrier!');
{      .
       .
       .
       .                                       }
    InvalidOperation        : Writeln('Missing or Invalid Operation Specified!');
    InvalidSwitch           : Writeln('Invalid Command Line Switch!');
    InvalidBaudRate         : Writeln('Invalid Baud Rate!');
    InvalidCOMPort          : Writeln('Invalid COM Port Number!');
  End;{Case}
  Beep;
  Beep;
  Delay(1000);
  Com_DeInstall;      { No need to keep COM Port running  }
  Halt(Code);         { Exit program & return exit status }
End;


{ Ahhhh....the main routine......... }


Begin

  DirectVideo := True;    { Fast video speeds up the transfer time! }
  ClrScr;                 { print opening credits }

  Writeln('Xmodem Checksum/CRC/1K Transfer 1.0');
  Writeln('Copyright (C) 1990 By Andrew Bartels');
  Writeln('A Product of Digital Innovations');
  Writeln;
  Writeln;

  Write('Command line = XFER ');   { Print out the command line entered }
  For Count := 1 to ParamCount do
    Write(Uppercase(ParamStr(Count)),' ');
  Writeln;

  ComPort  := 1;        { Default COM Port = 1           }
  Count    := 1;        { Count points to first ParamStr }
  CRCMode  := False;    { Default to no CRC's yet        }
  OneK     := False;    { Default to 128 byte blocks     }
  OpCode   := 0;        { Set operation to nothing yet   }


  If Uppercase(ParamStr(Count)) = 'PORT'  { if parameter is PORT, then }
    then
      Begin

        Val(ParamStr(Count+1),ComPort,Status);  {See if it's a valid # }

        If (Status <> 0) or (ComPort < 1) or (ComPort > 4)
          then                               {If not a valid number, then }
            InterpretCode(InvalidCOMPort);   {give error to user          }
        Inc(Count,2);        {If it was valid, set pointer to next param}
      End;


  { The default baud rate is whatever the COM port is set at.  This little }
  { area of the code figures out the default rate by reading I/O memory.   }

  Case ComPort of          {Figure out memory address of COM port}
    1 : Place := $3F8;
    2 : Place := $2F8;
    3 : Place := $3E8;
    4 : Place := $2E8;
  End;{Case}

  Hold := Port[Place+3];
  Port[Place+3] := Hold or $80;    {Open latch to current baud rate of port}
  Baud := Trunc(115200.0 / (256 * Port[Place+1] + Port[Place])); {Get Baud}
  Port[Place+3] := Hold and $7F;   {Close latch back up}


  If Uppercase(ParamStr(Count)) = 'SPEED'    { If SPEED is specified, then }
                                             { prepare to override default }
    then
      Begin
        Val(ParamStr(Count+1),Baud,Status);  { Check if it's a valid speed}
        If (Status <> 0) or
           ((Baud <>  300) and (Baud <>  600) and (Baud <> 1200) and
            (Baud <> 2400) and (Baud <> 4800) and (Baud <> 9600) and
            (Baud <> 19200))
          then
            InterpretCode(InvalidBaudRate);  {If not, give user an error}

        Inc(Count,2);          { else new baud rate is set, and pointer now}
                               { points to the next successive ParamStr    }
      End;


  If Uppercase(ParamStr(Count)) = 'RX'
    then
      Begin
        OpCode := RX;  { If user chose Rec. Xmodem, then set code}
        Inc(Count);    { Move pointer to next ParamStr           }
      End
    else
      Begin
        If Uppercase(ParamStr(Count)) = 'SX'
          then
            Begin
              OpCode := SX;  { If user chose Send Xmodem, then set code}
              Inc(Count);    { Move pointer to next ParamStr           }
            End
          else
            Begin
            End;
      End;

  { Since the FileName variable has not yet been used, we're going to   }
  { temporarily use it here to hold parameter switches from the command }
  { line.  This saves us memory space from allocating another variable  }

  FileName := Uppercase(ParamStr(Count));    {Get next cmd. line item}

  While (FileName[1] = '-') and (Length(FileName) = 2) do
    Begin    { As long as it's a switch of some kind, loop }
      Case FileName[2] of
        'C' : Begin     { If CRC switch, then set CRC on }
                CRCMode := True;
                Inc(Count);
              End;
        'K' : Begin     { If 1K switch, then set 1K blocks on }
                OneK := True;
                Inc(Count);
              End;
        else  Begin     { If invalid, then report error & exit }
                InterpretCode(InvalidSwitch);
              End;
      End;{Case}
      FileName := Uppercase(ParamStr(Count));  { get next parameter }
    End;

    If OneK                { If 1K Xmodem is selected, attempt to force }
      then                 { Use of CRC for best error correction.      }
        CRCMode := True;

  { OK, from now on, FileName is used exclusively for the purpose of    }
  { holding the path/filename the user specifies on the command line.   }

  FileName := '';     { Get rid of any traces of switches }

  If ParamCount >= Count  { If there is another parameter out there, then }
    then
      FileName := Uppercase(ParamStr(Count));    { get it as the filename }


  Com_Install(ComPort,Code);    { OK, now try to fire up the COM routines }
  If Code <> 0                  { If an error, then report it & exit     }
    then
      InterpretCode(InvalidCOMPort);
  Com_Set_Speed(Baud);          { OK, now set the baud rate }
  Com_Set_Parity(Com_None,1);   { Xmodem runs at 8-N-1      }

  Writeln('Using COM',ComPort,' at ',Baud,' baud, 8-N-1');


  Case OpCode of

            { If Rec. Xmodem selected, then do it & report errors }
    RX : InterpretCode(XmodemReceive(CRCMode,FileName));
            { If Send Xmodem selected, then do it & report errors }
    SX : InterpretCode(XmodemSend(CRCMode,OneK,FileName));
            { If nothing selected, report error }
    else InterpretCode(InvalidOperation);

  End;{Case}

End.