Topspeed_JPI/TS-V3/SRC/WXMODEM.LST

Listing:

    1  (* Release 3.10 *)
    2  (*-------------------------------------------------------------------------*
    3  *                                                                          *
    4  *  WXMODEM.MOD - COMMS Toolkit file protocols                              *
    5  *                                                                          *
    6  *  COPYRIGHT (C) 1988..1992 Clarion Software Corporation.                  *
    7  *  All Rights Reserved                                                     *
    8  *                                                                          *
    9  *--------------------------------------------------------------------------*)
   10  
   11  IMPLEMENTATION MODULE WXModem;
   12    IMPORT CommUtil,FIO,FTSupport,Lib,RS232,Str;
   13    FROM FTSupport        IMPORT ACK,NAK,SOH,EOT,CAN,SYN,WNDREQ;
*****         ^ duplicate identifier
   14  
   15    CONST
   16      DLE                 = CHR(16);
*****                            ^ undeclared identifier
*****                                  ^ not supported yet
   17      XON                 = CHR(17);
*****                            ^ undeclared identifier
*****                                  ^ not supported yet
   18      XOFF                = CHR(19);
*****                            ^ undeclared identifier
*****                                  ^ not supported yet
   19  
   20    VAR
   21      f                   : FIO.File;
*****                                ^ not supported yet
   22      Response            : ARRAY[0..1] OF CHAR;
*****                                     ^ not supported yet
*****                                           ^ not supported yet
   23      LastBlockNo,BlockNo,
   24      BlockSize           : CARDINAL;
   25  
   26  (*..................................................*)
   27  
   28    PROCEDURE InitVars(VAR Filename:ARRAY OF CHAR);
*****                                             ^ not supported yet
   29      BEGIN
   30        FTSupport.Errors:=0;
*****        ^ not supported yet
*****                  ^ not supported yet
   31        FTSupport.LastMessage:='';
*****        ^ not supported yet
*****                  ^ not supported yet
   32        FTSupport.XferMode := 'CRC';
*****        ^ not supported yet
*****                  ^ not supported yet
*****                              ^ not supported yet
   33        FTSupport.Transferred:=0;
*****        ^ not supported yet
*****                  ^ not supported yet
   34        FTSupport.Aborted := FALSE;
*****        ^ not supported yet
*****                  ^ not supported yet
   35        FTSupport.SizeInBytes:=0;
*****        ^ not supported yet
*****                  ^ not supported yet
   36        Str.Copy(FTSupport.FileSpec,Filename);
*****        ^ not supported yet
*****            ^ not supported yet
*****                 ^ not supported yet
*****                           ^ not supported yet
*****                                    ^ not supported yet
   37        BlockNo:=1;
   38        LastBlockNo:=0FFFFH;
   39        BlockSize:=128;
   40      END InitVars;
*****          ^ not supported yet
   41  
   42  (*...............................................*)
   43  
   44    PROCEDURE SendResponse;
   45      BEGIN
   46        IF (Response[0]=ACK) OR (Response[0]=NAK) THEN
*****            ^ not supported yet
*****                      ^ not supported yet
*****                        ^ not supported yet
*****                                 ^ not supported yet
*****                                           ^ not supported yet
*****                                             ^ not supported yet
   47          Response[1] := CHR(ORD(Response[1]) MOD 4);
*****          ^ not supported yet
*****                    ^ not supported yet
*****                         ^ undeclared identifier
*****                             ^ undeclared identifier
*****                                 ^ not supported yet
*****                                           ^ not supported yet
*****                                                   ^ not supported yet
   48          RS232.SerialWrite(Response,2)
*****          ^ not supported yet
*****                ^ not supported yet
*****                            ^ not supported yet
*****                                      ^ not supported yet
   49        ELSIF Response[0]<>0C THEN
*****              ^ not supported yet
*****                        ^ not supported yet
   50          RS232.SerialWrite(Response,1)
*****          ^ not supported yet
*****                ^ not supported yet
*****                            ^ not supported yet
*****                                      ^ not supported yet
   51        END;
   52      END SendResponse;
*****          ^ not supported yet
   53  
   54  (*...............................................*)
   55  
   56    PROCEDURE RcvNoDLE(VAR c:CHAR; Timeout:CARDINAL):BOOLEAN;
   57      (* Strip DLE sequences from incoming data *)
   58      BEGIN
   59        IF RS232.SerialRead(c,Timeout) THEN
*****           ^ not supported yet
*****                 ^ not supported yet
*****                                     ^ not supported yet
   60          IF c=DLE THEN
   61            IF RS232.SerialRead(c,Timeout) THEN
