Category : Files from Magazines
Archive   : ISSUE-31.ZIP
Filename : CPMTRANS.PAS

 
Output of file : CPMTRANS.PAS contained in archive : ISSUE-31.ZIP
{ File Transfer Program: CP/M to MS-DOS }
{ Created 4/1/86 -- last edit 5/22/86 }
{ Copyright (c) 1986 by Gregory C. Flothe }
{ All Rights Reserved }
{ Permission granted to copy for academic }
{ and educational purposes only. }

PROGRAM Transfer;
CONST
RatePort= 0; {Baud rate port address}
DataPort= 4; {Serial port data registers}
StatPort= 6; {Status register address}
BaudCode300= 5; {Codes for baud rate port}
BaudCode1200= 7;
BaudCode4800= $0C;
BaudCode9600= $0E;
SOH= 1; {Start-Of-Header character}
RecSize= 128; {# of records in a block}

TYPE
ModeType= (send, receive);

VAR
Mode: ModeType;
Source, Dest: File;
Response: Char;
RemBlks: String[5];
FileName: String[14];
Buffer: ARRAY[1 .. RecSize] OF Byte;
PrintEnable, OK,
PrintOn: Boolean;
BufByte: Byte;
Baud, Bytecount,
HighRem,
Remaining: Integer;

PROCEDURE LogOn;
BEGIN
ClrScr;
writeln('File Transfer Utility Program -- Version 1.0');
writeln('for KayPro II running under CP/M 2.2');
writeln('Copyright (c) 1986 by Greg C. Flothe');
writeln('All Rights Reserved');
Delay(3000);
END; {LogOn}

PROCEDURE BaudRate; {adjusts port speed with baud code byte}
VAR Baudtype: integer;
BEGIN
writeln('Baud Rate currently at ', Baud);
write('Change rate? '); readln(Response);
IF UpCase(Response) = 'Y' THEN
BEGIN
write('Enter 1>300 2>1200 3>4800 4>9600: ');
readln(BaudType);
CASE BaudType OF {Baud code sent to RatePort}
1: BEGIN
Baud:= 300;
Port[RatePort]:= BaudCode300;
END;
2: BEGIN
Baud:= 1200;
Port[RatePort]:= BaudCode1200;
END;
3: BEGIN
Baud:= 4800;
Port[RatePort]:= BaudCode4800;
END;
4: BEGIN
Baud:= 9600;
Port[RatePort]:= BaudCode9600;
END;
END;
writeln('Baud Rate set to ',Baud,' BPS.');
END; {if}
END; {BaudRate}

PROCEDURE SetUpIO; {change input/output parameters}
BEGIN
ClrScr;
BaudRate;
writeln; write('I/O MODE - ');
CASE Mode OF
send: writeln('TRANSMIT');
receive: writeln('RECEIVE');
END;
writeln; write('Change Mode (Y/N)? ');
readln(Response);
IF UpCase(Response) = 'Y' THEN
BEGIN
write('THIS terminal in SEND or RECEIVE mode? ');
REPEAT
readln(Response);
UNTIL UpCase(Response) IN ['R','S'];
CASE UpCase(Response) OF
'R': Mode:= receive;
'S': Mode:= send;
END; {case}
END;
writeln;
END; {SetUpIO}

PROCEDURE WaitForChar;
BEGIN
REPEAT
OK:= (Port[StatPort] AND $01) = 1; {wait for char.}
UNTIL KeyPressed OR OK;
END; {WaitForChar}

PROCEDURE WaitToSend;
BEGIN
REPEAT
OK:= (Port[StatPort] AND $04 > 0); {ok to transmit?}
UNTIL KeyPressed OR OK;
END; {WaitToSend}

PROCEDURE InBlock; {read a block from serial port}
BEGIN
Bytecount:= 1;
WHILE Bytecount <= RecSize DO
BEGIN
WaitForChar;
Buffer[Bytecount]:= Port[DataPort]; {read char. from port}
WaitToSend;
Port[DataPort]:= Buffer[Bytecount]; {echo character to port}
IF PrintOn THEN
BEGIN
IF ((Remaining = 1) AND (Buffer[Bytecount] = 26)) THEN
PrintOn:= false {search for ^Z (EOF) to halt output}
ELSE
write(Char(Buffer[Bytecount]));
END;
Bytecount:= succ(Bytecount); {increment byte pointer}
END; {while bytecount}
END; {InBlock}

PROCEDURE GetHeader; {Set up incoming file for transfer}
BEGIN
REPEAT
UNTIL KeyPressed OR (Port[DataPort] = SOH); {test for SOH character}
Port[DataPort]:= SOH;
WaitForChar;
Remaining:= Port[DataPort]; {read low remaining record count}
Port[DataPort]:= Remaining; {echo it}
WaitForChar;
HighRem:= Port[DataPort]; {read high remaining rec. count}
Remaining:= HighRem shl 8 + Remaining; {re-join low & high bytes}
Port[DataPort]:= Hi(Remaining); {echo high byte of record count}
END; {GetHeader}

PROCEDURE ReceiveFile; {read a file from serial port and write to disk}
BEGIN
writeln;
write('Name of file to be received? ');
readln(FileName);
writeln;
IF FileName <> '' THEN
BEGIN
assign(Dest,FileName);
Rewrite(Dest);
write('Incoming file ready? '); {wait for ready signal}
readln(Response);
IF UpCase(Response) = 'Y' THEN
BEGIN
GetHeader; {Wait for SOH char., read # of blocks remaining}
writeln;
Str(Remaining:5,RemBlks); {convert Remaining to 5-digit string}

writeln('Blocks to be transferred: ',RemBlks);
writeln;
PrintOn:= PrintEnable; {turn on display if enabled}
WHILE Remaining > 0 DO
BEGIN {read Remaining # of blocks until done}
InBlock;
BlockWrite(Dest,Buffer,1); {write to new file on disk}
Remaining:= pred(Remaining);
END; {while remaining}
close(Dest);
writeln;
writeln('File ',FileName,' written to disk.');
END; {if}
END
ELSE writeln('Aborting RECEIVE procedure.');
END; {ReceiveFile}

PROCEDURE OutBlock; {send a block of data to serial port}
BEGIN
Bytecount:= 1;
WHILE Bytecount <= RecSize DO
BEGIN
WaitToSend;
Port[DataPort]:= Buffer[Bytecount]; {send byte}
WaitForChar;
BufByte:= Port[DataPort]; {read echoed character}
IF PrintOn THEN
BEGIN
IF ((Remaining = 1) AND (BufByte = 26)) THEN
PrintOn:= false {test for ^Z (EOF character)}
ELSE
write(Char(BufByte));
END;
Bytecount:= succ(Bytecount);
END;
END; {OutBlock}

PROCEDURE SendHeader;
BEGIN
Remaining:= FileSize(Source); {get # of records to transmit}
writeln; writeln('File ',FileName,' contains ',Remaining,' records.');
Port[DataPort]:= SOH; {send start-of-header}
REPEAT
UNTIL KeyPressed OR (Port[DataPort] = SOH); {wait for echo}
Port[DataPort]:= Lo(Remaining); {send low block count}
REPEAT
UNTIL KeyPressed OR (Port[DataPort] = Lo(Remaining)); {wait for verify}
Port[DataPort]:= Hi(Remaining); {send high block count}
REPEAT
UNTIL KeyPressed OR (Port[DataPort] = Hi(Remaining)); {wait for verify}
END; {SendHeader}

PROCEDURE SendFile; {send file to serial port}
BEGIN
writeln;
REPEAT
writeln;
write('Transfer from file name: ');
readln(FileName);
assign(Source, FileName);
{$I-} reset(source) {$I+};
OK:= (IOresult=0);
IF NOT OK THEN
writeln('Cannot find file ',FileName);
UNTIL (OK = true) OR (FileName = '');
IF OK THEN
BEGIN
SendHeader;
PrintOn:= PrintEnable; {turn on screen display}
WHILE Remaining > 0 DO
BEGIN
BlockRead(Source, Buffer, 1); {get a block from disk}
OutBlock; {send it to serial port}
Remaining:=pred(Remaining); {until Remaining = 0}
END;
writeln; writeln('File ',FileName,' transferred.');
close(Source);
END {if}
ELSE
writeln('Aborting SEND procedure.');
END; {SendFile}

BEGIN {Transfer} {main program begins here}
Baud:= 1200;
Port[RatePort]:= BaudCode1200; {set up 1200 baud rate, receive mode}
Mode:= receive; {Default Mode = receive}
LogOn;
REPEAT
SetUpIo;
REPEAT
writeln('If this is a TEXT file, would you like the file');
write('displayed on the screen? ');
readln(Response);
IF UpCase(Response) = 'N' THEN
PrintEnable:= false {disable/enable screen output}
ELSE
PrintEnable:= true;
IF Mode = send THEN
SendFile
ELSE ReceiveFile;
writeln;
write('Transfer another file (Y/N)? ');
readln(Response);
UNTIL UpCase(Response) = 'N';
write('Change Parameters, ( to exit)? ');
readln(Response);
UNTIL UpCase(Response) = 'N';
writeln;writeln('TRANSFER program done.');
END. {Transfer}


  3 Responses to “Category : Files from Magazines
Archive   : ISSUE-31.ZIP
Filename : CPMTRANS.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/