home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programming
/
powerprogramming1994.iso
/
progtool
/
microcrn
/
issue_31.arc
/
CPMTRANS.PAS
next >
Wrap
Pascal/Delphi Source File
|
1979-12-31
|
9KB
|
277 lines
{ 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, (<N> to exit)? ');
readln(Response);
UNTIL UpCase(Response) = 'N';
writeln;writeln('TRANSFER program done.');
END. {Transfer}