*****               ^ not supported yet
*****                     ^ not supported yet
*****                                         ^ not supported yet
   62              c := CHR(CARDINAL(BITSET(ORD(c))/BITSET(64)))
*****                   ^ undeclared identifier
*****                                ^ undeclared identifier
*****                                       ^ undeclared identifier
*****                                            ^ not supported yet
*****                                               ^ undeclared identifier
*****                                                        ^ not supported yet
   63            ELSE
   64              RETURN FALSE;
   65            END;
   66          END;
   67          RETURN TRUE;
   68        ELSE
   69          RETURN FALSE;
   70        END;
   71      END RcvNoDLE;
*****          ^ not supported yet
   72  
   73  (*...............................................*)
   74  
   75    PROCEDURE ReceiveData():CARDINAL;
   76      (* Attempt to receive a single packet, returning an error code. Zero *)
   77      (* means that a packet was successfully received.                    *)
   78      VAR
   79        c                 : CHAR;
   80        RxBlk,CRC,RxCRC,
   81        Result,Cnt,
   82        CRCIndex          : CARDINAL;
   83        RxState           : (Start,Blk,Compl,Data,CRCH,CRCL);
*****                                                           ^ not supported yet
   84      BEGIN
   85        (* Already had the first character - SYN *)
   86        RxState:=Start;
*****        ^ not supported yet
*****                 ^ not supported yet
   87        CRC:=0;
   88        Cnt:=0;
   89        Result:=0;
   90        LOOP
   91          IF FTSupport.AbortRequested() THEN
*****             ^ not supported yet
*****                       ^ not supported yet
*****                                      ^ not supported yet
   92            RETURN(128+6);
   93          END;
   94          IF NOT RcvNoDLE(c,50) THEN
*****                 ^ not supported yet
*****                              ^ not supported yet
   95            FTSupport.LastMessage := 'Timeout';
*****            ^ not supported yet
*****                      ^ not supported yet
*****                                     ^ not supported yet
   96            RETURN(3);
   97          END;
   98          CASE RxState OF
*****               ^ not supported yet
   99            Start         : IF c=SOH THEN
*****            ^ not supported yet
*****                                 ^ not supported yet
  100                              RxState:=Blk;
*****                              ^ not supported yet
*****                                       ^ not supported yet
  101                              BlockSize:=128
  102                            ELSIF c=EOT THEN
*****                                    ^ not supported yet
  103                              RETURN 127;
  104                            END;                                            |
  105            Blk           : RxBlk := ORD(c);
*****            ^ not supported yet
*****                                     ^ undeclared identifier
*****                                          ^ not supported yet
  106                            RxState := Compl;                               |
*****                            ^ not supported yet
*****                                       ^ not supported yet
  107            Compl         : IF 255-ORD(c)<>RxBlk THEN
*****            ^ not supported yet
*****                                   ^ undeclared identifier
*****                                        ^ not supported yet
  108                              FTSupport.LastMessage:='Bad Block No';
*****                              ^ not supported yet
*****                                        ^ not supported yet
*****                                                     ^ not supported yet
  109                              RETURN 11;
  110                            ELSIF RxBlk=BlockNo THEN
  111                              RxState := Data;
*****                              ^ not supported yet
*****                                         ^ not supported yet
  112                            ELSE
  113                              Result := 15;
  114                              FTSupport.LastMessage := 'Block Resent';
*****                              ^ not supported yet
*****                                        ^ not supported yet
*****                                                       ^ not supported yet
  115                              RxState := Data;
*****                              ^ not supported yet
*****                                         ^ not supported yet
  116                            END;                                            |
  117            Data          : FTSupport.FBuff[Cnt] := c;
*****            ^ not supported yet
*****                            ^ not supported yet
*****                                      ^ not supported yet
*****                                               ^ not supported yet
  118                            CRCIndex := CARDINAL(BITSET(CRC>>8)/BITSET(ORD(c)));
*****                                                 ^ undeclared identifier
*****                                                              ^ not supported yet
*****                                                                ^ undeclared identifier
*****                                                                       ^ undeclared identifier
*****                                                                            ^ not supported yet
  119                            CRC := CARDINAL(BITSET(FTSupport.CRCTable[CRCIndex])/BITSET(CRC<<8));
*****                                            ^ undeclared identifier
*****                                                   ^ not supported yet
*****                                                             ^ not supported yet
*****                                                                              ^ not supported yet
*****                                                                                 ^ undeclared identifier
*****                                                                                              ^ not supported yet
  120                            INC(Cnt);
