home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / msdos / microcrn / issue_31.arc / CPMTRANS.PAS next >
Encoding:
Pascal/Delphi Source File  |  1979-12-31  |  8.6 KB  |  277 lines
  1. {              File Transfer Program: CP/M to MS-DOS                  }
  2. {               Created 4/1/86 -- last edit 5/22/86                   }
  3. {             Copyright (c) 1986 by Gregory C. Flothe                 }
  4. {                       All Rights Reserved                           }
  5. {             Permission granted to copy for academic                 }
  6. {                 and educational purposes only.                      }
  7.  
  8. PROGRAM Transfer;
  9. CONST
  10.   RatePort=        0;         {Baud rate port address}
  11.   DataPort=        4;         {Serial port data registers}
  12.   StatPort=        6;         {Status register address}
  13.   BaudCode300=     5;         {Codes for baud rate port}
  14.   BaudCode1200=    7;
  15.   BaudCode4800=    $0C;
  16.   BaudCode9600=    $0E;
  17.   SOH=             1;         {Start-Of-Header character}
  18.   RecSize=         128;       {# of records in a block}
  19.  
  20. TYPE
  21.   ModeType=        (send, receive);
  22.  
  23. VAR
  24.   Mode:            ModeType;
  25.   Source, Dest:    File;
  26.   Response:        Char;
  27.   RemBlks:         String[5];
  28.   FileName:        String[14];
  29.   Buffer:          ARRAY[1 .. RecSize] OF Byte;
  30.   PrintEnable, OK,
  31.   PrintOn:         Boolean;
  32.   BufByte:         Byte;
  33.   Baud, Bytecount,
  34.   HighRem,
  35.   Remaining:       Integer;
  36.  
  37. PROCEDURE LogOn;
  38. BEGIN
  39.   ClrScr;
  40.   writeln('File Transfer Utility Program -- Version 1.0');
  41.   writeln('for KayPro II running under CP/M 2.2');
  42.   writeln('Copyright (c) 1986 by Greg C. Flothe');
  43.   writeln('All Rights Reserved');
  44.   Delay(3000);
  45. END;  {LogOn}
  46.  
  47. PROCEDURE BaudRate;       {adjusts port speed with baud code byte}
  48. VAR Baudtype: integer;
  49. BEGIN
  50.   writeln('Baud Rate currently at ', Baud);
  51.   write('Change rate? '); readln(Response);
  52.   IF UpCase(Response) = 'Y' THEN
  53.     BEGIN
  54.       write('Enter 1>300  2>1200  3>4800  4>9600: ');
  55.       readln(BaudType);
  56.       CASE BaudType OF       {Baud code sent to RatePort}
  57.        1: BEGIN
  58.             Baud:= 300;
  59.             Port[RatePort]:= BaudCode300;
  60.           END;
  61.        2: BEGIN
  62.             Baud:= 1200;
  63.             Port[RatePort]:= BaudCode1200;
  64.           END;
  65.        3: BEGIN
  66.             Baud:= 4800;
  67.             Port[RatePort]:= BaudCode4800;
  68.           END;
  69.        4: BEGIN
  70.             Baud:= 9600;
  71.             Port[RatePort]:= BaudCode9600;
  72.           END;
  73.       END;
  74.       writeln('Baud Rate set to ',Baud,' BPS.');
  75.     END;  {if}
  76. END; {BaudRate}
  77.  
  78. PROCEDURE SetUpIO;      {change input/output parameters}
  79. BEGIN
  80.   ClrScr;
  81.   BaudRate;
  82.   writeln; write('I/O MODE - ');
  83.   CASE Mode OF
  84.     send:    writeln('TRANSMIT');
  85.     receive: writeln('RECEIVE');
  86.    END;
  87.   writeln; write('Change Mode (Y/N)? ');
  88.   readln(Response);
  89.   IF UpCase(Response) = 'Y' THEN
  90.     BEGIN
  91.       write('THIS terminal in SEND or RECEIVE mode? ');
  92.       REPEAT
  93.         readln(Response);
  94.       UNTIL UpCase(Response) IN ['R','S'];
  95.       CASE UpCase(Response) OF
  96.         'R':  Mode:= receive;
  97.         'S':  Mode:= send;
  98.       END; {case}
  99.     END;
  100.   writeln;
  101. END;  {SetUpIO}
  102.  
  103. PROCEDURE WaitForChar;
  104. BEGIN
  105.   REPEAT
  106.     OK:= (Port[StatPort] AND $01) = 1;  {wait for char.}
  107.   UNTIL KeyPressed OR OK;
  108. END;  {WaitForChar}
  109.  
  110. PROCEDURE WaitToSend;
  111. BEGIN
  112.   REPEAT
  113.     OK:= (Port[StatPort] AND $04 > 0);  {ok to transmit?}
  114.   UNTIL KeyPressed OR OK;
  115. END; {WaitToSend}
  116.  
  117. PROCEDURE InBlock;     {read a block from serial port}
  118. BEGIN
  119.   Bytecount:= 1;
  120.     WHILE Bytecount <= RecSize DO
  121.       BEGIN
  122.         WaitForChar;
  123.         Buffer[Bytecount]:= Port[DataPort];   {read char. from port}
  124.         WaitToSend;
  125.         Port[DataPort]:= Buffer[Bytecount];   {echo character to port}
  126.           IF PrintOn THEN
  127.             BEGIN
  128.               IF ((Remaining = 1) AND (Buffer[Bytecount] = 26)) THEN
  129.                 PrintOn:= false     {search for ^Z (EOF) to halt output}
  130.                   ELSE
  131.                     write(Char(Buffer[Bytecount]));
  132.             END;
  133.         Bytecount:= succ(Bytecount);  {increment byte pointer}
  134.       END; {while bytecount}
  135. END;  {InBlock}
  136.  
  137. PROCEDURE GetHeader;  {Set up incoming file for transfer}
  138. BEGIN
  139.   REPEAT
  140.   UNTIL KeyPressed OR (Port[DataPort] = SOH); {test for SOH character}
  141.   Port[DataPort]:= SOH;
  142.   WaitForChar;
  143.   Remaining:= Port[DataPort];  {read low remaining record count}
  144.   Port[DataPort]:=  Remaining; {echo it}
  145.   WaitForChar;
  146.   HighRem:= Port[DataPort];    {read high remaining rec. count}
  147.   Remaining:= HighRem shl 8 + Remaining; {re-join low & high bytes}
  148.   Port[DataPort]:= Hi(Remaining); {echo high byte of record count}
  149. END; {GetHeader}
  150.  
  151. PROCEDURE ReceiveFile;  {read a file from serial port and write to disk}
  152. BEGIN
  153.   writeln;
  154.   write('Name of file to be received? ');
  155.   readln(FileName);
  156.   writeln;
  157.   IF FileName <> '' THEN
  158.   BEGIN
  159.     assign(Dest,FileName);
  160.     Rewrite(Dest);
  161.     write('Incoming file ready? ');   {wait for ready signal}
  162.     readln(Response);
  163.     IF UpCase(Response) = 'Y' THEN
  164.      BEGIN
  165.       GetHeader;   {Wait for SOH char., read # of blocks remaining}
  166.       writeln;
  167.       Str(Remaining:5,RemBlks); {convert Remaining to 5-digit string}
  168.       writeln('Blocks to be transferred: ',RemBlks);
  169.       writeln;
  170.       PrintOn:= PrintEnable;     {turn on display if enabled}
  171.       WHILE Remaining > 0 DO
  172.       BEGIN          {read Remaining # of blocks until done}
  173.         InBlock;
  174.         BlockWrite(Dest,Buffer,1);    {write to new file on disk}
  175.         Remaining:= pred(Remaining);
  176.       END;  {while remaining}
  177.       close(Dest);
  178.       writeln;
  179.       writeln('File ',FileName,' written to disk.');
  180.     END;  {if}
  181.   END
  182.     ELSE writeln('Aborting RECEIVE procedure.');
  183. END;  {ReceiveFile}
  184.  
  185. PROCEDURE OutBlock;     {send a block of data to serial port}
  186. BEGIN
  187.   Bytecount:= 1;
  188.   WHILE Bytecount <= RecSize DO
  189.       BEGIN
  190.         WaitToSend;
  191.         Port[DataPort]:= Buffer[Bytecount];   {send byte}
  192.         WaitForChar;
  193.         BufByte:= Port[DataPort];             {read echoed character}
  194.         IF PrintOn THEN
  195.            BEGIN
  196.              IF ((Remaining = 1) AND (BufByte = 26)) THEN
  197.                PrintOn:= false       {test for ^Z (EOF character)}
  198.                ELSE
  199.                  write(Char(BufByte));
  200.            END;
  201.         Bytecount:= succ(Bytecount);
  202.       END;
  203. END; {OutBlock}
  204.  
  205. PROCEDURE SendHeader;
  206. BEGIN
  207.   Remaining:= FileSize(Source);   {get # of records to transmit}
  208.   writeln; writeln('File ',FileName,' contains ',Remaining,' records.');
  209.   Port[DataPort]:= SOH;    {send start-of-header}
  210.   REPEAT
  211.   UNTIL KeyPressed OR (Port[DataPort] = SOH);    {wait for echo}
  212.   Port[DataPort]:= Lo(Remaining);  {send low block count}
  213.   REPEAT
  214.   UNTIL KeyPressed OR (Port[DataPort] = Lo(Remaining));  {wait for verify}
  215.   Port[DataPort]:= Hi(Remaining);  {send high block count}
  216.   REPEAT
  217.   UNTIL KeyPressed OR (Port[DataPort] = Hi(Remaining));  {wait for verify}
  218. END;  {SendHeader}
  219.  
  220. PROCEDURE SendFile;         {send file to serial port}
  221. BEGIN
  222.   writeln;
  223.   REPEAT
  224.     writeln;
  225.     write('Transfer from file name: ');
  226.     readln(FileName);
  227.     assign(Source, FileName);
  228.         {$I-} reset(source) {$I+};
  229.           OK:= (IOresult=0);
  230.           IF NOT OK THEN
  231.               writeln('Cannot find file ',FileName);
  232.   UNTIL (OK = true) OR (FileName = '');
  233.   IF OK THEN
  234.     BEGIN
  235.       SendHeader;
  236.       PrintOn:= PrintEnable;     {turn on screen display}
  237.       WHILE Remaining > 0 DO
  238.             BEGIN
  239.               BlockRead(Source, Buffer, 1);  {get a block from disk}
  240.               OutBlock;                      {send it to serial port}
  241.               Remaining:=pred(Remaining);    {until Remaining = 0}
  242.             END;
  243.       writeln; writeln('File ',FileName,' transferred.');
  244.       close(Source);
  245.     END  {if}
  246.       ELSE
  247.         writeln('Aborting SEND procedure.');
  248. END; {SendFile}
  249.  
  250. BEGIN {Transfer}         {main program begins here}
  251.   Baud:= 1200;
  252.   Port[RatePort]:= BaudCode1200;  {set up 1200 baud rate, receive mode}
  253.   Mode:= receive;     {Default Mode = receive}
  254.   LogOn;
  255.   REPEAT
  256.     SetUpIo;
  257.       REPEAT
  258.         writeln('If this is a TEXT file, would you like the file');
  259.         write('displayed on the screen? ');
  260.         readln(Response);
  261.         IF UpCase(Response) = 'N' THEN
  262.         PrintEnable:= false           {disable/enable screen output}
  263.           ELSE
  264.             PrintEnable:= true;
  265.         IF Mode = send THEN
  266.           SendFile
  267.            ELSE ReceiveFile;
  268.         writeln;
  269.         write('Transfer another file (Y/N)? ');
  270.         readln(Response);
  271.       UNTIL UpCase(Response) = 'N';
  272.       write('Change Parameters, (<N> to exit)? ');
  273.       readln(Response);
  274.   UNTIL UpCase(Response) = 'N';
  275.   writeln;writeln('TRANSFER program done.');
  276. END. {Transfer}
  277.