Category : BASIC Source Code
Archive   : QBXMODEM.ZIP
Filename : XMODEM.BAS
sub XMODEM static
'**************************************************************************
'* EBBS-PC xmodem module copyright 1987 by Ed Parry - started 871107 *
'**************************************************************************
'
' Handles xmodem checksum & xmodem/crc-ccitt
'
' Read "XMODEM.DAT" file for passed/shared variables
' Read : port, baud$, name$, start.time!, filename$, mode$, xm, local.mode
' Defs :
' port = active rs232 port
' baud$ = baud rate IE:0300, 1200, 2400, etc.
' name$ = User's name (Currently not in use)
' start.time! = Value of TIMER when user 1st logged on
' filename$ = Name of file to transfer
' mode$ = send or receive mode
' xm = xmodem protocol indicator (1 - 3) - Checksum, CRC, 1k
' local.mode = local or remote - if remote then dropped carrier aborts
'
' Send "XMODEM.DAT" file for passed/shared vars
' Send : abort, time.on, xfer.time
' Defs:
' abort = abort status - either true (-1) or false (0)
' time.on = time.of actual transfer
' xfer.time = Actual effective xfer time (So EBBS can calc BPS Rate)
'
' Pass abort status (true/false), time.on, effective xfer rate (BPS & %)
'
'*************************************************************************
'* INITIALIZE ALL SYSTEM VARIABLES - MISC EBBS SETUP *
'*************************************************************************
'INIT.VARS:' Set-up and init
defint a-z
up$="871126":au$="Ed Parry":ve$="v1.0"
locate 15,1
dim xm$(2),crctb(256):r$=chr$(13):rl$=r$+chr$(10)
s$=space$(1):q$=chr$(34):true=-1:false=0
offset=0:start.time!=timer:cdm=128:abort=false
null$=chr$(0):soh$=chr$(1):eot$=chr$(4)
ack$=chr$(6):nak$=chr$(21):can$=chr$(24):pad$=chr$(26)
xm$(1)="Xmodem":xm$(2)="Xmodem/CRC":bs=128:crc$=null$+null$
test.mode=false 'set to true for local testing and mods
'LOAD.CONFIG.VARIABLES: ' Load variables here!
if test.mode then ' Define for desired settings
port=2:baud$="1200":name$="System Operater"
filename$="c:\ebbs\NEWUSERS.MSG"
mode$="send":xm=2
local.mode=true
goto SETUP.CFG.VARS
end if
open "XMODEM.INP" for input as # 2
if oops=53 then close #2:print"XMODEM.DAT file not found":_
abort=true:goto EXIT.MODULE
input#2,port,baud$,name$,start.time!,filename$,mode$,xm,local.mode
close # 2
SETUP.CFG.VARS:
if port=1 then msr=&h3fe:mcr=&h3fc:lsr=&h3fd
if port=2 then msr=&h2fe:mcr=&h2fc:lsr=&h2fd
if xm=1 then chking$="CHECKSUM ":xoffset=4:_
else chking$="CRC/CCITT":xoffset=5
if mode$="send" then send=true:recv=false:else recv=true:send=false
'READ.CRC.TABLE:
for i=0 to 255:read crctb(i):next:restore
data 0,4129,8258,12387,16516,20645,24774,28903
data -32504,-28375,-24246,-20117,-15988,-11859,-7730,-3601
data 4657,528,12915,8786,21173,17044,29431,25302
data -27847,-31976,-19589,-23718,-11331,-15460,-3073,-7202
data 9314,13379,1056,5121,25830,29895,17572,21637
data -23190,-19125,-31448,-27383,-6674,-2609,-14932,-10867
data 13907,9842,5649,1584,30423,26358,22165,18100
data -18597,-22662,-26855,-30920,-2081,-6146,-10339,-14404
data 18628,22757,26758,30887,2112,6241,10242,14371
data -13876,-9747,-5746,-1617,-30392,-26263,-22262,-18133
data 23285,19156,31415,27286,6769,2640,14899,10770
data -9219,-13348,-1089,-5218,-25735,-29864,-17605,-21734
data 27814,31879,19684,23749,11298,15363,3168,7233
data -4690,-625,-12820,-8755,-21206,-17141,-29336,-25271
data 32407,28342,24277,20212,15891,11826,7761,3696
data -97,-4162,-8227,-12292,-16613,-20678,-24743,-28808
data -28280,-32343,-20022,-24085,-12020,-16083,-3762,-7825
data 4224,161,12482,8419,20484,16421,28742,24679
data -31815,-27752,-23557,-19494,-15555,-11492,-7297,-3234
data 689,4752,8947,13010,16949,21012,25207,29270
data -18966,-23093,-27224,-31351,-2706,-6833,-10964,-15091
data 13538,9411,5280,1153,29798,25671,21540,17413
data -22565,-18438,-30823,-26696,-6305,-2178,-14563,-10436
data 9939,14066,1681,5808,26199,30326,17941,22068
data -9908,-13971,-1778,-5841,-26168,-30231,-18038,-22101
data 22596,18533,30726,26663,6336,2273,14466,10403
data -13443,-9380,-5313,-1250,-29703,-25640,-21573,-17510
data 19061,23124,27191,31254,2801,6864,10931,14994
data -722,-4849,-8852,-12979,-16982,-21109,-25112,-29239
data 31782,27655,23652,19525,15522,11395,7392,3265
data -4321,-194,-12451,-8324,-20581,-16454,-28711,-24584
data 28183,32310,20053,24180,11923,16050,3793,7920
'*************************************************************************
'* Reset modem and goto xfer file *
'*************************************************************************
'INIT.MODEM:
close:out mcr,inp(mcr) or 1 'force modem to keep DTR high
open "com"+mid$(str$(port),2)+":"+baud$+",n,8,1,DS0,CS0" as # 1
if not test.mode or (inp(msr) and cdm) then goto IM1
print "Press ENTER":while inkey$ <> r$:wend
print#1,"AT E0 Q1 M0 A":call SLEEP(7.0)
IM1: gosub CLEAR.BUFS
if send then goto SEND.FILE
if recv then goto RECV.FILE
abort=true:goto EXIT.MODULE
'*************************************************************************
'* Xmodem Module Sub-Routines (Alphabetized) *
'*************************************************************************
CHECK.ABORT:' Check for a CAN$ (aborted xfer)
if a$=can$ then status$="Remote abort"
if b$=can$ then status$="Local abort"
if a$ = can$ or b$ = can$ then abort=true
return
CHECK.CARRIER:' Keep an eye on the carrier
carrier = true
if local.mode or (inp(msr) and cdm) then return
if (inp(msr) and cdm) <> cdm then call SLEEP(.5)
if (inp(msr) and cdm) <> cdm then carrier=false
return
CLEAR.BUFS:' Clear keyboard and RS232 input buffers
call SLEEP(.1):while not eof(1):a$=input$(loc(1),1):wend
while inkey$ > "":a$=inkey$:wend
return
CONVERT.TIMER:' Use timer to maintain and calc online time
if start.time! > timer then offset! = 86400 - start.time!:_
start.time! = 0
time.on = (timer - start.time!) + offset!
return
CALC.CRC:' Calculates CRC for xfer recv block
crc$=null$+null$:for p=1 to bs
crc$=mki$(crctb(asc(left$(crc$,1)) xor_
asc(mid$(dat$,p,1))) xor cvi(null$+right$(crc$,1)))
crc$=right$(crc$,1)+left$(crc$,1):next
return
CALC.RECV.CRC:' Calculates CRC for xfer send block
if len(block$) < 4 or len(block$) > bs+3 then return
crc$=mki$(crctb(asc(left$(crc$,1)) xor_
asc(right$(block$,1))) xor cvi(null$+right$(crc$,1)))
crc$=right$(crc$,1)+left$(crc$,1)
return
GET.BYTE:' Checks keyboard AND modem for a byte
a$="":if not eof(1) then a$=input$(1,1)
b$=inkey$:return
READ.BLOCK:' Read in a block from disk - send file
get#2:if loc(2) < filesize! then return
block$=left$(bloc$,lof(2) mod bs)
bloc$=block$+string$(bs - len(block$),pad$)
done=true
return
RECV.BLOCK:' Reads in a modem block - recv file
while not eof(1) and loc(1) > 0
block$=block$+input$(1,1):gosub CALC.RECV.CRC:wend
if len(block$) >= bs+xoffset then return
gosub CHECK.CARRIER:if not carrier then_
status$="Lost Carrier":goto ABORTED.XFER
call SLEEP(.1):if not eof(1) then goto RECV.BLOCK
return
SEND.NAK:' Sends init nak
if nak = 6 then xm=1 ' drop to checksum
if xm = 1 then print#1,nak$; ' init checksum
if xm = 2 then print#1,"C";:nak=nak+1 ' init CRC
return
TIMEOUT:' Check carrier & timeouts during xfer
gosub CONVERT.TIMER:tim.out=false:er=false
if val(sec$) <> time.on mod 60 then
gosub UPDATE.TIME.ON:gosub CHECK.CARRIER:gosub XMIT.DATA
if not carrier then status$="Lost carrier":abort=true
end if
if time.on > it+9 then
er$="Timeout":er=true:bad.blocks=bad.blocks+1:timeout=timeout+1
gosub XMIT.DATA:tim.out=true
if timeout = 10 then status$="Timeout abort":abort=true
gosub CONVERT.TIMER:it=time.on
end if
return
UPDATE.TIME.ON:' Prints elapsed time
row=csrlin:col=pos(0):view print 1 to 2
gosub CONVERT.TIMER:locate 1,72:min$=mid$(str$(int(time.on/60)),2)
sec$=mid$(str$(time.on mod 60),2):if len(sec$) = 1 then sec$="0"+sec$
print min$":"sec$:view print 3 to 24
locate row,col
return
XMIT.DATA:' Update xfer info
print "Error Checking : "chking$
if len(crc$)=1 then crc$=null$+crc$
print "CRC/Checksum : "hex$(cvi(right$(crc$,1)+left$(crc$,1)))s$s$s$
if send then sr$="Sent :":else sr$="Received :"
print "Bytes "sr$;bytes!
print "Good Blocks :"block-1
print "Errors :"bad.blocks
if er then er$=er$+" in block"+str$(block)
print "Last Error : "er$;;space$(78-pos(0)):er=false
print "Status : "status$;space$(78-pos(0))
gosub CONVERT.TIMER:et=time.on-start.xfer
min=int(et/60):sec=et mod 60
if min <> 1 then m$="mins":else m$="min"
if sec <> 1 then se$="secs":else se$="sec"
print "Elapsed Time :"min;m$;sec;se$;space$(5)
locate 16,1
return
XMIT.WAIT:' Waits til xmit buffer is clear
while inp(lsr)=0:wend
return
'*************************************************************************
'* Xmodem Send Routine *
'*************************************************************************
SEND.FILE:' 1st set-up
oops=0:open filename$ for random access read as # 2 len=bs
if oops=53 then goto ABORTED.XFER
field #2,bs as bloc$:last.block=false
total.blocks=int(lof(2)/bs)+1
filesize!=(lof(2)/bs):counter!=1
print:block=1:bytes!=0:bad.blocks=0
er$="None":done=false:status$="Waiting for initial handshake"
gosub XMIT.DATA:b$="":gosub CONVERT.TIMER
timeout=0:it=time.on:start.xfer=time.on
SEND1: gosub GET.BYTE ' check for init nak or "C"
if a$=nak$ then chking$="CHECKSUM ":_
xm=1:goto SEND5 ' CHKSUM init
if a$="C" then chking$="CRC/CCITT":_
xm=2:goto SEND5 ' CRC init
gosub CHECK.ABORT:if abort then goto ABORTED.XFER
gosub TIMEOUT:if abort then goto ABORTED.XFER
goto SEND1
SEND5: gosub XMIT.DATA:gosub CONVERT.TIMER
start.xfer=time.on:er=false:gosub READ.BLOCK:dat$=bloc$
gosub CALC.CRC
SEND2: gosub CLEAR.BUFS:status$="Sending block"
x2$=chr$(block and 255):x3$=chr$(255 - (255 and block))
if xm=1 then 'checksum
chksum=0:for i=1 to bs:chksum=chksum+asc(mid$(block$,i,1))
next:chksum=chksum and 255:block1$=soh$+x2$+x3$+bloc$+chr$(chksum)
crc$=chr$(chksum)
goto SEND3
end if
' CRC
block1$=soh$+x2$+x3$+bloc$+crc$
SEND3: gosub XMIT.DATA:print#1,block1$;
if done then last.block=true:goto SEND4
if a$ <> nak$ then gosub READ.BLOCK:dat$=bloc$:gosub CALC.CRC
gosub CONVERT.TIMER:it=time.on:timeout=0
SEND4: gosub GET.BYTE
if a$=nak$ then status$="Resending block":_
bad.blocks=bad.blocks+1:er=true:er$="NAK":goto SEND3
if a$=ack$ then
block=block+1:bytes!=bytes!+bs:er=false:status$="Received ACK"
gosub XMIT.DATA:if last.block then goto SENEX
goto SEND2
end if
gosub CHECK.ABORT:if abort then goto ABORTED.XFER
gosub TIMEOUT:if abort then goto ABORTED.XFER
goto SEND4
SENEX: print#1,eot$;:gosub CONVERT.TIMER:it=time.on:timeout=0
SENX1: status$="Sending EOT":gosub XMIT.DATA
gosub GET.BYTE
gosub CHECK.ABORT:if abort then goto ABORTED.XFER
if a$=ack$ then abort=false:status$="Transfer Complete":_
goto EXIT.MODULE
if a$=nak$ then print#1,eot$;:goto SENX1
gosub TIMEOUT:if abort then goto ABORTED.XFER
goto SENX1
'*************************************************************************
'* Xmodem Receive Routine *
'*************************************************************************
RECV.FILE:' Set-up and init vars
oops=0:open filename$ for output as # 2
if oops=53 then goto ABORTED.XFER
print:block=1:bytes!=0:bad.blocks=0
er$="none":done=false:status$="Sending initial handshake"
gosub XMIT.DATA:b$="":gosub CONVERT.TIMER
timeout=0:it=time.on:start.xfer=time.on:seq.err=0:nak=0
gosub CLEAR.BUFS:gosub SEND.NAK:in.row=0
RECV1: gosub GET.BYTE:if a$=soh$ then_
block$=a$:start.xfer=time.on:goto RECV5
gosub CHECK.ABORT:if abort then goto ABORTED.XFER
gosub TIMEOUT:if abort then goto ABORTED.XFER
if tim.out then gosub SEND.NAK
goto RECV1
RECV5: gosub CONVERT.TIMER:it=time.on:timeout=0
RECTO: gosub XMIT.DATA
if not eof(1) and b$="" then status$="Receiving block":_
gosub XMIT.DATA:crc$=null$+null$:gosub RECV.BLOCK:er=false
gosub TIMEOUT:if abort then goto ABORTED.XFER
b$=inkey$:if b$ = can$ then status$="Local abort":goto ABORTED.XFER
x1$=left$(block$,1):x2$=mid$(block$,2,1):x3$=mid$(block$,3,1)
if x1$ = can$ then status$="Remote abort":goto ABORTED.XFER
if x1$ = eot$ then status$="Received EOT":goto RECV3
if (x1$ <> soh$) then er=true:er$="Incorrect SOH":goto RCER
if x2$=null$ and x3$=chr$(255) then if block=1 then_
status$="Sending 0 block ACK":print#1,ack$;:block$="":goto RECV5
if x2$ <> chr$(block and 255) then er=true:_
er$="Block out of sequence":goto RCER
if x3$ <> chr$(255 - (255 and block)) then_
er=true:er$="Compliment out of sequence":goto RCER
if x2$ = chr$((block-1) and 255) then_
er=true:er$="Duplicate block":goto RCER
dat$=mid$(block$,4,bs)
rcrc$=mid$(block$,132,2):if xm=1 then chk$=right$(block$,1)
if len(block$) < bs+xoffset then er=true:er$="Short Block"
if len(block$) > bs+xoffset then er=true:er$="Long Block"
RCER: if not er and xm=1 then
chksum=0:for i=1 to bs:chksum=chksum+asc(mid$(dat$,i,1))
next:chksum=chksum and 255:crc$=chr$(chksum)
if chk$ <> chr$(chksum) then er=true:er$="Bad checksum"
end if
if not er and xm=2 then_
if rcrc$ <> crc$ then er=true:er$="Bad CRC checksum"
if er then
bad.blocks=bad.blocks+1:in.row=in.row+1
if in.row = 10 then er$="10 consecutive errors":_
status$="Aborting transfer":goto ABORTED.XFER
status$="Sending NAK for block"+str$(block)
gosub XMIT.DATA:gosub CLEAR.BUFS:print#1,nak$;
block$="":goto RECV5
end if
block=block+1:print#2,dat$;:bytes!=bytes!+bs:in.row=0:block$=""
status$="Sending ACK":gosub CLEAR.BUFS:print#1,ack$;
goto RECV5
RECV3: print#1,ack$;:gosub XMIT.DATA:status$="Transfer complete"
abort=false:goto EXIT.MODULE
'*************************************************************************
'* Wrap it up and exit! *
'*************************************************************************
ABORTED.XFER:
close #2:gosub CLEAR.BUFS:abort=true
print#1,string$(2,can$); ' send 2 CAN$(celled)
EXIT.MODULE:' Clean up and return to EBBS
gosub CONVERT.TIMER:xfer.time=time.on-start.xfer
gosub CLEAR.BUFS:gosub XMIT.DATA:close #2
open "XMODEM.OUT" for output as #2
print#2,abort;rl$;xfer.time:locate 23,1:close #2
close #1:out mcr,inp(mcr) or 1 'force modem to keep DTR high
end sub
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/