*****                            ^ undeclared identifier
*****                                   ^ not supported yet
  121                            IF Cnt=BlockSize THEN
  122                              RxState:=CRCH;
*****                              ^ not supported yet
*****                                       ^ not supported yet
  123                            END;                                            |
  124            CRCH          : RxCRC := ORD(c)<<8;
*****            ^ not supported yet
*****                                     ^ undeclared identifier
*****                                          ^ not supported yet
*****                                             ^ arithmetic operand must be numeric
  125                            RxState := CRCL;                                |
*****                            ^ not supported yet
*****                                       ^ not supported yet
  126            CRCL          : RxCRC := RxCRC+ORD(c);
*****            ^ not supported yet
*****                                           ^ undeclared identifier
*****                                                ^ not supported yet
  127                            IF CRC=RxCRC THEN
  128                              RETURN Result
  129                            ELSE
  130                              FTSupport.LastMessage := 'Bad CRC';
*****                              ^ not supported yet
*****                                        ^ not supported yet
*****                                                       ^ not supported yet
  131                              RETURN 9;
  132                            END;                                            |
  133          END; (* case *)
  134        END; (* loop *)
  135      END ReceiveData;
*****          ^ not supported yet
  136  
  137  (*...............................................*)
  138  
  139    PROCEDURE WXMReceive():CARDINAL;
  140      VAR
  141        c                 : CHAR;
  142        Result            : CARDINAL;
  143        IncomingData,
  144        Negotiating,
  145        EndOfFile         : BOOLEAN;
  146      BEGIN
  147        Negotiating:=TRUE;
  148        EndOfFile:=FALSE;
  149        REPEAT
  150          IncomingData := FALSE;
  151          REPEAT
  152            FTSupport.UpdateStatus;
*****            ^ not supported yet
*****                      ^ not supported yet
  153            IF FTSupport.AbortRequested() THEN
*****               ^ not supported yet
*****                         ^ not supported yet
*****                                        ^ not supported yet
  154              RETURN(6);
  155            END;
  156            LOOP
  157              SendResponse;
*****              ^ not supported yet
  158              IF RS232.SerialRead(c,150) THEN
*****                 ^ not supported yet
*****                       ^ not supported yet
*****                                       ^ not supported yet
  159                IF (c=SYN) OR (c=EOT) THEN
*****                      ^ not supported yet
*****                                 ^ not supported yet
  160                  FTSupport.LastMessage:='';
*****                  ^ not supported yet
*****                            ^ not supported yet
  161                  Negotiating:=FALSE;
  162                  IncomingData := TRUE;
  163                  EXIT;
  164                END
  165              ELSE
  166                FTSupport.LastMessage := 'Timeout';
*****                ^ not supported yet
*****                          ^ not supported yet
*****                                         ^ not supported yet
  167                INC(FTSupport.Errors);
*****                ^ undeclared identifier
*****                    ^ not supported yet
*****                              ^ not supported yet
  168                IF (FTSupport.Errors>1) THEN
*****                    ^ not supported yet
*****                              ^ not supported yet
  169                  IF Negotiating THEN
  170                    RETURN(1);
  171                  ELSE
  172                    RETURN(2);
  173                  END;
  174                END;
  175                EXIT;
  176              END;
  177            END;
  178          UNTIL IncomingData;
  179          IF c=EOT THEN
*****               ^ not supported yet
  180            Result := 127
  181          ELSE
  182            Result := ReceiveData();
*****                      ^ not supported yet
*****                                  ^ not supported yet
  183          END;
  184          IF Result=127 (* end of file *) THEN
  185            FTSupport.LastMessage := 'End of File';
*****            ^ not supported yet
*****                      ^ not supported yet
*****                                     ^ not supported yet
  186            EndOfFile := TRUE;
  187            Response[0]:=ACK;
*****            ^ not supported yet
*****                      ^ not supported yet
*****                         ^ not supported yet
  188            RS232.SerialWrite(Response,1)
*****            ^ not supported yet
*****                  ^ not supported yet
*****                              ^ not supported yet
*****                                        ^ not supported yet
  189          ELSIF Result=0 THEN  (* good block received *)
  190            Response[0]:=ACK;
*****            ^ not supported yet
*****                      ^ not supported yet
*****                         ^ not supported yet
  191            Response[1]:=CHR(BlockNo);
