home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programming
/
powerprogramming1994.iso
/
progtool
/
microcrn
/
issue_31.arc
/
MSTRANS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1979-12-31
|
10KB
|
334 lines
{ File Transfer Program: MS-DOS to CP/M
Created 4/4/86 -- last edit 5/5/86
Copyright (c) 1986 by Gregory C. Flothe
All Rights Reserved
Permission granted to copy for academic
and educational purposes only.
}
PROGRAM Transfer;
CONST
BaudCode300= 2;
BaudCode1200= 4;
BaudCode4800= 6;
BaudCode9600= 7;
SOH= 1;
RecSize= 128;
TYPE
ModeType= (send,receive);
regpack = RECORD
ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
END;
VAR
Mode: ModeType;
Source, Dest: File;
Response: Char;
RemBlks: String[5];
FileName: String[14];
Buffer: ARRAY[1 .. RecSize] OF Byte;
PrintEnable,
OK,PrintOn: Boolean;
Baud, Bytecount,
NewChar,
HighRem,StatWord,
Remaining: Integer;
recpack: regpack;
BaudByte,
ah,al: byte;
PROCEDURE LogOn;
BEGIN
ClrScr;
writeln('File Transfer Utility Program -- Version 1.0');
writeln('for Zenith Z-130 and IBM PC-Compatibles');
writeln('running under MS-DOS 3.1');
writeln;
writeln('Copyright (c) 1986 by Greg C. Flothe');
writeln('All Rights Reserved');
Delay(3000);
END; {LogOn}
PROCEDURE InitPort; {BaudByte contains current 3-bit Baud code}
BEGIN
ah:= 0; {Init. port code -- '0' -- to high byte of AX}
al:= BaudByte shl 5 + $03; {Baud code, no parity, 1 stop bit, 8-bit char}
WITH recpack DO
BEGIN
ax:= ah shl 8 + al; {combine codes into AX register}
dx:= 0; {DX contains serial port number}
END;
intr($14, recpack); {interrupt & change serial port parameters}
writeln('Serial Port Ready');
END;
PROCEDURE BaudRate; {establish serial port speed with code}
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
1: BEGIN {Assign baud code constant by 1 .. 4}
Baud:= 300;
BaudByte:= BaudCode300;
END;
2: BEGIN
Baud:= 1200;
BaudByte:= BaudCode1200;
END;
3: BEGIN
Baud:= 4800;
BaudByte:= BaudCode4800;
END;
4: BEGIN
Baud:= 9600;
BaudByte:= BaudCode9600;
END;
END;
END; {if}
initport; {send Baud code to serial port}
writeln('Baud Rate set to ',Baud,' BPS.');
END; {BaudRate}
PROCEDURE SetUpIO; {Set Input/Output speed, flow}
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;
END;
writeln;
END; {SetUpIO}
PROCEDURE TestPort(VAR StatWord: integer);
BEGIN
REPEAT
ah:= 3; {high AX = 03 -- test status code}
WITH recpack DO
BEGIN
ax:= ah shl 8;
dx:=0; {DX register contains port number ('0' for COM1)}
END;
intr($14, recpack);
WITH recpack DO
OK:= (ax AND StatWord > 0);
UNTIL KeyPressed OR OK;
END; {testport}
PROCEDURE OutChar(VAR NewChar: integer);
BEGIN
StatWord:=$2000; {wait for xmit holding register to clear}
TestPort(StatWord);
ah:= 1; {out char. code -- '1' -- to high AX}
al:= NewChar; {New Character in low AX byte}
WITH recpack DO
ax:= ah shl 8 + al; {combine code with char. in AX register}
intr($14, recpack); {interrupt and send character to port}
END; {outchar}
PROCEDURE InChar(VAR NewChar: Integer);
BEGIN
StatWord:= $100; {wait for data ready = true}
TestPort(StatWord);
{get char when OK}
ah:= 2; {in char. code -- '2' -- to high AX}
WITH recpack DO
BEGIN
ax:= ah shl 8;
dx:= 0;
END;
intr($14, recpack); {interrupt for serial port service}
WITH recpack DO
NewChar:= Lo(ax); {New Char. returned in low AX byte}
END;
PROCEDURE GetHeader;
BEGIN
REPEAT {wait for Start Of Header 'SOH' char.}
InChar(NewChar);
UNTIL KeyPressed OR (NewChar = SOH);
OutChar(NewChar); {echo SOH flag}
InChar(NewChar); {read low block count byte}
Remaining:= NewChar; {save lower byte}
OutChar(Remaining); {echo for confirmation}
InChar(NewChar); {get high block count}
HighRem:=NewChar; {save it}
OutChar(NewChar); {echo high count byte}
Remaining:= HighRem shl 8 + Remaining; {restore Remaining}
END; {GetHeader}
PROCEDURE InBlock;
BEGIN
Bytecount:= 1;
WHILE Bytecount <= RecSize DO {read a block from port}
BEGIN
InChar(NewChar); {get char}
Buffer[Bytecount]:= NewChar; {store it}
OutChar(NewChar); {echo char}
IF PrintOn THEN
BEGIN
IF ((Remaining = 1) AND (NewChar = 26)) THEN
PrintOn:= false {search for ^Z (EOF) to halt output}
ELSE
write(Char(NewChar));
END;
Bytecount:= succ(Bytecount);
END; {while Bytecount}
END; {InBlock}
PROCEDURE ReceiveFile; {get a file from ser. port & store it}
BEGIN
writeln; write('Name of file to be received? ');
readln(FileName);
writeln;
IF FileName <> '' THEN
BEGIN
Assign(Dest, FileName); {open file for write}
Rewrite(Dest);
writeln;
write('Incoming File Ready (Y/N)? '); {wait for cue}
readln(Response);
IF UpCase(Response) = 'Y' THEN
BEGIN
GetHeader;
writeln;
Str(Remaining:5,RemBlks); {turn Remaining into a string}
writeln('Blocks to be transferred: ', RemBlks); {print it}
writeln;
PrintOn:= PrintEnable; {send copy to screen if desired}
WHILE Remaining > 0 DO
BEGIN {Remaining is # of blocks to be read}
InBlock;
BlockWrite(Dest,Buffer,1); {save complete record to disk}
Remaining:= pred(Remaining);
END; {while Remaining}
close(Dest);
writeln;
writeln; writeln('File ',FileName,' written to disk.');
END; {if Response}
END {if FileName <> ''}
ELSE writeln('Aborting RECEIVE procedure.');
END; {ReceiveFile}
PROCEDURE SendHeader;
BEGIN
NewChar:= SOH;
OutChar(NewChar); {Send Start-Of-Header char.}
REPEAT
InChar(NewChar);
UNTIL KeyPressed OR (NewChar = SOH); {wait for echo}
NewChar:= Lo(Remaining);
OutChar(NewChar); {Send low-order byte of Remaining}
REPEAT
InChar(NewChar);
UNTIL KeyPressed OR (NewChar = Lo(Remaining)); {wait for confirm.}
NewChar:= Hi(Remaining);
OutChar(NewChar); {High-order byte to serial port}
REPEAT
InChar(newChar);
UNTIL KeyPressed OR (NewChar = Hi(Remaining)); {wait for confirm.}
END; {SendHeader}
PROCEDURE OutBlock; {Send a block to serial port}
BEGIN
Bytecount:= 1;
WHILE Bytecount <= RecSize DO
BEGIN
NewChar:= Buffer[Bytecount];
OutChar(NewChar);
IF PrintOn THEN
BEGIN
IF ((Remaining = 1) AND (NewChar = 26)) THEN
PrintOn:= false
ELSE
write(Char(NewChar));
END;
InChar(NewChar);
Bytecount:= succ(Bytecount);
END;
END; {OutBlock}
PROCEDURE SendFile; {get an MS-DOS file and transfer it}
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
Remaining:= FileSize(Source);
writeln; writeln('File ',FileName,' contains ',Remaining,' records.');
writeln;
SendHeader;
PrintOn:= PrintEnable;
WHILE Remaining > 0 DO {send 1 block at a time until done}
BEGIN
BlockRead(Source, Buffer, 1);
OutBlock;
Remaining:=pred(Remaining);
END;
writeln;
writeln; writeln('File ',FileName,' transferred.');
close(Source);
END {if}
ELSE
writeln('Aborting SEND procedure.');
END; {SendFile}
BEGIN {Transfer} {main program begins here}
LogOn;
Baud:=1200; {set up default parameters -- 1200 Baud, Receive Mode}
BaudByte:=BaudCode1200;
Mode:= receive;
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}
σσσσσσσσσσσσσσσσσσσσ