home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
basic
/
library
/
tb
/
tbxm10
/
xmodem.bas
< prev
Wrap
BASIC Source File
|
1987-10-13
|
11KB
|
428 lines
'┌───────────────────────────────────────────────────────────┐
'│ TITLE: XMODEM.BAS Version 1.0 │
'│ DESC.: A sample Xmodem routine for Turbo Basic (R) │
'│ DATE : October 13, 1987 │
'│ AUTH.: Joe Vest (BIX & GEnie: JVEST - CIS: 74017,1672) │
'│ 8051 E. Roper St., Long Beach, CA, 90808 │
'│ │
'│ Placed in the public domain Oct. 13, 1987 by Joe Vest. │
'│ │
'│ ***** USE THESE ROUTINES AT YOUR OWN RISK ***** │
'│ │
'│ The author makes no guarantee as to the accuracy or │
'│ suitability for a purpose of these routines. Your use │
'│ of these routines signifies your acceptance of the │
'│ complete responsibility for any and all outcomes as │
'│ the result of said use. │
'│ │
'│ Isn't it sad that the inherent greed of certain people │
'│ in our society compels me to put a statement like that │
'│ in a document that is circulated without charge for │
'│ informational purposes? Just remember, TANSTAAFL! │
'│ │
'│ ═════════════════════════════════════════════════════════ │
'│ │
'│ I would like to thank Peter Boswell for helping me to │
'│ understand the Xmodem protocol through his XMODEM.DOC │
'│ file. I would also like to thank Craig J. Kim for his │
'│ sharing with us the CHKCRC.INL code that is used here │
'│ to impliment the CRC checking. And, of course, we │
'│ should all thank Ward Christensen for providing us │
'│ with the original MODEM7 protocol. │
'│ │
'│ ═════════════════════════════════════════════════════════ │
'│ │
'│ Documentation: │
'│ │
'│ This program is a simple demonstration of the Comm port │
'│ routines in Turbo Basic. It contains a simple commun- │
'│ cation program and some sample Xmodem routines. These │
'│ routines are meant to be a starting point for those │
'│ programmers who wish to learn more about the Comm system │
'│ in Turbo Basic and the author requests that you do not │
'│ use them, without major modifications, in any other │
'│ program. │
'│ │
'│ I'm not going to document this package much because you │
'│ should get in there and figure it out for yourself if │
'│ you expect to learn anything. │
'│ │
'│ F1 - Sends a Xmodem file │
'│ F2 - Receives a Xmodem File │
'│ F3 - Exits │
'│ │
'└───────────────────────────────────────────────────────────┘
'═════════════════════════════════════════════════════════════
On key(1) gosub f1pressed
On key(2) gosub f2pressed
On key(3) gosub f3pressed
True% = 0=0
False% = not True%
DevelSwitch% = False%
ComFileNum% = 1
ComNum% = 1
ComSettings$ = "1200,N,8,1"
Call initcomm
Gosub KeysOn
do
Call ReceiveChar(60,ch$,TooLong%)
if TooLong% Then
if instat then
k$ = Inkey$
Call SendChar(k$)
Else
k$ = inkey$
End if
Else
Call Echo(ch$)
end if
loop
stop
KeysOff:
Key(1) off
Key(2) off
Key(3) off
Return
KeysOn:
Key(1) on
Key(2) on
Key(3) on
Return
f1Pressed:
Gosub KeysOff
Line Input "File to send: ";SF$
If Sf$ = "" or Ucase$(Sf$)="STOP" Then Return
Call xmodemsend(SF$,2,x%)
if x% = true then
Print "SUCCESS!!!!!"
else
Print "Failed."
End if
Gosub KeysOn
Return
f2pressed:
Gosub KeysOff
Line Input "File to receive: ";RF$
If Rf$ = "" or Ucase$(rf$)="STOP" Then Return
Call xmodemReceive(RF$,2,x%)
If x% = True% then
Print "SUCCESS!!!!!"
Else
Print "Failed."
End if
Gosub KeysOn
return
f3pressed:
close
stop
$include "CHKCRC.INL"
Sub XmodemSend(Filename$,Filenum%,Success%)
Shared True%,False%
CRCRecieve% = False%
Success% = False%
FirstOK% = False%
NAK$ = Chr$(5)
ACK$ = Chr$(6)
SOH$ = Chr$(1)
EOT$ = Chr$(4)
CAN$ = Chr$(24)
CPM$ = Chr$(26)
Print "Attempting Xmodem send. Press <ESC> to abort."
Open FileName$ for binary as # filenum%
CurBlock% = 1
LstBlock% = (Lof(Filenum%) +127) \ 128
XmodemSendCRCTest:
Do
Call ReceiveChar(60,ch$,TooLong%)
If ch$ = "C" then CRCReceive% = True%
Loop Until ch$="C" or ch$=NAK$ or TooLong%
If Instat Then
K$ = Inkey$
If K$ = chr$(27) then AbortXmodemSend Else XmodemSendCRCTest
End if
If TooLong% Then XmodemSendExit
Do until CurBlock% > LstBlock%
Seek FileNum%, (CurBlock%-1)*128
Get$ FileNum%, 128, Dta$
If Len(Dta$) < 128 Then Dta$=Left$(Dta$+String$(128,CPM$),128)
Call ChkCRC(Dta$, ChkSum%, CRC%, CRC.Hi%, CRC.Low%)
Dta$ = SOH$ + Chr$(CurBlock% and 255) + Chr$(255-(CurBlock% and 255)) +Dta$
If CRCReceive% Then
Dta$ = Dta$ + Chr$(CRC.Hi%) + Chr$(CRC.Low%)
Else
Dta$ = Dta$ + Chr$(ChkSum%)
End if
Retransmit% = 0
Do
Call SendString(Dta$)
Incr Retransmit%
Call ReceiveChar(60,ch$,TooLong%)
If Instat Then
K$ = Inkey$
If K$ = chr$(27) then ch$ = CAN$
End if
If ch$ = "C" and FirstOK% = False% Then
CRCReceive% = True%
Dta$ = Left$(Dta$,131) + CHr$(CRC.Hi%) + Chr$(CRC.Low%)
TooLong% = True%
End if
Loop Until ch$ = ACK$ or Retransmit% > 10% or ch$ = CAN$
If Retransmit% > 10% Then
ch$ = CAN$
Else
FirstOk% = True%
Incr CurBlock%
End if
Loop Until ch$ = CAN$
If ch$ = CAN$ then AbortXmodemSend
Retransmit% = 0
Do
Incr Retransmit%
Call SendChar(EOT$)
Call ReceiveChar(10,ch$,TooLong%)
If Instat Then
k$ = inkey$
if k$ = chr$(27) Then ch$ = CAN$
End if
Loop Until ch$ = ACK$ or ch$ = CAN$ or Retransmit% > 10
If ch$ = ACK$ Then
Call SendChar(ACK$)
Success% = True%
Goto XmodemSendExit
End if
AbortXmodemSend:
Call SendString(String$(5,CAN$)+String$(5,8))
XmodemSendExit:
Close Filenum%
End Sub 'XmodemSend
Sub XmodemReceive(Filename$,Filenum%,Success%)
Shared True%,False%
CRCSend% = 99
Success% = False%
FirstOK% = False%
BlockHi% = 0
PrevBlock% = 0
NAK$ = "C"
ACK$ = Chr$(6)
SOH$ = Chr$(1)
EOT$ = Chr$(4)
CAN$ = Chr$(24)
CPM$ = Chr$(26)
Print "Attemting Xmodem receive. Press <ESC> to abort."
Open FileName$ for binary as # filenum%
Call SendChar(nak$)
Do
Retries% = 0
Do
Incr Retries%
R$ = ""
x% = 10
Do
Call ReceiveChar(x%,ch$,TooLong%)
If Instat Then
k$ = Inkey$
If k$ = chr$(27) then R$ = CAN$
End if
If not TooLong% Then r$ = r$ + ch$
x% = 1
Loop Until TooLong%
If FirstOk% = False% Then
If Len(r$) = 132 then CRCSend% = False%
If Len(r$) = 133 then CRCSend% = True%
End if
Ok% = False%
Start$ = Left$(r$,1)
If Len(R$)<132 Then NotOK
Block% = Asc(Mid$(r$,2,1))
BlkCk% = 255 - Asc(Mid$(r$,3,1))
Dta$ = Mid$(r$,4,128)
Chk$ = Mid$(r$,132,3)
If Start$ <> SOH$ then NotOK
If Len(dta$) <> 128 Then NotOK
If Block% <> BlkCk% Then NotOK
Call ChkCRC(Dta$, ChkSum%, CRC%, CRC.Hi%, CRC.Low%)
If CRCSend% Then
If chk$ <> Chr$(CRC.Hi%)+Chr$(CRC.Low%) Then NotOk
Else
If Chk$ <> Chr$(ChkSum%) Then NotOK
End if
Ok% = True%
NotOk:
If Not ok% Then Call SendChar(NAK$)
Loop Until Ok% or Retries% > 10 or Start$ = CAN$ or Start$ = EOT$
If Start$ = SOH$ and Ok% Then
Print "Save Block ";Block%
If Block% = 0 And PrevBlock% = 255 Then Incr BlockHi%
Seek FileNum%, ( (Block%+ BlockHi%*256)-1 ) * 128
Put$ FileNum%, Dta$
PrevBlock% = Block%
FirstOk% = True%
NAK$ = Chr$(5)
Call SendChar(ACK$)
End if
Loop Until Start$ = CAN$ or Start$ = EOT$ or Retries% > 10
If Start$ <> EOT$ Then XmodemReceiveAbort
Retries% = 0
Do
Incr Retries%
Call SendChar$(ACK$)
Call ReceiveChar(10,ch$,TooLong%)
If Instat then
k$ = inkey$
if k$ = Chr$(27) then ch$=CAN$
End if
Loop Until ch$ <> EOT$ or Retries% > 10
If Retries% < 11 and ch$ <> can$ then
Success% = True%
Goto XmodemReceiveExit
End if
XmodemReceiveAbort:
Call SendString(String$(5,CAN$)+String$(5,8))
XmodemReceiveExit:
Close Filenum%
if success% = false% then kill filename$
End Sub 'XmodemReceive
Sub BS
If Pos(0)>1 then
Locate ,Pos(0)-1,1
Print " ";
Locate ,Pos(0)-1,1
end if
End Sub 'Bs
Sub Echo(ch$)
EchoAgain:
Select Case Asc(Ch$)
Case 8
Call Bs
Case 13
Print
Case 0 to 31
Exit select
Case 128 to 255
ch$ = chr$(asc(ch$)-128)
Goto EchoAgain
Case Else
Print Ch$;
End Select
End Sub
Sub SendChar(c$)
shared DevelSwitch%,ComFileNum%
if DevelSwitch% then print "{";c$;"}";
Print #ComFileNum%,C$;
End Sub 'SendChar
Sub SendString(s$)
Local I%
For I% = 1 to Len(s$)
Delay .1
Call SendChar(Mid$(s$,I%,1))
Next I%
End Sub 'SendString
Sub ReceiveChar(TimeLimit%,NextChar$,TooLong%)
Shared True%,False%,ComFileNum%
Local Tstart!,a$
TooLong%=True%
NextChar$=Chr$(0)
Tstart!=Timer
11111
On Error Goto 0
While Eof(ComFileNum%) and Timer-Tstart! =< TimeLimit%
If Instat then Exit Sub
Wend
If Not Eof(ComFileNum%) then
On Error Goto 22222
NextChar$=Input$(1,#ComFileNum%)
TooLong%=False%
End if
On Error Goto 0
Exit Sub
22222
Call InitComm
If DevelSwitch% then ?"***Comm error***"
resume 11111
End Sub 'ReceiveChar
Sub InitComm
Shared ComNum%,ComSettings$,ComFileNum%
Close ComFileNum%
Open "COM"+Chr$(ComNum%+48)+":"+ComSettings$ as ComFileNum%
End Sub