*****            ^ not supported yet
*****                      ^ not supported yet
*****                         ^ undeclared identifier
*****                                    ^ not supported yet
  192            LastBlockNo := BlockNo;
  193            BlockNo := (BlockNo+1) MOD 100H;
  194            FIO.WrBin(f,FTSupport.FBuff,BlockSize);
*****            ^ not supported yet
*****                ^ not supported yet
*****                      ^ not supported yet
*****                        ^ not supported yet
*****                                  ^ not supported yet
*****                                                 ^ not supported yet
  195            IF FIO.IOresult()<>0 THEN
*****               ^ not supported yet
*****                   ^ not supported yet
*****                            ^ not supported yet
  196              FTSupport.LastMessage := 'Disk Write Error';
*****              ^ not supported yet
*****                        ^ not supported yet
*****                                       ^ not supported yet
  197              FTSupport.UpdateStatus;
*****              ^ not supported yet
*****                        ^ not supported yet
  198              RETURN(4);
  199            END;
  200            FTSupport.Transferred := FTSupport.Transferred+LONGCARD(BlockSize);
*****            ^ not supported yet
*****                      ^ not supported yet
*****                                     ^ not supported yet
*****                                               ^ not supported yet
*****                                                           ^ undeclared identifier
*****                                                                             ^ not supported yet
  201            FTSupport.Errors:=0;
*****            ^ not supported yet
*****                      ^ not supported yet
  202            FTSupport.LastMessage:='';
*****            ^ not supported yet
*****                      ^ not supported yet
  203            FTSupport.UpdateStatus;
*****            ^ not supported yet
*****                      ^ not supported yet
  204          ELSIF Result=15 THEN (* Sender resent a block - ignore *)
  205            Response[0] := 0C;
*****            ^ not supported yet
*****                      ^ not supported yet
  206            FTSupport.Errors := 0;
*****            ^ not supported yet
*****                      ^ not supported yet
  207            FTSupport.LastMessage := '';
*****            ^ not supported yet
*****                      ^ not supported yet
  208            FTSupport.UpdateStatus;
*****            ^ not supported yet
*****                      ^ not supported yet
  209          ELSE                 (* protocol error of some kind *)
  210            INC(FTSupport.Errors);
*****            ^ undeclared identifier
*****                ^ not supported yet
*****                          ^ not supported yet
  211            FTSupport.UpdateStatus;
*****            ^ not supported yet
*****                      ^ not supported yet
  212            IF Result>127 (* fatal *) THEN
  213              FTSupport.Aborted := TRUE;
*****              ^ not supported yet
*****                        ^ not supported yet
  214              RETURN(Result MOD 100H)
  215            END;
  216            Response[0]:=NAK;
*****            ^ not supported yet
*****                      ^ not supported yet
*****                         ^ not supported yet
  217            Response[1]:=CHR(BlockNo);
*****            ^ not supported yet
*****                      ^ not supported yet
*****                         ^ undeclared identifier
*****                                    ^ not supported yet
  218            IF FTSupport.Errors>5 (* too many *) THEN RETURN(Result) END;
*****               ^ not supported yet
*****                         ^ not supported yet
  219          END;
  220        UNTIL EndOfFile OR FTSupport.Aborted;
*****                           ^ not supported yet
*****                                     ^ not supported yet
  221        IF FTSupport.Aborted THEN
*****           ^ not supported yet
*****                     ^ not supported yet
  222          RETURN(6);
  223        ELSE
  224          RETURN(0);
  225        END;
  226      END WXMReceive;
*****          ^ not supported yet
  227  
  228  (*...............................................*)
  229  
  230    PROCEDURE WXModemReceive(VAR Filename:ARRAY OF CHAR):CARDINAL;
*****                                                   ^ not supported yet
  231      VAR
  232        Result            : CARDINAL;
  233      BEGIN
  234        InitVars(Filename);
*****        ^ not supported yet
*****                 ^ not supported yet
  235        FTSupport.CompleteFilename;
*****        ^ not supported yet
*****                  ^ not supported yet
  236        f := FIO.Create(Filename);
*****        ^ not supported yet
*****             ^ not supported yet
*****                 ^ not supported yet
*****                        ^ not supported yet
  237        IF FIO.IOresult()=0 THEN
*****           ^ not supported yet
*****               ^ not supported yet
*****                        ^ not supported yet
  238          FTSupport.OpenStatusWindow('WXModem Download');
*****          ^ not supported yet
*****                    ^ not supported yet
*****                                     ^ not supported yet
  239          FTSupport.NewFilename;
*****          ^ not supported yet
*****                    ^ not supported yet
  240          Response := WNDREQ;
