home *** CD-ROM | disk | FTP | other *** search
/ ftp.whtech.com / ftp.whtech.com.tar / ftp.whtech.com / compuserve / P-Code / REMTLK.PAS < prev    next >
Pascal/Delphi Source File  |  2006-10-19  |  10KB  |  363 lines
  1.  
  2. (*
  3.         Source and object code for the REMTALK utility are provided
  4. in "as is" condition. No warranty is made, particularly with respect
  5. to fitness for a particular purpose.
  6.         Copies of source and object code for the REMTALK utility may 
  7. be used for any lawful purpose providing each copy retains all markings
  8. and legends that appear on or in the source and object code items. Failure
  9. to include such markings and legends is a violation of U.S. Copyright Laws.
  10. *)
  11.  
  12. (*$R-,I-*)
  13. (*NATIVE*)
  14. (*$L PRINTER:*)
  15. PROGRAM REMOTETALK;
  16.  
  17. CONST version='IV.0 a1';
  18.       res_segs='fileops,pascalio,extraio,heapops'; {resident segments}
  19.       slop=2000; {extra slop for buffer allocation}
  20.       
  21.       REMIN=7;
  22.       REMOUT=8;
  23.       FINALBLOCK=50;
  24.       NOTLASTBLOCK=51;
  25.       SENDAGAIN=52;
  26.       SENDNEXT=53;
  27.       ABORT=54;
  28.       UNSLAVE=55;
  29.       CLOSEFILE=56;
  30.       RECEIVEFILE=57;
  31.       SENDFILE=58;
  32.       OPENFILE=59;
  33.       FILEOPENED=60;
  34.       BUMFILE=61;
  35.       FILECLOSED=62;
  36.  
  37. TYPE BYTE=0..255;
  38.      BLOCK=PACKED ARRAY[0..511] OF BYTE;
  39.      TWOBYTES=PACKED ARRAY[0..1] OF BYTE;
  40.      SETOFCHAR=SET OF CHAR;
  41.      BLOCKARRAY=ARRAY[0..0] OF BLOCK;
  42.      BLOCKPTR=^BLOCKARRAY;
  43.  
  44. VAR BUFF,FOON:BLOCKPTR;
  45.     PACKBLOCK:BLOCK;
  46.     FILENAME:STRING;
  47.     INCH:CHAR;
  48.     F:FILE;
  49.     COMMAND:PACKED ARRAY[0..81] OF BYTE;
  50.     FIRSTBLOCK,UNITNUM,LASTBLOCK,UNOCNTR,BUFFSIZE:INTEGER;
  51.  
  52.   PROCEDURE SIGNAL(COMMAND:INTEGER);
  53.   VAR WART:TWOBYTES;
  54.   BEGIN
  55.     WART[0]:=COMMAND;
  56.     UNITWRITE(REMOUT,WART[0],1,0,12);
  57.   END;
  58.   
  59.   FUNCTION WAIT:INTEGER;
  60.   VAR WART:TWOBYTES;
  61.   BEGIN
  62.     UNITREAD(REMIN,WART[0],1,0,12);
  63.     WAIT:=WART[0];
  64.   END;
  65.   
  66.   PROCEDURE UNO(CH:CHAR);
  67.   BEGIN
  68.     UNOCNTR:=UNOCNTR+1;
  69.     WRITE(CH);
  70.     IF UNOCNTR=40 THEN
  71.     BEGIN
  72.       WRITELN;
  73.       UNOCNTR:=0;
  74.     END;
  75.   END;
  76.   
  77.   FUNCTION GETCHAR(OKSET:SETOFCHAR):CHAR;
  78.   VAR CH:CHAR;
  79.   BEGIN
  80.     REPEAT
  81.       READ(KEYBOARD,CH);
  82.       IF CH IN ['a'..'z'] THEN
  83.         CH:=CHR(ORD(CH)-ORD('a')+ORD('A'));
  84.     UNTIL CH IN OKSET;
  85.     WRITELN(CH);
  86.     GETCHAR:=CH;
  87.   END;
  88.   
  89.   PROCEDURE RECEIVEIT;
  90.   VAR INBLOCK:PACKED ARRAY[0..1025] OF BYTE;
  91.       JUSTONE:TWOBYTES;
  92.       BADOUTPUT:BOOLEAN;
  93.       BYTENUM,CHECKSUM,BUFFPTR,BYTE0,BYTE1,ANSWER:INTEGER;
  94.   
  95.     FUNCTION PUTBLOCK(VAR ONEBLOCK:BLOCK):BOOLEAN;
  96.     BEGIN
  97.       PUTBLOCK:=TRUE;
  98.       BUFF^[BUFFPTR]:=ONEBLOCK;
  99.       BUFFPTR:=BUFFPTR+1;
  100.       IF BUFFPTR=BUFFSIZE THEN
  101.       BEGIN
  102.         PUTBLOCK:=BLOCKWRITE(F,BUFF^,BUFFSIZE)=BUFFSIZE;
  103.         BUFFPTR:=0;
  104.       END;
  105.     END;
  106.     
  107.   BEGIN
  108.     BUFFPTR:=0;
  109.     UNOCNTR:=0;
  110.     BADOUTPUT:=FALSE;
  111.     REPEAT
  112.       ANSWER:=WAIT;
  113.       IF ANSWER=NOTLASTBLOCK THEN
  114.       BEGIN
  115.         UNITREAD(REMIN,INBLOCK,1026,0,12);
  116.         CHECKSUM:=0;
  117.         FOR BYTENUM:=0 TO 511 DO
  118.         BEGIN
  119.           BYTE0:=ORD(ODD(15) AND ODD(INBLOCK[BYTENUM+BYTENUM]));
  120.           BYTE1:=ORD(ODD(15) AND ODD(INBLOCK[BYTENUM+BYTENUM+1]));
  121.           PACKBLOCK[BYTENUM]:=BYTE0*16+BYTE1;
  122.           CHECKSUM:=CHECKSUM+BYTE0+BYTE1;
  123.         END;
  124.         IF CHECKSUM=ORD(ODD(127) AND ODD(INBLOCK[1024]))*128+
  125.            ORD(ODD(127) AND ODD(INBLOCK[1025])) THEN
  126.         BEGIN
  127.           IF PUTBLOCK(PACKBLOCK) THEN
  128.           BEGIN
  129.             UNO('.');
  130.             SIGNAL(SENDNEXT);
  131.           END ELSE
  132.           BEGIN
  133.             BADOUTPUT:=TRUE;
  134.             SIGNAL(ABORT);
  135.           END;
  136.         END ELSE
  137.         BEGIN
  138.           UNO('?');
  139.           SIGNAL(SENDAGAIN);
  140.         END;
  141.       END ELSE
  142.         IF ANSWER=ABORT THEN
  143.           BEGIN
  144.             WRITELN;
  145.             WRITE(' ERROR in input file');
  146.           END;
  147.     UNTIL ANSWER IN [FINALBLOCK,ABORT];
  148.     BADOUTPUT:=BADOUTPUT OR (BLOCKWRITE(F,BUFF^,BUFFPTR)<>BUFFPTR);
  149.     CLOSE(F,LOCK);
  150.     IF (IORESULT<>0) OR BADOUTPUT THEN
  151.     BEGIN
  152.       SIGNAL(ABORT);
  153.       WRITELN;
  154.       WRITE(' ERROR in output file');
  155.     END ELSE
  156.       SIGNAL(FILECLOSED);
  157.   END;
  158.   
  159.   PROCEDURE SENDIT;
  160.   VAR ANS,BYTE0,BYTE1,BYTENUM,CHECKSUM,BLOCKSREAD,BUFFPTR:INTEGER;
  161.       BADINPUT:BOOLEAN;
  162.       UNPACKBLOCK:PACKED ARRAY[0..1023] OF BYTE;
  163.       JUSTTWO:TWOBYTES;
  164.   
  165.     FUNCTION GETBLOCK(VAR ONEBLOCK:BLOCK):BOOLEAN;
  166.     BEGIN
  167.       BUFFPTR:=BUFFPTR+1;
  168.       IF BUFFPTR>=BLOCKSREAD THEN
  169.       BEGIN
  170.         BLOCKSREAD:=BLOCKREAD(F,BUFF^,BUFFSIZE);
  171.         BADINPUT:=IORESULT<>0;
  172.         BUFFPTR:=0;
  173.       END;
  174.       GETBLOCK:=(BLOCKSREAD<>0) AND (NOT BADINPUT);
  175.       ONEBLOCK:=BUFF^[BUFFPTR];
  176.     END;
  177.     
  178.   BEGIN
  179.     BADINPUT:=FALSE;
  180.     UNOCNTR:=0;
  181.     BUFFPTR:=-1;
  182.     BLOCKSREAD:=0;
  183.     ANS:=SENDNEXT;
  184.     WHILE GETBLOCK(PACKBLOCK) AND (ANS<>ABORT) DO
  185.     BEGIN
  186.       CHECKSUM:=0;
  187.       SIGNAL(NOTLASTBLOCK);
  188.       FOR BYTENUM:=0 TO 511 DO
  189.       BEGIN
  190.         BYTE0:=PACKBLOCK[BYTENUM] DIV 16;
  191.         UNPACKBLOCK[BYTENUM+BYTENUM]:=BYTE0;
  192.         BYTE1:=ORD(ODD(PACKBLOCK[BYTENUM]) AND ODD(15));
  193.         UNPACKBLOCK[BYTENUM+BYTENUM+1]:=BYTE1;
  194.         CHECKSUM:=CHECKSUM+BYTE0+BYTE1;
  195.       END;
  196.       UNITWRITE(REMOUT,UNPACKBLOCK,1024,0,12);
  197.       JUSTTWO[0]:=CHECKSUM DIV 128;
  198.       JUSTTWO[1]:=ORD(ODD(CHECKSUM) AND ODD(127));
  199.       UNITWRITE(REMOUT,JUSTTWO,2,0,12);
  200.       ANS:=WAIT;
  201.       CASE ANS OF
  202.         SENDNEXT :UNO('.');
  203.         SENDAGAIN:BEGIN
  204.                     BUFFPTR:=BUFFPTR-1;
  205.                     UNO('?');
  206.                   END;
  207.       END;
  208.     END;
  209.     CLOSE(F);
  210.     IF BADINPUT THEN
  211.     BEGIN
  212.       WRITELN;
  213.       WRITE(' ERROR in input file');
  214.       SIGNAL(ABORT);
  215.     END ELSE
  216.       SIGNAL(FINALBLOCK);
  217.     IF WAIT<>FILECLOSED THEN
  218.       BEGIN
  219.         WRITELN;
  220.         WRITE(' ERROR in output file');
  221.       END;
  222.   END;
  223.   
  224.   PROCEDURE DOCOMMAND(SENDORRECEIVE:CHAR);
  225.   VAR CH:CHAR;
  226.       I,TRANSFERUNIT:INTEGER;
  227.       ANSWER:TWOBYTES;
  228.       S:STRING;
  229.   BEGIN
  230.     FILLCHAR(COMMAND,82,0);
  231.     IF SENDORRECEIVE='S' THEN
  232.     BEGIN
  233.       COMMAND[0]:=SENDFILE;
  234.       REPEAT
  235.         WRITE('  Send what file? ');
  236.         READLN(S);
  237.         IF LENGTH(S)=0 THEN
  238.           EXIT(DOCOMMAND);
  239.         RESET(F,S);
  240.       UNTIL IORESULT=0;
  241.       REPEAT
  242.         WRITE('  Send to what remote file? ');
  243.         READLN(S);
  244.         IF LENGTH(S)=0 THEN
  245.         BEGIN
  246.           CLOSE(F);
  247.           EXIT(DOCOMMAND);
  248.         END;
  249.         FOR I:=0 TO LENGTH(S) DO
  250.           COMMAND[I+1]:=ORD(S[I]);
  251.         UNITWRITE(REMOUT,COMMAND,82,0,12);
  252.       UNTIL WAIT=FILEOPENED;
  253.       SENDIT;
  254.     END ELSE
  255.     BEGIN
  256.       REPEAT
  257.         WRITE('  Receive what remote file? ');
  258.         READLN(S);
  259.         IF LENGTH(S)=0 THEN
  260.           EXIT(DOCOMMAND);
  261.         COMMAND[0]:=OPENFILE;
  262.         FOR I:=0 TO LENGTH(S) DO
  263.           COMMAND[I+1]:=ORD(S[I]);
  264.         UNITWRITE(REMOUT,COMMAND,82,0,12);
  265.       UNTIL WAIT=FILEOPENED;
  266.       REPEAT
  267.         WRITE('  Write to what file? ');
  268.         READLN(S);
  269.         IF LENGTH(S)=0 THEN
  270.         BEGIN
  271.           COMMAND[0]:=CLOSEFILE;
  272.           UNITWRITE(REMOUT,COMMAND,82,0,12);
  273.           EXIT(DOCOMMAND);
  274.         END;
  275.         REWRITE(F,S);
  276.       UNTIL IORESULT=0;
  277.       COMMAND[0]:=RECEIVEFILE;
  278.       UNITWRITE(REMOUT,COMMAND,82,0,12);
  279.       RECEIVEIT;
  280.     END;
  281.   END;
  282.   
  283.   PROCEDURE DOSLAVECOMMANDS;
  284.   VAR I:INTEGER;
  285.       S:STRING;
  286.   BEGIN
  287.     REPEAT
  288.       UNITREAD(REMIN,COMMAND,82,0,12);
  289.       FOR I:=0 TO COMMAND[1] DO
  290.         S[I]:=CHR(COMMAND[I+1]);
  291.       WRITELN;
  292.       CASE COMMAND[0] OF
  293.         CLOSEFILE  :CLOSE(F);
  294.         SENDFILE   :BEGIN
  295.                       REWRITE(F,S);
  296.                       IF IORESULT=0 THEN
  297.                       BEGIN
  298.                         WRITE('Opening new file: ',S);
  299.                         COMMAND[0]:=FILEOPENED;
  300.                       END ELSE
  301.                       BEGIN
  302.                         WRITE('ERROR opening new file: ',S);
  303.                         COMMAND[0]:=BUMFILE;
  304.                       END;
  305.                       UNITWRITE(REMOUT,COMMAND,1,0,12);
  306.                       WRITELN;
  307.                       IF COMMAND[0]=FILEOPENED THEN
  308.                         RECEIVEIT;
  309.                     END;
  310.         RECEIVEFILE:SENDIT;
  311.         OPENFILE   :BEGIN
  312.                       RESET(F,S);
  313.                       IF IORESULT=0 THEN
  314.                       BEGIN
  315.                         WRITE('Opening old file: ',S);
  316.                         COMMAND[0]:=FILEOPENED;
  317.                       END ELSE
  318.                       BEGIN
  319.                         WRITE('ERROR opening old file: ',S);
  320.                         COMMAND[0]:=BUMFILE;
  321.                       END;
  322.                       UNITWRITE(REMOUT,COMMAND,1,0,12);
  323.                     END;
  324.       END;
  325.     UNTIL COMMAND[0]=UNSLAVE;
  326.   END;
  327.   
  328. BEGIN
  329.   buffsize:= 1 + ((varavail(res_segs)-slop) div 256);
  330.   if varnew(buff,buffsize*256) = 0
  331.     then
  332.       begin
  333.         writeln('program error allocating buffer');
  334.         exit(program);
  335.       end;
  336.   WRITELN('REMTALK [',version,'] - press S(lave first');
  337.   REPEAT
  338.     WRITE('M(aster  S(lave  Q(uit ');
  339.     CASE GETCHAR(['M','S','Q']) OF
  340.       'M':BEGIN
  341.             REPEAT
  342.               WRITE('  S(end  R(eceive  Q(uit ');
  343.               INCH:=GETCHAR(['S','R','Q']);
  344.               CASE INCH OF
  345.                 'S',
  346.                 'R':DOCOMMAND(INCH);
  347.                 'Q':BEGIN
  348.                       COMMAND[0]:=UNSLAVE;
  349.                       UNITWRITE(REMOUT,COMMAND,82,0,12);
  350.                     END;
  351.               END;
  352.               WRITELN;
  353.             UNTIL INCH='Q';
  354.           END;
  355.       'S':DOSLAVECOMMANDS;
  356.       'Q':EXIT(REMOTETALK);
  357.     END;
  358.     WRITELN;
  359.   UNTIL FALSE;
  360. END.
  361.  
  362.  
  363.