.pl 60
.n3
.he \d
.fo #
'
$e
$i+
$U+
$s<
$m40960
'
' ************************************************************************
' *            Source Basic Du Protocole BBT de Jean Claude MICHOT
' *
' *  TOUTE UTILISATION COMMERCIALE DU PROTOCOLE BBT EST STRICTEMENT INTERDITE
' *                       SANS L'ACCORD ECRIT DE L'AUTEUR !
' *
' ************************************************************************
' ========================= PREPARATION =====================================
ON ERROR GOSUB bug
CLS
CLEAR
VOID XBIOS(15,W:7,W:0,W:174,W:-1,W:-1,W:-1)!configuration rs232. 1200 bauds
PAUSE 5                                   !7 bits, parite paire, 1 bit de stop
OPEN " ",#1,"AUX:"                         !ouverture de la prise serie
'
@tampon_on
'
REPEAT
  CLR ulp!,dl!
  CLS
  PRINT "BBT_W V1.0"
  PRINT "Telechargement format BBT00"
  PRINT
  PRINT "[U]pload         [D]ownload"
  INPUT a$
  SELECT a$
  CASE "U","u"
    ulp!=TRUE
  CASE "D","d"
    dl!=TRUE
  ENDSELECT
  FILESELECT "","",fichier$
  CLR a%,b%
  REPEAT
    b%=a%
    a%=INSTR(b%+1,fichier$,"\")
  UNTIL a%=0
  chemin$=LEFT$(fichier$,b%)
  fichier$=MID$(fichier$,b%+1)
  IF ulp! AND fichier$<>""
    @upload(fichier$,chemin$)
  ELSE IF dl!
    @download(chemin$)
  ENDIF
  CLS
  PRINT "BBT Termine !"
  ALERT 0,"Encore ?",1,"OUI|NON",ret%
UNTIL ret%=2
CLOSE
@tampon_off
END
' ========================= PROGRAMME DOWN LOAD ==============================
> PROCEDURE download(path$)
  LOCAL findown!,fin!,fichier$,taille_fich%,taille_pak%,ouinon$,long%,buf$,l%,donnees$,t1%
  CLS
  findown!=FALSE
  PRINT AT(1,2);"TELECHARGEMENT EN COURS..."
  PRINT
  PRINT #1,CHR$(13)
  init(fichier$,taille_fich%)  !fichier$=@init$
  IF fin!
    GOTO fin_dl
  ENDIF
  PRINT #1,"!00"+CHR$(13);
  PRINT AT(1,7);"** Ouverture du fichier...        "
  OPEN "O",#2,path$+fichier$
  CLR taille_pak%,long%
  t1%=TIMER
  REPEAT
    buf$=@recoit$
    taille_pak%=VAL(LEFT$(buf$,4))
    PRINT AT(1,9);"** Taille paquet en cours: ";taille_pak%
    PRINT AT(1,10);"** Deja transfere: ";long%
    fin!=FALSE
    IF (buf$="@@!@@") OR (buf$="#") OR (buf$="#BREAK#") THEN
      findown!=TRUE
      ouinon$="#"
      fin!=TRUE
    ELSE IF LEN(buf$)<8
      ouinon$="?"
      fin!=TRUE
    ENDIF
    IF NOT fin!
      ouinon$=@calculcrc$(buf$)
    ENDIF
    PRINT #1,ouinon$+CHR$(13);
    IF ouinon$="!"
      PRINT AT(1,11);"Vitesse:";ROUND((long%+taille_pak%)/(TIMER-t1%)*200);" Cps"
      donnees$=@decodage$(MID$(buf$,5,SUB(LEN(buf$),8)))
      l%=MIN(LEN(donnees$),SUB(taille_fich%,long%))  ! fo pas trop en ecrire car en transmet plus sur le dernier block
      long%=MIN(ADD(long%,LEN(donnees$)),taille_fich%)
      PRINT AT(1,7);"** Sauvegarde des donnees              "
      PRINT #2,LEFT$(donnees$,l%);
    ENDIF
  UNTIL findown!
  PRINT #1,"#"+CHR$(13);
  CLOSE #2
fin_dl:
RETURN
' ========================== DEBUT TELECHARGEMENT ============================
> PROCEDURE init(VAR fichier$,taille%)
  LOCAL memrc$,a|,paquet$,tri%
  PRINT AT(1,7);"** Attente synchro..."
  WHILE INSTR(memrc$,"@@!@@"+CHR$(13))=0
    REPEAT
      IF (BIOS(11,-1) AND 3)=3
        fin!=TRUE
        GOTO fin_init
      ENDIF
    UNTIL INP?(1)
    a|=INP(1)
    memrc$=memrc$+CHR$(a|)
    memrc$=RIGHT$(memrc$,6)
  WEND
  paquet$=@recoit$
  paquet$=TRIM$(paquet$)
  taille%=VAL(paquet$)
  paquet$=TRIM$(MID$(paquet$,INSTR(paquet$+" "," ")))
  fichier$=TRIM$(LEFT$(paquet$,INSTR(paquet$," ")))
  LOCATE 1,4
  PRINT "** Le fichier est: ";
  PRINT fichier$
  PRINT "** Taille Fichier: ";
  PRINT taille%
fin_init:
RETURN
' ========================== RECEPTION DES DONNEES ===========================
> FUNCTION recoit$
LOCAL a|,paquet$
paquet$=""
PRINT AT(1,7);"** Reception des donnees...        "
DO
  REPEAT
    IF (BIOS(11,-1) AND 3)=3
      PRINT #1,CHR$(13)+"#BREAK#"+CHR$(13);
      PAUSE 20
      finulp!=TRUE
      findown!=TRUE
      GOTO fin_recoit
    ENDIF
  UNTIL INP?(1)
  a|=INP(1)
  EXIT IF a|=13
  paquet$=paquet$+CHR$(a|)
LOOP
fin_recoit:
RETURN paquet$
ENDFUNC
' =========================== VERIFIE CRC BLOC ===============================
> FUNCTION calculcrc$(bloc$)
LOCAL chek%,ca%,rcrc%,t%
PRINT AT(1,7);"** Calcul checksum paquet...              "
PRINT AT(1,8);"                              "
rcrc%=VAL("&H"+RIGHT$(bloc$,4))
FOR ca%=1 TO SUB(LEN(bloc$),4)
chek%=AND(ADD(chek%,ASC(MID$(bloc$,ca%,1))),&HFFFF)
NEXT ca%
IF chek%=rcrc%
RETURN "!"
ELSE
PRINT AT(1,8);"## Mauvais checksum";CHR$(7)
RETURN "?"
ENDIF
ENDFUNC
' ============================ DECODAGE DU BLOC ==============================
> FUNCTION decodage$(paquet$)
LOCAL ca%,donne$,car1|,car2|,car3|
PRINT AT(1,7);"** Decodage bloc...             ";
FOR ca%=0 TO PRED(LEN(paquet$)) STEP 4
'   car1|=(((BYTE{V:paquet$+ca%}-32)*4) OR (((BYTE{V:paquet$+ca%+1}-32) AND 48)/16)) AND &HFF
'  car2|=((((BYTE{V:paquet$+ca%+1}-32) AND 15)*16) OR ((((BYTE{V:paquet$+ca%+2}-32) AND 60)*4)/16)) AND &HFF
' car3|=((((BYTE{V:paquet$+ca%+2}-32) AND 3)*64) OR (BYTE{V:paquet$+ca%+3}-32)) AND &HFF
' donne$=donne$+CHR$(car1|)+CHR$(car2|)+CHR$(car3|)
'
car1|=OR(SHL(SUB(BYTE{V:paquet$+ca%},32),2),SHR(AND(SUB(BYTE{V:paquet$+ca%+1},32),48),4)) AND &HFF
car2|=OR(SHL(AND(SUB(BYTE{V:paquet$+ca%+1},32),15),4),SHR(AND(SUB(BYTE{V:paquet$+ca%+2},32),60),2)) AND &HFF
car3|=OR(SHL(AND(SUB(BYTE{V:paquet$+ca%+2},32),3),6),SUB(BYTE{V:paquet$+ca%+3},32)) AND &HFF
donne$=donne$+CHR$(car1|)+CHR$(car2|)+CHR$(car3|)
NEXT ca%
RETURN donne$
ENDFUNC
' =============================== BOF !! =====================================
> PROCEDURE bug
RESUME NEXT
RETURN
' ============================ TAMPON RS232 ==================================
> PROCEDURE tampon_on
RESERVE -20000
ad%=XBIOS(14,0)
initin%=LPEEK(ad%)
longin%=DPEEK(ad%)
ad%=XBIOS(14,0)+14
initout%=LPEEK(ad%)
longout%=DPEEK(ad%)
'       Nouveau tampon
xxxin%=MALLOC(5120)
xbios14in(xxxin%,5120)
xxxout%=MALLOC(5120)
xbios14out(xxxout%,5120)
lect%=MALLOC(5120)
DPOKE (xxxout%+6),0
RETURN
> PROCEDURE tampon_off
xbios14in(initin%,longin%)
xbios14out(initout%,longout%)
~MFREE(xxxin%)
~MFREE(xxxout%)
~MFREE(lect%)
RETURN
> PROCEDURE xbios14out(adr%,long%)
LOCAL ad%
ad%=XBIOS(14,0)+14
SLPOKE ad%,adr%
SDPOKE ad%+4,long%
SLPOKE ad%+6,0
PAUSE 10
RETURN
> PROCEDURE xbios14in(adr%,long%)
LOCAL ad%
ad%=XBIOS(14,0)
SLPOKE ad%,adr%
SDPOKE ad%+4,long%
SLPOKE ad%+6,0
PAUSE 10
RETURN
' =========================== PROGRAMME UP LOAD ==============================
> PROCEDURE upload(fichier$,chemin$)
LOCAL finupl!,prog$,paquet$,long%,pos%,a%,buf$,taille_prog%,timeout!,t1%,taille_2%,paquet2$,toto%,cmp|
CLS
finupl!=FALSE
timeout!=FALSE
PRINT AT(1,2);"UPL en cours..."
PRINT
OPEN "i",#2,chemin$+fichier$
PRINT AT(1,7);"Ouverture du fichier..."
t1%=TIMER
OUT 1,19,76 ! demande de retournement Transpac
PAUSE 40
WHILE INP?(1)
~INP(1)
WEND
REPEAT
@debut(fichier$)
toto%=TIMER
REPEAT
UNTIL INP?(1) OR SUB(TIMER,toto%)>800
EXIT IF INP?(1)
INC cmp|
UNTIL cmp|<3
buf$=@recoit$
IF LEFT$(buf$)<>"!"
finupl!=TRUE
ENDIF
IF finupl!
GOTO fin_upl
ENDIF
SEEK #2,0
long%=LOF(#2)
taille_prog%=1536
taille_2%=1536
CLR pos%
REPEAT
'
IF SUB(long%,pos%)<taille_prog%
taille_prog%=SUB(long%,pos%)
ENDIF
'
label1:
BGET #2,lect%,taille_prog%
paquet$=@bloc$(lect%,taille_prog%)
'
label2:
PRINT AT(1,9);"Taille Paquet en cours: ";taille_prog%
PRINT AT(1,10);"D‚j… transf‚r‚: ";pos%
'
envoi(paquet$)
'
buf$=@recoit$
'
IF buf$="?"
SEEK #2,pos%
taille_prog%=MAX(192,DIV(taille_prog%,2))
PRINT AT(1,7);"Erreur de transmission..."
GOTO label1                         ! on recommence car erreur
ENDIF
'
IF buf$="#" OR buf$="#BREAK#"
finupl!=TRUE
ENDIF
'
'    IF buf$="!"
ADD pos%,taille_prog%
taille_prog%=MIN(1536,MUL(taille_prog%,2))
EXIT IF finupl! OR pos%=>long%
PRINT AT(1,7);"Transmission bien r‚alis‚e"
PRINT AT(1,11);"Vitesse:";ROUND(pos%/(TIMER-t1%)*200);" Cps "
'    paquet$=paquet2$
'    GOTO label2                         ! paquet suivant deja calcul‚ ! astuce !
' ENDIF
UNTIL pos%=long% OR finulp!
PRINT #1,"@@!@@"+CHR$(13)+"#"+CHR$(13);
'
fin_upl:
OUT 1,19,77 ! re re tournement du modem selonTranspac
CLOSE #2
RETURN
' ============================ DEBUT TRANSFERT ===============================
> PROCEDURE debut(fichier$)
LOCAL taille$,dat$,niv$,vers$,comp$
taille$=STR$(LOF(#2))
dat$=@dat_bbt$
niv$="666"
vers$="00"
comp$="0"
PRINT AT(1,7);"Envoie Synchro..."
'  PRINT #1,CHR$(13)+"#BREAK#"+CHR$(13)+"#"+CHR$(13);
PRINT #1,CHR$(13)+"@@!@@"+CHR$(13);
PAUSE 10
PRINT AT(1,4);"** Le fichier est: ";fichier$
PRINT "** Taille fichier: ";taille$
PRINT #1,taille$+" "+fichier$+" "+dat$+" "+niv$+" "+vers$+" "+comp$+CHR$(13);
RETURN
' =========================== ENVOI DES DONNES ===============================
> PROCEDURE envoi(p$)
LOCAL a%,l%
PRINT AT(1,7);"** Envoi des donnees...        "
l%=LEN(p$)
CLR a%
REPEAT
INC a%
OUT 1,ASC(MID$(p$,a%,1))
IF (BIOS(11,-1) AND 3)=3
PRINT #1,CHR$(13)+"#BREAK#"+CHR$(13)+"#"+CHR$(13);
PAUSE 20
finupl!=TRUE
GOTO fin_envoi
ENDIF
UNTIL a%=l%
OUT 1,13
fin_envoi:
RETURN
' ========================== CALCUL CRC BLOC =================================
> FUNCTION crc$(bloc$)
LOCAL chek%,ca%,rcrc%,t%
PRINT AT(1,7);"** Calcul checksum paquet...              "
PRINT AT(1,8);"                              "
CLR chek%
FOR ca%=1 TO LEN(bloc$)
chek%=AND(ADD(chek%,ASC(MID$(bloc$,ca%,1))),&HFFFF)
NEXT ca%
crc$=RIGHT$("00000"+HEX$(chek%),4)
RETURN crc$
ENDFUNC
' ========================== CODAGE DU BLOC ==================================
> FUNCTION codage$(lect%,taille_prog%)
LOCAL ca%,paquet$,car1|,car2|,car3|,car4|
PRINT AT(1,7);"** Codage bloc...             ";
FOR ca%=0 TO PRED(taille_prog%) STEP 3
car1|=SHR(AND(BYTE{lect%+ca%},252),2) AND &H3F
car2|=OR(SHL(AND(BYTE{lect%+ca%},3),4),SHR(AND(BYTE{lect%+ca%+1},240),4)) AND &H3F
car3|=OR(SHL(AND(BYTE{lect%+ca%+1},15),2),SHR(AND(BYTE{lect%+ca%+2},192),6)) AND &H3F
car4|=AND(BYTE{lect%+ca%+2},63) AND &H3F
paquet$=paquet$+CHR$(ADD(car1|,32))+CHR$(ADD(car2|,32))+CHR$(ADD(car3|,32))+CHR$(ADD(car4|,32))
NEXT ca%
RETURN paquet$
ENDFUNC
' ========================= Calcul de la date en hexa ========================
> FUNCTION dat_bbt$
j=VAL(LEFT$(DATE$,2))
m=VAL(MID$(DATE$,3,2))
a=VAL(RIGHT$(DATE$,4))
h=VAL(LEFT$(TIME$,2))
m=VAL(MID$(TIME$,3,2))
s=VAL(RIGHT$(TIME$,2))
j=j+h/24+t/1440+s/86400
n=a*365+31*(m1)+j
IF m<=2
a=a-1
ENDIF
n=n+INT(a/4)-INT(a/100)+INT(a-400)
IF m>2
n=n-INT((m-1)*0.4+2.7)
ENDIF
n=n-694325
bbt=n*3600*24-2312755200
RETURN HEX$(bbt)
ENDFUNC
' =================== Pr‚pare Bloc ===========================================
> FUNCTION bloc$(l%,t%)
LOCAL bloc$
bloc$=@codage$(l%,t%)
bloc$=RIGHT$("0000"+STR$(t%),4)+bloc$
bloc$=bloc$+@crc$(bloc$)
RETURN bloc$
ENDFUNC