Category : Pascal Source Code
Archive   : SUNCOM.ZIP
Filename : TPZVIDBK.PAS
(* Status window routines for Turbo Pascal Zmodem *)
(* (c)1988 by J.R.Louvau *)
INTERFACE
USES Crt;
PROCEDURE Z_OpenWindow(title: STRING);
(* Setup the area of the screen for transfer status window *)
PROCEDURE Z_CloseWindow;
(* Restore the original window *)
PROCEDURE Z_ShowName(filename: STRING);
(* Display the file name *)
PROCEDURE Z_ShowSize(l: LONGINT);
(* Display the file size in blocks and bytes *)
PROCEDURE Z_ShowCheck(is32: BOOLEAN);
(* Display CRC16 or CRC32 block checking *)
PROCEDURE Z_ShowTransferTime(fsize, zbaud: LONGINT);
(* Show estimated transfer time in minutes *)
PROCEDURE Z_Message(s: STRING);
(* Show miscelaneous messages *)
PROCEDURE Z_Frame(n: INTEGER);
(* Show current ZMODEM frame type *)
PROCEDURE Z_ShowLoc(l: LONGINT);
(* Show byte position of file in blocks and bytes *)
PROCEDURE Z_Errors(w: WORD);
(* Show total error count *)
IMPLEMENTATION
CONST
x1: BYTE = 20;
x2: BYTE = 59;
y1: BYTE = 5;
y2: BYTE = 17;
fore: BYTE = black;
back: BYTE = white;
bfore: BYTE = yellow;
bback: BYTE = blue;
{$F+}
{$L \turbo5\util\mcmvsmem.obj }
PROCEDURE MoveToScreen(var Source, Dest; Len: WORD);external;
PROCEDURE MoveFromScreen(var Source, Dest; Len: WORD);external;
{$F-}
VAR
vmode: BYTE absolute $0040:$0049;
vcols: WORD absolute $0040:$004A;
oldx, oldy, oldattr: BYTE;
oldmin, oldmax, cols, rows, size, vseg, vofs: WORD;
buffer: POINTER;
FUNCTION RtoS(r: REAL; width, decimals: WORD): STRING;
VAR
s: STRING;
BEGIN
{$I-}
Str(r:width:decimals,s);
{$I+}
IF (IoResult <> 0) THEN
s := ''
ELSE
WHILE (Length(s) > 0) AND (s[1] = ' ') DO
Delete(s,1,1);
RtoS := s
END;
FUNCTION ItoS(r: LONGINT; width: WORD): STRING;
VAR
s: STRING;
BEGIN
{$I-}
Str(r:width,s);
{$I+}
IF (IoResult <> 0) THEN
s := ''
ELSE
WHILE (Length(s) > 0) AND (s[1] = ' ') DO
Delete(s,1,1);
ItoS := s
END;
PROCEDURE Z_OpenWindow(title: STRING);
VAR
p, q: POINTER;
n, pads, bytes: WORD;
BEGIN
DirectVideo := TRUE;
CheckSnow := FALSE;
oldx := WhereX;
oldy := WhereY;
oldattr := TextAttr;
oldmin := WindMin;
oldmax := WindMax;
Window(x1,y1,x2,y2);
TextColor(bfore);
TextBackground(bback);
cols := Lo(WindMax) - Lo(WindMin) + 1;
rows := Hi(WindMax) - Hi(WindMin) + 1;
IF vmode = 7 THEN
vseg := $B000
ELSE
vseg := $B800;
vofs := ((Hi(WindMin) * vcols) + Lo(WindMin)) * 2;
size := (rows * cols) * 2;
bytes := cols * 2;
pads := (vcols * 2) - bytes;
GetMem(buffer,size);
p := Ptr(vseg,vofs);
q := buffer;
FOR n := 1 TO rows DO
BEGIN
MoveFromScreen(p^,q^,cols * 2);
Inc(LONGINT(p),vcols * 2);
Inc(LONGINT(q),cols * 2)
END;
ClrScr;
IF (Length(title) > (cols - 2)) THEN
title[0] := Chr(cols-2);
GotoXY((cols - Length(title) - 2) DIV 2 + 1,1);
WRITE(title);
title := ' ESCape to abort';
GotoXY((cols - Length(title) - 2) DIV 2 + 1,rows);
WRITE(title);
Window(x1+1,y1+1,x2-1,y2-1);
TextColor(fore);
TextBackground(back);
ClrScr;
GotoXY(1,1);
WRITELN(' File name.....:');
WRITELN(' File size.....:');
WRITELN(' File blocks...:');
WRITELN(' Block check...:');
WRITELN(' Transfer time.:');
WRITELN(' Current BYTE..:');
WRITELN(' Current BLOCK.:');
WRITELN(' Error count...:');
WRITELN(' Last frame....:');
TextColor(bfore);
TextBackground(bback);
GotoXY(1,10);
ClrEol;
title := #$19+'Last Message'+#$19;
GotoXY((cols - Length(title) - 2) DIV 2 + 1,10);
writeln;
WRITE(title);
TextColor(red);
TextBackground(back)
END;
PROCEDURE Z_CloseWindow;
VAR
p, q: POINTER;
n: WORD;
BEGIN
TextAttr := oldattr;
WindMax := oldmax;
WindMin := oldmin;
GotoXY(oldx,oldy);
q := buffer;
p := Ptr(vseg,vofs);
FOR n := 1 TO rows DO
BEGIN
MoveToScreen(q^,p^,cols * 2);
Inc(LONGINT(p),vcols * 2);
Inc(LONGINT(q),cols * 2)
END;
FreeMem(buffer,size)
END;
PROCEDURE Z_ShowName(filename: STRING);
BEGIN
IF (Length(filename) > 14) THEN
filename[0] := #14;
GotoXY(18,1);
WRITE(filename);
GotoXY(1,11)
END;
PROCEDURE Z_ShowSize(l: LONGINT);
BEGIN
GotoXY(18,2);
WRITE(ItoS(l,14));
IF (l MOD 128 <> 0) THEN
l := (l DIV 128) + 1
ELSE
l := (l DIV 128);
GotoXY(18,3);
WRITE(ItoS(l,14));
GotoXY(1,11);
END;
PROCEDURE Z_ShowCheck(is32: BOOLEAN);
BEGIN
GotoXY(18,4);
IF (is32) THEN
WRITE('CRC32')
ELSE
WRITE('CRC16');
GotoXY(1,11)
END;
PROCEDURE Z_ShowTransferTime(fsize, zbaud: LONGINT);
VAR
bits: REAL;
BEGIN
bits := fsize * 10.0;
GotoXY(18,5);
IF (bits <> 0.0) THEN
WRITE(RtoS(((bits / zbaud) / 60),10,2),'min.')
ELSE
WRITE('0min.');
GotoXY(1,11)
END;
PROCEDURE Z_Message(s: STRING);
BEGIN
IF (Length(s) > 31) THEN
s[0] := #31;
GotoXY(1,11);
WRITE(s,#13)
END;
PROCEDURE Z_Frame(n: INTEGER);
VAR Num : Byte;
BEGIN
IF (n < -3) OR (n > 20) THEN
n := 20;
GotoXY(18,9);
Num := Lo(n);
if Num = -3
then WRITE('ZNOCARRIER')
else if Num = -2
then WRITE('ZTIMEOUT ')
else if Num = -1
then WRITE('ZERROR ')
else
CASE Lo(n) OF
0 : WRITE('ZRQINIT ');
1 : WRITE('ZRINIT ');
2 : WRITE('ZSINIT ');
3 : WRITE('ZACK ');
4 : WRITE('ZFILE ');
5 : WRITE('ZSKIP ');
6 : WRITE('ZNAK ');
7 : WRITE('ZABORT ');
8 : WRITE('ZFIN ');
9 : WRITE('ZRPOS ');
10 : WRITE('ZDATA ');
11 : WRITE('ZEOF ');
12 : WRITE('ZFERR ');
13 : WRITE('ZCRC ');
14 : WRITE('ZCHALLENGE');
15 : WRITE('ZCOMPL ');
16 : WRITE('ZCAN ');
17 : WRITE('ZFREECNT ');
18 : WRITE('ZCOMMAND ');
19 : WRITE('ZSTDERR ');
20 : WRITE('ZUNKNOWN ')
END;
GotoXY(1,11)
END;
PROCEDURE Z_ShowLoc(l: LONGINT);
BEGIN
GotoXY(18,6);
WRITE(ItoS(l,14));
IF (l MOD 128 <> 0) THEN
l := (l DIV 128) + 1
ELSE
l := (l DIV 128);
GotoXY(18,7);
WRITE(ItoS(l,14));
GotoXY(1,11)
END;
PROCEDURE Z_Errors(w: WORD);
BEGIN
GotoXY(18,8);
WRITE(ItoS(w,14));
GotoXY(1,11)
END;
END.
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
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/