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

 
Output of file : MSTRANS.PAS contained in archive : ISSUE-31.ZIP
{ 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, ( 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 : MSTRANS.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/