home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / os2pm / pad.mod < prev    next >
Text File  |  2020-01-01  |  28KB  |  932 lines
  1. IMPLEMENTATION MODULE PAD;   (* Packet Assembler/Disassembler for Kermit *)
  2.  
  3.    FROM SYSTEM IMPORT
  4.       ADR;
  5.  
  6.    FROM Storage IMPORT
  7.       ALLOCATE, DEALLOCATE;
  8.  
  9.    FROM Screen IMPORT
  10.       ClrScr, WriteString, WriteInt, WriteHex, WriteLn;
  11.  
  12.    FROM DosCalls IMPORT
  13.       ExitType, DosExit;
  14.  
  15.    FROM Strings IMPORT
  16.       Length, Assign;
  17.  
  18.    FROM FileSystem IMPORT
  19.       File;
  20.  
  21.    FROM Directories IMPORT
  22.       FileAttributes, AttributeSet, DirectoryEntry, FindFirst, FindNext;
  23.  
  24.    FROM Files IMPORT
  25.       Status, FileType, Open, Create, CloseFile, Get, Put, DoWrite;
  26.  
  27.    FROM PMWIN IMPORT
  28.       MPARAM, WinPostMsg;
  29.  
  30.    FROM Shell IMPORT
  31.       ChildFrameWindow, comport;
  32.  
  33.    FROM KH IMPORT
  34.       COM_OFF;
  35.  
  36.    FROM DataLink IMPORT
  37.       FlushUART, SendPacket, ReceivePacket;
  38.  
  39.    FROM SYSTEM IMPORT
  40.       BYTE;
  41.  
  42.    IMPORT ASCII;
  43.  
  44.  
  45.    CONST
  46.       myMAXL = 94;
  47.       myTIME = 10;
  48.       myNPAD = 0;
  49.       myPADC = 0C;
  50.       myEOL  = 0C;
  51.       myQCTL = '#';
  52.       myQBIN = '&';
  53.       myCHKT = '1';     (* one character checksum *)
  54.       MAXtrys = 5;
  55.       (* From DEFINITION MODULE:
  56.       PAD_Quit = 0;  *)
  57.       PAD_SendPacket = 1;
  58.       PAD_ResendPacket = 2;
  59.       PAD_NoSuchFile = 3;
  60.       PAD_ExcessiveErrors = 4;
  61.       PAD_ProbClSrcFile = 5;
  62.       PAD_ReceivedPacket = 6;
  63.       PAD_Filename = 7;
  64.       PAD_RequestRepeat = 8;
  65.       PAD_DuplicatePacket = 9;
  66.       PAD_UnableToOpen = 10;
  67.       PAD_ProbClDestFile = 11;
  68.       PAD_ErrWrtFile = 12;
  69.       PAD_Msg = 13;
  70.  
  71.  
  72.    TYPE
  73.       (* From Definition Module:
  74.       PacketType = ARRAY [1..100] OF CHAR;
  75.       *)
  76.       SMALLSET = SET OF [0..7];   (* a byte *)
  77.  
  78.  
  79.    VAR
  80.       yourMAXL : INTEGER;   (* maximum packet length -- up to 94 *)
  81.       yourTIME : INTEGER;   (* time out -- seconds *)
  82.       (* From Definition Module
  83.       yourNPAD : INTEGER;   (* number of padding characters *)
  84.       yourPADC : CHAR;   (* padding characters *)
  85.       yourEOL  : CHAR;   (* End Of Line -- terminator *)
  86.       *)
  87.       yourQCTL : CHAR;   (* character for quoting controls '#' *)
  88.       yourQBIN : CHAR;   (* character for quoting binary '&' *)
  89.       yourCHKT : CHAR;   (* check type -- 1 = checksum, etc. *)
  90.       sF, rF : File;   (* files being sent/received *)
  91.       InputFileOpen : BOOLEAN;
  92.       rFname : ARRAY [0..20] OF CHAR;
  93.       sP, rP : PacketType;   (* packets sent/received *)
  94.       sSeq, rSeq : INTEGER;   (* sequence numbers *)
  95.       PktNbr : INTEGER;   (* actual packet number -- no repeats up to 32,000 *)
  96.       ErrorMsg : ARRAY [0..40] OF CHAR;
  97.       MP1, MP2 : MPARAM;
  98.  
  99.  
  100.    PROCEDURE PtrToStr (mp [VALUE] : MPARAM; VAR s : ARRAY OF CHAR);
  101.    (* Convert a pointer to a string into a string *)
  102.  
  103.       TYPE
  104.          PC = POINTER TO CHAR;
  105.  
  106.       VAR
  107.          p : PC;
  108.          i : CARDINAL;
  109.          c : CHAR;
  110.  
  111.       BEGIN
  112.          i := 0;
  113.          REPEAT
  114.             p := PC (mp);
  115.             c := p^;
  116.             s[i] := c;
  117.             INC (i);
  118.             INC (mp.L);
  119.          UNTIL c = 0C;
  120.       END PtrToStr;
  121.  
  122.  
  123.    PROCEDURE DoPADMsg (mp1, mp2 [VALUE] : MPARAM);
  124.    (* Output messages for Packet Assembler/Disassembler *)
  125.  
  126.       VAR
  127.          Message : ARRAY [0..40] OF CHAR;
  128.  
  129.       BEGIN
  130.          CASE CARDINAL (mp1.W1) OF
  131.             PAD_SendPacket:
  132.                WriteString ("Sent Packet #");
  133.                WriteInt (mp2.W1, 5);
  134.                WriteString ("  (ID: ");   WriteHex (mp2.W2, 2);
  135.                WriteString ("h)");
  136.          |  PAD_ResendPacket:
  137.                WriteString ("ERROR -- Resending:");   WriteLn;
  138.                WriteString ("     Packet #");
  139.                WriteInt (mp2.W1, 5);
  140.                WriteString ("  (ID: ");   WriteHex (mp2.W2, 2);
  141.                WriteString ("h)");
  142.          |  PAD_NoSuchFile:
  143.                WriteString ("No such file: ");
  144.                PtrToStr (mp2, Message);   WriteString (Message);
  145.          |  PAD_ExcessiveErrors:
  146.                WriteString ("Excessive errors ...");
  147.          |  PAD_ProbClSrcFile:
  148.                WriteString ("Problem closing source file...");
  149.          |  PAD_ReceivedPacket:
  150.                WriteString ("Received Packet #");
  151.                WriteInt (mp2.W1, 5);
  152.                WriteString ("  (ID: ");   WriteHex (mp2.W2, 2);
  153.                WriteString ("h)");
  154.          |  PAD_Filename:
  155.                WriteString ("Filename = ");
  156.                PtrToStr (mp2, Message);   WriteString (Message);
  157.          |  PAD_RequestRepeat:
  158.                WriteString ("ERROR -- Requesting Repeat:");   WriteLn;
  159.                WriteString ("         Packet #");
  160.                WriteInt (mp2.W1, 5);
  161.                WriteString ("  (ID: ");   WriteHex (mp2.W2, 2);
  162.                WriteString ("h)");
  163.          |  PAD_DuplicatePacket:
  164.                WriteString ("Discarding Duplicate:");   WriteLn;
  165.                WriteString ("         Packet #");
  166.                WriteString ("  (ID: ");   WriteHex (mp2.W2, 2);
  167.                WriteString ("h)");
  168.          |  PAD_UnableToOpen:
  169.                WriteString ("Unable to open file: ");
  170.                PtrToStr (mp2, Message);   WriteString (Message);
  171.          |  PAD_ProbClDestFile:
  172.                WriteString ("Error closing file: ");
  173.                PtrToStr (mp2, Message);   WriteString (Message);
  174.          |  PAD_ErrWrtFile:
  175.                WriteString ("Error writing to file: ");
  176.                PtrToStr (mp2, Message);   WriteString (Message);
  177.          |  PAD_Msg:
  178.                PtrToStr (mp2, Message);   WriteString (Message);
  179.          ELSE
  180.             (* Do Nothing *)
  181.          END;
  182.          WriteLn;
  183.       END DoPADMsg;
  184.  
  185.  
  186.    PROCEDURE CloseInput;
  187.    (* Close the input file, if it exists.  Reset Input File Open flag *)
  188.       BEGIN
  189.          IF InputFileOpen THEN
  190.             IF CloseFile (sF, Input) = Done THEN
  191.                InputFileOpen := FALSE;
  192.             ELSE
  193.                MP1.W1 := PAD_ProbClSrcFile;   MP1.W2 := 0;
  194.                MP2.L := LONGINT (ADR (sFname));
  195.                WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  196.             END;
  197.          END;
  198.       END CloseInput;
  199.  
  200.  
  201.    PROCEDURE NormalQuit;
  202.    (* Exit from Thread, Post message to Window *)
  203.       BEGIN
  204.          MP1.W1 := PAD_Quit;   MP1.W2 := 0;
  205.          MP1.L := 0;
  206.          WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  207.          DosExit (EXIT_THREAD, 0);
  208.       END NormalQuit;
  209.  
  210.  
  211.    PROCEDURE ErrorQuit;
  212.    (* Exit from Thread, Post message to Window *)
  213.       BEGIN
  214.          MP1.W1 := PAD_Error;   MP1.W2 := 0;
  215.          MP2.L := 0;
  216.          WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  217.          DosExit (EXIT_THREAD, 0);
  218.       END ErrorQuit;
  219.  
  220.  
  221.    PROCEDURE ByteXor (a, b : BYTE) : BYTE;
  222.       BEGIN
  223.          RETURN BYTE (SMALLSET (a) / SMALLSET (b));
  224.       END ByteXor;
  225.  
  226.  
  227.    PROCEDURE Char (c : INTEGER) : CHAR;
  228.    (* converts a number 0-94 into a printable character *)
  229.       BEGIN
  230.          RETURN (CHR (CARDINAL (ABS (c) + 32)));
  231.       END Char;
  232.  
  233.  
  234.    PROCEDURE UnChar (c : CHAR) : INTEGER;
  235.    (* converts a character into its corresponding number *)
  236.       BEGIN
  237.          RETURN (ABS (INTEGER (ORD (c)) - 32));
  238.       END UnChar;
  239.  
  240.  
  241.    PROCEDURE TellError (Seq : INTEGER);
  242.    (* Send error packet *)
  243.       BEGIN
  244.          sP[1] := Char (15);
  245.          sP[2] := Char (Seq);
  246.          sP[3] := 'E';   (* E-type packet *)
  247.          sP[4] := 'R';   (* error message starts *)
  248.          sP[5] := 'e';
  249.          sP[6] := 'm';
  250.          sP[7] := 'o';
  251.          sP[8] := 't';
  252.          sP[9] := 'e';
  253.          sP[10] := ' ';
  254.          sP[11] := 'A';
  255.          sP[12] := 'b';
  256.          sP[13] := 'o';
  257.          sP[14] := 'r';
  258.          sP[15] := 't';
  259.          sP[16] := 0C;
  260.          SendPacket (sP);
  261.       END TellError;
  262.  
  263.  
  264.    PROCEDURE ShowError (p : PacketType);
  265.    (* Output contents of error packet to the screen *)
  266.  
  267.       VAR
  268.          i : INTEGER;
  269.  
  270.       BEGIN
  271.          FOR i := 4 TO UnChar (p[1]) DO
  272.             ErrorMsg[i - 4] := p[i];
  273.          END;
  274.          ErrorMsg[i - 4] := 0C;
  275.          MP1.W1 := PAD_Msg;   MP1.W2 := 0;
  276.          MP2.L := LONGINT (ADR (ErrorMsg));
  277.          WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  278.       END ShowError;
  279.  
  280.  
  281.    PROCEDURE youInit (type : CHAR);
  282.    (* I initialization YOU for Send and Receive *)
  283.       BEGIN
  284.          sP[1] := Char (11);   (* Length *)
  285.          sP[2] := Char (0);   (* Sequence *)
  286.          sP[3] := type;
  287.          sP[4] := Char (myMAXL);
  288.          sP[5] := Char (myTIME);
  289.          sP[6] := Char (myNPAD);
  290.          sP[7] := CHAR (ByteXor (myPADC, 100C));
  291.          sP[8] := Char (ORD (myEOL));
  292.          sP[9] := myQCTL;
  293.          sP[10] := myQBIN;
  294.          sP[11] := myCHKT;
  295.          sP[12] := 0C;   (* terminator *)
  296.          SendPacket (sP);
  297.       END youInit;
  298.  
  299.  
  300.    PROCEDURE myInit;
  301.    (* YOU initialize ME for Send and Receive *)
  302.  
  303.       VAR
  304.          len : INTEGER;
  305.  
  306.       BEGIN
  307.          len := UnChar (rP[1]);
  308.          IF len >= 4 THEN
  309.             yourMAXL := UnChar (rP[4]);
  310.          ELSE
  311.             yourMAXL := 94;
  312.          END;
  313.          IF len >= 5 THEN
  314.             yourTIME := UnChar (rP[5]);
  315.          ELSE
  316.             yourTIME := 10;
  317.          END;
  318.          IF len >= 6 THEN
  319.             yourNPAD := UnChar (rP[6]);
  320.          ELSE
  321.             yourNPAD := 0;
  322.          END;
  323.          IF len >= 7 THEN
  324.             yourPADC := CHAR (ByteXor (rP[7], 100C));
  325.          ELSE
  326.             yourPADC := 0C;
  327.          END;
  328.          IF len >= 8 THEN
  329.             yourEOL := CHR (UnChar (rP[8]));
  330.          ELSE
  331.             yourEOL := 0C;
  332.          END;
  333.          IF len >= 9 THEN
  334.             yourQCTL := rP[9];
  335.          ELSE
  336.             yourQCTL := 0C;
  337.          END;
  338.          IF len >= 10 THEN
  339.             yourQBIN := rP[10];
  340.          ELSE
  341.             yourQBIN := 0C;
  342.          END;
  343.          IF len >= 11 THEN
  344.             yourCHKT := rP[11];
  345.             IF yourCHKT # myCHKT THEN
  346.                yourCHKT := '1';
  347.             END;
  348.          ELSE
  349.             yourCHKT := '1';
  350.          END;
  351.       END myInit;
  352.  
  353.  
  354.    PROCEDURE SendInit;
  355.       BEGIN
  356.          youInit ('S');
  357.       END SendInit;
  358.  
  359.  
  360.    PROCEDURE SendFileName;
  361.  
  362.       VAR
  363.          i, j : INTEGER;
  364.  
  365.       BEGIN
  366.          (* send file name *)
  367.          i := 4;   j := 0;
  368.          WHILE sFname[j] # 0C DO
  369.             sP[i] := sFname[j];
  370.             INC (i);   INC (j);
  371.          END;
  372.          sP[1] := Char (j + 3);
  373.          sP[2] := Char (sSeq);
  374.          sP[3] := 'F';   (* filename packet *)
  375.          sP[i] := 0C;
  376.          SendPacket (sP);
  377.       END SendFileName;
  378.  
  379.  
  380.    PROCEDURE SendEOF;
  381.       BEGIN
  382.          sP[1] := Char (3);
  383.          sP[2] := Char (sSeq);
  384.          sP[3] := 'Z';   (* end of file *)
  385.          sP[4] := 0C;
  386.          SendPacket (sP);
  387.       END SendEOF;
  388.  
  389.  
  390.    PROCEDURE SendEOT;
  391.       BEGIN
  392.          sP[1] := Char (3);
  393.          sP[2] := Char (sSeq);
  394.          sP[3] := 'B';   (* break -- end of transmit *)
  395.          sP[4] := 0C;
  396.          SendPacket (sP);
  397.       END SendEOT;
  398.  
  399.  
  400.    PROCEDURE GetAck() : BOOLEAN;
  401.    (* Look for acknowledgement -- retry on timeouts or NAKs *)
  402.  
  403.       VAR
  404.          Type : CHAR;
  405.          Seq : INTEGER;
  406.          retrys : INTEGER;
  407.          AckOK : BOOLEAN;
  408.  
  409.       BEGIN
  410.          MP1.W1 := PAD_SendPacket;   MP1.W2 := 0;
  411.          MP2.W1 := PktNbr;   MP2.W2 := sSeq;
  412.          WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  413.  
  414.          retrys := MAXtrys;
  415.          LOOP
  416.             IF Aborted THEN
  417.                TellError (sSeq);
  418.                CloseInput;
  419.                ErrorQuit;
  420.             END;
  421.             IF ReceivePacket (rP) THEN
  422.                Seq := UnChar (rP[2]);
  423.                Type := rP[3];
  424.                IF (Seq = sSeq) AND (Type = 'Y') THEN
  425.                   AckOK := TRUE;
  426.                ELSIF (Seq = (sSeq + 1) MOD 64) AND (Type = 'N') THEN
  427.                   AckOK := TRUE;   (* NAK for (n + 1) taken as ACK for n *)
  428.                ELSIF Type = 'E' THEN
  429.                   ShowError (rP);
  430.                   AckOK := FALSE;
  431.                   retrys := 0;
  432.                ELSE
  433.                   AckOK := FALSE;
  434.                END;
  435.             ELSE
  436.                AckOK := FALSE;
  437.             END;
  438.             IF AckOK OR (retrys = 0) THEN
  439.                EXIT;
  440.             ELSE
  441.                MP1.W1 := PAD_ResendPacket;   MP1.W2 := 0;
  442.                MP2.W1 := PktNbr;   MP2.W2 := sSeq;
  443.                WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  444.  
  445.                DEC (retrys);
  446.                FlushUART;
  447.                SendPacket (sP);
  448.             END;
  449.          END;
  450.  
  451.          IF AckOK THEN
  452.             INC (PktNbr);
  453.             sSeq := (sSeq + 1) MOD 64;
  454.             RETURN TRUE;
  455.          ELSE
  456.             RETURN FALSE;
  457.          END;
  458.       END GetAck;
  459.  
  460.  
  461.    PROCEDURE GetInitAck() : BOOLEAN;
  462.    (* configuration for remote station *)
  463.       BEGIN
  464.          IF GetAck() THEN
  465.             myInit;
  466.             RETURN TRUE;
  467.          ELSE
  468.             RETURN FALSE;
  469.          END;
  470.       END GetInitAck;
  471.  
  472.  
  473.    PROCEDURE Send;
  474.    (* Send one or more files: sFname may be ambiguous *)
  475.  
  476.       TYPE
  477.          LP = POINTER TO LIST;   (* list of filenames *)
  478.          LIST = RECORD
  479.                    fn : ARRAY [0..20] OF CHAR;
  480.                    next : LP;
  481.                 END;
  482.  
  483.       VAR
  484.          gotFN : BOOLEAN;
  485.          attr : AttributeSet;
  486.          ent : DirectoryEntry;
  487.          front, back, t : LP;   (* add at back of queue, remove from front *)
  488.  
  489.       BEGIN
  490.          Aborted := FALSE;
  491.          InputFileOpen := FALSE;
  492.  
  493.          front := NIL;   back := NIL;
  494.          attr := AttributeSet {};   (* normal files only *)
  495.          IF Length (sFname) = 0 THEN
  496.             MP1.W1 := PAD_Msg;   MP1.W2 := 0;
  497.             MP2.L := LONGINT (ADR ("No file specified..."));
  498.             WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  499.             ErrorQuit;
  500.          ELSE
  501.             gotFN := FindFirst (sFname, attr, ent);
  502.             WHILE gotFN DO   (* build up a list of file names *)
  503.                ALLOCATE (t, SIZE (LIST));
  504.                Assign (ent.name, t^.fn);
  505.                t^.next := NIL;
  506.                IF front = NIL THEN
  507.                   front := t;   (* start from empty queue *)
  508.                ELSE
  509.                   back^.next := t;   (* and to back of queue *)
  510.                END;
  511.                back := t;
  512.                gotFN := FindNext (ent);
  513.             END;
  514.          END;
  515.  
  516.          IF front = NIL THEN
  517.             MP1.W1 := PAD_NoSuchFile;   MP1.W2 := 0;
  518.             MP2.L := LONGINT (ADR (sFname));
  519.             WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  520.             ErrorQuit;
  521.          ELSE
  522.             sSeq := 0;   PktNbr := 0;
  523.             FlushUART;
  524.             SendInit;   (* my configuration information *)
  525.             IF NOT GetInitAck() THEN     (* get your configuration information *)
  526.                MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
  527.                MP2.L := 0;
  528.                WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  529.                ErrorQuit;
  530.             END;
  531.  
  532.             WHILE front # NIL DO   (* send the files *)
  533.                Assign (front^.fn, sFname);
  534.                PktNbr := 1;
  535.                Send1;
  536.                t := front;
  537.                front := front^.next;
  538.                DEALLOCATE (t, SIZE (LIST));
  539.             END;
  540.          END;
  541.  
  542.          SendEOT;
  543.          IF NOT GetAck() THEN
  544.             MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
  545.             MP2.L := 0;
  546.             WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  547.             CloseInput;
  548.             ErrorQuit;
  549.          END;
  550.          NormalQuit;
  551.       END Send;
  552.  
  553.  
  554.    PROCEDURE Send1;
  555.    (* Send one file: sFname *)
  556.  
  557.       VAR
  558.          ch : CHAR;
  559.          i : INTEGER;
  560.  
  561.       BEGIN
  562.          IF Open (sF, sFname) = Done THEN
  563.             InputFileOpen := TRUE;
  564.          ELSE;
  565.             MP1.W1 := PAD_NoSuchFile;   MP1.W2 := 0;
  566.             MP2.L := LONGINT (ADR (sFname));
  567.             WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  568.             ErrorQuit;
  569.          END;
  570.  
  571.          MP1.W1 := PAD_Filename;   MP1.W2 := 0;
  572.          MP2.L := LONGINT (ADR (sFname));
  573.          WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  574.          MP1.W1 := PAD_Msg;   MP1.W2 := 0;
  575.          MP2.L := LONGINT (ADR ("(<ESC> to abort file transfer.)"));
  576.          WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  577.  
  578.          SendFileName;
  579.          IF NOT GetAck() THEN
  580.             MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
  581.             MP2.L := 0;
  582.             WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  583.             CloseInput;
  584.             ErrorQuit;
  585.          END;
  586.  
  587.          (* send file *)
  588.          i := 4;
  589.          LOOP
  590.             IF Get (sF, ch) = EOF THEN   (* send current packet & terminate *)
  591.                sP[1] := Char (i - 1);
  592.                sP[2] := Char (sSeq);
  593.                sP[3] := 'D';   (* data packet *)
  594.                sP[i] := 0C;   (* indicate end of packet *)
  595.                SendPacket (sP);
  596.                IF NOT GetAck() THEN
  597.                   MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
  598.                   MP2.L := 0;
  599.                   WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  600.                   CloseInput;
  601.                   ErrorQuit;
  602.                END;
  603.                SendEOF;
  604.                IF NOT GetAck() THEN
  605.                   MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
  606.                   MP2.L := 0;
  607.                   WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  608.                   CloseInput;
  609.                   ErrorQuit;
  610.                END;
  611.                EXIT;
  612.             END;
  613.  
  614.             IF i >= (yourMAXL - 4) THEN   (* send current packet *)
  615.                sP[1] := Char (i - 1);
  616.                sP[2] := Char (sSeq);
  617.                sP[3] := 'D';
  618.                sP[i] := 0C;
  619.                SendPacket (sP);
  620.                IF NOT GetAck() THEN
  621.                   MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
  622.                   MP2.L := 0;
  623.                   WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  624.                   CloseInput;
  625.                   ErrorQuit;
  626.                END;
  627.                i := 4;
  628.             END;
  629.  
  630.             (* add character to current packet -- update count *)
  631.             IF ch > 177C THEN   (* must be quoted (QBIN) and altered *)
  632.                (* toggle bit 7 to turn it off *)
  633.                ch := CHAR (ByteXor (ch, 200C));
  634.                sP[i] := myQBIN;   INC (i);
  635.             END;
  636.             IF (ch < 40C) OR (ch = 177C) THEN   (* quote (QCTL) and alter *)
  637.                (* toggle bit 6 to turn it on *)
  638.                ch := CHAR (ByteXor (ch, 100C));
  639.                sP[i] := myQCTL;   INC (i);
  640.             END;
  641.             IF (ch = myQCTL) OR (ch = myQBIN) THEN   (* must send it quoted *)
  642.                sP[i] := myQCTL;   INC (i);
  643.             END;
  644.             sP[i] := ch;   INC (i);
  645.          END;   (* loop *)
  646.  
  647.          CloseInput;
  648.       END Send1;
  649.  
  650.  
  651.    PROCEDURE ReceiveInit() : BOOLEAN;
  652.    (* receive my initialization information from you *)
  653.  
  654.       VAR
  655.          RecOK : BOOLEAN;
  656.          trys : INTEGER;
  657.  
  658.       BEGIN
  659.          trys := 1;
  660.          LOOP
  661.             IF Aborted THEN
  662.                TellError (rSeq);
  663.                ErrorQuit;
  664.             END;
  665.             RecOK := ReceivePacket (rP) AND (rP[3] = 'S');
  666.             IF RecOK OR (trys = MAXtrys) THEN
  667.                EXIT;
  668.             ELSE
  669.                INC (trys);
  670.                SendNak;
  671.             END;
  672.          END;
  673.  
  674.          IF RecOK THEN
  675.             myInit;
  676.             RETURN TRUE;
  677.          ELSE
  678.             RETURN FALSE;
  679.          END;
  680.       END ReceiveInit;
  681.  
  682.  
  683.    PROCEDURE SendInitAck;
  684.    (* acknowledge your initialization of ME and send mine for YOU *)
  685.       BEGIN
  686.          MP1.W1 := PAD_ReceivedPacket;   MP1.W2 := 0;
  687.          MP2.W1 := PktNbr;   MP2.W2 := rSeq;
  688.          WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  689.          INC (PktNbr);
  690.          rSeq := (rSeq + 1) MOD 64;
  691.          youInit ('Y');
  692.       END SendInitAck;
  693.  
  694.  
  695.    PROCEDURE ValidFileChar (VAR ch : CHAR) : BOOLEAN;
  696.    (* checks if character is one of 'A'..'Z', '0'..'9', makes upper case *)
  697.       BEGIN
  698.          ch := CAP (ch);
  699.          RETURN ((ch >= 'A') AND (ch <= 'Z')) OR ((ch >= '0') AND (ch <= '9'));
  700.       END ValidFileChar;
  701.  
  702.  
  703.    TYPE
  704.       HeaderType = (name, eot, fail);
  705.  
  706.    PROCEDURE ReceiveHeader() : HeaderType;
  707.    (* receive the filename -- alter for local conditions, if necessary *)
  708.  
  709.       VAR
  710.          i, j, k : INTEGER;
  711.          RecOK : BOOLEAN;
  712.          trys : INTEGER;
  713.  
  714.       BEGIN
  715.          trys := 1;
  716.          LOOP
  717.             IF Aborted THEN
  718.                TellError (rSeq);
  719.                ErrorQuit;
  720.             END;
  721.             RecOK := ReceivePacket (rP) AND ((rP[3] = 'F') OR (rP[3] = 'B'));
  722.             IF trys = MAXtrys THEN
  723.                RETURN fail;
  724.             ELSIF RecOK AND (rP[3] = 'F') THEN
  725.                i := 4;   (* data starts here *)
  726.                j := 0;   (* beginning of filename string *)
  727.                WHILE (ValidFileChar (rP[i])) AND (j < 8) DO
  728.                   rFname[j] := rP[i];
  729.                   INC (i);   INC (j);
  730.                END;
  731.                REPEAT
  732.                   INC (i);
  733.                UNTIL (ValidFileChar (rP[i])) OR (rP[i] = 0C);
  734.                rFname[j] := '.';   INC (j);
  735.                k := 0;
  736.                WHILE (ValidFileChar (rP[i])) AND (k < 3) DO
  737.                   rFname[j + k] := rP[i];
  738.                   INC (i);   INC (k);
  739.                END;
  740.                rFname[j + k] := 0C;
  741.                MP1.W1 := PAD_Filename;   MP1.W2 := 0;
  742.                MP2.L := LONGINT (ADR (rFname));
  743.                WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  744.                RETURN name;
  745.             ELSIF RecOK AND (rP[3] = 'B') THEN
  746.                RETURN eot;
  747.             ELSE
  748.                INC (trys);
  749.                SendNak;
  750.             END;
  751.          END;
  752.       END ReceiveHeader;
  753.  
  754.  
  755.    PROCEDURE SendNak;
  756.       BEGIN
  757.          MP1.W1 := PAD_RequestRepeat;   MP1.W2 := 0;
  758.          MP2.W1 := PktNbr;   MP2.W2 := rSeq;
  759.          WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  760.          FlushUART;
  761.          sP[1] := Char (3);   (* LEN *)
  762.          sP[2] := Char (rSeq);
  763.          sP[3] := 'N';   (* negative acknowledgement *)
  764.          sP[4] := 0C;
  765.          SendPacket (sP);
  766.       END SendNak;
  767.  
  768.  
  769.    PROCEDURE SendAck (Seq : INTEGER);
  770.       BEGIN
  771.          IF Seq # rSeq THEN
  772.             MP1.W1 := PAD_DuplicatePacket;   MP1.W2 := 0;
  773.             MP2.W1 := 0;   MP2.W2 := rSeq;
  774.             WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  775.          ELSE
  776.             MP1.W1 := PAD_ReceivedPacket;   MP1.W2 := 0;
  777.             MP2.W1 := PktNbr;   MP2.W2 := rSeq;
  778.             WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  779.             rSeq := (rSeq + 1) MOD 64;
  780.             INC (PktNbr);
  781.          END;
  782.  
  783.          sP[1] := Char (3);
  784.          sP[2] := Char (Seq);
  785.          sP[3] := 'Y';   (* acknowledgement *)
  786.          sP[4] := 0C;
  787.          SendPacket (sP);
  788.       END SendAck;
  789.  
  790.  
  791.    PROCEDURE Receive;
  792.    (* Receives a file  (or files) *)
  793.  
  794.       VAR
  795.          ch, Type : CHAR;
  796.          Seq : INTEGER;
  797.          i : INTEGER;
  798.          EOF, EOT, QBIN : BOOLEAN;
  799.          trys : INTEGER;
  800.  
  801.       BEGIN
  802.          Aborted := FALSE;
  803.  
  804.          MP1.W1 := PAD_Msg;   MP1.W2 := 0;
  805.          MP2.L := LONGINT (ADR ("Ready to receive file(s)..."));
  806.          WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  807.          MP1.W1 := PAD_Msg;   MP1.W2 := 0;
  808.          MP2.L := LONGINT (ADR ("(<ESC> to abort file transfer.)"));
  809.          WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  810.  
  811.          FlushUART;
  812.          rSeq := 0;   PktNbr := 0;
  813.          IF NOT ReceiveInit() THEN   (* your configuration information *)
  814.             MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
  815.             MP2.L := 0;
  816.             WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  817.             ErrorQuit;
  818.          END;
  819.          SendInitAck;       (* send my configuration information *)
  820.          EOT := FALSE;
  821.          WHILE NOT EOT DO
  822.             CASE ReceiveHeader() OF
  823.                eot  : EOT := TRUE;   EOF := TRUE;
  824.             |  name : IF Create (rF, rFname) # Done THEN
  825.                          MP1.W1 := PAD_UnableToOpen;   MP1.W2 := 0;
  826.                          MP2.L := LONGINT (ADR (rFname));
  827.                          WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  828.                          ErrorQuit;
  829.                       ELSE
  830.                          PktNbr := 1;
  831.                          EOF := FALSE;
  832.                       END;
  833.             |  fail : MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
  834.                       MP2.L := 0;
  835.                       WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  836.                       ErrorQuit;
  837.             END;
  838.             SendAck (rSeq);   (* acknowledge for name or eot *)
  839.             trys := 1;   (* initialize *)
  840.             WHILE NOT EOF DO
  841.                IF Aborted THEN
  842.                   TellError (rSeq);
  843.                   ErrorQuit;
  844.                END;
  845.                IF ReceivePacket (rP) THEN
  846.                   Seq := UnChar (rP[2]);
  847.                   Type := rP[3];
  848.                   IF Type = 'Z' THEN
  849.                      EOF := TRUE;
  850.                      IF CloseFile (rF, Output) = Done THEN
  851.                         (* normal file termination *)
  852.                      ELSE
  853.                         MP1.W1 := PAD_ProbClDestFile;   MP1.W2 := 0;
  854.                         MP2.L := LONGINT (ADR (rFname));
  855.                         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  856.                         ErrorQuit;
  857.                      END;
  858.                      trys := 1;   (* good packet -- reset *)
  859.                      SendAck (rSeq);
  860.                   ELSIF Type = 'E' THEN
  861.                      ShowError (rP);
  862.                      ErrorQuit;
  863.                   ELSIF (Type = 'D') AND ((Seq + 1) MOD 64 = rSeq) THEN
  864.                   (* discard duplicate packet, and Ack anyway *)
  865.                      trys := 1;
  866.                      SendAck (Seq);
  867.                   ELSIF (Type = 'D') AND (Seq = rSeq) THEN
  868.                      (* put packet into file buffer *)
  869.                      i := 4;   (* first data in packet *)
  870.                      WHILE rP[i] # 0C DO
  871.                         ch := rP[i];   INC (i);
  872.                         IF ch = yourQBIN THEN
  873.                            ch := rP[i];   INC (i);
  874.                            QBIN := TRUE;
  875.                         ELSE
  876.                            QBIN := FALSE;
  877.                         END;
  878.                         IF ch = yourQCTL THEN
  879.                            ch := rP[i];   INC (i);
  880.                            IF (ch # yourQCTL) AND (ch # yourQBIN) THEN
  881.                               ch := CHAR (ByteXor (ch, 100C));
  882.                            END;
  883.                         END;
  884.                         IF QBIN THEN
  885.                            ch := CHAR (ByteXor (ch, 200C));
  886.                         END;
  887.                         Put (ch);
  888.                      END;
  889.  
  890.                      (* write file buffer to disk *)
  891.                      IF DoWrite (rF) # Done THEN
  892.                         MP1.W1 := PAD_ErrWrtFile;   MP1.W2 := 0;
  893.                         MP2.L := LONGINT (ADR (rFname));
  894.                         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  895.                         ErrorQuit;
  896.                      END;
  897.                      trys := 1;
  898.                      SendAck (rSeq);
  899.                   ELSE
  900.                      INC (trys);
  901.                      IF trys = MAXtrys THEN
  902.                         MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
  903.                         MP2.L := 0;
  904.                         WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  905.                         ErrorQuit;
  906.                      ELSE
  907.                         SendNak;
  908.                      END;
  909.                   END;
  910.                ELSE
  911.                   INC (trys);
  912.                   IF trys = MAXtrys THEN
  913.                      MP1.W1 := PAD_ExcessiveErrors;   MP1.W2 := 0;
  914.                      MP2.L := 0;
  915.                      WinPostMsg (ChildFrameWindow, WM_PAD, MP1, MP2);
  916.                      ErrorQuit;
  917.                   ELSE
  918.                      SendNak;
  919.                   END;
  920.                END;
  921.             END;
  922.          END;
  923.          NormalQuit;
  924.       END Receive;
  925.  
  926.  
  927. BEGIN   (* module initialization *)
  928.    yourEOL := ASCII.cr;
  929.    yourNPAD := 0;
  930.    yourPADC := 0C;
  931. END PAD.
  932.