Browse files

Initial commit

  • Loading branch information...
0 parents commit aeb2449dd308d4b74f0b2b5fc1fc7644e402444f @cpeterso committed Oct 4, 2012
Showing with 2,092 additions and 0 deletions.
  1. +7 −0 README.md
  2. +115 −0 src/wxmodem.pas
  3. +235 −0 src/wxmodial.inc
  4. +61 −0 src/wxmomisc.inc
  5. +320 −0 src/wxmoport.inc
  6. +311 −0 src/wxmowind.inc
  7. +1,005 −0 src/wxmoxfer.inc
  8. BIN wxmodem.com
  9. +38 −0 wxmodem.txt
7 README.md
@@ -0,0 +1,7 @@
+* Name: wxmodem
+* Description: Windowed XMODEM file transfer protocol
+* Latest Version: 4.0
+* Latest Release: 1986-10-XX?
+* Initial Release: 1986?
+* Author: Peter Boswell
+* Website: http://www.zoklet.net/totse/en/technology/telecommunications/wxmodem.html
115 src/wxmodem.pas
@@ -0,0 +1,115 @@
+{$U-,C-,R-}
+program WXMODEM;
+{
+Peter Boswell
+}
+Const
+ VERSION = '4.0';
+
+type
+ bigstring = string[80]; {general purpose}
+ cset = set of 0..127;
+var
+ transmit,
+ pcjrmode : boolean;
+ exitfl,
+ testfl,
+ good,
+ xtnd : boolean;
+ displayfl : boolean;
+ a : byte;
+ c,i : integer;
+ fmin, fsec : integer;
+ xmofile : bigstring;
+ bytes : bigstring;
+ rbytes : real;
+ ch, xmotype : char;
+
+{$C-,R-,U-,K-}
+{$I WXMOPORT.INC}
+{$I WXMOMISC.INC}
+{$I WXMOWIND.INC}
+{$I WXMOXFER.INC}
+{$I WXMODIAL.INC}
+
+
+begin
+ displayfl := false;
+ ScreenBase := $B000; {assume monochrome}
+ MemW[ ScreenBase:0000 ] := 69;
+ if Mem[ ScreenBase:0000 ] <> 69 then
+ ScreenBase := $B800;
+ exitfl := true;
+ setup;
+ if displayfl then
+ begin
+ LowVideo;
+ ClrScr;
+ InitWindow(StatWin,1,1,80,2);
+ InitWindow(TermWin,1,3,80,25);
+ CurrentWin := TermWin;
+ UsePermWindow(TermWin);
+ status(1,'WXMODEM ver: ' + VERSION);
+ status(2,'Initializing');
+ end;
+ init_port;
+ term_ready(true);
+ set_up_recv_buffer;
+ remove_port;
+ init_port;
+ term_ready(true);
+ set_up_recv_buffer;
+ good := false;
+ if displayfl then
+ begin
+ GotoXY(1,1);
+ if carrier then
+ status(2,'On-Line/Ready')
+ else
+ status(2,'Off-Line/Ready');
+ status(3,'TCOMM Support');
+ end;
+ if scan(xtnd,a) then
+ begin
+ if xtnd then
+ begin
+ case a of
+ 45 : {alt-X}
+ begin
+ if displayfl then
+ OpenTemp(20,18,60,22,1);
+ writeln(' WXMODEM ');
+ write('Do you really want to exit (Y/N)? ');
+ readln(ch);
+ if upcase(ch) = 'Y' then
+ exitfl := TRUE;
+ if displayfl then
+ CloseTemp
+ end;
+ 48 : {alt-B}
+ break;
+ end; {case}
+ end {if extended key}
+ end; {if KeyPressed}
+ if (exitfl = false) and carrier then
+ case transmit of
+ false : recv_wcp;
+ true : send_wcp;
+ end;
+ assign(cmfile,cmdfname);
+ {$I-} Rewrite(cmfile) {I+};
+ if IOresult = 0 then
+ begin
+ if good then
+ begin
+ rbytes := 128.0 * tblks;
+ str(rbytes:7:0,bytes);
+ writeln(cmfile,'0 '+xmofile+' '+bytes);
+ {$I-} close(cmfile); {$I+}
+ If IOresult <> 0 then
+ writeln('WXTERM - error rewriting parm file');
+ end;
+ end;
+
+ remove_port;
+end.
235 src/wxmodial.inc
@@ -0,0 +1,235 @@
+{$U-,C-,R-,K-}
+Var
+ cmfile : text;
+ cmdfname : bigstring;
+
+procedure setup;
+{initialize most stuff -
+
+ Command Line: WXMODEM filename [w/c/x] [pcjr] [test]
+
+ filename - name of control file
+ [w/c/x] - default is w
+ w - windowed xmodem
+ c - crc xmodem
+ x - checksum xmodem
+ [pcjr] - if present, xoff pause during disk i/o on receive
+
+ [test] - if present, no user messages are sent through com port
+
+ Control file:
+
+ [s/r] filename [p] [baud] [parity] [display] [color]
+
+}
+Var
+ n, j, k, l : integer;
+ result : integer;
+ paramstring : bigstring;
+ cspeed : bigstring;
+ parity_str : bigstring;
+ com_str : bigstring;
+Label
+ 99;
+begin
+ exitfl := true; {assume an error}
+ n := ParamCount; { Parameter count }
+ if n < 1 then { Must be atleast one parm }
+ begin
+ writeln('WXMODEM - No filename present on command line!');
+ goto 99;
+ end;
+ { Process parms }
+ testfl := false;
+ xmotype := 'W';
+ cmdfname := ParamStr(1); { command filename }
+ if n > 1 then
+ begin
+ for i := 2 to n do
+ begin
+ paramstring := ParamStr(i);
+ if (length(paramstring) = 1) and (i = 2) then
+ begin
+ case UpCase(paramstring[1]) of
+ 'W' : xmotype := 'W';
+ 'C' : xmotype := 'C';
+ 'X' : xmotype := 'X';
+ else begin
+ writeln('WXMODEM - Xmodem type must be W/C/X');
+ goto 99;
+ end;
+ end; { of case }
+ end
+ else
+ begin {either length > or i > 2}
+ for j := 1 to length(paramstring) do
+ paramstring[j] := UpCase(paramstring[j]);
+ if paramstring = 'PCJR' then pcjrmode := true;
+ if paramstring = 'NOPCJR' then pcjrmode := false;
+ if paramstring = 'TEST' then
+ begin
+ writeln('Test mode!!!!');
+ testfl := true;
+ end;
+ end;
+ end; { of for loop}
+ end;
+ if exists(cmdfname) then
+ begin
+
+ Assign(cmfile,cmdfname);
+ {I-} Reset(cmfile); {I+}
+ If IOresult <> 0 then
+ begin
+ writeln('WXMODEM - Unable to open command file');
+ goto 99;
+ end;
+ read(cmfile,paramstring); {get the stuff}
+ i := 1; {string pointer}
+ while (i <= length(paramstring)) and
+ (paramstring[i] = ' ') do
+ i := i + 1;
+ case upcase(paramstring[i]) of
+ 'S' : transmit := true;
+ 'R' : transmit := false;
+ else
+ begin
+ writeln('WXMODEM - Expecting S/R');
+ goto 99;
+ end;
+ end;
+ i := i + 1;
+ while (i <= length(paramstring)) and
+ (paramstring[i] = ' ') do
+ i := i + 1;
+ j := i;
+ while (j <= length(paramstring)) and
+ (paramstring[j] <> ' ') do
+ j := j + 1;
+ if j <= i then
+ begin
+ writeln('WXMODEM - xmodem filename missing');
+ goto 99;
+ end;
+ k := j - i;
+ for l := 1 to k do
+ begin
+ xmofile[l] := paramstring[i];
+ i := i + 1;
+ end;
+ xmofile[0] := chr(k);
+ i := j;
+ while (i <= length(paramstring)) and
+ (paramstring[i] = ' ') do
+ i := i + 1;
+ j := i;
+ while (j <= length(paramstring)) and
+ (paramstring[j] <> ' ') do
+ j := j + 1;
+ if j <= i then
+ begin
+ writeln('WXMODEM - COM Port parameter missing',j:4,i:4);
+ goto 99;
+ end;
+ k := j - i;
+ for l := 1 to k do
+ begin
+ com_str[l] := paramstring[i];
+ i := i + 1;
+ end;
+ com_str[0] := chr(k);
+ if (com_str = 'COM1') or (com_str = 'COM2') then
+ begin
+ case com_str[4] of
+ '1' : Cport := com1;
+ '2' : Cport := com2;
+ else
+ begin
+ writeln('WXMODEM - COM'+com_str+' not supported, only COM1/COM2');
+ goto 99;
+ end;
+ end; {of case}
+ end
+ else
+ begin
+ writeln('WXMODEM - Unable to decifer COM port');
+ goto 99;
+ end;
+ speed := 1200;
+ i := j;
+ while (i <= length(paramstring)) and
+ (paramstring[i] = ' ') do
+ i := i + 1;
+ j := i;
+ while (j <= length(paramstring)) and
+ (paramstring[j] <> ' ') do
+ j := j + 1;
+ if j > i then
+ begin
+ for k := 1 to j - i do
+ begin
+ if (paramstring[i] >= '0') and (paramstring[i] <= '9') then
+ cspeed[k] := paramstring[i];
+ i := i + 1;
+ end;
+ cspeed[0] := chr(k);
+ val(cspeed,speed,result);
+ if result <> 0 then
+ begin
+ writeln('WXMODEM - Speed not recognized');
+ speed := 1200;
+ end;
+ end;
+ i := j;
+ while (i <= length(paramstring)) and
+ (paramstring[i] = ' ') do
+ i := i + 1;
+ j := i;
+ while (j <= length(paramstring)) and
+ (paramstring[j] <> ' ') do
+ j := j + 1;
+ if j <= i then
+ begin
+ writeln('WXMODEM - parity missing from file');
+ goto 99;
+ end;
+ case upcase(paramstring[i]) of
+ 'E' : begin
+ parity := even;
+ dbits := 7;
+ end;
+ 'N' : begin
+ parity := none;
+ dbits := 8;
+ end;
+ else
+ begin
+ writeln('WXMODEM - Parity must be Even or None');
+ goto 99;
+ end;
+ end;
+ stop_bits := 1; {that's the only choice!}
+ i := i + 1;
+ while (i <= length(paramstring)) and
+ (paramstring[i] = ' ') do
+ i := i + 1;
+ if paramstring[i] = '0' then
+ displayfl := false
+ else
+ if paramstring[i] = '1' then
+ displayfl := true;
+ exitfl := false; {good }
+ end
+ else
+ begin
+ writeln('WXMODEM - command file does not exist');
+ end;
+99:
+ close(cmfile);
+ if exitfl = true then
+ begin
+ writeln(paramstring);
+ delay(10000);
+ displayfl := false;
+ end;
+ end;
61 src/wxmomisc.inc
@@ -0,0 +1,61 @@
+{$U-,C-,R-}
+function scan(var extend : boolean; var code : byte) : boolean;
+{
+ Uses BIOS service 16 to get a keystroke w/o echo. Sets 'extend' true
+ for extended codes from PC-Clone keyboards, and returns ASCII/Scan code
+ in 'code'. Returns true if a character exists, false if none is in the
+ buffer.
+}
+type
+ regs = record
+ ax,bx,cx,dx,bp,si,di,ds,es,flags : integer;
+ end;
+var
+ r : regs;
+ c : integer;
+begin
+ code := 0;
+ r.ax := 1 shl 8; {AH := 1}
+ Intr($16,r);
+ if r.flags and 64 <> 64 then
+ begin
+ r.ax := 0;
+ Intr($16,r); {Get character and clear from buffer}
+ code := lo(r.ax);
+ scan := true;
+ extend := false;
+ if code = 0 then
+ begin
+ extend := true;
+ code := hi(r.ax)
+ end;
+ end
+ else
+ scan := false;
+end;
+
+function exists(fname : bigstring) : boolean;
+var
+ f : file;
+begin
+ assign(f, fname);
+ {$I-}
+ reset(f);
+ {$I+}
+ if IOresult = 0 then
+ begin
+ exists := true;
+ close(f)
+ end
+ else
+ exists := false
+end;
+
+procedure supcase(var s);
+var
+ ss : bigstring absolute s;
+ i : integer;
+begin
+ for i := 1 to length(ss) do
+ ss[i] := upcase(ss[i])
+end;
320 src/wxmoport.inc
@@ -0,0 +1,320 @@
+{$U-,C-,I-,K-}
+type
+ tCport = (com1, com2);
+ tSaveInt = record {Save interrupt vector address}
+ IP : integer;
+ CS : integer;
+ end;
+ tRegs = record {Dos registers}
+ AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : integer;
+ end;
+Const
+ RECV_BUF_SIZE = 2048; {this may be changed to
+ whatever size you need}
+{ *** Port addresses *** }
+ cRBR: array[com1..com2] of integer = ($3F8,$2F8);
+ {Receive Buffer Register}
+ cTHR: array[com1..com2] of integer = ($3F8,$2F8);
+ {Transmitter Holding Register: the
+ serial port address we use to send
+ data}
+ cIER: array[com1..com2] of integer = ($3F9,$2F9);
+ {Interrupt Enable Register for the
+ serial port}
+ cLCR: array[com1..com2] of integer = ($3FB,$2FB);
+ {Line Control Register for the serial
+ port. Determines data bits, stop bits
+ and parity, contributes to setting
+ baud-rate}
+ cMCR: array[com1..com2] of integer = ($3FC,$2FC);
+ {Modem Control Register}
+ cLSR: array[com1..com2] of integer = ($3FD,$2FD);
+ {Line Status Register}
+ cMSR: array[com1..com2] of integer = ($3FE,$2FE);
+ {Modem Status Register}
+ IMR = $021; {Interrupt Mask Register port address
+ of Intel 8259A Programmable Interrupt
+ controller}
+{ *** Masks *** }
+ ENABLE_OUT2 = 8; {Setting bit 3 of MCR enables OUT2}
+ ENABLE_DAV = 1; {Setting bit 0 of IER enables Data
+ AVailable interrupt from serial port}
+ ENABLE_IRQ: array[com1..com2] of integer = ($00EF,$00F7);
+ {Clearing bit of IMR enables serial
+ interrupts to reach the CPU}
+ DISABLE_OUT2 = 1; {Clearing MCR disables OUT2}
+ DISABLE_DAV = 0; {Clearing IER disables Data
+ AVailable interrupt from serial port}
+ DISABLE_IRQ: array[com1..com2] of integer = ($0010,$0008);
+ {Setting bit of IMR stops serial
+ interrupts from reaching the CPU}
+ cINVLIST: array[com1..com2] of integer = ($000C,$000B);
+ {Interrupt vector number}
+ SET_BAUD = $80; {Setting bit 7 of LCR allows us to set
+ the baud rate of the serial port}
+ SET_PARMS = $7F; {Clearing bit 7 of LCR allows us to set
+ non-baud-rate parameters on the
+ serial port}
+Type
+ parity_set = (none,even); {readability and expansion}
+Var
+ SaveInt : tSaveInt;
+ Regs : tRegs;
+ RBR, THR, IER, LCR, MCR, LSR, MSR : integer;
+ INVLIST : integer;
+ SavIER, SavLCR, SavMCR, SavIMR : integer;
+ buf_start, buf_end : integer; {NOTE: these will change by them-
+ selves in the background}
+ recv_buffer : array [1..RECV_BUF_SIZE] of byte;
+ {also self-changing}
+ speed : integer; {I don't know the top speed these
+ routines will handle}
+ dbits : 7..8; {only ones most people use}
+ stop_bits : 1..2; {does anyone use 2?}
+ parity : parity_set; {even and none are the common ones}
+ Cport : tCport; {set at initialization}
+
+function cgetc(TimeLimit : integer) : integer;
+{if a byte is recieved at COM1/COM2: in less than TimeLimit seconds,
+ returns byte as an integer, else returns -1}
+const
+ TIMED_OUT = -1;
+begin
+ TimeLimit := TimeLimit shl 10; {convert TimeLimit to millisecs}
+ while (buf_start = buf_end) and (TimeLimit > 0) do
+ begin
+ delay(1);
+ TimeLimit := pred(TimeLimit)
+ end;
+ if (TimeLimit >= 0) and (buf_start <> buf_end) then
+ begin
+ inline ($FA); {suspend interrupts}
+ cgetc := recv_buffer[buf_start];
+ buf_start := succ(buf_start);
+ if buf_start > RECV_BUF_SIZE then
+ buf_start := 1;
+ inline ($FB); {resume interrupts}
+ end
+ else
+ cgetc := TIMED_OUT;
+end;
+
+procedure send(c : byte);
+var
+ a : byte;
+begin
+{
+ repeat
+ a := port[LSR]
+ until odd(a shr 5);
+ port[THR] := c;
+ }
+ inline(
+ $8B/$16/LSR/ {in: mov dx,[LSR]}
+ $EC/ {in al,dx}
+ $24/$20/ {and al,20}
+ $74/$F7/ {jz in}
+ $8B/$16/THR/ {mov dx,[THR]}
+ $36/ {ss:}
+ $8B/$86/c/ {mov ax,[bp+c]}
+ $EE {out dx,al}
+ );
+end;
+
+
+{Communications routines for TURBO Pascal written by Alan Bishop,
+ modified slightly by Scott Murphy. Modified by Peter Boswell to
+ add COM2, saving the original interrupt vector, more inline code.
+ Handles standart COM1/COM2: ports with interrupt handling. Includes
+ support for only one port, and with no overflow, parity, or other
+ such checking. However, even some of the best communication programs
+ don't do this anyway, and I never use it. If you make modifications,
+ please send me a copy if you have a simple way of doing it (CIS EMAIL,
+ Usenet, MCI Mail, etc) Hope these are useful.
+
+Alan Bishop - CIS - 72405,647
+ Usenet - bishop@ecsvax
+ MCI Mail - ABISHOP
+}
+procedure update_uart;
+{uses dbits, stop_bits, and parity}
+var
+ newparm, oldLCR : byte;
+begin
+ newparm := dbits-5;
+ if stop_bits = 2 then newparm := newparm + 4;
+ if parity = even then newparm := newparm + 24;
+ oldLCR := port[LCR];
+ port[LCR] := oldLCR and SET_PARMS;
+ port[LCR] := newparm;
+end;
+
+procedure term_ready(state : boolean);
+{if state = TRUE then set RTS true else set false}
+var
+ OldMCR : byte;
+begin
+ OldMCR := port[MCR];
+ if state then
+ port[MCR] := OldMCR or 1
+ else
+ port[MCR] := OldMCR and $FE
+end;
+
+function carrier : boolean;
+{true if carrier, false if not}
+begin
+ carrier := odd(port[MSR] shr 7);
+end;
+
+procedure set_up_recv_buffer;
+begin
+ buf_start := 1;
+ buf_end := 1;
+end;
+
+procedure new_baud(rate : integer);
+{has no problems with non-standard bauds}
+var
+ OldLCR : byte;
+begin
+ if rate <= 9600 then
+ begin
+ speed := rate;
+ rate := trunc(115200.0/rate);
+ OldLCR := port[LCR] or SET_BAUD;
+ port[LCR] := OldLCR;
+ port[THR] := lo(rate);
+ port[IER] := hi(rate);
+ port[LCR] := OldLCR and SET_PARMS;
+ end;
+end;
+
+procedure init_port;
+{installs interrupt sevice routine for serial port}
+var a,b : integer;
+ buf_len : integer;
+begin
+ RBR := cRBR[Cport];
+ THR := cTHR[Cport];
+ IER := cIER[Cport];
+ LCR := cLCR[Cport];
+ MCR := cMCR[Cport];
+ LSR := cLSR[Cport];
+ MSR := cMSR[Cport];
+ INVLIST := cINVLIST[Cport];
+ update_uart;
+ new_baud(speed);
+ buf_len := RECV_BUF_SIZE;
+
+ {save the original vector}
+
+ with Regs do begin
+ AX := $3500 + INVLIST;
+ MsDos(Regs);
+ SaveInt.CS := ES;
+ SaveInt.IP := BX;
+ end;
+
+ {this is the background routine}
+
+ inline (
+ $FA/ {cli}
+ $1E/ {push ds}
+ $0E/ {push cs}
+ $A1/INVLIST/ {mov ax,[INVLIST] interrupt vector}
+ $1F/ {pop ds ;ds := cs}
+ $BA/*+22/ {mov dx, offset ISR}
+ $B4/$25/ {mov ah,25H}
+ $CD/$21/ {int 21H}
+ $8B/$BE/BUF_LEN/ {mov di, buf_len}
+ $89/$3E/*+88/ {mov lcl_buf_len,di}
+ $1F/ {pop ds}
+ $2E/$8C/$1E/*+84/ {mov lcl_ds, ds}
+ $EB/$52/ {jmp exit}
+{ISR:} $1E/ {push ds}
+ $50/ {push ax}
+ $53/ {push bx}
+ $52/ {push dx}
+ $56/ {push si}
+ $FB/ {sti}
+ $2E/$8E/$1E/*+71/ {mov ds,[lcl_ds]}
+ $8B/$16/RBR/ {mov dx,[RBR] 3F8H/2F8H ;address RBR}
+ $EC/ {in al, dx ;read rbr}
+ $BE/RECV_BUFFER/ {mov si, recv_buffer ;address start of recv_buffer}
+ $8B/$1E/BUF_END/ {mov bx, [buf_end] ;index of current char in recv_buffer}
+ $88/$40/$FF/ {mov [bx+si-1],al ;copy char to recv_buffer}
+ $43/ {inc bx ;update buf_end}
+ $E8/$22/$00/ {call adj_idx}
+ $89/$1E/BUF_END/ {mov [buf_end],bx}
+ $3B/$1E/BUF_START/ {cmp bx, [buf_start]}
+ $75/$0C/ {jnz ISR_DONE}
+ $8B/$1E/BUF_START/ {mov bx,buf_start}
+ $43/ {inc bx}
+ $E8/$10/$00/ {call adj_idx}
+ $89/$1E/BUF_START/ {mov [buf_start],bx}
+ $BA/$20/$00/ {mov dx,20H ;EOI command for 8259A PIC}
+ $B0/$20/ {mov al,20H ;EOI port for 8259A PIC}
+ $EE/ {out dx,al ;End Of Interrupt}
+ $5E/ {pop si}
+ $5A/ {pop dx}
+ $5B/ {pop bx}
+ $58/ {pop ax}
+ $1F/ {pop ds}
+ $CF/ {iret}
+{adj_idx:} $2E/$8B/$16/*+11/ {mov dx,[lcl_buf_len]}
+ $42/ {inc dx}
+ $39/$DA/ {cmp dx,bx}
+ $75/$03/ {jnz no_change}
+ $BB/$01/$00/ {mov bx,1}
+{no_change:} $C3/ {ret}
+{lcl_buf_len;}$00/$00/ {dw 0}
+ $00/$01/ {dw 1}
+{exit:} $90/ {nop}
+ $FB {cli}
+ );
+ SavLCR := port[LCR];
+ SavIER := port[IER];
+ port[IER] := ENABLE_DAV; {interrupt enable}
+ a := port[MCR];
+ SavMCR := a;
+ port[MCR] := a or ENABLE_OUT2; {preserve RTS and enable OUT2}
+ a := port[IMR];
+ SavIMR := a;
+ a := a and ENABLE_IRQ[Cport];
+ port[IMR] := a;
+end;
+
+
+procedure remove_port;
+{Restores status to reflect the status upon entry}
+var
+ a : byte;
+begin
+ inline($FA); {disable interrupts}
+ port[IMR] := SavIMR;
+ port[IER] := SavIER;
+ port[MCR] := SavMCR;
+ port[LCR] := SavLCR;
+
+ {Restore the interrupt vector}
+ with Regs do begin
+ AX := $2500 + INVLIST; {function 25H & INVLIST port}
+ DS := SaveInt.CS;
+ DX := SaveInt.IP;
+ MsDos(Regs);
+ end;
+ inline($FB);
+end;
+
+
+procedure break;
+{send a break}
+var a,b : byte;
+begin
+ a := port[LCR];
+ b := (a and $7F) or $40;
+ port[LCR] := b;
+ delay(750);
+ port[LCR] := a;
+end;
311 src/wxmowind.inc
@@ -0,0 +1,311 @@
+{$U-,C-,R-,K-}
+{ A set of routines for text window manipulation
+ By Bela Lubkin
+ Borland International Technical Support
+ 1/10/85
+ 2/20/85 Bug fix: DisposeWindow left a bunch of junk on the heap, causing
+ uncontrolled growth!
+ (For PC-DOS Turbo Pascal version 2 or greater)
+}
+Type
+ XTCoord=1..80; { X Text coordinate }
+ YTCoord=1..25; { Y Text coordinate }
+ XTCoord0=0..80; { X Text coordinate + 0 for nothing }
+ YTCoord0=0..25; { Y Text coordinate + 0 for nothing }
+ WindowRec=Record
+ XSize: XTCoord;
+ YSize: YTCoord;
+ XPosn: XTCoord;
+ YPosn: YTCoord;
+ Contents: Array [0..1999] Of Integer;
+ End;
+ WindowPtr=^WindowRec;
+
+Var
+ WindowXLo: XTCoord;
+ WindowYLo: YTCoord;
+ WindowXHi: XTCoord;
+ WindowYHi: YTCoord;
+ ScreenBase: Integer;
+
+Procedure TurboWindow(XL: XTCoord; YL: YTCoord; XH: XTCoord; YH: YTCoord);
+{ This procedure provides an entry to Turbo's built in Window procedure }
+ Begin
+ Window(XL,YL,XH,YH);
+ End;
+
+Procedure Window(XL: XTCoord; YL: YTCoord; XH: XTCoord; YH: YTCoord);
+{ This procedure replaces Turbo's built in Window procedure. It calls the
+ original Window procedure, and also keeps track of the window boundaries. }
+
+ Begin
+ TurboWindow(XL,YL,XH,YH);
+ WindowXLo:=XL;
+ WindowYLo:=YL;
+ WindowXHi:=XH;
+ WindowYHi:=YH;
+ End;
+
+Function SaveWindow(XLow: XTCoord; YLow: YTCoord;
+ XHigh: XTCoord; YHigh:YTCoord): WindowPtr;
+{ Allocate a WindowRec of the precise size needed to save the window, then
+ fill it with the text that is in the window XLow..XHigh, YLow..YHigh.
+ Return a pointer to this WindowRec. }
+
+ Var
+ SW: WindowPtr;
+ I: Integer;
+ XS: XTCoord;
+ YS: YTCoord;
+
+ Begin
+ XS:=XHigh-XLow+1;
+ YS:=YHigh-YLow+1;
+ GetMem(SW,2*XS*YS + 4);
+ { Allocate 2 bytes for each screen position, + 4 for size and position }
+ With SW^ Do
+ Begin
+ XSize:=XS;
+ YSize:=YS;
+ XPosn:=XLow;
+ YPosn:=YLow;
+ For I:=0 To YSize-1 Do
+ Move(Mem[ScreenBase:((YPosn+I-1)*80+XPosn-1) Shl 1],
+ Contents[I*XSize],XSize Shl 1);
+ { For each line of the window,
+ Move XSize*2 bytes (1 for char, 1 for attribute) into the Contents
+ array. Leave no holes in the array. }
+ End;
+ SaveWindow:=SW;
+ End;
+
+Function SaveCurrentWindow: WindowPtr;
+ Begin
+ SaveCurrentWindow:=SaveWindow(WindowXLo,WindowYLo,WindowXHi,WindowYHi);
+ End;
+
+Procedure RestoreWindow(WP: WindowPtr; XPos: XTCoord0; YPos: YTCoord0);
+{ Given a pointer to a WindowRec, restore the contents of the window. If
+ XPos or YPos is 0, use the XPosn or YPosn that the window was originally
+ saved with. If either is nonzero, use it. Thus a window can be restored
+ exactly with RestoreWindow(wp,0,0); or its upper left corner can be
+ placed at (2,3) with RestoreWindow(wp,2,3); }
+
+ Var
+ I: Integer;
+
+ Begin
+ With WP^ Do
+ Begin
+ If XPos=0 Then XPos:=XPosn;
+ If YPos=0 Then YPos:=YPosn;
+ For I:=0 To YSize-1 Do
+ Move(Contents[I*XSize],
+ Mem[ScreenBase:2*((YPos+I-1)*80+XPos-1)],XSize*2);
+ { For each line of the window,
+ Move XSize*2 bytes (1 for char, 1 for attribute) from the Contents
+ array onto the screen. }
+ End;
+ End;
+
+Procedure DisposeWindow(Var WP: WindowPtr);
+{ Dispose of a WindowPtr. The built in procedure Dispose cannot be used,
+ because it will deallocate SizeOf(WindowRec) bytes, even though less may
+ have been allocated. }
+
+ Begin
+ With WP^ Do FreeMem(WP,2*XSize*YSize+4);
+ WP:=Nil;
+ End;
+
+Procedure DRestoreWindow(Var WP: WindowPtr; XPos: XTCoord0; YPos: YTCoord0);
+{ Restore the contents of a window, then dispose of the saved image }
+
+ Begin
+ RestoreWindow(WP, XPos, YPos);
+ DisposeWindow(WP);
+ End;
+
+Procedure DRestoreCurrentWindow(Var WP: WindowPtr;
+ XPos: XTCoord0; YPos: YTCoord0);
+{ Restore the contents of a window, set the current window to fit the restored
+ window, and dispose of the saved image. A similar procedure
+ RestoreCurrentWindow could be written by changing DRestoreWindow to
+ RestoreWindow in the last line of the procedure, but I have assumed that
+ when you select a window area, you are going to modify it, and not want the
+ old image }
+
+ Begin
+ With WP^ Do
+ Begin
+ If XPos=0 Then XPos:=XPosn;
+ If YPos=0 Then YPos:=YPosn;
+ Window(XPos,YPos,XPos+XSize-1,YPos+YSize-1);
+ End;
+ DRestoreWindow(WP, XPos, YPos);
+ End;
+
+{****** My interface - S. Murphy ******}
+
+type
+ WindowParms = record
+ col1, col2,
+ row1, row2 : integer; {corner co-ordinates}
+ frame : 0..2; {border type}
+ CursorX, CursorY : integer; {cursor position}
+ end;
+
+ WindowDescriptor = ^WindowParms;
+Var
+ StatWin, TermWin,
+ CurrentWin, border : WindowDescriptor;
+ TempWin : WindowPtr;
+ StackedPage : WindowPtr;
+
+procedure UsePermWindow(var w : WindowDescriptor);
+begin
+ with CurrentWin^ do
+ begin
+ CursorX := WhereX;
+ CursorY := WhereY
+ end;
+ CurrentWin := w;
+ with w^ do
+ begin
+ window(col1,row1,col2,row2);
+ GotoXY(CursorX, CursorY)
+ end
+end;
+
+procedure Status(slot :integer; msg : bigstring);
+var
+ i : integer;
+begin
+ if not displayfl then
+ exit;
+ UsePermWindow(StatWin);
+ GotoXY(20*slot+1,1);
+ if slot < 3 then
+ write(' ')
+ else
+ write(' ');
+ GotoXY(20*slot+1,1);
+ write(msg);
+ UsePermWindow(TermWin)
+end;
+
+
+procedure InitWindow(var w : WindowDescriptor;
+ x1, y1, x2, y2 : integer);
+begin
+ new(w);
+ with w^ do
+ begin
+ col1 := x1;
+ col2 := x2;
+ row1 := y1;
+ row2 := y2;
+ CursorX := 1;
+ CursorY :=1
+ end
+end;
+
+procedure DrawBox(col1, row1, col2, row2, frame : integer);
+type
+ cvec6 = array[1..6] of char;
+ cptr = ^cvec6;
+const
+ V1 = #179; UR1 = #191; UL1 = #218;
+ V2 = #186; UR2 = #187; UL2 = #201;
+ H1 = #196; LR1 = #217; LL1 = #192;
+ H2 = #205; LR2 = #188; LL2 = #200;
+
+ SFRAME : cvec6 = (UL1,H1,UR1,V1,LL1,LR1);
+ DFRAME : cvec6 = (UL2,H2,UR2,V2,LL2,LR2);
+
+var
+ framedef : cptr;
+ i,j : integer;
+begin
+ if frame <> 0 then
+ begin
+ case frame of
+ 1 : framedef := ptr(seg(SFRAME),ofs(SFRAME));
+ 2 : framedef := ptr(seg(DFRAME),ofs(DFRAME))
+ end;
+ GotoXY(col1, row1);
+ write(framedef^[1]);
+ for i := col1 + 1 to col2 - 1 do
+ write(framedef^[2]);
+ write(framedef^[3]);
+ for i := row1 + 1 to row2 - 1 do
+ begin
+ GotoXY(col1, i);
+ write(framedef^[4]);
+ GotoXY(col2, i);
+ write(framedef^[4])
+ end;
+ GotoXY(col1, row2);
+ write(framedef^[5]);
+ for i := col1 + 1 to col2 - 1 do
+ write(framedef^[2]);
+ write(framedef^[6])
+ end
+end;
+
+Procedure OpenTemp(x1,y1,x2,y2,border : integer);
+begin
+ if not displayfl then
+ exit;
+ with CurrentWin^ do
+ begin
+ CursorX := WhereX;
+ CursorY := WhereY;
+ TempWin := SaveWindow(col1,row1,col2,row2)
+ end;
+ DrawBox(x1,y1,x2,y2,border);
+ TurboWindow(x1+1, y1+3, x2-1, y2+1);
+ ClrScr;
+ GotoXY(1,1)
+end;
+
+Procedure CloseTemp;
+begin
+ if not displayfl then
+ exit;
+ DRestoreWindow(TempWin,0,0);
+ with CurrentWin^ do
+ begin
+ TurboWindow(col1,row1,col2,row2);
+ GotoXY(CursorX,CursorY)
+ end
+end;
+
+procedure PushPage;
+const
+ MEMNEEDED = 3696; {memory overhead to store a page}
+Var
+ c : char;
+begin
+ if MemAvail >= MEMNEEDED then
+ begin
+ OpenTemp(20,5,75,10,2);
+ write('Save this screen? (Y/N; default N) ');
+ readln(c);
+ CloseTemp;
+ if c in ['Y','y'] then
+ StackedPage := SaveWindow(1,3,80,25)
+ end
+ else begin
+ OpenTemp(30,5,70,10,2);
+ writeln('Out of Memory: Can''t save page.');
+ write('Type <cr> to continue.');
+ readln
+ end
+end;
+
+procedure PopPage;
+begin
+ if StackedPage <> NIL then
+ DRestoreWindow(StackedPage,0,0)
+end;
1,005 src/wxmoxfer.inc
@@ -0,0 +1,1005 @@
+{$U-,C-,R-,K-}
+ { - modified to add CRC xmodem, wxmodem 7/86 - 10/86
+Peter Boswell
+ADI
+Suite 650
+350 N. Clark St.
+Chicago, Il 60610
+People/Link: Topper
+Compuserve : 72247,3671
+ }
+const
+ SOH = 1; {Start Of Header}
+ EOT = 4; {End Of Transmission}
+ ACK = 6; {ACKnowledge}
+ DLE = $10; {Data Link Escape}
+ XON = $11; {X-On}
+ XOFF = $13; {X-Off}
+ NAK = $15; {Negative AcKnowledge}
+ SYN = $16; {Synchronize}
+ CAN = $18; {CANcel}
+ CHARC = $43; {C = CRC Xmodem}
+ CHARW = $57; {W = WXmodem}
+ MAXERRS = 10; {Maximum allowed errors}
+ L = 0;
+ H = 1;
+ Buflen = 128; {Disk I/O buffer length}
+ Bufnum = 64; {Disk I/O buffer count}
+ Maxwindow = 4; {Wxmodem window size}
+ {CRC byte translation table}
+ Crctab: array[0..255] of Integer =
+ (0, 4129, 8258, 12387, 16516, 20645, 24774, 28903,
+ -32504,-28375,-24246,-20117,-15988,-11859,-7730,-3601,
+ 4657, 528, 12915, 8786, 21173, 17044, 29431, 25302,
+ -27847,-31976,-19589,-23718,-11331,-15460,-3073,-7202,
+ 9314, 13379, 1056, 5121, 25830, 29895, 17572, 21637,
+ -23190,-19125,-31448,-27383,-6674,-2609,-14932,-10867,
+ 13907, 9842, 5649, 1584, 30423, 26358, 22165, 18100,
+ -18597,-22662,-26855,-30920,-2081,-6146,-10339,-14404,
+ 18628, 22757, 26758, 30887, 2112, 6241, 10242, 14371,
+ -13876,-9747,-5746,-1617,-30392,-26263,-22262,-18133,
+ 23285, 19156, 31415, 27286, 6769, 2640, 14899, 10770,
+ -9219,-13348,-1089,-5218,-25735,-29864,-17605,-21734,
+ 27814, 31879, 19684, 23749, 11298, 15363, 3168, 7233,
+ -4690,-625,-12820,-8755,-21206,-17141,-29336,-25271,
+ 32407, 28342, 24277, 20212, 15891, 11826, 7761, 3696,
+ -97,-4162,-8227,-12292,-16613,-20678,-24743,-28808,
+ -28280,-32343,-20022,-24085,-12020,-16083,-3762,-7825,
+ 4224, 161, 12482, 8419, 20484, 16421, 28742, 24679,
+ -31815,-27752,-23557,-19494,-15555,-11492,-7297,-3234,
+ 689, 4752, 8947, 13010, 16949, 21012, 25207, 29270,
+ -18966,-23093,-27224,-31351,-2706,-6833,-10964,-15091,
+ 13538, 9411, 5280, 1153, 29798, 25671, 21540, 17413,
+ -22565,-18438,-30823,-26696,-6305,-2178,-14563,-10436,
+ 9939, 14066, 1681, 5808, 26199, 30326, 17941, 22068,
+ -9908,-13971,-1778,-5841,-26168,-30231,-18038,-22101,
+ 22596, 18533, 30726, 26663, 6336, 2273, 14466, 10403,
+ -13443,-9380,-5313,-1250,-29703,-25640,-21573,-17510,
+ 19061, 23124, 27191, 31254, 2801, 6864, 10931, 14994,
+ -722,-4849,-8852,-12979,-16982,-21109,-25112,-29239,
+ 31782, 27655, 23652, 19525, 15522, 11395, 7392, 3265,
+ -4321,-194,-12451,-8324,-20581,-16454,-28711,-24584,
+ 28183, 32310, 20053, 24180, 11923, 16050, 3793, 7920);
+
+{*** variables used as globals in this source segment
+ (actually global to whole source) ***}
+var
+ checksum : integer;
+ tblks : integer;
+ fname : bigstring;
+ response : string[1];
+ crcval,db,sb : integer;
+ packetln : integer; {128 + Checksum or 128 + CRC}
+ p : parity_set;
+ dbuffer : array[1..Bufnum,1..Buflen] of byte;
+ dcount : integer;
+ Wxmode : boolean;
+ Crcmode : boolean;
+ Openflag : boolean;
+ Windowfl : boolean;
+
+
+procedure updcrc(a : byte);
+begin
+ {
+ crcval := Crctab[hi(crcval) xor a] xor (lo(crcval) shl 8);
+ }
+ inline(
+
+ $A1/crcval/ {mov ax,crcval AX <- crcval}
+ $89/$C2/ {mov dx,ax DX <- crcval}
+ $88/$E0/ {mov al,ah (AX) crcval >> 8}
+ $B4/$00/ {mov ah,0 }
+ $36/ {ss:}
+ $8B/$8E/a/ {mov cx,[bp+a] CX <- a}
+ $31/$C8/ {xor ax,cx AX <- (crcval >> 8) xor a}
+ $D1/$E0/ {shl ax,1 AX <- AX * 2 (word index)}
+ $BB/crctab/ {mov bx,offset crctab BX <- addr(crctab)}
+ $01/$C3/ {add bx,ax BX <- addr(crctab)+((crcval>>8)xor a)*2 }
+ $2E/ {cs:}
+ $8B/07/ {mov ax,[bx] AX <- contents of crctab}
+ $88/$D6/ {mov dh,dl (DX) crcval << 8}
+ $B2/$00/ {mov dl,00}
+ $31/$D0/ {xor ax,dx AX <- contents of crctab xor crcval << 8}
+ $A3/crcval {mov crcval,ax crcval <- AX}
+
+ );
+end;
+{ Xmodem transmit window routine
+ Peter Boswell, July 1986 }
+
+procedure txwindow(opt : integer; in_string : bigstring);
+
+begin
+ if not displayfl then
+ exit;
+ case opt of
+ 1 : begin {initialize}
+ OpenTemp(36,3,78,18,2);
+ Windowfl := true;
+ Clrscr;
+ GotoXY(10,1);
+ write('File - ',in_string);
+ GotoXY(10,2);
+ write('Mode -');
+ GotoXY(4,3);
+ write('Total time -');
+ GotoXY(2,4);
+ write('Total Blocks -');
+ GotoXY(10,5);
+ write('Sent -');
+ GotoXY(9,6);
+ write('ACK''d -');
+ GotoXY(6,7);
+ write('Last NAK -');
+ GotoXY(9,8);
+ write('X-Off - No');
+ GotoXY(8,9);
+ write('Window - 0');
+ GotoXY(4,11);
+ write('Last Error -');
+ GotoXY(8,10);
+ write('Errors -');
+ end;
+ 2..11 : begin
+ GotoXY(17,opt);
+ ClrEol;
+ write(in_string);
+ end;
+ 12 : begin
+ GotoXY(3,12);
+ ClrEol;
+ write(in_string);
+ end;
+ 99 : begin
+ if windowfl then
+ CloseTemp;
+ end;
+
+ end; {case}
+end;
+{ Xmodem receive window routine
+ Peter Boswell, October 1986 }
+
+procedure trwindow(opt : integer; in_string : bigstring);
+
+begin
+ if not displayfl then
+ exit;
+ case opt of
+ 1 : begin {initialize}
+ windowfl := true;
+ OpenTemp(36,3,78,13,2);
+ Clrscr;
+ GotoXY(10,1);
+ write('File - ',in_string);
+ GotoXY(10,2);
+ write('Mode -');
+ GotoXY(6,3);
+ write('Received -');
+ GotoXY(6,4);
+ write('Last NAK -');
+ GotoXY(4,5);
+ write('Last Error -');
+ GotoXY(8,6);
+ write('Errors -');
+ end;
+ 2..6 : begin
+ GotoXY(17,opt);
+ ClrEol;
+ write(in_string);
+ end;
+ 8 : begin
+ GotoXY(3,8);
+ ClrEol;
+ write(in_string);
+ end;
+ 99 : begin
+ if windowfl then
+ CloseTemp;
+ end;
+ end; {case}
+end;
+
+{
+ This routine deletes all DLE characters and XOR's the following character
+ with 64. If a SYN character is found then -2 is returned.
+ }
+function dlecgetc(Tlimit : integer) : integer;
+var
+savecgetc : integer;
+begin
+ if wxmode then
+ begin
+ savecgetc := cgetc(Tlimit);
+ if savecgetc = SYN then
+ savecgetc := -2
+ else
+ if savecgetc = DLE then
+ begin
+ savecgetc := cgetc(Tlimit);
+ if savecgetc >= 0 then savecgetc := savecgetc XOR 64;
+ end;
+ dlecgetc := savecgetc;
+ end
+ else
+ dlecgetc := cgetc(Tlimit);
+end;
+
+procedure purge;
+begin
+ while dlecgetc(1) >= 0 do
+ ;
+end;
+
+procedure SaveCommStatus;
+begin
+ p := parity;
+ db := dbits;
+ sb := stop_bits;
+ dbits := 8;
+ parity := none;
+ stop_bits := 1;
+ update_uart
+end;
+
+
+procedure recv_wcp;
+{receive a file using Ward Christensen's checksum protocol}
+label
+ 99;
+var
+ j, firstchar, sectnum, sectcurr, prevchar, lignore, blkcnt,
+ toterr, errors, sectcomp, bufcurr, bresult : integer;
+ Xtrace, EotFlag, ErrorFlag, Extend : boolean;
+ UserKey : byte;
+ blkfile : file;
+ statstr : bigstring;
+ trfile : text;
+begin
+ status(2, 'RECV XMODEM');
+ windowfl := False;
+ EotFlag := False;
+ Xtrace := False;
+ Openflag := False;
+ Bufcurr := 1;
+ SaveCommStatus;
+ fname := xmofile;
+ Assign(blkfile,fname);
+ {$I-} Rewrite(blkfile); {$I+}
+ ErrorFlag := (IOresult <> 0);
+ if ErrorFlag then
+ begin
+ writeln(#13,#10,'WXMODEM --- cannot open receive file');
+ goto 99;
+ end
+ else
+ openflag := True;
+
+ trwindow(1, fname);
+ blkcnt := 0;
+ sectnum := 0;
+ errors := 0;
+ toterr := 0;
+{ assign(trfile,'trace');}
+{ rewrite(trfile);}
+ Crcmode := true; {Assume CRC versus Checksum}
+ Packetln := 130; {128 byte data + 2 byte CRC}
+ Wxmode := true; {Assume Wxmodem}
+ Lignore := 0; {ignore packets after error}
+ i:=0; {Try for Wxmodem 3 times}
+ purge;
+ if xmotype = 'W' then
+ begin
+ trwindow(8,'Trying Wxmodem');
+ repeat
+ send(ord('W'));
+ firstchar := cgetc(6); {6 seconds each}
+ if scan(Extend, UserKey) then
+ if UserKey = CAN then goto 99;
+ i := i + 1;
+ until (firstchar=SYN) or (firstchar=CAN) or (i=7);
+ if firstchar=CAN then goto 99;
+ if firstchar <> SYN then
+ xmotype := 'C';
+ end;
+ if xmotype = 'C' then
+ begin
+ trwindow(8,'Trying CRC Xmodem');
+ wxmode := false;
+ i:=0; {Try CRC xmodem 3 times}
+ repeat
+ send(ord('C'));
+ firstchar := cgetc(4); {4 seconds each}
+ if scan(Extend,UserKey) then
+ if UserKey = CAN then goto 99;
+ i := i + 1;
+ until (firstchar=SOH) or (firstchar=CAN) or (i=3);
+ if firstchar = CAN then goto 99;
+ if firstchar <> SOH then
+ xmotype := 'X';
+ end;
+ if xmotype = 'X' then
+ begin
+ trwindow(5,'Trying Checksum Xmodem');
+ wxmode := false;
+ Crcmode := false;
+ Packetln := 129; {128 bytes + 1 byte Checksum}
+ i:=0; {Try Checksum xmodem 4 times}
+ repeat
+ send(NAK);
+ firstchar := cgetc(10); {10 seconds each}
+ if scan(Extend,UserKey) then
+ if UserKey = CAN then goto 99;
+ i := i + 1;
+ until (firstchar=SOH) or (firstchar=CAN) or (i=4);
+ end; {Checksum}
+ { firstchar contains the first character and Wxmode and Crcmode
+ indicate the type of Xmodem }
+
+ If wxmode then
+ trwindow(2,'WXmodem');
+ If not wxmode and crcmode then
+ trwindow(2,'CRC Xmodem');
+ if not wxmode and not crcmode then
+ trwindow(2,'Checksum Xmodem');
+ trwindow(8,'Press ^X to quit');
+ prevchar := firstchar; {save the firstchar}
+ while (EotFlag = false) and (Errors < MAXERRS) do
+ begin {locate start of packet}
+ if (firstchar=SOH) and
+ ((Wxmode and (prevchar=SYN)) or (not Wxmode)) then
+ begin {process packet}
+ prevchar := -1;
+ firstchar := -1;
+ sectcurr := dlecgetc(15);
+{ writeln(trfile,'sectcurr=',sectcurr:4);}
+ sectcomp := dlecgetc(15);
+ if sectcurr = (sectcomp xor 255) then
+ begin {sequence versus compl 1ood}
+ if sectcurr = ((sectnum + 1) and 255) then
+ begin {in sequence}
+ crcval := 0;
+ checksum := 0;
+ j := 1;
+ repeat
+ firstchar := dlecgetc(15);
+ if firstchar >= 0 then
+ begin
+ if j < 129 then
+ dbuffer[bufcurr,j] := firstchar;
+ if Crcmode then updcrc(firstchar)
+ else checksum := (checksum and 255) + firstchar;
+ j := j + 1;
+ end;
+ until (j > Packetln) or (firstchar < 0);
+ if j > Packetln then {good packet length}
+ begin
+ if (Crcmode and (crcval=0) or
+ (not Crcmode and ((checksum shr 1) = firstchar)))
+ then
+ begin {good crc/checksum}
+ firstchar := -1; {make sure this byte not used
+ for start of packet } errors := 0;
+ sectnum := sectcurr;
+ blkcnt := blkcnt + 1;
+ send(ACK);
+ str(blkcnt:4,statstr);
+ trwindow(3,statstr);
+ if Wxmode then send(sectcurr and 3);
+{ write(trfile,' ACK ');}
+{ if Wxmode then write(trfile,(sectcurr and 3):1);}
+ if errors <> 0 then
+ begin
+ trwindow(6,'0');
+ trwindow(5,' ');
+ errors := 0;
+ end;
+ bufcurr := bufcurr + 1;
+ if bufcurr > bufnum then
+ begin {Disk write routine}
+ bufcurr := 1;
+ if wxmode and pcjrmode then
+ begin {if unable to overlap
+ disk i/o and comm i/o.}
+ send(XOFF); {stop transmitter}
+ delay(250); {give it a chance}
+ end;
+ BlockWrite(blkfile,dbuffer,bufnum,bresult);
+ if wxmode and pcjrmode then
+ begin
+ flush(blkfile); {complete all i/o}
+ send(XON); {restart transmitter}
+ end;
+ if bresult <> bufnum then
+ begin
+ trwindow(8,'Disk write error');
+ goto 99;
+ end;
+ end; {End of disk write routine}
+ end {good crc/checksum}
+ else
+ begin {bad crc/checksum}
+ trwindow(5,'CRC/Checksum error');
+ str((blkcnt+1):6,statstr);
+ trwindow(4,statstr);
+ errors := errors + 1;
+ toterr := toterr + 1;
+ str(errors:3,statstr);
+ trwindow(6,statstr);
+ purge; {clear any garbage coming in}
+ send(NAK);
+ if wxmode then
+ begin
+ send(sectcurr and 3);
+ lignore := maxwindow;
+ end;
+{ write(trfile,' NAK CRC ',(sectcurr and 3):1);}
+ end; {bad crc/checsum}
+ end {good packet length}
+ else
+ begin {bad packet length}
+ trwindow(5,'Short block error');
+ str((blkcnt+1):6,statstr);
+ trwindow(4,statstr);
+ errors := errors + 1;
+ str(errors:3,statstr);
+ trwindow(6,statstr);
+ purge; {clear any garbage}
+ send(NAK);
+ if wxmode then
+ begin
+ send(sectcurr and 3);
+ lignore := maxwindow;
+ end;
+ purge; {clear any garbage}
+{ write(trfile,' NAK SHORT ',(sectcurr and 3):1);}
+ end; {bad packet length}
+ end {good block sequence number}
+ else
+ begin {invalid sequence number}
+ if lignore <= 0 then {are we ignoring packets?}
+ begin
+ toterr := toterr + 1;
+ trwindow(5,'Out of sequence');
+ str((blkcnt+1):6,statstr);
+ trwindow(4,statstr);
+ errors := errors + 1;
+ str(errors:3,statstr);
+ trwindow(6,statstr);
+ purge; {clear any garbage coming in}
+ send(NAK);
+ if wxmode then
+ begin
+ send((sectnum+1) and 3);
+ lignore := Maxwindow;
+ end;
+ purge; {clear any garbage coming in}
+{ write(trfile,' NAK SEQ ',((sectnum+1) and 3):1);}
+ end
+ else lignore := lignore -1
+ end; {invalid sequence number}
+ end {valid complement}
+ else
+ begin {invalid complement}
+ toterr := toterr + 1;
+ trwindow(5,'Sequence complement error');
+ str((blkcnt+1):6,statstr);
+ trwindow(4,statstr);
+ errors := errors + 1;
+ str(errors:3,statstr);
+ trwindow(6,statstr);
+ purge; {clear any garbage comming in}
+ send(NAK);
+ if wxmode then
+ begin
+ send((sectnum+1) and 3);
+ lignore := Maxwindow;
+ end;
+ purge; {clear any garbage comming in}
+{ write(trfile,' NAK CMP ',((sectnum + 1) and 3):1);}
+ end; {invalid complement}
+ end {process packet}
+ else {not start of packet}
+ begin
+ case prevchar of
+ EOT: begin
+ if firstchar=EOT then
+ begin
+ EotFlag := True;
+ send(ACK);
+ end;
+ end;
+ CAN: begin
+ if firstchar=CAN then
+ goto 99;
+ end;
+ end; {Of case}
+ if not EotFlag then
+ begin
+ if firstchar=EOT then
+ begin
+ send(NAK); {first EOT received}
+ trwindow(5,' First EOT received');
+ end;
+ prevchar := firstchar;
+ firstchar := cgetc(15); {start of packet!!!!}
+ if firstchar=-1 then
+ begin
+ if (prevchar=CAN) or (prevchar=EOT) then
+ firstchar := prevchar {assume two have been received}
+ else
+ begin
+ trwindow(5,'Timeout on start of packet');
+ str((blkcnt+1):6,statstr);
+ trwindow(4,statstr);
+ errors := errors + 1;
+ str(errors:3,statstr);
+ trwindow(6,statstr);
+ send(XON);
+ toterr := toterr + 1;
+ send(NAK);
+ if wxmode then
+ begin
+ send((sectnum+1) and 3);
+ lignore := Maxwindow;
+ end;
+{ write(trfile,' NAK TIM ',((sectnum+1) and 3):1);}
+ end;
+ end; {Timeout at start of packet}
+ if scan(Extend,UserKey) then
+ if UserKey = CAN then goto 99;
+ end; {end of not EotFlag}
+ end; {not start of packet}
+ end; {xmodem loop}
+ {If there are any xmodem packets left in dbuffer, we had best
+ write them out}
+
+ If EotFlag and (bufcurr>1) then
+ begin
+ bufcurr := bufcurr - 1;
+ trwindow(8,'Writing final blocks');
+ if wxmode and pcjrmode then
+ begin {if unable to overlap
+ disk i/o and comm i/o.}
+ send(XOFF); {stop transmitter}
+ delay(250); {give it a chance}
+ end;
+ BlockWrite(Blkfile,dbuffer,bufcurr,bresult);
+ if wxmode and pcjrmode then
+ begin
+ flush(blkfile); {complete all i/o}
+ send(XON); {restart transmitter}
+ end;
+ if bufcurr <> bresult then
+ begin
+ EotFlag := False; {no longer a 'real' eot}
+ trwindow(8,'Disk write error at end of receive');
+ end;
+ end;
+ If Eotflag and Openflag then
+ begin
+ tblks := blkcnt;
+ {$I-} close(blkfile); {$I+}
+ If IOresult = 0 then
+ good := true
+ else writeln('WXMODEM - error closing receive file');
+ end;
+ 99:
+ if not Eotflag then
+ begin
+ if (errors >= Maxerrs) then
+ trwindow(8,'Maximum errors exceeded')
+ else
+ if UserKey = CAN then
+ begin
+ trwindow(5,'^X entered');
+ send(CAN); send(CAN); send(CAN);
+ end;
+ if (firstchar = CAN) then
+ trwindow(5,'Cancel received');
+ if openflag then
+ begin
+ {$I-} close(blkfile) {$I+};
+ i := IOresult; {clear ioresult}
+ {$I-} erase(blkfile); {$I+}
+ i := IOresult; {clear ioresult}
+ end;
+ end;
+ dbits := db;
+ parity := p;
+ stop_bits := sb;
+{ close(trfile);}
+ update_uart;
+ trwindow(99,' ');
+end;
+
+procedure send_wcp;
+Label
+ tran,99;
+Var
+ UserKey : byte;
+ c, i, j, sectnum, errors : integer;
+ sblks, ackblks, rblks : integer; {total, sent, ack'd blocks}
+ twindow, awindow : integer; {transmission window}
+ bresult, nblks, prevchar : integer;
+ bflag, canflag, xpause : boolean;
+ extend : boolean;
+ blkfile : file;
+ statstr, statstr2 : bigstring;
+ xblk, ackseq : integer;
+ trfile : text;
+
+procedure checkack(tlimit : integer);
+
+var
+inchar : integer;
+
+begin
+ repeat {until no more data & timelimit}
+ inchar := cgetc(0);
+ if inchar <> -1 then
+ begin {got a character}
+ if wxmode then {wxmodem}
+ begin
+{ write(trfile,inchar:4);}
+ case inchar of
+ XOFF : begin
+ xpause := true;
+ txwindow(8,'Received - waiting');
+ end;
+ XON : begin
+ xpause := false;
+ txwindow(8,'No');
+ end;
+ ACK, NAK, CAN : prevchar := inchar; {save ACK/NAK/CAN}
+
+ 0..3 : begin {valid ACK/NAK sequence number}
+ case prevchar of
+ ACK : begin
+ ackseq := inchar - (ackblks and twindow);
+ if ackseq <= 0 then
+ ackseq := ackseq + maxwindow;
+ nblks := ackblks + ackseq;
+ if nblks <= sblks then
+ begin
+ ackblks := nblks;
+ str(ackblks:4,statstr);
+ txwindow(6,statstr);
+ if errors <> 0 then
+ begin
+ errors := 0;
+ txwindow(10,'0');
+ end;
+ end;
+{ writeln(trfile,' ACK ',inchar:2,ackblks:5);}
+ prevchar := -1;
+ end; {case ACK}
+ NAK : begin
+ ackseq := inchar - (ackblks and twindow);
+ if ackseq <= 0 then
+ ackseq := ackseq + maxwindow;
+ nblks := ackblks + ackseq;
+ if nblks <= sblks then
+ begin
+ sblks := nblks - 1;
+ if (sblks - ackblks) <= 2 then
+ ackblks := sblks;
+ str(nblks:4,statstr);
+ txwindow(7,statstr);
+ str(sblks:4,statstr);
+ txwindow(5,statstr);
+ errors := errors + 1;
+ str(errors:3,statstr);
+ txwindow(10,statstr);
+ end
+ else
+ begin
+ GotoXY(3,12);
+ ClrEol;
+ writeln('Invalid NAK seq ',nblks:4,ackseq:4,inchar:3);
+ end;
+{ writeln(trfile,' NAK ',inchar:2,ackblks:5,sblks:5);}
+ prevchar := -1;
+ end; {case NAK}
+ CAN : begin
+ if inchar = CAN then
+ canflag := true;
+ end;
+ end; {of case prevchar}
+ end; {case 0..3}
+ else {of case inchar}
+ prevchar := -1; {inchar not XON/XOFF/ACK/NAK/CAN/0/1/2/3}
+ end; {of case inchar}
+ end {wxmodem mode}
+ else
+ begin {regular xmodem}
+ case inchar of
+ ACK : begin
+ ackblks := ackblks + 1;
+ errors := 0;
+ end;
+ NAK : begin
+ sblks := sblks - 1;
+ errors := errors + 1;
+ end;
+ CAN : begin
+ if prevchar = CAN then
+ canflag := true;
+ prevchar := CAN;
+ end;
+ else prevchar := inchar;
+ end; {end of case inchar}
+ end; {regular xmodem}
+ end {end of got a character}
+ else {no incoming data, inchar=-1}
+ begin
+ if tlimit > 0 then
+ begin
+ delay(1);
+ tlimit := tlimit - 1;
+ end;
+ end; {end no incoming data}
+ if scan(Extend,UserKey) then
+ begin
+ if UserKey = CAN then
+ begin
+ canflag := true;
+ tlimit := 0; {force end of repeat}
+ inchar := -1; { " " " " }
+ xpause := false;
+ purge;
+ end;
+ end; {end of keypressed}
+ until (tlimit <= 0) and (inchar = -1); {repeat until nothing left}
+end; {of procedure checkack}
+
+procedure ChkXoff;
+var
+ j : integer;
+begin
+ j := 0;
+ repeat
+ checkack(0);
+ j := j + 1;
+ delay(1);
+ until ((xpause = false) or (j = 10000));
+ if xpause then {but not forever}
+ begin
+ txwindow(8,'No - Timed Out');
+ xpause := false;
+ end;
+end;
+
+procedure dlesend(c:integer);
+begin
+ if wxmode then
+ begin
+ if buf_start <> buf_end then {if there is any incoming data}
+ checkack(0);
+ if xpause then ChkXoff; {X-Off received .. better wait}
+ case c of
+ SYN, XON, XOFF, DLE : begin
+ send(DLE);
+ send(c xor 64);
+ end;
+ else send(c);
+ end;
+ end
+ else send(c); {regular xmodem}
+end;
+
+
+begin
+ status(2, 'SEND XMODEM');
+ SaveCommStatus;
+ Windowfl := false;
+ openflag := false;
+{ assign(trfile,'trace');}
+{ rewrite(trfile);}
+ fname := xmofile;
+ Assign(Blkfile,fname);
+ {I-} Reset(Blkfile); {I+}
+ If IOresult <> 0 then
+ goto 99;
+ openflag := true;
+ txwindow(1,fname);
+ tblks := Trunc(LongFileSize(Blkfile));
+ fmin := Trunc((tblks)*22.3333333/speed);
+ str(fmin:3,statstr);
+ fsec := Trunc((tblks*22.3333333/speed - fmin) * 60);
+ str(fsec:2,statstr2);
+ txwindow(3,statstr+':'+statstr2);
+ str(tblks:4,statstr);
+ txwindow(4,statstr);
+ txwindow(12,'Press ^X to abort transfer');
+ prevchar := -1;
+ sblks := 0; {sent blks}
+ ackblks := 0; {ack'd blocks}
+ rblks := 0; {highest read block}
+ errors := 0;
+ canflag := false; {not cancelled yet}
+ xpause := false;
+ UserKey := 0;
+
+ {Xmodem transmit protocol initialization}
+
+ i := 0;
+ repeat
+ c := cgetc(1);
+ if c <> -1 then
+ begin {we got a character!}
+ i := i + 1; {one of our 10 characters}
+ case c of
+ NAK : begin {Checksum Xmodem}
+ crcmode := false;
+ wxmode := false;
+ twindow := 0;
+ txwindow(2,'Checksum Xmodem Send');
+ goto tran;
+ end;
+ CHARC : begin {CRC Xmodem}
+ crcmode := true;
+ wxmode := false;
+ twindow := 0;
+ txwindow(2,'CRC Xmodem Send');
+ goto tran;
+ end;
+ CHARW : begin {WXmodem}
+ crcmode := true;
+ wxmode := true;
+ twindow := Maxwindow - 1;
+ txwindow(2,'WXmodem Send');
+ str(Maxwindow:1,statstr);
+ txwindow(9,statstr);
+ goto tran;
+ end;
+
+ CAN : begin {Cancel request received}
+ if canflag then goto 99
+ else canflag := true;
+ end;
+ end; {of case c}
+ end; {got a character}
+
+ if scan(Extend, UserKey) then ;
+ until (i > 10) or (UserKey = CAN);
+ if UserKey = CAN then goto 99;
+ UserKey := 0;
+ txwindow(10,'Could not start: cancelled');
+ purge;
+ goto 99;
+
+tran: {let's send the file!}
+ awindow := twindow;
+ errors := 0;
+ {Xmodem packet level loop}
+
+ while (ackblks < tblks) and (errors <= MAXERRS) do
+ begin
+ i := 0;
+ while (sblks - ackblks) > awindow do {is the ack window open?}
+ begin {no, so wait for ack/nak}
+ i := i + 1;
+ if i <= 1 then
+ begin
+ str((awindow+1):1,statstr);
+ txwindow(9,concat(statstr,' Closed'));
+ end;
+ checkack(50); {50*2400 = 120 seconds +}
+ if canflag then
+ goto 99;
+ if scan(Extend,UserKey) then
+ if UserKey = CAN then
+ goto 99;
+ if i > 2400 then
+ begin
+ txwindow(11,'Timeout for ack');
+ sblks := ackblks + 1;
+ if sblks > tblks then
+ goto 99;
+ end;
+ if (sblks - ackblks) <= awindow then
+ begin
+ str((awindow+1):1,statstr);
+ txwindow(9,statstr);
+ end;
+ end; {window closed}
+
+ if sblks < tblks then {is there anything left?}
+ begin
+ awindow := twindow; {ack window is transmit window}
+ {disk read routine}
+ sblks := sblks + 1;
+ xblk := sblks;
+ while (xblk > rblks) or (xblk <= (rblks - bufnum)) do
+ begin
+ if xblk < (rblks - bufnum) then {if we got nak'd back}
+ begin
+ seek(blkfile,(xblk-1));
+ end;
+ BlockRead(blkfile,dbuffer,bufnum,bresult);
+ rblks := xblk + bufnum - 1; {note rblks must go past eof}
+ end; {end of disk read routine}
+
+ j := bufnum - rblks + xblk; {index of next packet}
+
+ crcval := 0;
+ checksum := 0;
+ if wxmode then
+ begin
+ if xpause then ChkXoff;
+ send(SYN);
+ end;
+ dlesend(SOH);
+ dlesend(xblk and 255); {block sequence}
+ dlesend((xblk and 255) xor 255); {complement sequence}
+ for i := 1 to 128 do
+ begin
+ c := dbuffer[j,i];
+ if crcmode then updcrc(c)
+ else checksum := (checksum + c) and 255;
+ dlesend(c);
+ end;
+ if crcmode then
+ begin
+ dlesend(hi(crcval));
+ dlesend(lo(crcval));
+ end
+ else
+ send(checksum);
+ if canflag then
+ goto 99;
+ str(xblk:4,statstr);
+ txwindow(5,statstr);
+{ writeln(trfile,'SENT ',sblks:5,xblk:5);}
+ end {something to send}
+ else
+ begin {nothing else to send}
+ if wxmode then
+ begin
+ str(awindow:1,statstr);
+ txwindow(9,concat(statstr,' -- Closing'));
+ awindow := sblks - ackblks - 1; {wait for final acks}
+ end;
+ end;
+ end; {xmodem send routine}
+
+ repeat {end of transmission}
+ send(EOT);
+ UserKey := 0;
+ repeat
+ c := cgetc(15);
+ if scan(Extend,UserKey) then ;
+ until (c <> -1) or (UserKey = CAN);
+ if UserKey = CAN then goto 99;
+ if c = NAK then
+ begin
+ errors := errors + 1;
+ delay(250);
+ end;
+ until (c = ACK) or (errors = MAXERRS);
+ if errors = MAXERRS then
+ txwindow(11,'ACK not received at EOT');
+ good := true; {Yea - we sent it}
+ 99:
+{ close(trfile);}
+ if openflag then
+ begin
+ {$I-} close(blkfile) {$I+} ;
+ i := IOresult; {clear ioresult}
+ end;
+ if ((UserKey = CAN) or canflag) and (length(fname) > 0) then
+ begin
+ repeat
+ send(CAN);
+ send(CAN);
+ purge
+ until cgetc(1) = -1
+ end;
+ txwindow(99,' ');
+ dbits := db;
+ parity := p;
+ stop_bits := sb;
+ update_uart
+end;
BIN wxmodem.com
Binary file not shown.
38 wxmodem.txt
@@ -0,0 +1,38 @@
+ This set of files is a sample WXmodem program for the TCOMM demo
+ BBS system. It is public domain.
+
+ The program is executed from a .BAT file as follows:
+
+ WXMODEM %1 W PCJR
+
+ %1 Filename of parameter/control file
+ W/C/X W for windowed xmodem, C for CRC Xmodem, X for checksum
+ PCJR Optional, only if TCOMM BBS is run on a PC Junior
+
+ WXMODEM looks for the following information in the parameter/control
+ file:
+
+ [S/R] filename [port] [baud] [parity]
+
+ [S/R] Send or Receive
+ filename To be sent or received
+ [port] Either COM1 or COM2
+ [baud] Any number over 0 and less than or equal to 9600
+ [parity] Supports EVEN and NONE. Only checks the first letter.
+ If EVEN then it assumes 7 data bits. If None, it assumes
+ 8 data bits. Assumes 1 stop bit.
+
+ In all cases, the parity, baud rate and stop bits are restored
+ to what they were prior to invoking the program.
+
+ At initialization time, WXMODEM will send a message out the line
+ indicating filenames, abort sequence, time estimate and block counts.
+
+ Please let me know how it works.
+
+ Peter Boswell (312) 670-2660
+ People/Link (Topper)
+
+ Windowed Xmodem has been provided to the public domain by People/Link
+ Call 800 826-8855 (modem) for a free hour. In Illinois call
+ 312 822-9712.

0 comments on commit aeb2449

Please sign in to comment.