*****          ^ not supported yet
*****                      ^ not supported yet
  241          Result := WXMReceive();
*****                    ^ not supported yet
*****                               ^ not supported yet
  242          FIO.Close(f);
*****          ^ not supported yet
*****              ^ not supported yet
*****                    ^ not supported yet
  243          IF FTSupport.Aborted THEN
*****             ^ not supported yet
*****                       ^ not supported yet
  244            FTSupport.Cancel;
*****            ^ not supported yet
*****                      ^ not supported yet
  245          END;
  246          FTSupport.CloseStatusWindow;
*****          ^ not supported yet
*****                    ^ not supported yet
  247          RETURN Result
  248        ELSE
  249          CommUtil.ErrorMessage('Could not open file!');
*****          ^ not supported yet
*****                   ^ not supported yet
*****                                ^ not supported yet
  250          RETURN 12;
  251        END;
  252      END WXModemReceive;
*****          ^ not supported yet
  253  
  254  (*..................................................*)
  255  
  256    PROCEDURE GetResponse(VAR c:CHAR):CARDINAL;
  257      VAR
  258        CANCount          : CARDINAL;
  259        GotResponse       : BOOLEAN;
  260      BEGIN
  261        CANCount := 0;
  262        REPEAT
  263          IF FTSupport.AbortRequested() THEN
*****             ^ not supported yet
*****                       ^ not supported yet
*****                                      ^ not supported yet
  264            RETURN(6);
  265          END;
  266          GotResponse := RS232.SerialRead(c,100);
*****                         ^ not supported yet
*****                               ^ not supported yet
*****                                               ^ not supported yet
  267          IF GotResponse THEN
  268            IF c=CAN THEN
*****                 ^ not supported yet
  269              INC(CANCount);
*****              ^ undeclared identifier
*****                          ^ not supported yet
  270              IF CANCount=3 THEN
  271                RETURN(13);
  272              END;
  273            END
  274          ELSE
  275            FTSupport.LastMessage := 'Timeout';
*****            ^ not supported yet
*****                      ^ not supported yet
*****                                     ^ not supported yet
  276            INC(FTSupport.Errors);
*****            ^ undeclared identifier
*****                ^ not supported yet
*****                          ^ not supported yet
  277            FTSupport.UpdateStatus;
*****            ^ not supported yet
*****                      ^ not supported yet
  278            IF FTSupport.Errors=5 THEN
*****               ^ not supported yet
*****                         ^ not supported yet
  279              RETURN(2);
  280            END;
  281          END;
  282        UNTIL GotResponse AND ((c=NAK) OR (c=ACK) OR (c=WNDREQ));
*****                                  ^ not supported yet
*****                                             ^ not supported yet
*****                                                        ^ not supported yet
  283        FTSupport.LastMessage := '';
*****        ^ not supported yet
*****                  ^ not supported yet
  284        FTSupport.UpdateStatus;
*****        ^ not supported yet
*****                  ^ not supported yet
  285        RETURN 0;
  286      END GetResponse;
*****          ^ not supported yet
  287  
  288  (*..................................................*)
  289  
  290    PROCEDURE SendBlock(VAR Block:ARRAY OF CHAR; BlockNo:CARDINAL);
*****                                           ^ not supported yet
  291      (* Send a block out the serial port while calculating a CRC in       *)
  292      (* parallel, then send the CRC.                                      *)
  293      VAR
  294        i,TxCRC,CRC       : CARDINAL;
  295  
  296  (*. . . . . . . . . . . . . . . . . . . . . . . .*)
  297  
  298      PROCEDURE Send(c:CHAR);
  299        VAR
  300          CRCIndex        : CARDINAL;
  301        BEGIN
  302          CRCIndex := CARDINAL(BITSET(CRC>>8)/BITSET(ORD(c)));
*****                               ^ undeclared identifier
*****                                            ^ not supported yet
*****                                              ^ undeclared identifier
*****                                                     ^ undeclared identifier
*****                                                          ^ not supported yet
  303          CRC := CARDINAL(BITSET(FTSupport.CRCTable[CRCIndex])/BITSET(CRC<<8));
*****                          ^ undeclared identifier
*****                                 ^ not supported yet
*****                                           ^ not supported yet
*****                                                            ^ not supported yet
*****                                                               ^ undeclared identifier
*****                                                                            ^ not supported yet
  304          IF (c=DLE) OR (c=SYN) OR (c=XON) OR (c=XOFF) THEN
*****                           ^ not supported yet
  305            RS232.SerialWrite(DLE,1);
