home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / vmspascal / vxpar.pas < prev    next >
Pascal/Delphi Source File  |  1988-08-15  |  27KB  |  1,110 lines
  1.  
  2. {  Determine length of string. }
  3. function LenString(var tempStr : string80) : integer;
  4. var
  5.     i : integer;
  6.     endofstring : boolean;
  7. begin
  8.     i := 80;
  9.     endofstring := false;
  10.     while ((i >= 1) and not(endofstring)) do
  11.     if (tempStr[i] = ' ') then
  12.         i := i - 1
  13.     else
  14.         endofstring := true;
  15.  
  16.     LenString := i;
  17. end;
  18.  
  19.  
  20. {  Copy command line into temporary string until either EOS or blank }
  21. procedure SkipBlanks(var command : string80;
  22.              var commandLen : integer);
  23. var
  24.     i, k, j, oldComLen : integer;
  25.     endOfString : boolean;
  26.  
  27. begin
  28.  
  29.     i := 1;
  30.     endofString := false;
  31.     oldComLen := commandLen;
  32.     while ((i <= commandLen) and (not(endofString))) do
  33.     if (command[i] = ' ') then
  34.         i := i + 1
  35.     else
  36.         endofString := true;
  37.  
  38.     k := 1;
  39.     for j:=i to commandLen do
  40.     begin
  41.         command[k] := command[j];
  42.         k := k + 1;
  43.     end;
  44.  
  45.     if ((oldComLen = 1) and (i <> 1)) then
  46.         commandLen := commandLen - i
  47.     else
  48.     commandLen := commandLen - (i-1);
  49. end;
  50.  
  51.  
  52. {  Copy command line into temporary string until either EOS or blank }
  53. procedure CopyToken(var command : string80;
  54.             var commandLen : integer;
  55.             var tempStr : string13;
  56.             var totChars : integer);
  57.  
  58. const
  59. %include 'kermdir:pglobal.pas/nolist'
  60.  
  61. var
  62.     i, j, k : integer;
  63.     noBlank : boolean;
  64.     tempToken : string80;
  65.  
  66. begin
  67.  
  68.     for i:=1 to SMALLSIZE do
  69.     tempStr[i] := ' ';
  70.  
  71.     i := 1;
  72.     noblank := true;
  73.     while ((i <= commandLen) and (noblank)) do
  74.     if (command[i] <> ' ') then
  75.         begin
  76.         tempToken[i] := command[i];
  77.         i := i + 1;
  78.         end
  79.     else
  80.         noBlank := false;
  81.  
  82.     totChars := i - 1;
  83.  
  84.     if (totChars <= SMALLSIZE) then
  85.     for i:=1 to totChars do
  86.         tempStr[i] := tempToken[i]
  87.     else
  88.     begin
  89.         totChars := 2;
  90.         tempStr := cBADTOKEN;
  91.     end;
  92.  
  93.     k := 1;
  94.     for j:=(totChars+1) to commandLen do
  95.     begin
  96.         command[k] := command[j];
  97.         k := k + 1;
  98.     end;
  99.  
  100.     commandLen := commandLen - totChars;
  101. end;
  102.  
  103.  
  104. {  Routine to compare strings for symbol comparison. }
  105. function CompareStr(command, symbol : string13;
  106.             commandLen, symbolLen : integer) : boolean;
  107. var
  108.     i : integer;
  109.     sameStr : boolean;
  110.  
  111. begin
  112.     sameStr := true;
  113.     i := 1;
  114.     while (sameStr and (i <= commandLen)) do
  115.     if command[i] <> symbol[i] then
  116.         sameStr := false
  117.     else
  118.         i := i + 1;
  119.     i := i - 1;
  120.  
  121.     CompareStr := sameStr and (i >= symbolLen);
  122. end;
  123.  
  124.  
  125. procedure StrUpcase(var command : string80;
  126.             commandLen : integer);
  127. var
  128.     i, diff : integer;
  129.  
  130. begin
  131.     diff := ord('a') - ord('A');
  132.     for i:=1 to commandLen do
  133.     if ((command[i] >= 'a') and (command[i] <= 'z')) then
  134.         command[i] := chr(ord(command[i]) - diff);
  135. end;
  136.  
  137.  
  138. function IsNumeric(    token : string13;
  139.             var tokLen, value : integer;
  140.             typeToken : integer) : boolean;
  141. const
  142. %include   'kermdir:pglobal.pas/nolist'
  143.  
  144. var
  145.     goodChar : boolean;
  146.     upBound : char;
  147.     base, i : integer;
  148.  
  149. begin
  150.  
  151.     value := 0;
  152.     i := 1;
  153.     goodChar := true;
  154.     upBound := '9';
  155.     base := 10;
  156.     if (typeToken = OCTAL) then
  157.     begin
  158.         upBound := '7';
  159.         base := 8;
  160.     end;
  161.     
  162.     while ((i <= tokLen) and (goodChar)) do
  163.     if ((token[i] >= '0') and (token[i] <= upBound)) then
  164.         begin
  165.         value := (value*base) + (ord(token[i]) - ord('0'));
  166.         i := i + 1;
  167.         end
  168.     else
  169.         begin
  170.         goodChar := false;
  171.         value := 0;
  172.         end;
  173.     
  174.     goodChar := goodChar and (tokLen > 0);
  175.  
  176.     if (typeToken = OCTAL) then
  177.     IsNumeric := goodChar and ((value >= 0) and (value <= 31))
  178.     else if (typeToken = SDECIMAL) then
  179.     IsNumeric := goodChar and ((value >= MINPACKETSIZE) and
  180.                    (value <= MAXPACKETSIZE))
  181.     else if (typeToken = IDECIMAL) then
  182.     IsNumeric := goodChar and ((value = o300BAUD) or (value = o600BAUD) or
  183.                    (value = o1200BAUD) or (value = o2400BAUD) or
  184.                    (value = o4800BAUD) or (value = o9600BAUD))
  185.     else
  186.     IsNumeric := goodChar and ((value >= 0) and
  187.                    (value <= 99))
  188.  
  189. end;
  190.  
  191.  
  192. {  Print the ? help message for main menu.  }
  193. procedure PrintMainHelp;
  194. begin
  195.     writeln('  send <filename or filegroup>');
  196.     writeln('  receive [<filename>]');
  197.     writeln('  status');
  198.     writeln('  connect');
  199.     writeln('  set  <option>');
  200.     writeln('  show <option>');
  201.     writeln('  dcl [<vms command>]');
  202.     writeln('  help');
  203.     writeln('  exit | quit');
  204.     writeln('  ?');
  205. end;
  206.  
  207.  
  208. {  Print the ? help message for send/receive command}
  209. procedure PrintSendReceiveHelp;
  210. begin
  211.     writeln('  <filename or filegroup>');
  212. end;
  213.  
  214.  
  215. {  Print the ? help message for set menu. }
  216. procedure PrintSetHelp;
  217. begin
  218.     writeln('  send  <option>');
  219.     writeln('  receive <option>');
  220.     writeln('  transmode <ASCII | binary>');
  221.     writeln('  eight-quote <c>');
  222.     writeln('  filerecord <CLF | lf | cr>');
  223.     writeln('  local-echo <on | OFF>');
  224.     writeln('  parity <NONE | even | odd>');
  225.     writeln('  debugging <on | OFF>');
  226.     writeln('  speed  <d>');
  227.     writeln('  delay  <d>');
  228.     writeln('  ?');
  229. end;
  230.  
  231.  
  232. {  Print the ? help message for show menu. }
  233. procedure PrintShowHelp;
  234. begin
  235.     writeln('  send  <option>');
  236.     writeln('  receive <option>');
  237.     writeln('  transmode');
  238.     writeln('  eight-quote');
  239.     writeln('  filerecord');
  240.     writeln('  local-echo');
  241.     writeln('  debugging');
  242.     writeln('  speed');
  243.     writeln('  delay');
  244.     writeln('  all');
  245.     writeln('  ?');
  246. end;
  247.  
  248.  
  249. {  Print the ? help message for set send/receive menu. }
  250. procedure PrintSetSendReceiveHelp;
  251. begin
  252.     writeln('  packet-length <d>');
  253.     writeln('  padding <d>');
  254.     writeln('  padchar <o>');
  255.     writeln('  timeout <d>');
  256.     writeln('  end-of-line   <o>');
  257.     writeln('  quote   <c>');
  258. end;
  259.  
  260.  
  261. {  Print the ? help message for show send/receive menu. }
  262. procedure PrintShowSendReceiveHelp;
  263. begin
  264.     writeln('  packet-length');
  265.     writeln('  padding');
  266.     writeln('  padchar');
  267.     writeln('  timeout');
  268.     writeln('  end-of-line');
  269.     writeln('  quote');
  270. end;
  271.  
  272.  
  273. procedure PrintStatus;
  274. {  Print the status of the last send/receive. }
  275. const
  276.     STRWIDTH = 7;
  277. var
  278.     overHead, effectiveRate : integer;
  279. begin
  280.     writeln('  Packets Sent =                ', NumSendPacks : STRWIDTH);
  281.     if (oldRunType = Transmit) then
  282.     begin
  283.        writeln('  Number of ACK packets =       ', NumACKrecv : STRWIDTH);
  284.        writeln('  Number of NAK packets =       ', NumNAKrecv : STRWIDTH);
  285.        writeln('  Number of BAD packets =       ', NumBADrecv : STRWIDTH);
  286.     end
  287.     else
  288.     begin
  289.         writeln('  Number of ACK packets =       ', NumACK : STRWIDTH);
  290.         writeln('  Number of NAK packets =       ', NumNAK : STRWIDTH);
  291.     end;
  292.     writeln('  Data characters Sent =        ', ChInFileSend : STRWIDTH);
  293.     writeln('  Total characters Sent =       ', ChInPackSend : STRWIDTH);
  294.     OverHd(ChInPackSend, ChInFileSend, overHead);
  295.     writeln('  Overhead on Send Packets =    ', overHead : STRWIDTH, ' %');
  296.     writeln(' ');
  297.     writeln('  Packets Received =            ', NumRecvPacks : STRWIDTH);
  298.     writeln('  Data characters Received =    ', ChInFileRecv : STRWIDTH);
  299.     writeln('  Total characters Received =   ', ChInPackRecv : STRWIDTH);
  300.     OverHd(ChInPackRecv, ChInFileRecv, overHead);
  301.     writeln('  Overhead on Receive Packets = ', overHead : STRWIDTH, ' %');
  302.  
  303.     writeln;
  304.     writeln('  Run Time =                    ', RunTime : STRWIDTH);
  305.  
  306.     if (oldRunType = Transmit) then
  307.     CalRat(ChInFileSend, RunTime-Delay, effectiveRate)
  308.     else
  309.     CalRat(ChInFileRecv, RunTime, effectiveRate);
  310.     writeln('  Effective Baud Rate =         ', effectiveRate : STRWIDTH);
  311.  
  312. end;
  313.  
  314.  
  315. {  Print the message specified. }
  316. procedure PrintMessage(messageNumber : integer);
  317.  
  318. const
  319. %include   'kermdir:pglobal.pas/nolist'
  320.  
  321. begin
  322.     case messageNumber of
  323.     NOTIMPLEMENTED :
  324.         writeln(' ? Not Implemented');
  325.     INVALIDCOMMAND :
  326.         writeln(' ? Invalid command');
  327.     INVALIDSETCOMMAND :
  328.         writeln(' ? Invalid set command');
  329.     INVALIDSHOWCOMMAND :
  330.         writeln(' ? Invalid show command');
  331.     INVALIDFILESPEC :
  332.         writeln(' ? Invalid file specification');
  333.     INVALIDSETCVALUE :
  334.         writeln(' ? Bad value: character');
  335.     INVALIDSETDVALUE :
  336.         writeln(' ? Bad value: decimal');
  337.     INVALIDSETOVALUE :
  338.         writeln(' ? Bad value: octal');
  339.     INVALIDSETRANGE :
  340.         writeln(' ? Value not in accepted range');
  341.     NOHELPAVAILABLE :
  342.         writeln(' ? Help file does not exist');
  343.     DCLSPAWNFAILED :
  344.         writeln(' ? DCL spawn failed');
  345.     SENDPARMS :
  346.         writeln('Send Parameters:');
  347.     RECEIVEPARMS :
  348.         writeln('Receive Parameters:');
  349.     LOCALPARMS :
  350.         writeln('Local System Parameters:');
  351.     BLANKLINE :
  352.         writeln(' ');
  353.      end;
  354. end;
  355.  
  356.  
  357. procedure ExecShell(dclcommd : string80;
  358.             commdLen : integer);
  359. {  Call the dcl shell }
  360. const
  361.     SPAWN = 'SPAWN';
  362.     BLANK = '                                                           ';
  363.     MAXCOMMD = 60;
  364. var
  365.     status, i : integer;
  366.     shellLine : varying [80] of char;
  367.  
  368. begin
  369.     SetUpExitHandlerVMS(1, 4);        { Lower process priority }
  370.     shellLine := ' ';
  371.     if ((commdLen - 1) > 0) then
  372.     begin
  373.            for i:=1 to commdLen do
  374.         if i < MAXCOMMD then
  375.             shellLine := shellLine + dclcommd[i];
  376.     end
  377.     else
  378.     shellLine := SPAWN;
  379.  
  380.     status := $Enable_ctrl(ctrlOff);
  381.     status := $Spawn(shellLine);
  382.     if (status <> SS$_NORMAL) then
  383.     PrintMessage(DCLSPAWNFAILED)
  384.     else
  385.     writeln;
  386.  
  387.     status := $Disable_ctrl(ctrlOff);
  388.     SetUpExitHandlerVMS(1, 6);        { Raise process priority }
  389. end;
  390.     
  391.  
  392. {  Routine to type the help file. }
  393. procedure PrintHelpVMS;
  394.  
  395. const
  396. %include   'kermdir:pglobal.pas/nolist'
  397.     SCREENSIZE = 24;
  398. var
  399.     info : varying[160] of char;
  400.     i : integer;
  401.     ch : char;
  402.  
  403. begin
  404.     open(FILE_VARIABLE := helpFile,
  405.      FILE_NAME := KERMITHELP,
  406.      HISTORY := OLD,
  407.      ERROR := CONTINUE);
  408.  
  409.     if (status(helpFile) = 0) then
  410.     begin
  411.         reset(helpFile);
  412.         i := 1;
  413.         while (not(eof(helpFile))) do
  414.         begin
  415.             readln(helpFile, info);
  416.             writeln(info);
  417.             i := i + 1;
  418.             if ((i mod SCREENSIZE) = 0) then
  419.             begin
  420.                 i := 1;
  421.                 write('< Press RETURN to continue >');
  422.                 read(ch);
  423.             end;
  424.         end;
  425.  
  426.         close(helpFile);
  427.     end
  428.     else
  429.     PrintMessage(NOHELPAVAILABLE);
  430.  
  431. end;
  432.  
  433.  
  434. {  Routine to print parameter values. }
  435. procedure PrintParmValue(value, token : integer);
  436.  
  437. const
  438. %include   'kermdir:pglobal.pas/nolist'
  439.  
  440. begin
  441.     case token of
  442.     oPACKETLENGTH :
  443.         writeln('  Packet-Length =         ', value : 2, ' (dec)');
  444.     oPADDING :
  445.         writeln('  Padding =               ', value : 2, ' (dec)');
  446.     oPADCHAR :
  447.         writeln('  Padding Character =     ', OCT (value, 2), ' (oct)');
  448.     oTIMEOUT :
  449.         writeln('  Time-out length =       ', value : 2, ' (sec)');
  450.     oENDOFLINE :
  451.         writeln('  End of Line Character = ', OCT (value, 2), ' (oct)');
  452.     oQUOTE :
  453.         writeln('  Quote Character =       ', chr(value));
  454.     oTRANSMODE :
  455.         begin
  456.         write('  File Transfer Type =    ');
  457.         if (value = oASCII) then
  458.             writeln('ascii')
  459.         else 
  460.             writeln('binary');
  461.         end;
  462.     oEIGHTQUOTE :
  463.         writeln('  Eight-Bit Quote =       ', chr(value));
  464.     oFILERECORD :
  465.         begin
  466.         write('  End of Line for file =  ');
  467.         if (value = oCR) then
  468.             writeln('cr')
  469.         else if (value = oLF) then
  470.             writeln('lf')
  471.         else
  472.             writeln('cr/lf');
  473.         end;
  474.     oLOCALECHO :
  475.         begin
  476.         write('  Local Echo =            ');
  477.         if (value = oOFF) then
  478.             writeln('off')
  479.         else
  480.             writeln('on');
  481.         end;
  482.     oDELAY :
  483.         writeln('  Delay =                 ', value : 2, ' (sec)');
  484.     oDEBUGGING :
  485.         begin
  486.         write('  Debugging =             ');
  487.         if (value = oOFF) then
  488.             writeln('off')
  489.         else
  490.             writeln('on');
  491.         end;
  492.      oPARITY :
  493.         begin
  494.         write('  Parity =                ');
  495.         if (value = oEVEN) then
  496.             writeln('even')
  497.         else if (value = oODD) then
  498.             writeln('odd')
  499.         else
  500.             writeln('none');
  501.         end;
  502.      oSPEED :
  503.         writeln('  Line Speed =            ', lSpeed : 4);
  504.     end;
  505. end;
  506.  
  507.  
  508. {  Routine to scan for an appropriate value }
  509. procedure ScanForValue(var command : string80;
  510.                var commandLen, value : integer;
  511.                convertType, commandType : integer);
  512.  
  513. const
  514. %include   'kermdir:pglobal.pas/nolist'
  515.  
  516. var
  517.     tempToken : string13;
  518.     totChars  : integer;
  519.     badvalue : boolean;
  520.  
  521. begin
  522.  
  523.     CopyToken(command, commandLen, tempToken, totChars);
  524.  
  525.     case convertType of
  526.     DECIMAL ,
  527.      SDECIMAL,
  528.      IDECIMAL :
  529.         if not(IsNumeric(tempToken, totChars, value, convertType)) and
  530.            (commandType <> oSHOWTYPE) then
  531.         begin
  532.             PrintMessage(INVALIDSETDVALUE);
  533.             value := RANGENULL;
  534.         end;
  535.     OCTAL :
  536.         if not(IsNumeric(tempToken, totChars, value, convertType)) and
  537.            (commandType <> oSHOWTYPE) then
  538.         begin
  539.             PrintMessage(INVALIDSETOVALUE);
  540.             value := RANGENULL;
  541.         end;
  542.     CHRACTER :
  543.         if (totChars = 1) then
  544.         value := ord(tempToken[1])
  545.         else if (commandType <> oSHOWTYPE) then
  546.         begin
  547.             PrintMessage(INVALIDSETCVALUE);
  548.             value := RANGENULL;
  549.         end;
  550.     EBCHRACTER :
  551.         begin
  552.         if (totChars = 1) then
  553.             begin 
  554.             value := ord(tempToken[1]);
  555.             badvalue := false;
  556.             if (not(value in [EXMARK..RABRACK, GRAVE..TILDE])) then
  557.                 badvalue := true;
  558.             end
  559.             else
  560.             badvalue := true;
  561.  
  562.             if ((commandType <> oSHOWTYPE) and (badvalue)) then
  563.             begin
  564.                 PrintMessage(INVALIDSETCVALUE);
  565.                 value := RANGENULL;
  566.             end;
  567.         end;
  568.     end;
  569. end;
  570.  
  571.  
  572. {  Determine if we have a valid number, and if so set it.  }
  573. procedure TestAndSetValue(var value, numberToSet : integer;
  574.                   token, commandType : integer);
  575.  
  576. const
  577. %include   'kermdir:pglobal.pas/nolist'
  578.  
  579. begin
  580.     if (commandType = oSHOWTYPE) then
  581.     PrintParmValue(numberToSet, token)
  582.     else if (value = NULLTOKE) then
  583.     begin
  584.         PrintMessage(INVALIDSETCOMMAND);
  585.     end
  586.     else if (value <> RANGENULL) then
  587.     numberToSet := value;
  588. end;
  589.  
  590.  
  591. {  Routine to print the value of all parameters in program.  }
  592. procedure PrintAllParameters;
  593.  
  594. const
  595. %include   'kermdir:pglobal.pas/nolist'
  596.  
  597. begin
  598.     PrintMessage(SENDPARMS);
  599.     PrintParmValue(SizeSend, oPACKETLENGTH);
  600.     PrintParmValue(Pad, oPADDING);
  601.     PrintParmValue(PadChar, oPADCHAR);
  602.     PrintParmValue(TheirTimeOut, oTIMEOUT);
  603.     PrintParmValue(SendEOL, oENDOFLINE);
  604.     PrintParmValue(SendQuote, oQUOTE);
  605.  
  606.     PrintMessage(RECEIVEPARMS);
  607.     PrintParmValue(SizeRecv, oPACKETLENGTH);
  608.     PrintParmValue(MyPad, oPADDING);
  609.     PrintParmValue(MyPadChar, oPADCHAR);
  610.     PrintParmValue(MyTimeOut, oTIMEOUT);
  611.     PrintParmValue(MyEOL, oENDOFLINE);
  612.     PrintParmValue(MyQuote, oQUOTE);
  613.  
  614.     PrintMessage(LOCALPARMS);
  615.     PrintParmValue(transtype, oTRANSMODE);
  616.     PrintParmValue(EBQChar, oEIGHTQUOTE);
  617.     PrintParmValue(fileEol, oFILERECORD);
  618.     PrintParmValue(localEcho, oLOCALECHO);
  619.     PrintParmValue(parity, oPARITY);
  620.     PrintParmValue(lSpeed, oSPEED);
  621.     PrintParmValue(Delay, oDELAY);
  622.     PrintParmValue(debugging, oDEBUGGING);
  623. end;
  624.  
  625.  
  626. {  Routine to parse send/receive command for file name or wildcard des. }
  627. procedure ParseSendReceiveCommand(var commandLine : string80;
  628.                   var commandLen : integer;
  629.                   var tempFile : string80;
  630.                   var token : integer);
  631. const
  632. %include   'kermdir:pglobal.pas/nolist'
  633.  
  634. var
  635.     i : integer;
  636.  
  637. begin
  638.     for i:=1 to CONLENGTH do
  639.     tempFile[i] := ' ';
  640.  
  641.     if ((commandLine[1] <> ' ') and (commandLen > 0)) then
  642.     begin
  643.  
  644.         if (commandLen > CONLENGTH) then
  645.         commandLen := CONLENGTH;
  646.  
  647.         for i := 1 to commandLen do
  648.         tempFile[i] := commandLine[i];
  649.  
  650.         if (commandLine[1] = '?') then
  651.         begin
  652.             PrintSendReceiveHelp;
  653.             token := oXXXX;
  654.         end
  655.         else
  656.              case token of
  657.             oSEND : 
  658.                 sFileSpec := oON;
  659.             otherwise
  660.                 rFileSpec := oON;
  661.         end;
  662.     end
  663.     else
  664.     begin
  665.         case token of
  666.         oSEND :
  667.             begin
  668.               sFileSpec := oOFF;
  669.               PrintMessage(INVALIDFILESPEC);
  670.             end
  671.         otherwise
  672.             rFileSpec := oOFF;
  673.         end;
  674.     end;
  675.  
  676.  
  677. end;
  678.  
  679.  
  680. {  Get a valid token form the command line and return it. }
  681. procedure ScanForToken(var commandLine : string80;
  682.                var commandLen, token : integer;
  683.                typeToken : integer);
  684.  
  685. const
  686. %include   'kermdir:pglobal.pas/nolist'
  687.  
  688. var
  689.     tempToken : string13;
  690.     totChars : integer;
  691.  
  692. begin
  693.  
  694.     CopyToken(commandLine, commandLen, tempToken, totChars);
  695.     SkipBlanks(commandLine, commandLen);
  696.  
  697.     token := NULLTOKE;
  698.     if (totChars <> 0) then
  699.     case typeToken of
  700.         oMAINTYPE :
  701.         if (CompareStr(tempToken, cSET, totChars, uSET)) then
  702.             token := oSET
  703.         else if (CompareStr(tempToken, cSHOW, totChars, uSHOW)) then
  704.             token := oSHOW
  705.         else if (CompareStr(tempToken, cSTATUS, totChars, uSTATUS)) then
  706.             token := oSTATUS
  707.         else if (CompareStr(tempToken, cCONNECT, totChars, uCONNECT)) then
  708.             token := oCONNECT
  709.         else if (CompareStr(tempToken, cSEND, totChars, uMSEND)) then
  710.             token := oSEND
  711.         else if (CompareStr(tempToken, cRECEIVE, totChars, uMRECEIVE)) then
  712.             token := oRECEIVE
  713.         else if (CompareStr(tempToken, cDCL, totChars, uDCL)) then
  714.             token := oDCL
  715.         else if (CompareStr(tempToken, cHELP, totChars, uHELP)) then
  716.             token := oHELP
  717.         else if (CompareStr(tempToken, cQUESTION, totChars, uQUESTION)) then
  718.             token := oQUESTIONM
  719.         else if (CompareStr(tempToken, cQUIT, totChars, uQUIT)) then
  720.             token := oQUIT
  721.         else if (CompareStr(tempToken, cEXIT, totChars, uEXIT)) then
  722.             token := oEXIT;
  723.  
  724.         oSETTYPE,
  725.          oSHOWTYPE :
  726.         if (CompareStr(tempToken, cSEND, totChars, uSEND)) then
  727.             token := oSEND
  728.         else if (CompareStr(tempToken, cRECEIVE, totChars, uRECEIVE)) then
  729.             token := oRECEIVE
  730.         else if (CompareStr(tempToken, cTRANSMODE, totChars, uTRANSMODE)) then
  731.             token := oTRANSMODE
  732.         else if (CompareStr(tempToken, cEIGHTQUOTE, totChars, uEIGHTQUOTE)) then
  733.             token := oEIGHTQUOTE
  734.         else if (CompareStr(tempToken, cDEBUGGING, totChars, uDEBUGGING)) then
  735.             token := oDEBUGGING
  736.         else if (CompareStr(tempToken, cFILERECORD, totChars, uFILERECORD)) then
  737.             token := oFILERECORD
  738.         else if (CompareStr(tempToken, cLOCALECHO, totChars, uLOCALECHO)) then
  739.             token := oLOCALECHO
  740.         else if (CompareStr(tempToken, cDELAY, totChars, uDELAY)) then
  741.             token := oDELAY
  742.         else if (CompareStr(tempToken, cPARITY, totChars, uPARITY)) then
  743.             token := oPARITY
  744.         else if (CompareStr(temptoken, cSPEED, totChars, uSPEED)) then
  745.             token := oSPEED
  746.         else if (CompareStr(tempToken, cALL, totChars, uALL)) then
  747.             token := oALL
  748.         else if (CompareStr(tempToken, cQUESTION, totChars, uQUESTION)) then
  749.             token := oQUESTIONM;
  750.  
  751.         oSENDTYPE,
  752.          oRECEIVETYPE :
  753.         if (CompareStr(tempToken, cPACKETLENGTH, totChars, uPACKETLENGTH)) then
  754.             token := oPACKETLENGTH
  755.         else if (CompareStr(tempToken, cPADDING, totChars, uPADDING)) then
  756.             token := oPADDING
  757.         else if (CompareStr(tempToken, cQUESTION, totChars, uQUESTION)) then
  758.             token := oQUESTIONM
  759.         else if (CompareStr(tempToken, cPADCHAR, totChars, uPADCHAR)) then
  760.             token := oPADCHAR
  761.         else if (CompareStr(tempToken, cTIMEOUT, totChars, uTIMEOUT)) then
  762.             token := oTIMEOUT
  763.         else if (CompareStr(tempToken, cENDOFLINE, totChars, uENDOFLINE)) then
  764.             token := oENDOFLINE
  765.         else if (CompareStr(tempToken, cQUOTE, totChars, uQUOTE)) then
  766.             token := oQUOTE;
  767.  
  768.         oTRANSTYPE :
  769.         if (CompareStr(tempToken, cASCII, totChars, uASCII)) then
  770.             token := oASCII
  771.         else if (CompareStr(tempToken, cBINARY, totChars, uBINARY)) then
  772.             token := oBINARY;
  773.  
  774.         oDEBUGTYPE,
  775.          oLOCECHOTYPE :
  776.         if (CompareStr(tempToken, cON, totChars, uON)) then
  777.             token := oON
  778.         else if (CompareStr(tempToken, cOFF, totChars, uOFF)) then
  779.             token := oOFF;
  780.  
  781.         oFILERECTYPE :
  782.         if (CompareStr(tempToken, cCR, totChars, uCR)) then
  783.             token := oCR
  784.         else if (CompareStr(tempToken, cLF, totChars, uLF)) then
  785.             token := oLF
  786.         else if (CompareStr(tempToken, cCLF, totChars, uCLF)) then
  787.             token := oCLF;
  788.  
  789.         oPARITYTYPE :
  790.         if (CompareStr(tempToken, cEVEN, totChars, uEVEN)) then
  791.             token := oEVEN
  792.         else if (CompareStr(tempToken, cODD, totChars, uODD)) then
  793.             token := oODD
  794.         else if (CompareStr(tempToken, cNONE, totChars, uNONE)) then
  795.             token := oNONE;
  796.     end; 
  797.  
  798. end;
  799.  
  800.  
  801. {  Parse the set and show command and the proceed to set appropriate
  802.    kermit variables.                                                 }
  803. procedure ParseSetShowCommand(var commandLine : string80;
  804.                   var commandLen : integer;
  805.                   commandType : integer);
  806. const
  807. %include   'kermdir:pglobal.pas/nolist'
  808.  
  809. var
  810.     token, value : integer;
  811.  
  812. begin
  813.     ScanForToken(commandLine, commandLen, token, commandType);
  814.  
  815.     case token of
  816.     oSEND    :
  817.         begin
  818.         ScanForToken(commandLine, commandLen, token, oSENDTYPE);
  819.         case token of
  820.             oPACKETLENGTH :
  821.             begin
  822.                 ScanForValue(commandLine, commandLen, value, 
  823.                      SDECIMAL, commandType);
  824.                 TestAndSetValue(value, SizeSend, token, 
  825.                         commandType);
  826.             end;
  827.             oPADDING :
  828.             begin
  829.                 ScanForValue(commandLine, commandLen, value, 
  830.                      DECIMAL, commandType);
  831.                 TestAndSetValue(value, Pad, token, commandType);
  832.             end;
  833.             oPADCHAR :
  834.             begin
  835.                 ScanForValue(commandLine, commandLen, value, 
  836.                      OCTAL, commandType);
  837.                 TestAndSetValue(value, PadChar, token, 
  838.                         commandType);
  839.             end;
  840.             oTIMEOUT :
  841.             begin
  842.                 ScanForValue(commandLine, commandLen, value, 
  843.                      DECIMAL, commandType);
  844.                 TestAndSetValue(value, TheirTimeOut, token,
  845.                         commandType);
  846.             end;
  847.             oENDOFLINE :
  848.             begin
  849.                 ScanForValue(commandLine, commandLen, value, 
  850.                      OCTAL, commandType);
  851.                 TestAndSetValue(value, SendEol, token, 
  852.                         commandType);
  853.             end;
  854.             oQUOTE :
  855.             begin
  856.                 ScanForValue(commandLine, commandLen, value, 
  857.                      CHRACTER, commandType);
  858.                 TestAndSetValue(value, SendQuote, token, 
  859.                         commandType);
  860.             end;
  861.             oQUESTIONM :
  862.             if (commandType = oSETTYPE) then
  863.                 PrintSetSendReceiveHelp
  864.             else
  865.                 PrintShowSendReceiveHelp;
  866.             otherwise
  867.             if (commandType = oSETTYPE) then
  868.                PrintMessage(INVALIDSETCOMMAND)
  869.             else
  870.                PrintMessage(INVALIDSHOWCOMMAND);
  871.         end;
  872.         end;
  873.  
  874.     oRECEIVE :
  875.         begin
  876.         ScanForToken(commandLine, commandLen, token, oRECEIVETYPE);
  877.         case token of
  878.             oPACKETLENGTH :
  879.             begin
  880.                 ScanForValue(commandLine, commandLen, value,
  881.                      SDECIMAL, commandType);
  882.                 TestAndSetValue(value, SizeRecv, token, 
  883.                         commandType);
  884.             end;
  885.             oPADDING :
  886.             begin
  887.                 ScanForValue(commandLine, commandLen, value, 
  888.                      DECIMAL, commandType);
  889.                 TestAndSetValue(value, MyPad, token, commandType);
  890.             end;
  891.             oPADCHAR :
  892.             begin
  893.                 ScanForValue(commandLine, commandLen, value,
  894.                      OCTAL, commandType);
  895.                 TestAndSetValue(value, MyPadChar, token, 
  896.                         commandType);
  897.             end;
  898.             oTIMEOUT :
  899.             begin
  900.                 ScanForValue(commandLine, commandLen, value,
  901.                      DECIMAL, commandType);
  902.                 TestAndSetValue(value, MyTimeOut, token, 
  903.                         commandType);
  904.             end;
  905.             oENDOFLINE :
  906.             begin
  907.                 ScanForValue(commandLine, commandLen, value,
  908.                      OCTAL, commandType);
  909.                 TestAndSetValue(value, MyEol, token, commandType);
  910.             end;
  911.             oQUOTE :
  912.             begin
  913.                 ScanForValue(commandLine, commandLen, value,
  914.                      CHRACTER, commandType);
  915.                 TestAndSetValue(value, MyQuote, token, 
  916.                         commandType);
  917.             end;
  918.             oQUESTIONM :
  919.             if (commandType = oSETTYPE) then
  920.                 PrintSetSendReceiveHelp
  921.             else
  922.                 PrintShowSendReceiveHelp;
  923.             otherwise
  924.             if (commandType = oSETTYPE) then
  925.                 PrintMessage(INVALIDSETCOMMAND)
  926.             else
  927.                 PrintMessage(INVALIDSHOWCOMMAND);
  928.         end;
  929.         end;
  930.  
  931.     oTRANSMODE :
  932.         begin
  933.         ScanForToken(commandLine, commandLen, value, oTRANSTYPE);
  934.         TestAndSetValue(value, transtype, token, commandType);
  935.         end;
  936.     oEIGHTQUOTE :
  937.         begin
  938.         ScanForValue(commandLine, commandLen, value, 
  939.                  EBCHRACTER, commandType);
  940.         TestAndSetValue(value, EBQChar, token, commandType);
  941.         end;
  942.     oDEBUGGING :
  943.         begin
  944.         ScanForToken(commandLine, commandLen, value, oDEBUGTYPE);
  945.         TestAndSetValue(value, debugging, token, commandType);
  946.         end;
  947.     oFILERECORD :
  948.         begin
  949.         ScanForToken(commandLine, commandLen, value, oFILERECTYPE);
  950.         TestAndSetValue(value, fileEOL, token, commandType);
  951.         end;
  952.     oLOCALECHO :
  953.         begin
  954.         ScanForToken(commandLine, commandLen, value, oLOCECHOTYPE);
  955.         TestAndSetValue(value, localEcho, token, commandType);
  956.         end;
  957.     oPARITY :
  958.         begin
  959.         ScanForToken(commandLine, commandLen, value, oPARITYTYPE);
  960.         TestAndSetValue(value, parity, token, commandType);
  961.         end;
  962.         oSPEED :
  963.         begin
  964.         ScanForValue(commandLine, commandLen, value,
  965.                  IDECIMAL, commandType);
  966.         TestAndSetValue(value, lSpeed, token, commandType);
  967.         end;
  968.     oDELAY :
  969.         begin
  970.         ScanForValue(commandLine, commandLen, value,
  971.                  DECIMAL, commandType);
  972.         TestAndSetValue(value, delay, token, commandType);
  973.         end;
  974.     oQUESTIONM :
  975.         if (commandType = oSETTYPE) then
  976.         PrintSetHelp
  977.         else
  978.         PrintShowHelp;
  979.     oALL :
  980.         if (commandType = oSHOWTYPE) then
  981.         PrintAllParameters
  982.         else
  983.         PrintMessage(INVALIDSETCOMMAND);
  984.     otherwise 
  985.         if (commandType = oSETTYPE) then
  986.         PrintMessage(INVALIDSETCOMMAND)
  987.         else
  988.         { Print all }
  989.         PrintAllParameters;
  990.     end;
  991. end;
  992.  
  993.  
  994. {  Routine to Parse the incoming line for a valid command. }
  995. procedure ParseInput(var commandLine : string80;
  996.              var commandLen : integer;
  997.              var runType : command);
  998.  
  999. const
  1000. %include    'kermdir:pglobal.pas/nolist'
  1001.  
  1002. var
  1003.     token : integer;
  1004.  
  1005. begin
  1006.     ScanForToken(commandLine, commandLen, token, oMAINTYPE);
  1007.  
  1008.     case token of
  1009.     oSET       : ParseSetShowCommand(commandLine, commandLen, oSETTYPE);
  1010.     oSHOW      : ParseSetShowCommand(commandLine, commandLen, oSHOWTYPE);
  1011.     oSEND,
  1012.      oRECEIVE  : 
  1013.         begin
  1014.         ParseSendReceiveCommand(commandLine, commandLen, 
  1015.                     fileSpec, token);
  1016.         if ((token = oSEND) and (sFileSpec = oON)) then
  1017.             runType := Transmit
  1018.         else if (token = oRECEIVE) then
  1019.             runType := Receive;
  1020.         end;     
  1021.     oSTATUS    : PrintStatus;
  1022.     oCONNECT   : runType := Connect;
  1023.     oDCL       : ExecShell(commandLine, commandLen);
  1024.     oHELP      : PrintHelpVMS;
  1025.     oQUESTIONM : PrintMainHelp;
  1026.     oEXIT,
  1027.      oQUIT     : exitProgram := true;
  1028.     otherwise
  1029.              PrintMessage(INVALIDCOMMAND);
  1030.    end;
  1031. end;
  1032.  
  1033.  
  1034. {  Routine to print command line prompt and get user input }
  1035. function CommandPrompt(var commandLine : string80;
  1036.                var commandLen : integer) : boolean;
  1037.  
  1038. const
  1039. %include      'kermdir:pglobal.pas/nolist'
  1040. %include      'kermdir:version.pas'
  1041.  
  1042. var
  1043.     noInput : boolean;
  1044.  
  1045. begin
  1046.     noInput := true;
  1047.  
  1048.     write(KERMITPROMPT);
  1049.     while ((noInput) and (not eof)) do
  1050.     begin
  1051.         readln(commandLine);
  1052.         commandLen := LenString(commandLine);
  1053.  
  1054.         if (commandLen > 0) then
  1055.         begin
  1056.             noInput := false;
  1057.             StrUpcase(commandLine, commandLen);
  1058.             SkipBlanks(commandLine, commandLen);
  1059.         end
  1060.          else
  1061.         write(KERMITPROMPT);
  1062.     end;
  1063.  
  1064.     CommandPrompt := not(noInput);
  1065. end;
  1066.  
  1067.  
  1068. procedure PromptAndParseUser(var exitProgram : boolean;
  1069.                  var RunType : command);
  1070.  
  1071. begin
  1072.  
  1073.     while ( not(exitProgram) and 
  1074.        not((RunType = Receive) or 
  1075.            (RunType = Transmit) or
  1076.            (RunType = Connect)) ) do
  1077.     begin
  1078.         if CommandPrompt(commandLine, commandLen) then
  1079.         ParseInput(commandLine, commandLen, RunType)
  1080.         else
  1081.         exitProgram := true;
  1082.     end;
  1083.  
  1084.     {  Set parms that could not be set normally }
  1085.     if (debugging = oOFF) then
  1086.     debug := false
  1087.     else
  1088.     debug := true;
  1089.  
  1090.     if (fileEol = oLF) then
  1091.     EOLFORFILE := LineFeed
  1092.     else if (fileEol = oCLF) then
  1093.     EOLFORFILE := CrLf
  1094.     else
  1095.     EOLFORFILE := JustCr;
  1096.  
  1097.     if (transtype = oASCII) then
  1098.     begin
  1099.         EBQstate := Ascii;
  1100.         binascflg := oASCSTATE;
  1101.     end
  1102.     else 
  1103.     begin
  1104.         EBQstate := Binary;
  1105.         binascflg := oBINSTATE;
  1106.     end;
  1107.  
  1108.     vmsFilePnt := 0;
  1109. end;
  1110.