*****            ^ not supported yet
*****                  ^ not supported yet
*****                                   ^ not supported yet
  306            c := CHR(CARDINAL(BITSET(ORD(c))/BITSET(64)))
*****                 ^ undeclared identifier
*****                              ^ undeclared identifier
*****                                     ^ undeclared identifier
*****                                          ^ not supported yet
*****                                             ^ undeclared identifier
*****                                                      ^ not supported yet
  307          END;
  308          RS232.SerialWrite(c,1);
*****          ^ not supported yet
*****                ^ not supported yet
*****                               ^ not supported yet
  309        END Send;
*****            ^ not supported yet
  310  
  311  (*. . . . . . . . . . . . . . . . . . . . . . . .*)
  312  
  313      BEGIN (* SendBlock *)
  314        RS232.SerialWrite(SYN,1);
*****        ^ not supported yet
*****              ^ not supported yet
*****                          ^ not supported yet
*****                               ^ not supported yet
  315        RS232.SerialWrite(SYN,1);
*****        ^ not supported yet
*****              ^ not supported yet
*****                          ^ not supported yet
*****                               ^ not supported yet
  316        RS232.SerialWrite(SOH,1);
*****        ^ not supported yet
*****              ^ not supported yet
*****                          ^ not supported yet
*****                               ^ not supported yet
  317        Send(CHR(BlockNo));
*****        ^ not supported yet
*****             ^ undeclared identifier
*****                        ^ not supported yet
  318        Send(CHR(255-BlockNo));
*****        ^ not supported yet
*****             ^ undeclared identifier
*****                            ^ not supported yet
  319        CRC := 0;
  320        FOR i:=0 TO 127 DO
  321          Send(Block[i]);
*****          ^ not supported yet
*****               ^ not supported yet
*****                      ^ not supported yet
  322        END;
  323        TxCRC := CRC;
  324        Send(CHR(TxCRC DIV 100H));
*****        ^ not supported yet
*****             ^ undeclared identifier
*****                               ^ not supported yet
  325        Send(CHR(TxCRC MOD 100H));
*****        ^ not supported yet
*****             ^ undeclared identifier
*****                               ^ not supported yet
  326      END SendBlock;
*****          ^ not supported yet
  327  
  328  (*..................................................*)
  329  
  330    PROCEDURE GetStartChar(VAR c:CHAR):CARDINAL;
  331      VAR
  332        Result            : CARDINAL;
  333      BEGIN
  334        REPEAT
  335          Result := GetResponse(c);
*****                    ^ not supported yet
*****                                 ^ not supported yet
  336          IF Result<>0 THEN
  337            RETURN(Result);
  338          END;
  339        UNTIL (c=WNDREQ);
*****                 ^ not supported yet
  340        RS232.FlushInBuf;
*****        ^ not supported yet
*****              ^ not supported yet
  341        RETURN 0;
  342      END GetStartChar;
*****          ^ not supported yet
  343  
  344  (*..................................................*)
  345  
  346    PROCEDURE WXMSend():CARDINAL;
  347      CONST
  348        WindowSize        = 4;
  349      VAR
  350        c,Resp            : CHAR;
  351        Result,BytesRead,
  352        BlockNo,LastAcked : CARDINAL;
  353        Buffer            : ARRAY[0..127] OF CHAR;
*****                                     ^ not supported yet
*****                                             ^ not supported yet
  354  
  355  (*. . . . . . . . . . . . . . . . . . . . . . . . .*)
  356  
  357      PROCEDURE CheckWindow(Resp,c:CHAR):CARDINAL;
  358        VAR
  359          Temp            : CARDINAL;
  360        BEGIN
  361          Temp := LastAcked;
  362          WHILE ((LastAcked+1) MOD 4)<>ORD(c) DO
*****                                       ^ undeclared identifier
*****                                            ^ not supported yet
  363            INC(LastAcked);
*****            ^ undeclared identifier
*****                         ^ not supported yet
  364          END;
  365          IF Resp=ACK THEN
*****                  ^ not supported yet
  366            INC(LastAcked);
*****            ^ undeclared identifier
*****                         ^ not supported yet
  367          END;
  368          IF LastAcked>BlockNo THEN
  369            (* got ACK for block I havent sent yet!! (eg double ack), forget it *)
  370            LastAcked := Temp;
  371            RETURN 0;
  372          END;
  373          IF Resp=NAK THEN
*****                  ^ not supported yet
  374            FTSupport.LastMessage := 'Got NAK';
*****            ^ not supported yet
*****                      ^ not supported yet
*****                                     ^ not supported yet
  375            BlockNo:=LastAcked+1;
  376            FIO.Seek(f,128*LONGCARD(BlockNo-1));
*****            ^ not supported yet
*****                ^ not supported yet
*****                     ^ not supported yet
*****                           ^ undeclared identifier
*****                                             ^ not supported yet
  377            INC(FTSupport.Errors);
*****            ^ undeclared identifier
*****                ^ not supported yet
*****                          ^ not supported yet
  378            IF FTSupport.Errors=10 THEN
*****               ^ not supported yet
*****                         ^ not supported yet
  379              FTSupport.Aborted := TRUE;
*****              ^ not supported yet
*****                        ^ not supported yet
  380              RETURN(6)
  381            END;
  382          ELSE
  383            FTSupport.Errors := 0;
*****            ^ not supported yet
*****                      ^ not supported yet
  384            FTSupport.LastMessage := '';
*****            ^ not supported yet
*****                      ^ not supported yet
  385          END;
  386          FTSupport.Transferred := LONGCARD(LastAcked)*128;
*****          ^ not supported yet
*****                    ^ not supported yet
*****                                   ^ undeclared identifier
*****                                                     ^ not supported yet
  387          FTSupport.UpdateStatus;
*****          ^ not supported yet
*****                    ^ not supported yet
  388          RETURN 0;
  389        END CheckWindow;
*****            ^ not supported yet
  390  
  391  (*. . . . . . . . . . . . . . . . . . . . . . . . .*)
  392  
  393      BEGIN (* WXMSend *)
  394        Result := GetStartChar(c);
*****                  ^ not supported yet
*****                                ^ not supported yet
  395        IF Result<>0 THEN
  396          RETURN(Result);
  397        END;
  398        LastAcked := 0;
  399        BlockNo := 1;
  400        FTSupport.UpdateStatus;
*****        ^ not supported yet
*****                  ^ not supported yet
  401        WHILE NOT FIO.EOF DO
*****                  ^ not supported yet
*****                      ^ not supported yet
  402          WHILE BlockNo-LastAcked>=WindowSize DO
  403            FTSupport.UpdateStatus;
*****            ^ not supported yet
*****                      ^ not supported yet
  404            REPEAT
  405              REPEAT
  406                Result := GetResponse(c);
*****                          ^ not supported yet
*****                                       ^ not supported yet
  407                IF (Result<>0) AND (Result<>2) THEN
  408                  RETURN(Result); (* dont return on timeout *)
  409                END;
  410              UNTIL (c=ACK) OR (c=NAK) OR (Result=2);
*****                       ^ not supported yet
*****                                  ^ not supported yet
  411              IF Result=0 THEN
  412                Resp:=c;
  413                IF NOT RS232.SerialRead(c,150) THEN
*****                       ^ not supported yet
*****                             ^ not supported yet
*****                                             ^ not supported yet
  414                  Result:=2;
  415                END;
  416              END;
  417            UNTIL (ORD(c)>=0) AND (ORD(c)<=3) OR (Result=2);
*****                   ^ undeclared identifier
*****                        ^ not supported yet
*****                                   ^ undeclared identifier
*****                                        ^ not supported yet
  418            IF Result=0 THEN
  419              Result := CheckWindow(Resp,c);
*****                        ^ not supported yet
*****                                          ^ not supported yet
  420              IF Result<>0 THEN
  421                RETURN(Result);
  422              END;
  423            ELSE
  424              (* handle timeout by resending last block *)
  425              DEC(BlockNo);
*****              ^ undeclared identifier
*****                         ^ not supported yet
  426              FIO.Seek(f,128*LONGCARD(BlockNo-1));
*****              ^ not supported yet
*****                  ^ not supported yet
*****                       ^ not supported yet
*****                             ^ undeclared identifier
*****                                               ^ not supported yet
  427            END;
  428          END;
  429          BytesRead := FIO.RdBin(f,Buffer,128);
*****                       ^ not supported yet
*****                           ^ not supported yet
*****                                 ^ not supported yet
*****                                   ^ not supported yet
*****                                             ^ not supported yet
  430          IF FIO.IOresult()<>0 THEN
*****             ^ not supported yet
*****                 ^ not supported yet
*****                          ^ not supported yet
  431            RETURN(5);
  432          END;
  433          IF BytesRead<128 THEN
  434            Lib.Fill(ADR(Buffer[BytesRead]),128-BytesRead,CHR(26));
*****            ^ not supported yet
*****                ^ not supported yet
*****                     ^ undeclared identifier
*****                         ^ not supported yet
*****                                         ^ not supported yet
*****                                                          ^ undeclared identifier
*****                                                                ^ not supported yet
  435          END;
  436          SendBlock(Buffer,BlockNo MOD 100H);
*****          ^ not supported yet
*****                    ^ not supported yet
*****                                           ^ not supported yet
  437          INC(BlockNo);
*****          ^ undeclared identifier
*****                     ^ not supported yet
  438          FTSupport.UpdateStatus;
*****          ^ not supported yet
*****                    ^ not supported yet
  439          LOOP
  440            IF (RS232.SerialRead(c,0)) AND ((c=ACK) OR (c=NAK)) THEN
*****                ^ not supported yet
*****                      ^ not supported yet
*****                                    ^ not supported yet
*****                                               ^ not supported yet
*****                                                          ^ not supported yet
  441              Resp := c;
  442              IF (RS232.SerialRead(c,150)) AND (c>=0C) AND (c<=3C) THEN
*****                  ^ not supported yet
*****                        ^ not supported yet
*****                                        ^ not supported yet
  443                Result := CheckWindow(Resp,c);
*****                          ^ not supported yet
*****                                            ^ not supported yet
  444                IF Result<>0 THEN
  445                  RETURN(Result);
  446                END;
  447              ELSE
  448                EXIT;
  449              END;
  450            ELSE
  451              EXIT;
  452            END;
  453          END;
  454        END;
  455        FTSupport.LastMessage := 'End of File';
*****        ^ not supported yet
*****                  ^ not supported yet
*****                                 ^ not supported yet
  456        FTSupport.UpdateStatus;
*****        ^ not supported yet
*****                  ^ not supported yet
  457        REPEAT
  458          REPEAT
  459            RS232.SerialWrite(EOT,1);
*****            ^ not supported yet
*****                  ^ not supported yet
*****                              ^ not supported yet
*****                                   ^ not supported yet
  460            Result := GetResponse(c);
*****                      ^ not supported yet
*****                                   ^ not supported yet
  461            IF Result<>0 THEN
  462              RETURN(Result);
  463            END;
  464          UNTIL (c=NAK) OR (c=ACK);
*****                   ^ not supported yet
*****                              ^ not supported yet
  465        UNTIL c=ACK;
*****                ^ not supported yet
  466        RETURN 0;
  467      END WXMSend;
*****          ^ not supported yet
  468  
  469  (*..................................................*)
  470  
  471    PROCEDURE WXModemSend(VAR Filename:ARRAY OF CHAR):CARDINAL;
*****                                                ^ not supported yet
  472      VAR
  473        Result            : CARDINAL;
  474      BEGIN
  475        IF FIO.Exists(Filename) THEN
*****           ^ not supported yet
*****               ^ not supported yet
*****                      ^ not supported yet
  476          InitVars(Filename);
*****          ^ not supported yet
*****                   ^ not supported yet
  477          f := FIO.Open(Filename);
*****          ^ not supported yet
*****               ^ not supported yet
*****                   ^ not supported yet
*****                        ^ not supported yet
  478          FIO.EOF := FALSE;
*****          ^ not supported yet
*****              ^ not supported yet
  479          FTSupport.SizeInBytes := FIO.Size(f);
*****          ^ not supported yet
*****                    ^ not supported yet
*****                                   ^ not supported yet
*****                                       ^ not supported yet
*****                                            ^ not supported yet
  480          FTSupport.OpenStatusWindow('WXModem Upload');
*****          ^ not supported yet
*****                    ^ not supported yet
*****                                     ^ not supported yet
  481          FTSupport.NewFilename;
*****          ^ not supported yet
*****                    ^ not supported yet
  482          Result := WXMSend();
*****                    ^ not supported yet
*****                            ^ not supported yet
  483          FTSupport.CloseStatusWindow;
*****          ^ not supported yet
*****                    ^ not supported yet
  484          FIO.Close(f);
*****          ^ not supported yet
*****              ^ not supported yet
*****                    ^ not supported yet
  485          RETURN Result;
  486        ELSE
  487          CommUtil.ErrorMessage('Could not open file!');
*****          ^ not supported yet
*****                   ^ not supported yet
*****                                ^ not supported yet
  488          RETURN 7;
  489        END;
  490      END WXModemSend;
*****          ^ not supported yet
  491  
  492  (*..................................................*)
  493  
  494  END WXModem.
*****      ^ not supported yet
  495  

  496 errors